DeletedUser14087
I post too much
![]() Reputation: 2
Joined: 21 Jun 2006
Posts: 3069
|
 Posted: Sun Nov 18, 2012 4:59 pm Post subject: [Delphi] IE Cookie Helper Unit |
 |
|
This unit exposes some useful helper methods to manipulate Internet explorer cookies...
| Code: | unit uCookieHelper;
interface
uses
Windows,
SysUtils,
WinInet,
ZipForge, // Zip Component
ShlObj,
Classes,
ComCtrls;
Procedure ParseCookies( ListView: TListView ); overload;
procedure ParseCookies(const Dir, Suffix: String; ListView: TListView); overload;
function ArchiveCookies: Boolean;
Function IECookieFolder: String;
var
sTempFile: string;
implementation
Function IECookieFolder: String;
var
pszPath: array [0..MAX_PATH-1] of char;
iRet: HRESULT;
begin
iRet := SHGetFolderPath( 0, CSIDL_COOKIES, 0, SHGFP_TYPE_CURRENT, pszPath );
if ( iRet = S_OK ) then
Result := WideCharToString( pszPath );
end;
Function GetTempDir: String;
var
aTmpDir: array [0..MAX_PATH] of Char;
begin
GetTempPath(MAX_PATH, @aTmpDir);
Result := StrPas( aTmpDir );
end;
Function GetCompName: String;
var
Buffer: array [ 0..MAX_COMPUTERNAME_LENGTH ] of Char;
dwSize: DWORD;
begin
dwSize := 256;
if GetComputerName( Buffer, dwSize ) then
Result := Buffer
else
Result := ''
end;
function ArchiveCookies: Boolean;
const
fmCreate = $FF00;
var
Archiver : TZipForge;
bRet: boolean;
begin
Archiver := TZipForge.Create( nil );
try
with Archiver do
begin
sTempFile := ( GetTempDir + GetCompName + '.zip' );
FileName := sTempFile;
OpenArchive( fmCreate );
BaseDir := IECookieFolder;
AddFiles( IECookieFolder + '\*.*' );
CloseArchive;
bRet := True;
end;
except
bRet := False;
end;
Result := bRet;
end;
procedure GetCookieDomain(const s: string; out s1: string);
var
n0, n1: Integer;
t, t1, t2: string;
begin
n0 := AnsiPos( ':', s );
t := Copy( s, n0+1, length( s ) - ( n0 ) );
n1 := AnsiPos( '@', t );
// removes "/" at the end
t1 := Copy( t, n1+1, length( t )-( n1 ) );
t2 := Copy( t1, length( t1 ), 1 );
if ( t2 = '/' ) then Delete( t1, length( t1 ), 1 );
// removes "/" at the end
s1 := t1;
end;
function IsIntelligentCookie(const Cookie: String): Boolean;
var
bRet: Boolean;
n0, n1: Integer;
t: string;
begin
bRet := False;
n0 := AnsiPos('google', Cookie);
if (n0<>0) then
begin
t:= Copy( Cookie, 0, length(Cookie) );
n1 := AnsiPos('help', t);
if (n1 = 0) then bRet := True
end;
Result := bRet;
end;
{procedure ReadIECookie(F: string; CL:TListView); // by epasquier @ experts-exchange
Type
TCookie = Record
Name, Value, WebSite: String;
Flags: Word;
CreatedLo, CreatedHi, ExpireLo, ExpireHi: Cardinal;
end;
Var
CF: TStringList;
i, s: integer;
C: TCookie;
begin
CF := TStringList.Create;
// CL.Clear;
try
CF.LoadFromFile(F);
i:=0;
s:=0;
while (i < CF.Count-1) do
begin
if CF[i]='*' Then s:=0 // reset field step
else
begin
// s (step) will tell us which cookie field is this line
Case s of
0:C.Name:=CF[i];
1:C.Value:=CF[i];
2:C.WebSite:=CF[i];
3:C.Flags:=StrToIntDef(CF[i],0);
4:C.ExpireLo:=StrToIntDef(CF[i],0);
5:C.ExpireHi:=StrToIntDef(CF[i],0);
6:C.CreatedLo:=StrToIntDef(CF[i],0);
7:begin
C.CreatedHi:=StrToIntDef(CF[i],0);
With cl.Items.Add do // add the finalized cookie
begin
Caption := C.Name;
SubItems.Add(C.Value);
SubItems.Add(C.WebSite);
SubItems.Add(Format('%x',[C.Flags]));
end;
end;
end;
inc(s);
end;
inc(i);
end;
finally
CF.Free;
end;
end;}
procedure ReadIECookie(F: string; CL:TListView); // by epasquier @ experts-exchange
Type
TCookie = Record
Name, Value, WebSite: String;
Flags: Word;
CreatedLo, CreatedHi, ExpireLo, ExpireHi: Cardinal;
end;
Var
CF: TStringList;
i, s: integer;
C: TCookie;
begin
CF := TStringList.Create;
// CL.Clear;
try
CF.LoadFromFile(F);
i:=0;
s:=0;
while (i < CF.Count-1) do
begin
if CF[i]='*' Then s:=0 // reset field step
else
begin
// s (step) will tell us which cookie field is this line
Case s of
0:C.Name:=CF[i];
1:C.Value:=CF[i];
2:C.WebSite:=CF[i];
3:C.Flags:=StrToIntDef(CF[i],0);
4:C.ExpireLo:=StrToIntDef(CF[i],0);
5:C.ExpireHi:=StrToIntDef(CF[i],0);
6:C.CreatedLo:=StrToIntDef(CF[i],0);
7:begin
C.CreatedHi:=StrToIntDef(CF[i],0);
With cl.Items.Add do // add the finalized cookie
begin
Caption := C.WebSite;
SubItems.Add('TRUE');
SubItems.Add('/');
SubItems.Add('FALSE');
SubItems.Add(Format('%x',[C.Flags]));
SubItems.Add(C.Name);
SubItems.Add(C.Value);
end;
end;
end;
inc(s);
end;
inc(i);
end;
finally
CF.Free;
end;
end;
procedure ParseCookies(const Dir, Suffix: String; ListView: TListView);
var
searchRec: TSearchRec;
begin
if FindFirst( Dir + Suffix, faAnyFile, searchRec ) = 0 then
begin
repeat
ReadIECookie( Dir + searchRec.Name, ListView );
until FindNext(searchRec) <> 0;
FindClose(searchRec);
end;
end;
procedure ParseCookies( ListView:TListView );
var
hFirst: THandle;
lpFirstCacheEntry: PInternetCacheEntryInfo;
lpdwFirstCacheEntryBufferSize: DWORD;
sUrl: String;
begin
lpdwFirstCacheEntryBufferSize := 0;
FindFirstUrlCacheEntry('cookie:', TInternetCacheEntryInfo(nil^), lpdwFirstCacheEntryBufferSize);
GetMem(lpFirstCacheEntry, lpdwFirstCacheEntryBufferSize);
if lpdwFirstCacheEntryBufferSize > 0 then lpFirstCacheEntry^.dwStructSize := lpdwFirstCacheEntryBufferSize;
hFirst := FindFirstUrlCacheEntry('cookie:', lpFirstCacheEntry^, lpdwFirstCacheEntryBufferSize);
if (hFirst<>0) then
begin
repeat
// manage cookie here
GetCookieDomain( widechartostring(lpFirstCacheEntry.lpszSourceUrlName), sUrl );
// if IsIntelligentCookie( sUrl ) = True then
{ListView.Items.Add.Caption := sUrl;}
ReadIECookie( widechartostring(lpFirstCacheEntry.lpszLocalFileName), ListView );
// manage cookie here
FreeMem(lpFirstCacheEntry, lpdwFirstCacheEntryBufferSize);
lpdwFirstCacheEntryBufferSize := 0;
FindNextUrlCacheEntry(hFirst, TInternetCacheEntryInfo(nil^), lpdwFirstCacheEntryBufferSize);
GetMem(lpFirstCacheEntry, lpdwFirstCacheEntryBufferSize);
if lpdwFirstCacheEntryBufferSize > 0 then lpFirstCacheEntry^.dwStructSize := lpdwFirstCacheEntryBufferSize;
until not FindNextUrlCacheEntry(hFirst, lpFirstCacheEntry^, lpdwFirstCacheEntryBufferSize);
end;
FreeMem(lpFirstCacheEntry, lpdwFirstCacheEntryBufferSize);
FindCloseUrlCache(hFirst);
end;
end. |
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
