Reading and writing Opera cookies

That indeed sounds like a great thing! I'll gladly wait a day or two ;)
Especially since the Opera cache file should be the same format, and the way you describe it, it should be easy to adjust your classes to work with that file as well.
Will play around with Mozilla's mork format for a while then, that should take me at least a day as well *g*

As promised, I am including the source for the reading AND writing to the opera cookie file. I am also including a sample project that you can easily test with (create a new project in delphi, then copy code from here, and paste over the code for unit1. Don't worry about having to add controls, as my example builds it all at run time).

I included the project so you would have a feel for how to iterate the data contained within the cookie file. In a nutshell, after you create a TO4CookieRoot object (passing it a filename or stream), you have acess to the top level domain objects. Each domain (TO4Domain) object exposes a name, optional flags, a list of cookies (each cookie exposes 17 pieces of info), a list of paths, and a list of sub-domains. So to access all the info means walking the "tree" of domains. The classes are also set up so that you can free any child object without worrying about the parent object "messing up".

In regards to the cache file..... while the data is stored in similar fashion as the cookie, it does contain different tags and the heirarchy is not quite the same, so you will have to create your own reader/writer class for this. The up side though is:

1.) The TO4Stream class has methods for reading/writing the most common data types.
2.) You have fully working classes to base your work from. (Easier than doing it from scratch).
3.) I added utility routines to handle Big Endian/Little Endian conversions as well as the GMT (LongWord) <-> Local TDateTime conversions.

Based off the current code, you should have little difficulty creating a class to handle the cache file. (In the event that you do have a problem, I'm sure that I could help you out.).

Also, check this site out, it was a big help for me:

http://users.westelcom.com/jsegur/O4FE.HTM#TS1


Regards,
Russell


---------- o4cookie.pas ----------

unit o4cookie;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit           :  o4cookie.pas
//   Description    :  Cookie handling functionality for Opera version 4 cookies.
//                     Classes provide means for bi-directional streaming of the
//                     cookie data, as well as exposing all data as class objects.
//
//   Class Tree     :  TO4Stream (Base class for reading and writing cookie data)
//                     |__ TO4Domains (Inherited class for domain list handling)
//                     |   |__ TO4Domain (Inherited class to expose a single domain)
//                     |   |__ TO4CookieRoot (Inherited class that is the top level container)
//                     |__ TO4Cookie (Inherited class to expose a single cookie)
//
//                     In regards to usage, a TO4CookieRoot should be the only
//                     class directly created, as this class exposes the root
//                     domains, which themselves expose sub-domains, cookies, paths
//                     etc.
//
//   References     :  While this site did not provide any source code (other
//                     than constant values) to go from, it did provide valuable
//                     technical information in regards to the parsing of the
//                     cookies4.dat file.
//
//                     http://users.westelcom.com/jsegur/O4FE.HTM#TS1
//
//                     Opera's Technical documentation can be found at:
//                     http://www.opera.com/docs/fileformats
//
//   GMT Handling   :  The TO4Cookie exposes dates using the LongWord value
//                     which is the GMT from 1/1/1970. I added 2 utility
//                     routines that will convert the LongWord values to
//                     the a TDateTime (local date/time), and vica-versa.
//
////////////////////////////////////////////////////////////////////////////////
interface

uses
  Windows, SysUtils, Classes, contnrs;

////////////////////////////////////////////////////////////////////////////////
//   To enable trace debugging, remove the comment from the define below. If
//   TRACE is defined, the Event Log will display the TAG codes that have been
//   parsed from the cookie file/stream.
////////////////////////////////////////////////////////////////////////////////
//   {$DEFINE TRACE}
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
//   Opera 4 cookie version constants
////////////////////////////////////////////////////////////////////////////////
const
  O4_VER_FILE          =  $00001000;
  O4_VER_APP           =  $00002000;

////////////////////////////////////////////////////////////////////////////////
//   Opera 4 cookie header
////////////////////////////////////////////////////////////////////////////////
type
  TO4CookieHeader      =  packed record
     dwFileVer:        LongWord;
     dwAppVer:         LongWord;
     wTagSize:         Word;
     wRecSize:         Word;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Opera 4 tag headers
////////////////////////////////////////////////////////////////////////////////
type
  TO4TagHeader         =  packed record
     cbTagID:          Byte;
     wLength:          Word;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Opera 4 valid cookie header (Little Endian)
////////////////////////////////////////////////////////////////////////////////
const
  O4CookieHeader:       TO4CookieHeader  = (dwFileVer:  O4_VER_FILE;
                                            dwAppVer:   O4_VER_APP;
                                            wTagSize:   1;
                                            wRecSize:   2);

////////////////////////////////////////////////////////////////////////////////
// Opera 4 cookie domain tag id constants
////////////////////////////////////////////////////////////////////////////////
const
  // Domain start tag
  O4_ID_DMN            =  $01;

  // Domain element name (string).
  O4_ID_DMN_NAME       =  $1E;

  // Cookie server accept flags. Content is a numerical value:
  // 1 = Accept all from domain.
  // 2 = Refuse all from domain.
  // 3 = Accept all from server.
  // 4 = Refuse all from server.
  O4_ID_DMN_FILTER     =  $1F;

  // Cookie with path not matching:
  // 1 = Refuse.
  // 2 = Accept automatically.
  O4_ID_DMN_MATCH      =  $21;

  // Third party cookie handling:
  // 1 = Accept all from domain.
  // 2 = Refuse all from domain.
  // 3 = Accept all from server.
  // 4 = Refuse all from server.
  O4_ID_DMN_ACCEPT     =  $25;

  // End of domain flag
  O4_ID_DMN_END        =  $84;

////////////////////////////////////////////////////////////////////////////////
// Opera 4 cookie path tag id constants
////////////////////////////////////////////////////////////////////////////////
const
  // Path start tag
  O4_ID_PATH           =  $02;

  // Path element name (string).
  O4_ID_PATH_NAME      =  $1D;

  // End of path flag
  O4_ID_PATH_END       =  $85;

////////////////////////////////////////////////////////////////////////////////
// Opera 4 cookie tag id constants
////////////////////////////////////////////////////////////////////////////////
const
  // Cookie start tag
  O4_ID_COOKIE         =  $03;

  // Cookie name (string)
  O4_ID_COOKIE_NAME    =  $10;

  // Cookie value (string)
  O4_ID_COOKIE_VALUE   =  $11;

  // Cookie expires (time)
  O4_ID_COOKIE_EXPIRES =  $12;

  // Cookie last used (time)
  O4_ID_COOKIE_USED    =  $13;

  // Cookie2 comment (string)
  O4_ID_COOKIE_DESC    =  $14;

  // Cookie2 Comment URL (string)
  O4_ID_COOKIE_DESCURL =  $15;

  // Cookie2 Received Domain (string)
  O4_ID_COOKIE_RXDMN   =  $16;

  // Cookie2 Received Path (string)
  O4_ID_COOKIE_RXPATH  =  $17;

  // Cookie2 Portlist (string)
  O4_ID_COOKIE_PORT    =  $18;

  // Cookie secure flag (true if present)
  O4_ID_COOKIE_SECURE  =  $99;

  // Cookie Version (unsigned numerical)
  O4_ID_COOKIE_VER     =  $1A;

  // Cookie sent back to server that sent it (true if present)
  O4_ID_COOKIE_SERVER  =  $9B;

  // Cookie protected flag   (true if present)
  O4_ID_COOKIE_PROTECT =  $9C;

  // Cookie Path prefix flag (true if present)
  O4_ID_COOKIE_PREFIX  =  $A0;

  // Cookie Password Flag (true if present)
  O4_ID_COOKIE_PWD     =  $A2;

  // Cookie Authenticate Flag (true if present)
  O4_ID_COOKIE_AUTH    =  $A3;

  // Cookie Third party flag (true if present)
  O4_ID_COOKIE_3RD     =  $A4;

////////////////////////////////////////////////////////////////////////////////
// Opera 4 cookie data structures
////////////////////////////////////////////////////////////////////////////////
type
  // Forward class definitions
  TO4Domain         =  class;
  TO4Cookie         =  class;

  // Stream reader and writer (inherited by all classes)
  TO4Stream         =  class(TObject)
  protected
     procedure      WriteHeader(Stream: TStream; TagID: Byte; Length: Word);
     procedure      WriteString(Stream: TStream; TagID: Byte; Value: String);
     procedure      WriteLong(Stream: TStream; TagID: Byte; Value: LongWord);
     procedure      WriteByte(Stream: TStream; TagID: Byte; Value: Byte);
     procedure      WriteFlag(Stream: TStream; TagID: Byte; Value: Boolean);
     function       ReadString(Stream: TStream): String;
     function       ReadLong(Stream: TStream): LongWord;
     function       ReadByte(Stream: TStream): Byte;
  public
     constructor    Create;
     destructor     Destroy; override;
  end;

  // Domains Owner class
  TO4Domains        =  class(TO4Stream)
  private
     FDomains:      TObjectList;
  protected
     procedure      DomainRemove(Domain: TO4Domain);
     function       GetDomainCount: Integer;
     function       GetDomains(Index: Integer): TO4Domain;
  public
     constructor    Create;
     destructor     Destroy; override;
     function       AddDomain: TO4Domain;
     procedure      DeleteDomain(Index: Integer);
     property       DomainCount: Integer read GetDomainCount;
     property       Domains[Index: Integer]: TO4Domain read GetDomains;
  end;

  // Domain Class
  TO4Domain         =  class(TO4Domains)
  private
     // Private declarations
     FName:         String;
     FFilter:       Byte;
     FMatch:        Byte;
     FAccept:       Byte;
     FPaths:        TStringList;
     FCookies:      TObjectList;
  protected
     // Protected declarations
     FOwner:        TO4Domains;
     procedure      Load(Stream: TStream);
     procedure      Save(Stream: TStream);
     function       GetSize: Word;
     function       GetPathSize(Index: Integer): Word;
     function       GetCookieCount: Integer;
     function       GetCookie(Index: Integer): TO4Cookie;
     procedure      SetPaths(Value: TStringList);
     procedure      CookieRemove(Cookie: TO4Cookie);
  public
     // Public declarations
     constructor    Create(Owner: TO4Domains);
     destructor     Destroy; override;
     property       CookieCount: Integer read GetCookieCount;
     property       Cookies[Index: Integer]: TO4Cookie read GetCookie;
     property       Paths: TStringList read FPaths write SetPaths;
     property       Name: String read FName write FName;
     property       FilterType: Byte read FFilter write FFilter;
     property       MatchType: Byte read FMatch write FMatch;
     property       AcceptType: Byte read FAccept write FAccept;
     property       Size: Word read GetSize;
     function       AddCookie: TO4Cookie;
     procedure      DeleteCookie(Index: Integer);
     function       DomainPath: String;
  end;

  // Cookie Class
  TO4Cookie         =  class(TO4Stream)
  private
     // Private declarations
     FName:         String;
     FValue:        String;
     FComment:      String;
     FCommentURL:   String;
     FRecvDomain:   String;
     FRecvPath:     String;
     FPortList:     String;
     FVersion:      Byte;
     FAuthenticate: Boolean;
     FServer:       Boolean;
     FSecure:       Boolean;
     FProtected:    Boolean;
     F3rdParty:     Boolean;
     FPassword:     Boolean;
     FPrefixed:     Boolean;
     FExpires:      LongWord;
     FLastUsed:     LongWord;
  protected
     // Protected declarations
     FOwner:        TO4Domain;
     function       GetSize: Word;
     procedure      Save(Stream: TStream);
     procedure      Load(Stream: TStream);
  public
     // Public declarations
     constructor    Create(Owner: TO4Domain);
     destructor     Destroy; override;
     property       Domain: TO4Domain read FOwner;
     property       Name: String read FName write FName;
     property       Comment: String read FComment write FComment;
     property       CommentURL: String read FCommentURL write FCommentURL;
     property       Value: String read FValue write FValue;
     property       Expires: LongWord read FExpires write FExpires;
     property       LastUsed: LongWord read FLastUsed write FLastUsed;
     property       PortList: String read FPortList write FPortList;
     property       RecvDomain: String read FRecvDomain write FRecvDomain;
     property       RecvPath: String read FRecvPath write FRecvPath;
     property       IsSecure: Boolean read FSecure write FSecure;
     property       IsServerSendback: Boolean read FServer write FServer;
     property       IsProtected: Boolean read FProtected write FProtected;
     property       IsPrefixed: Boolean read FPrefixed write FPrefixed;
     property       Is3rdParty: Boolean read F3rdParty write F3rdParty;
     property       HasAuthenticate: Boolean read FAuthenticate write FAuthenticate;
     property       HasPassword: Boolean read FPassword write FPassword;
     property       Version: Byte read FVersion write FVersion;
     property       Size: Word read GetSize;
  end;

  // Cookie Root Class
  TO4CookieRoot     =  class(TO4Domains)
  private
     // Private declarations
     function       LoadHeader(Stream: TStream): Boolean;
  protected
     // Protected declarations
     procedure      Save(Stream: TStream);
     procedure      Load(Stream: TStream);
  public
     constructor    Create(FileName: String); overload;
     constructor    Create(Stream: TStream); overload;
     procedure      SaveToFile(FileName: String);
     procedure      SaveToStream(Stream: TStream);
     destructor     Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Utility functions
////////////////////////////////////////////////////////////////////////////////
procedure  SwapEndian(Value: Pointer; Size: Cardinal);
function   GmtToDateTime(Value: LongWord): TDateTime;
function   DateTimeToGmt(Value: TDateTime): LongWord;
function   GMTBias: Integer;

implementation

// Cookie class
procedure TO4Cookie.Save(Stream: TStream);
begin

  // First we write the cookie header
  WriteHeader(Stream, O4_ID_COOKIE, GetSize);

  // Next we write out the cookie properties (there is no cookie terminator)
  WriteString(Stream, O4_ID_COOKIE_NAME, FName);
  WriteString(Stream, O4_ID_COOKIE_VALUE, FValue);
  WriteLong(Stream, O4_ID_COOKIE_EXPIRES, FExpires);
  WriteLong(Stream, O4_ID_COOKIE_USED, FLastUsed);
  WriteString(Stream, O4_ID_COOKIE_DESC, FComment);
  WriteString(Stream, O4_ID_COOKIE_DESCURL, FCommentURL);
  WriteString(Stream, O4_ID_COOKIE_RXDMN, FRecvDomain);
  WriteString(Stream, O4_ID_COOKIE_RXPATH, FRecvPath);
  WriteString(Stream, O4_ID_COOKIE_PORT, FPortList);
  WriteByte(Stream, O4_ID_COOKIE_VER, FVersion);
  WriteFlag(Stream, O4_ID_COOKIE_SECURE, FSecure);
  WriteFlag(Stream, O4_ID_COOKIE_SERVER, FServer);
  WriteFlag(Stream, O4_ID_COOKIE_PROTECT, FProtected);
  WriteFlag(Stream, O4_ID_COOKIE_PREFIX, FPrefixed);
  WriteFlag(Stream, O4_ID_COOKIE_PWD, FPassword);
  WriteFlag(Stream, O4_ID_COOKIE_AUTH, FAuthenticate);
  WriteFlag(Stream, O4_ID_COOKIE_3RD, F3rdParty);

end;

procedure TO4Cookie.Load(Stream: TStream);
var  wTagLen:    Word;
     cbTagID:    Byte;
begin

  // Load the cookie tag size
  if (Stream.Read(wTagLen, 2) = 2) then
  begin
     // Tag indicates how many bytes we should read. We don't go by this,
     // because then we lose context of who the record belongs to
     SwapEndian(@wTagLen, 2);
     // Keep reading tags in
     while (Stream.Read(cbTagID, 1) = 1) do
     begin
        {$IFDEF TRACE}
        OutputDebugString(PChar(Format('Code: %x', [cbTagID])));
        {$ENDIF}
        // Handle the tag
        case cbTagID of
           // Another cookie
           O4_ID_COOKIE         :
           begin
              {$IFDEF TRACE}
              OutputDebugString('Repeat Code');
              {$ENDIF}
              // Break out here for the following reason. If we didn't, and for
              // example, there are 100 cookies in the domain, then the cookie
              // routine would recurse 100 levels down, hit a domain/path start
              // or terminator, and then have to recurse back up 100 levels.
              Stream.Seek((-1), soFromCurrent);
              break;
           end;
           // Cookie name
           O4_ID_COOKIE_NAME    :  FName:=ReadString(Stream);
           // Cookie value
           O4_ID_COOKIE_VALUE   :  FValue:=ReadString(Stream);
           // Cookie expires
           O4_ID_COOKIE_EXPIRES :  FExpires:=ReadLong(Stream);
           // Cookie last used
           O4_ID_COOKIE_USED    :  FLastUsed:=ReadLong(Stream);
           // Cookie2 comment
           O4_ID_COOKIE_DESC    :  FComment:=ReadString(Stream);
           // Cookie2 Comment URL
           O4_ID_COOKIE_DESCURL :  FCommentURL:=ReadString(Stream);
           // Cookie2 Received Domain
           O4_ID_COOKIE_RXDMN   :  FRecvDomain:=ReadString(Stream);
           // Cookie2 Received Path
           O4_ID_COOKIE_RXPATH  :  FRecvPath:=ReadString(Stream);
           // Cookie2 Portlist
           O4_ID_COOKIE_PORT    :  FPortList:=ReadString(Stream);
           // Cookie secure flag
           O4_ID_COOKIE_SECURE  :  FSecure:=True;
           // Cookie Version
           O4_ID_COOKIE_VER     :  FVersion:=ReadByte(Stream);
           // Cookie sent back to server that sent it
           O4_ID_COOKIE_SERVER  :  FServer:=True;
           // Cookie protected flag
           O4_ID_COOKIE_PROTECT :  FProtected:=True;
           // Cookie Path prefix flag
           O4_ID_COOKIE_PREFIX  :  FPrefixed:=True;
           // Cookie Password Flag
           O4_ID_COOKIE_PWD     :  FPassword:=True;
           // Cookie Authenticate Flag
           O4_ID_COOKIE_AUTH    :  FAuthenticate:=True;
           // Cookie Third party flag
           O4_ID_COOKIE_3RD     :  F3rdParty:=True;
        else
           {$IFDEF TRACE}
           OutputDebugString('Repeat Code');
           {$ENDIF}
           // Back up one
           Stream.Seek((-1), soFromCurrent);
           // Break
           break;
        end;
     end;
  end;

end;

function TO4Cookie.GetSize: Word;
begin

  // Calculate the size of the cookie data. This number is used when writing
  // the cookie start tag id.
  result:=0;

  // Check strings
  if (Length(FName) > 0) then Inc(result, 3+Length(FName));
  if (Length(FValue) > 0) then Inc(result, 3+Length(FValue));
  if (Length(FComment) > 0) then Inc(result, 3+Length(FComment));
  if (Length(FCommentURL) > 0) then Inc(result, 3+Length(FCommentURL));
  if (Length(FRecvDomain) > 0) then Inc(result, 3+Length(FRecvDomain));
  if (Length(FRecvPath) > 0) then Inc(result, 3+Length(FRecvPath));
  if (Length(FPortList) > 0) then Inc(result, 3+Length(FPortList));

  // Always write times
  Inc(result, 3+SizeOf(FExpires));
  Inc(result, 3+SizeOf(FLastUsed));

  // Byte value
  if (FVersion > 0) then Inc(result, 3+SizeOf(FVersion));

  // Flags only
  if FSecure then Inc(result, 1);
  if FServer then Inc(result, 1);
  if FProtected then Inc(result, 1);
  if FPrefixed then Inc(result, 1);
  if FPassword then Inc(result, 1);
  if FAuthenticate then Inc(result, 1);
  if F3rdParty then Inc(result, 1);

end;

constructor TO4Cookie.Create(Owner: TO4Domain);
begin

  // Perform inherited
  inherited Create;

  // Set starting defaults
  FOwner:=Owner;
  FName:='';
  FValue:='';
  FComment:='';
  FCommentURL:='';
  FRecvDomain:='';
  FRecvPath:='';
  FPortList:='';
  FVersion:=0;
  FAuthenticate:=False;
  FServer:=False;
  FSecure:=False;
  FProtected:=False;
  F3rdParty:=False;
  FPassword:=False;
  FPrefixed:=False;
  FExpires:=0;
  FLastUsed:=0;

end;

destructor TO4Cookie.Destroy;
begin

  // If owner is assigned then we need to notify the owner list
  // so that we can be removed from it
  if Assigned(FOwner) then FOwner.CookieRemove(Self);

  // Perform inherited
  inherited Destroy;

end;

// Domain Class
procedure TO4Domain.Load(Stream: TStream);
var  wTagLen:    Word;
     cbTagID:    Byte;
begin

  // Load the domain tag size
  if (Stream.Read(wTagLen, 2) = 2) then
  begin
     // Tag indicates how many bytes we should read. We don't go by this,
     // because then we lose context of who the record belongs to. For example,
     // there may be sub-domains, cookies, etc below this domain. Due to this,
     // we can't really break when we have read the content bytes of the domain.
     SwapEndian(@wTagLen, 2);
     // Keep reading tags in
     while (Stream.Read(cbTagID, 1) = 1) do
     begin
        {$IFDEF TRACE}
        OutputDebugString(PChar(Format('Code: %x', [cbTagID])));
        {$ENDIF}
        // Handle the tag
        case cbTagID of
           // Sub-domain
           O4_ID_DMN            :  AddDomain.Load(Stream);
           // Domain name string
           O4_ID_DMN_NAME       :  FName:=ReadString(Stream);
           // Domain filter value
           O4_ID_DMN_FILTER     :  FFilter:=ReadByte(Stream);
           // Domain match value
           O4_ID_DMN_MATCH      :  FMatch:=ReadByte(Stream);
           // Domain accept value
           O4_ID_DMN_ACCEPT     :  FAccept:=ReadByte(Stream);
           // End of domain record
           O4_ID_DMN_END        :  break;
           // Start of path
           O4_ID_PATH           :  ;
           // Path name string
           O4_ID_PATH_NAME      :  FPaths.Add(ReadString(Stream));
           // Path end
           O4_ID_PATH_END       :  ;
           // Cookie
           O4_ID_COOKIE         :  AddCookie.Load(Stream);
        else
           // We are done parsing
           Stream.Seek(0, soFromEnd);
        end;
     end;
  end;

end;

function TO4Domain.GetPathSize(Index: Integer): Word;
begin

  // Calculate the size of the path data. This number is used when
  // writing the path start id tag
  if (Index < 0) or (Index >= FPaths.Count) then
     result:=0
  else
     result:=3+Length(FPaths[Index]);

end;

function TO4Domain.GetSize: Word;
begin

  // Calculate the size of the domain data. This number is used when
  // writing the domain start id tag
  result:=0;

  // Check strings
  if (Length(FName) > 0) then Inc(result, 3+Length(FName));

  // Byte values (if set)
  if (FFilter > 0) then Inc(result, 3+SizeOf(FFilter));
  if (FMatch > 0) then Inc(result, 3+SizeOf(FMatch));
  if (FAccept > 0) then Inc(result, 3+SizeOf(FAccept));

end;

procedure TO4Domain.Save(Stream: TStream);
var  dwCount:    Integer;
begin

  // First we write the domain header
  WriteHeader(Stream, O4_ID_DMN, GetSize);

  // Next we write the domain properties
  WriteString(Stream, O4_ID_DMN_NAME, FName);
  WriteByte(Stream, O4_ID_DMN_FILTER, FFilter);
  WriteByte(Stream, O4_ID_DMN_MATCH, FMatch);
  WriteByte(Stream, O4_ID_DMN_ACCEPT, FAccept);

  // Next we need to write out the cookies for the domain
  for dwCount:=0 to Pred(CookieCount) do Cookies[dwCount].Save(Stream);

  // Next we write out any paths we might have
  for dwCount:=0 to Pred(FPaths.Count) do
  begin
     // Write the path header
     WriteHeader(Stream, O4_ID_PATH, GetPathSize(dwCount));
     // Write the path name
     WriteString(Stream, O4_ID_PATH_NAME, FPaths[dwCount]);
     // Terminate the path
     WriteFlag(Stream, O4_ID_PATH_END, True);
  end;

  // We need to write a final path terminator
  WriteFlag(Stream, O4_ID_PATH_END, True);

  // Next we let the sub-domains persist to the stream
  for dwCount:=0 to Pred(DomainCount) do Domains[dwCount].Save(Stream);

  // Last step is to write the domain terminator
  WriteFlag(Stream, O4_ID_DMN_END, True);

end;

function TO4Domain.DomainPath: String;
var  o4Domains:  TO4Domains;
begin

  // Walk up from the current domain and build the domain path
  // in the format of domain.parent.etc..
  result:=FName;

  // Walk up the owner chain
  o4Domains:=FOwner;
  while Assigned(o4Domains) and (o4Domains is TO4Domain) do
  begin
     // Add owner (domain) name to chain
     result:=result+'.'+TO4Domain(o4Domains).Name;
     // Set owner item to iterate
     o4Domains:=TO4Domain(o4Domains).FOwner;
  end;

end;

procedure TO4Domain.CookieRemove(Cookie: TO4Cookie);
begin

  // We are being called because the client has a reference to a Cookie class
  // object and is calling free (the FOwner is assigned). Remove the object from
  // our list to avoid stale pointers
  FCookies.Extract(Cookie);

end;

function TO4Domain.GetCookieCount: Integer;
begin

  // Return the count of cookies
  result:=FCookies.Count;

end;

function TO4Domain.GetCookie(Index: Integer): TO4Cookie;
begin

  // Return the cookie at the specified index
  result:=TO4Cookie(FCookies[Index]);

end;

procedure TO4Domain.SetPaths(Value: TStringList);
begin

  // Assign the strings to our strings
  if Assigned(Value) then
     FPaths.Assign(Value)
  else
     FPaths.Clear;

end;

function TO4Domain.AddCookie: TO4Cookie;
begin

  // Create and add a new cookie to the list
  result:=TO4Cookie.Create(Self);
  FCookies.Add(result);

end;

procedure TO4Domain.DeleteCookie(Index: Integer);
begin

  // Remove the cookie owner to prevent callback
  TO4Cookie(FCookies[Index]).FOwner:=nil;

  // Free the object from our list
  FCookies.Delete(Index);

end;

constructor TO4Domain.Create(Owner: TO4Domains);
begin

  // Perform inherited
  inherited Create;

  // Set starting values
  FPaths:=TStringList.Create;
  FPaths.Sorted:=True;
  FPaths.Duplicates:=dupIgnore;
  FCookies:=TObjectList.Create;
  FCookies.OwnsObjects:=True;
  FOwner:=Owner;
  FName:='';
  FFilter:=0;
  FMatch:=0;
  FAccept:=0;

end;

destructor TO4Domain.Destroy;
var  dwCount:    Integer;
begin

  // Free the paths list
  FPaths.Free;

  // If owner is assigned then we need to notify the owner list
  // so that we can be removed from it
  if Assigned(FOwner) then FOwner.DomainRemove(Self);

  // Clear the owner for all the cookies
  for dwCount:=0 to Pred(FCookies.Count) do TO4Cookie(FCookies[dwCount]).FOwner:=nil;

  // Free the cookies list
  FCookies.Free;

  // Perform inherited
  inherited Destroy;

end;

// Domains Class
function TO4Domains.AddDomain: TO4Domain;
begin

  // Create and add a new domain to the list
  result:=TO4Domain.Create(Self);
  FDomains.Add(result);

end;

procedure TO4Domains.DeleteDomain(Index: Integer);
begin

  // Remove the domain owner to prevent callback
  TO4Domain(FDomains[Index]).FOwner:=nil;

  // Free the object from our list
  FDomains.Delete(Index);

end;

procedure TO4Domains.DomainRemove(Domain: TO4Domain);
begin

  // We are being called because the client has a reference to a Domain class
  // object and is calling free (the FOwner is assigned). Remove the object from
  // our list to avoid stale pointers
  FDomains.Extract(Domain);

end;

function TO4Domains.GetDomainCount: Integer;
begin

  // Return the count of domains
  result:=FDomains.Count;

end;

function TO4Domains.GetDomains(Index: Integer): TO4Domain;
begin

  // Return the indexed domain
  result:=TO4Domain(FDomains[Index]);

end;

constructor TO4Domains.Create;
begin

  // Perform inherited
  inherited Create;

  // Create object list
  FDomains:=TObjectList.Create;

  // Object list owns the domains. We do have coding to handle cases where the
  // client calls free on our objects though.
  FDomains.OwnsObjects:=True;

end;

destructor TO4Domains.Destroy;
var  dwCount:    Integer;
begin

  // Clear the owner for all the domains so they don't call back on us
  for dwCount:=0 to Pred(FDomains.Count) do TO4Domain(FDomains[dwCount]).FOwner:=nil;

  // Free the object list
  FDomains.Free;

  // Perform inherited
  inherited Destroy;

end;

// Cookie Root Class
procedure TO4CookieRoot.Save(Stream: TStream);
var  o4Header:   TO4CookieHeader;
     dwCount:    Integer;
begin

  // Copy the const header over
  Move(O4CookieHeader, o4Header, SizeOf(TO4CookieHeader));

  // Swap bytes from little endian to big endian
  SwapEndian(@o4Header.dwFileVer, SizeOf(LongWord));
  SwapEndian(@o4Header.dwAppVer, SizeOf(LongWord));
  SwapEndian(@o4Header.wTagSize, SizeOf(Word));
  SwapEndian(@o4Header.wRecSize, SizeOf(Word));

  // Save the header first
  Stream.Write(o4Header, SizeOf(TO4CookieHeader));

  // Iterate the domains and let each one save itself to the stream
  for dwCount:=0 to Pred(DomainCount) do Domains[dwCount].Save(Stream);

  // Write the final end of domain to back out of tree altogether
  WriteFlag(Stream, O4_ID_DMN_END, True);

end;

procedure TO4CookieRoot.SaveToFile(FileName: String);
var  Stream:     TStream;
begin

  // Create the file stream on a new file
  Stream:=TFileStream.Create(FileName, fmCreate);
  try
     // Call save
     Save(Stream);
  finally
     // Free the stream
     Stream.Free;
  end;

end;

procedure TO4CookieRoot.SaveToStream(Stream: TStream);
begin

  // Call the save
  Save(Stream);

end;

function TO4CookieRoot.LoadHeader(Stream: TStream): Boolean;
var  o4Header:   TO4CookieHeader;
begin

  // Make sure we read the header in and validate the fields
  if (Stream.Read(o4Header, SizeOf(TO4CookieHeader)) = SizeOf(TO4CookieHeader)) then
  begin
     // Swap bytes from big endian to little endian
     SwapEndian(@o4Header.dwFileVer, SizeOf(LongWord));
     SwapEndian(@o4Header.dwAppVer, SizeOf(LongWord));
     SwapEndian(@o4Header.wTagSize, SizeOf(Word));
     SwapEndian(@o4Header.wRecSize, SizeOf(Word));
     // Validate the header
     result:=CompareMem(@o4Header, @O4CookieHeader, SizeOf(TO4CookieHeader));
  end
  else
     // Failed to read the amount of data
     result:=False;

end;

procedure TO4CookieRoot.Load(Stream: TStream);
var  cbTagID:    Byte;
begin

  // Start by reading the header in
  if LoadHeader(Stream) then
  begin
     // Start reading in the root level domain records.
     while (Stream.Read(cbTagID, 1) = 1) do
     begin
        {$IFDEF TRACE}
        OutputDebugString(PChar(Format('Code: %x', [cbTagID])));
        {$ENDIF}
        // Handle the record
        if (cbTagID = O4_ID_DMN) then
           AddDomain.Load(Stream)
        else
           // Failure - can only be a domain record at this level
           break;
     end;
  end;

end;

constructor TO4CookieRoot.Create(FileName: String);
var  strmCookie: TFileStream;
begin

  // Perform inherited
  inherited Create;

  // Resource protection
  strmCookie:=nil;
  try
     // Create file stream to load the cookies4.dat file
     strmCookie:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
     // Load the stream
     Load(strmCookie);
  finally
     // Free the file stream
     strmCookie.Free;
  end;

end;

constructor TO4CookieRoot.Create(Stream: TStream);
begin

  // Perform inherited
  inherited Create;

  // Make sure stream position is reset
  Stream.Seek(0, soFromBeginning);

  // Load the stream
  Load(Stream);

end;

destructor TO4CookieRoot.Destroy;
begin

  // Perform inherited
  inherited Destroy;

end;

// Stream class
function TO4Stream.ReadLong(Stream: TStream): LongWord;
var  wIntLen:   Word;
begin

  // Set default
  result:=0;

  // Read the length field value
  if (Stream.Read(wIntLen, 2) = 2) then
  begin
     // Swap bytes
     SwapEndian(@wIntLen, 2);
     // Read single byte
     if not(Stream.Read(result, 4) = 4) then
     begin
        // Failure
        Stream.Seek(0, soFromEnd);
        result:=0;
     end
     else
        // Swap to little endian
        SwapEndian(@result, 4)
  end
  else
     // Failure
     Stream.Seek(0, soFromEnd);

end;

function TO4Stream.ReadString(Stream: TStream): String;
var  wStrLen:    Word;
     lpszStr:    PChar;
begin

  // Set default
  result:='';

  // Read a string value from the stream
  if (Stream.Read(wStrLen, 2) = 2) then
  begin
     // Swap bytes
     SwapEndian(@wStrLen, 2);
     // Allocate string to read in
     lpszStr:=AllocMem(Succ(wStrLen));
     if (Stream.Read(lpszStr^, wStrLen) = wStrLen) then
        // Return string value
        result:=lpszStr
     else
        // Failed to read in required size
        Stream.Seek(0, soFromEnd);
     // Free allocated memory
     FreeMem(lpszStr);
  end
  else
     // Failure
     Stream.Seek(0, soFromEnd);

end;

function TO4Stream.ReadByte(Stream: TStream): Byte;
var  wByteLen:   Word;
begin

  // Set default
  result:=0;

  // Read the length field value
  if (Stream.Read(wByteLen, 2) = 2) then
  begin
     // Swap bytes
     SwapEndian(@wByteLen, 2);
     // Read single byte
     if not(Stream.Read(result, 1) = 1) then
     begin
        // Failure
        Stream.Seek(0, soFromEnd);
        result:=0;
     end;
  end
  else
     // Failure
     Stream.Seek(0, soFromEnd);

end;

procedure TO4Stream.WriteHeader(Stream: TStream; TagID: Byte; Length: Word);
var  o4TagHead:  TO4TagHeader;
begin

  // Set the header to write to the stream
  o4TagHead.cbTagID:=TagID;
  o4TagHead.wLength:=Length;
  SwapEndian(@o4TagHead.wLength, 2);

  // Write the header to the stream
  Stream.Write(o4TagHead, SizeOf(TO4TagHeader));

end;

procedure TO4Stream.WriteString(Stream: TStream; TagID: Byte; Value: String);
var  o4TagHead:  TO4TagHeader;
begin

  // Only write string if non-blank
  if (Length(Value) > 0) then
  begin
     // Set the header to write to the stream
     o4TagHead.cbTagID:=TagID;
     o4TagHead.wLength:=Length(Value);
     SwapEndian(@o4TagHead.wLength, 2);
     // Write the header to the stream
     Stream.Write(o4TagHead, SizeOf(TO4TagHeader));
     // Write the string to the stream
     Stream.Write(PChar(Value)^, Length(Value));
  end;

end;

procedure TO4Stream.WriteLong(Stream: TStream; TagID: Byte; Value: LongWord);
var  o4TagHead:  TO4TagHeader;
     dwValue:    LongWord;
begin

  // Set the header to write to the stream
  o4TagHead.cbTagID:=TagID;
  o4TagHead.wLength:=SizeOf(LongWord);
  SwapEndian(@o4TagHead.wLength, 2);

  // Write the header to the stream
  Stream.Write(o4TagHead, SizeOf(TO4TagHeader));

  // Get the value and swap it
  dwValue:=Value;
  SwapEndian(@dwValue, 4);

  // Write the longword to the stream
  Stream.Write(dwValue, SizeOf(LongWord));

end;

procedure TO4Stream.WriteByte(Stream: TStream; TagID: Byte; Value: Byte);
var  o4TagHead:  TO4TagHeader;
begin

  // Only write the byte value if non-zero (all byte flags start at one)
  if (Value > 0) then
  begin
     // Set the header to write to the stream
     o4TagHead.cbTagID:=TagID;
     o4TagHead.wLength:=SizeOf(Byte);
     SwapEndian(@o4TagHead.wLength, 2);
     // Write the header to the stream
     Stream.Write(o4TagHead, SizeOf(TO4TagHeader));
     // Write the byte value to the stream
     Stream.Write(Value, SizeOf(Byte));
  end;

end;

procedure TO4Stream.WriteFlag(Stream: TStream; TagID: Byte; Value: Boolean);
begin

  // Only write the flag if set (there is no tag length)
  if Value then Stream.Write(TagID, SizeOf(Byte));

end;

constructor TO4Stream.Create;
begin

  // Perform inherited
  inherited Create;

end;

destructor TO4Stream.Destroy;
begin

  // Perform inherited
  inherited Destroy;

end;

// Utility functions
function DateTimeToGmt(Value: TDateTime): LongWord;
var  dblTime:    TDateTime;
begin

  // Convert from local time to GMT time
  dblTime:=Value + GMTBias / (24.0 * 60.0);

  // Convert to 1970 based time
  dblTime:=(dblTime - 25569.0) + (GMTBias / (24.0 * 60.0));

  // Convert to integer based time
  result:=(Trunc(dblTime) * (60 * 60 * 24)) + Round((Frac(dblTime) * MSecsPerDay) / 1000);

end;

function GmtToDateTime(Value: LongWord): TDateTime;
var  days:       Integer;
     secs:       Integer;
begin

  // Base Jan 1 1970
  result:=25569.0;

  // Calculate the number of days and seconds in the time value
  days:=(Value div (60 * 60 * 24));
  secs:=(Value mod (60 * 60 * 24));

  // Convert from 1970 based time
  result:=((result+days)+((secs * 1000) / MSecsPerDay)) - (GMTBias / (24.0 * 60.0));

  // Convert to local time
  result:=result - GMTBias / (24.0 * 60.0);

end;

function GMTBias: Integer;
var  lpTZI:      TTimeZoneInformation;
begin

  // Check daylight bias
  if (GetTimeZoneInformation(lpTZI) = TIME_ZONE_ID_DAYLIGHT) then
     result:=lpTZI.DaylightBias
  else
     result:=0;

  // Return the time zone bias
  result:=result+lpTZI.Bias;

end;

procedure SwapEndian(Value: Pointer; Size: Cardinal);
var  lpszValue:  PChar;
     i:          Integer;
     j:          Integer;
     c:          Char;
begin

  // Cast pointer as string (allows for index accessing)
  lpszValue:=Value;

  // Handle any size byte swapping
  i:=0;
  j:=Pred(Size);

  // Swap the bytes
  while (i < j) do
  begin
     c:=lpszValue[i];
     lpszValue[i]:=lpszValue[j];
     lpszValue[j]:=c;
     // Adjust
     Inc(i);
     Dec(j);
  end;

end;

end.


-------------- Unit1 Source Code for test project --------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus, ExtCtrls, o4cookie;

type
  TForm1         =  class(TForm)
     procedure   OnOpenClick(Sender: TObject);
     procedure   FormCreate(Sender: TObject);
  private
     // Private declarations
     FTree:      TTreeView;
     FList:      TListView;
  public
     // Public declarations
     procedure   LoadDomain(Node: TTreeNode; Domain: TO4Domain);
  end;

// For testing only, hard coded the cookies4.dat file (change to you location)
const
  CookieDat      =  'c:\temp\cookies4.dat';

const
  ColNames:      Array [0..17] of String = ('Name',
                                            'Domain Path',
                                            'Comment',
                                            'CommentURL',
                                            'Value',
                                            'Expires',
                                            'Last Used',
                                            'Port List',
                                            'Recv Domain',
                                            'Recv Path',
                                            'Secure',
                                            'Server Send Back',
                                            'Protected',
                                            'Prefixed',
                                            '3rd Party',
                                            'Authenticate',
                                            'Password',
                                            'Version');

// Form variable
var
  Form1:         TForm1;

implementation
{$R *.DFM}

procedure TForm1.LoadDomain(Node: TTreeNode; Domain: TO4Domain);
var  Cookie:     TO4Cookie;
     tvDomain:   TTreeNode;
     tvPaths:    TTreeNode;
     tvDomains:  TTReeNode;
     dwCount:    Integer;
const
  BOOLSTRS:      Array [False..True] of String = ('False', 'True');
begin

  // Load the base domain information
  tvDomain:=FTree.Items.AddChild(Node, Domain.Name);

  // Add child items
  FTree.Items.AddChild(tvDomain, Format('Size: %d', [Domain.Size]));
  FTree.Items.AddChild(tvDomain, Format('Filter Type: %d', [Domain.FilterType]));
  FTree.Items.AddChild(tvDomain, Format('Match Type: %d', [Domain.MatchType]));
  FTree.Items.AddChild(tvDomain, Format('Accept Type: %d', [Domain.AcceptType]));

  // Add the paths sub node
  tvPaths:=FTree.Items.AddChild(tvDomain, 'Paths');

  // Add the paths to the path node
  if (Domain.Paths.Count = 0) then
     FTree.Items.AddChild(tvPaths, '< none >')
  else
     for dwCount:=0 to Pred(Domain.Paths.Count) do
        FTree.Items.AddChild(tvPaths, Domain.Paths[dwCount]);

  // Add the cookies to the list view
  for dwCount:=0 to Pred(Domain.CookieCount) do
  begin
     // Get the cookie
     Cookie:=Domain.Cookies[dwCount];
     with FList.Items.Add do
     begin
        // Add the cookie info
        Caption:=Cookie.Name;
        SubItems.Add(Cookie.Domain.DomainPath);
        SubItems.Add(Cookie.Comment);
        SubItems.Add(Cookie.CommentURL);
        SubItems.Add(Cookie.Value);
        SubItems.Add(DateTimeToStr(GmtToDateTime(Cookie.Expires)));
        SubItems.Add(DateTimeToStr(GmtToDateTime(Cookie.LastUsed)));
        SubItems.Add(Cookie.PortList);
        SubItems.Add(Cookie.RecvDomain);
        SubItems.Add(Cookie.RecvPath);
        SubItems.Add(BOOLSTRS[Cookie.IsSecure]);
        SubItems.Add(BOOLSTRS[Cookie.IsServerSendback]);
        SubItems.Add(BOOLSTRS[Cookie.IsProtected]);
        SubItems.Add(BOOLSTRS[Cookie.IsPrefixed]);
        SubItems.Add(BOOLSTRS[Cookie.Is3rdParty]);
        SubItems.Add(BOOLSTRS[Cookie.HasAuthenticate]);
        SubItems.Add(BOOLSTRS[Cookie.HasPassword]);
        SubItems.Add(IntToStr(Cookie.Version));
     end;
  end;

  // Add sub-domains
  tvDomains:=FTree.Items.AddChild(tvDomain, 'Domains');

  // Add the domains to the node
  if (Domain.DomainCount = 0) then
     FTree.Items.AddChild(tvDomains, '< none >')
  else
     // Recurse the domains
     for dwCount:=0 to Pred(Domain.DomainCount) do
        LoadDomain(tvDomains, Domain.Domains[dwCount]);

end;

procedure TForm1.OnOpenClick(Sender: TObject);
var  CookieRoot: TO4CookieRoot;
     dwCount:    Integer;
begin

  // Create the cookie object
  CookieRoot:=TO4CookieRoot.Create(CookieDat);

  // Load the cookie file
  with FTree do
  begin
     // Lock and clear both the tree and list
     Items.BeginUpdate;
     FList.Items.BeginUpdate;
     Items.Clear;
     FList.Items.Clear;
     // Recurse the loading of the domains
     for dwCount:=0 to Pred(CookieRoot.DomainCount) do
        // The load domain takes a tree node (nil for root items) and the domain
        // to be loaded in the tree
        LoadDomain(nil, CookieRoot.Domains[dwCount]);
     // Let the tree and list update
     Items.EndUpdate;
     FList.Items.EndUpdate;
  end;

  // Free the cookie file
  CookieRoot.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);
var  dwCount:    Integer;
begin

  // Set width / height
  Width:=600;
  Height:=380;

  // Create all items dynamically - makes it easier when you can't email
  // someone the project ;-)
  with TMainMenu.Create(Self) do
  begin
     // Add the one menu item
     Items.Add(NewItem('&Open', 0, False, True, OnOpenClick, 0, 'miOpen'));
  end;

  // Create the tree to diplay the domain tree listing
  FTree:=TTreeView.Create(Self);
  with FTree do
  begin
     Parent:=Self;
     Align:=alLeft;
     Width:=200;
     Visible:=True;
     Name:='CookieTree';
  end;

  // Create splitter
  with TSplitter.Create(Self) do
  begin
     Parent:=Self;
     Left:=205;
     Align:=alLeft;
     Visible:=True;
  end;

  // Create the list view
  FList:=TListView.Create(Self);
  with FList do
  begin
     Parent:=Self;
     Align:=alClient;
     Visible:=True;
     ViewStyle:=vsReport;
     Name:='CookieList';
     // Add the columns
     for dwCount:=0 to High(ColNames) do
     begin
        with FList.Columns.Add do
        begin
           Width:=100;
           Caption:=ColNames[dwCount];
        end;
     end;
  end;

end;

end.

Just a suggestion regarding unit layout....
If you do plan on supporting other opera files, (cache, etc), then it would probably be a good idea to split the source code out into multiple units (better now than later). For example, a base unit of "o4base.pas" which contains the utility functions, the TO4Stream class, constants, etc. Then keep the cookie related classes in the o4cookie.pas file, and add the o4base to the uses. When you add a new file handling class, you then won't have to wade through as much code ;-)

Eg:

o4base.pas
------------------
Opera 4 constants (tag ids, etc)
TO4Stream class
utility functions

o4cookie.pas (uses o4base.pas)
------------------
cookie related structures and classes

o4cache.pas (uses o4base.pas)
------------------
cache related structures and classes


I did not implement it this way in order to keep things simple for the posting here. Some people get confused with the cut/paste technique that must be employed here, and the more instructions (units to be created, etc) there are, the more chance there is for someone to miss something.

Kind Regards,
Russell

I wish there would be a better grade than 'A: Excellent' to give :-)
That was really great, and I could implement it within a few minutes.
I will start work on the cache part tomorrow, and annoy you with any questions that should arise ;)

Thanks for the compliment, and let me know if I can assist further.

Russell

Didn't find much time for this, so it took a few days, but it really was easy :)

Here's a small change needed for cache files: O4DataHeader.dwAppVer needs to be $00020000.
Also, the Opera documentation has a bug: 0x0007 is uint32, not uint8
And a missing entry: 0x0027 is (undocumented) uint32

Except for those three very minor things, it was basically just copying and adjusting existing code :)

Thanks for the update, as I wasn't aware of the documentation issues.
Hopefully the rest of it went smoothly for you.

Russell