type
...
TBcFirefoxCookies =
class(TBcHTTPCookies)
protected
procedure SetCookie(
Index: Integer; Value: TBcFirefoxCookie);
function GetCookie(
Index: Integer):TBcFirefoxCookie;
function PrimaryKeyIsUnique(Value: Int64; ExceptItem: Integer):Boolean;
public
function Add:Integer;
procedure LoadFromFile(FileName:
String);
procedure SaveToFile(FileName:
String);
property Cookies[
Index: Integer]: TBcFirefoxCookie
read GetCookie
write SetCookie;
default;
end;
...
{$WARNINGS OFF}
TBcCookie =
class(TPersistent)
private
FName:
String;
FContent:
String;
FDomain:
String;
FPath:
String;
FExpires: TDateTimeEx;
FSecure: LongBool;
FWholeDomain: LongBool;
FLastAccessed: TDateTimeEx;
FCreated: TDateTimeEx;
FFlags: Int64;
FData:
String;
FFileName:
String;
FOwner:
String;
protected
procedure SetLastAccessed(Value: TDateTimeEx);
procedure SetCreated(Value: TDateTimeEx);
procedure SetExpires(Value: TDateTimeEx);
property Secure: LongBool
read FSecure
write FSecure;
property WholeDomain: LongBool
read FWholeDomain
write FWholeDomain;
property LastAccessed: TDateTimeEx
read FLastAccessed
write SetLastAccessed;
property Created: TDateTimeEx
read FCreated
write SetCreated;
property Flags: Int64
read FFlags
write FFlags;
property Name:
String read FName
write FName;
property Content:
String read FContent
write FContent;
property Domain:
String read FDomain
write FDomain;
property Path:
String read FPath
write FPath;
property Expires: TDateTimeEx
read FExpires
write SetExpires;
property Data:
String read FData
write FData;
property FileName:
String read FFileName
write FFileName;
property Owner:
String read FOwner
write FOwner;
public
constructor Create;
destructor Destroy;
procedure Assign(Source: TBcCookie);
procedure AssignTo(Dest: TBcCookie);
end;
{$WARNINGS ON}
TBcHTTPCookie =
class(TBcCookie)
public
function IsBroken:Boolean;
function IsExpired:Boolean;
published
property Name;
property Content;
property Domain;
property Path;
property Expires;
end;
TBcMozillaCookie =
class(TBcHTTPCookie)
published
property Secure;
property WholeDomain;
end;
TBcFirefoxCookie =
class(TBcMozillaCookie)
published
property LastAccessed;
property Created;
end;
...
{ TBcFirefoxCookies }
procedure TBcFirefoxCookies.SetCookie(
Index: Integer; Value: TBcFirefoxCookie);
begin
FCookies[
Index] := Value;
end;
function TBcFirefoxCookies.GetCookie(
Index: Integer):TBcFirefoxCookie;
begin
Result := FCookies[
Index]
as TBcFirefoxCookie;
end;
function TBcFirefoxCookies.Add:Integer;
var
NewCookie: TBcFirefoxCookie;
begin
NewCookie := TBcFirefoxCookie.Create;
Result := FCookies.Add(NewCookie);
end;
function TBcFirefoxCookies.PrimaryKeyIsUnique(Value: Int64; ExceptItem: Integer):Boolean;
var
iCookie: Integer;
begin
Result := True;
for iCookie := 0
to Count -1
do
begin
if (iCookie <> ExceptItem)
and (Cookies[iCookie].Created.AsPRTime = Value)
then
begin
Result := False;
Break;
end;
end;
end;
procedure TBcFirefoxCookies.LoadFromFile(FileName:
string);
var
db: TSQLiteDatabase;
table: TSQLIteTable;
begin
Clear;
db := TSQLiteDatabase.Create(FileName);
try
if db.TableExists('
moz_cookies')
then
begin
table :=
db.GetTable('
SELECT id, name, value, host, path, expiry, isSecure, isHTTPOnly, lastAccessed FROM moz_cookies');
try
while not table.EOF
do
begin
with Cookies[Add]
do
begin
Name := table.FieldAsString(table.FieldIndex['
name']);
Content := table.FieldAsString(table.FieldIndex['
value']);
Domain := table.FieldAsString(table.FieldIndex['
host']);
Path := table.FieldAsString(table.FieldIndex['
path']);
Expires.AsUnixTime(StrToInt64(table.FieldAsString(table.FieldIndex['
expiry'])));
Secure := LongBool(StrToIntDef(table.FieldAsString(table.FieldIndex['
isSecure']), 0));
WholeDomain := LongBool(StrToIntDef(table.FieldAsString(table.FieldIndex['
isHTTPOnly']), 0));
LastAccessed.AsPRTime(StrToInt64(table.FieldAsString(table.FieldIndex['
lastAccessed'])));
Created.AsPRTime(StrToInt64(table.FieldAsString(table.FieldIndex['
id'])));
end;
table.Next;
end;
finally
table.Free;
end;
end;
finally
db.Free;
end;
end;
procedure TBcFirefoxCookies.SaveToFile(FileName:
string);
var
db: TSQLiteDatabase;
iCookie: Integer;
ExpiresStr:
String;
LastAccessedStr:
String;
IsUnique: Boolean;
begin
db := TSQLiteDatabase.Create(FileName);
try
if db.TableExists('
moz_cookies')
then
db.ExecSQL('
DROP TABLE moz_cookies');
db.ExecSQL('
CREATE TABLE moz_cookies (id INTEGER, name TEXT, value TEXT, host TEXT, path TEXT, expiry INTEGER, lastAccessed INTEGER, isSecure INTEGER, isHTTPOnly INTEGER, PRIMARY KEY(id))');
for iCookie := 0
to Count -1
do
begin
//sicherstellen das der Primärschlüssel nur einmal vorkommt
IsUnique := PrimaryKeyIsUnique(Cookies[iCookie].Created.AsPRTime, iCookie);
while not IsUnique
do
begin
Cookies[iCookie].Created.AsPRTime(Cookies[iCookie].Created.AsPRTime + 1000000);
IsUnique := PrimaryKeyIsUnique(Cookies[iCookie].Created.AsPRTime, iCookie);
end;
//sicherstellen das alle anderen Integer-Werte ungleich dem Primärschlüssel sind
LastAccessedStr := IntToStr(Cookies[iCookie].LastAccessed.AsPRTime);
if Cookies[iCookie].Created.AsPRTime = Cookies[iCookie].LastAccessed.AsPRTime
then
LastAccessedStr := IntToStr(Cookies[iCookie].LastAccessed.AsPRTime + 1000000);
ExpiresStr := IntToStr(Cookies[iCookie].Expires.AsUnixTime);
if Cookies[iCookie].Created.AsPRTime = Cookies[iCookie].Expires.AsUnixTime
then
ExpiresStr := IntToStr(Cookies[iCookie].Expires.AsUnixTime + 1000000);
db.ExecSQL('
INSERT INTO moz_cookies (id, name, value, host, path, expiry, lastAccessed, isSecure, isHTTPOnly)' +
'
VALUES ("' + IntToStr(Cookies[iCookie].Created.AsPRTime) + '
", "' +
EscapeSQLStatement(Cookies[iCookie].
Name) + '
", "' +
EscapeSQLStatement(Cookies[iCookie].Content) + '
", "' +
EscapeSQLStatement(Cookies[iCookie].Domain) + '
", "' +
EscapeSQLStatement(Cookies[iCookie].Path) + '
", "' +
ExpiresStr + '
", "' +
LastAccessedStr + '
", "' +
IntToStr(LongBoolToInt(Cookies[iCookie].Secure)) + '
", "' +
IntToStr(LongBoolToInt(Cookies[iCookie].WholeDomain)) + '
")');
end;
finally
db.Free;
end;
end;