|
Registriert seit: 7. Jan 2003 Ort: Gevelsberg 94 Beiträge Delphi 2006 Enterprise |
#1
Hallo zusammen,
ich bin gerade dabei einen Browser zu schreiben, der den Cache ignoriert (um die Privatsphäre) zu schützen. Man könnte den Cache zwar leeren, aber dann ist alles weg. Nun habe ich eine Unit geschrieben, die eingebunden werden muss. Der Cache wird nun total ignoriert bis auf 2 Merkmale wo ich nicht weiter komme. Es wird noch der Cookie gespeichert und in die besuchten Seiten werden gespeichert. Ich habe alles schon probiert, komme jetzt aber echt nicht mehr weiter. Hier der Sourcecode der Unit:
Delphi-Quellcode:
So wird die Unit eingebunden:
unit uNSPass;
interface uses Windows, SysUtils, UrlMon, ActiveX, Classes, ComObj, Axctrls, ComServ, WinInet, Dialogs; const CLSID_Passthrough: TGUID = '{A8BF46F5-7291-44F8-8DC3-6C1FAEB3C3E0}'; CLSID_HttpProtocol: TGUID = '{79EAC9E2-BAF9-11CE-8C82-00AA004BA90B}'; type TNSPassthrough = class(TComObject, IInternetProtocol, IInternetBindInfo, IInternetProtocolSink) private FDefaultSink: IInternetProtocol; FProtSink: IInternetProtocolSink; FBindInfo: IInternetBindInfo; public procedure Initialize(); override; function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; {IInternetProtocolRoot} function Start(szUrl: LPCWSTR; OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall; function Continue(const ProtocolData: TProtocolData): HResult; stdcall; function Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall; function Terminate(dwOptions: DWORD): HResult; stdcall; function Suspend: HResult; stdcall; function Resume: HResult; stdcall; {IInternetProtocol} function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall; function Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall; function LockRequest(dwOptions: DWORD): HResult; stdcall; function UnlockRequest: HResult; stdcall; {IInternetBindInfo} function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall; function GetBindString(ulStringType: ULONG; wzStr: POLEStrArray; cEl: ULONG; var cElFetched: ULONG): HResult; stdcall; {IInternetProtocolSink} function Switch(const ProtocolData: TProtocolData): HResult; stdcall; function ReportProgress(ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall; function ReportData(grfBSCF: DWORD; ulProgress, ulProgressMax: ULONG): HResult; stdcall; function ReportResult(hrResult: HResult; dwError: DWORD; szResult: LPCWSTR): HResult; stdcall; end; implementation procedure TNSPassthrough.Initialize(); begin inherited; FDefaultSink := nil; end; function TNSPassthrough.ObjQueryInterface(const IID: TGUID; out Obj): HResult; begin Result := inherited ObjQueryInterface(IID, Obj); if (Result = E_NOINTERFACE) and (Assigned(FDefaultSink)) then Result := FDefaultSink.QueryInterface(IID, Obj); end; {IInternetProtocolRoot} function TNSPassthrough.Start(szUrl: LPCWSTR; OIProtSink: IInternetProtocolSink; OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall; begin if (FDefaultSink = nil) then OleCheck(CoCreateInstance(CLSID_HttpProtocol, nil, CLSCTX_INPROC_SERVER, IUnknown, FDefaultSink)); FBindInfo := OIBindInfo; FProtSink := OIProtSink; if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocolRoot).Start(szUrl, Self, Self, grfPI, dwReserved) else Result := E_NOTIMPL; end; function TNSPassthrough.Continue(const ProtocolData: TProtocolData): HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocolRoot).Continue(ProtocolData) else Result := E_NOTIMPL; end; function TNSPassthrough.Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocolRoot).Abort(hrReason, dwOptions) else Result := E_NOTIMPL; end; function TNSPassthrough.Terminate(dwOptions: DWORD): HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocolRoot).Terminate(dwOptions) else Result := E_NOTIMPL; end; function TNSPassthrough.Suspend: HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocolRoot).Suspend() else Result := E_NOTIMPL; end; function TNSPassthrough.Resume: HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocolRoot).Resume() else Result := E_NOTIMPL; end; {IInternetProtocol} function TNSPassthrough.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocol).Read(pv, cb, cbRead) else Result := E_NOTIMPL; end; function TNSPassthrough.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocol).Seek(dlibMove, dwOrigin, libNewPosition) else Result := E_NOTIMPL; end; function TNSPassthrough.LockRequest(dwOptions: DWORD): HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocol).LockRequest(dwOptions) else Result := E_NOTIMPL; end; function TNSPassthrough.UnlockRequest: HResult; stdcall; begin if (Assigned(FDefaultSink)) then Result := (FDefaultSink as IInternetProtocol).UnlockRequest() else Result := E_NOTIMPL; end; {IInternetBindInfo} function TNSPassthrough.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall; begin Result := FBindInfo.GetBindInfo(grfBINDF, bindinfo); //set the flags here grfBINDF := grfBINDF or BINDF_NOWRITECACHE or BINDF_NEEDFILE or BINDF_PRAGMA_NO_CACHE; //-----> hier wird der Cache ignoriert end; function TNSPassthrough.GetBindString(ulStringType: ULONG; wzStr: POLEStrArray; cEl: ULONG; var cElFetched: ULONG): HResult; stdcall; begin Result := FBindInfo.GetBindString(ulStringType, wzStr, cEl, cElFetched); end; {IInternetProtocolSink} function TNSPassthrough.Switch(const ProtocolData: TProtocolData): HResult; stdcall; begin Result := FProtSink.Switch(ProtocolData); end; function TNSPassthrough.ReportProgress(ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall; begin case (ulStatusCode) of BINDSTATUS_COOKIE_SENT, BINDSTATUS_COOKIE_SUPPRESSED, BINDSTATUS_COOKIE_STATE_DOWNGRADE, BINDSTATUS_COOKIE_STATE_UNKNOWN, BINDSTATUS_SESSION_COOKIE_RECEIVED, BINDSTATUS_COOKIE_STATE_ACCEPT, BINDSTATUS_COOKIE_STATE_LEASH, BINDSTATUS_COOKIE_STATE_REJECT, BINDSTATUS_PERSISTENT_COOKIE_RECEIVED: Result := S_FALSE; else Result := FProtSink.ReportProgress(ulStatusCode, szStatusText); end; end; function TNSPassthrough.ReportData(grfBSCF: DWORD; ulProgress, ulProgressMax: ULONG): HResult; stdcall; begin Result := FProtSink.ReportData(grfBSCF, ulProgress, ulProgressMax); end; function TNSPassthrough.ReportResult(hrResult: HResult; dwError: DWORD; szResult: LPCWSTR): HResult; stdcall; begin Result := FProtSink.ReportResult(hrResult, dwError, szResult); end; initialization CoInitialize(nil); OleInitialize(nil); TComObjectFactory.Create(ComServer, TNSPassthrough, CLSID_Passthrough, 'TNSPassthrough', 'TNSPassthrough', ciMultiInstance); finalization CoUninitialize(); OleUninitialize(); end. Im OnCreate Ereignis des Mainforms
Delphi-Quellcode:
procedure TFMain.FormCreate(Sender: TObject);
var VerlaufAnzahl, I: Integer; Hotk, hotk2: longbool; begin CoGetClassObject(CLSID_Passthrough, CLSCTX_SERVER, nil, IClassFactory, Factory); CoInternetGetSession(0, InternetSession, 0); InternetSession.RegisterNameSpace(Factory, CLSID_Passthrough, 'http', 0, nil, 0); InternetSession.RegisterNameSpace(Factory, CLSID_Passthrough, 'https', 0, nil, 0); end; und die Initialisierung am Ende des Mainforms vor "end."
Delphi-Quellcode:
Im Projekt Source müsst Ihr die Unit ComServ einbinden. So sieht mein ProjectSource aus:
initialization
CoInitialize(nil); OleInitialize(nil); finalization CoUninitialize(); OleUninitialize(); end.
Delphi-Quellcode:
program Test; uses Forms, UMain in 'UMain.pas' {FMain}, ComServ; {$R *.res} begin Application.Initialize; ComServer.UIInteractive := False; Application.Title := 'Test'; Application.CreateForm(TFMain, FMain); Application.Run; end. Ich habe versucht die "Function ReportProgress" so zu modifizieren, dass Cookies ignoriert werden...aber kein Erfolg
Delphi-Quellcode:
function TNSPassthrough.ReportProgress(ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
begin case (ulStatusCode) of BINDSTATUS_COOKIE_SENT, BINDSTATUS_COOKIE_SUPPRESSED, BINDSTATUS_COOKIE_STATE_DOWNGRADE, BINDSTATUS_COOKIE_STATE_UNKNOWN, BINDSTATUS_SESSION_COOKIE_RECEIVED, BINDSTATUS_COOKIE_STATE_ACCEPT, BINDSTATUS_COOKIE_STATE_LEASH, BINDSTATUS_COOKIE_STATE_REJECT, BINDSTATUS_PERSISTENT_COOKIE_RECEIVED: Result := S_FALSE; else Result := FProtSink.ReportProgress(ulStatusCode, szStatusText); end; end; Ich hoffe Ihr habt eine Idee....
Dennis van der Vlugt
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |