home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d3456 / KBMWABD.ZIP / WABD_Cookies.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-09  |  4KB  |  131 lines
  1. unit WABD_Cookies;
  2.  
  3. interface
  4.  
  5. uses classes,sysutils,WABD_Utils;
  6.  
  7. type
  8.  
  9.    TWABD_Cookie = class(TCollectionItem)
  10.    private
  11.       FName: string;
  12.       FValue: string;
  13.       FPath: string;
  14.       FDomain: string;
  15.       FExpires: TDateTime;
  16.       FSecure: Boolean;
  17.    protected
  18.       function GetHeaderValue:string;
  19.    public
  20.       constructor Create(Collection: TCollection); override;
  21.       procedure AssignTo(Dest: TPersistent); override;
  22.       property Name: string read FName write FName;
  23.       property Value: string read FValue write FValue;
  24.       property Domain: string read FDomain write FDomain;
  25.       property Path: string read FPath write FPath;
  26.       property Expires: TDateTime read FExpires write FExpires;
  27.       property Secure: Boolean read FSecure write FSecure;
  28.       property HeaderValue: string read GetHeaderValue;
  29.    end;
  30.  
  31.    TWABD_Cookies = class(TCollection)
  32.    protected
  33.       function GetCookie(Index:Integer):TWABD_Cookie;
  34.       procedure SetCookie(Index:Integer; Cookie:TWABD_Cookie);
  35.    public
  36.       constructor Create(ItemClass:TCollectionItemClass);
  37.       function Add(AName,AValue:string):TWABD_Cookie;
  38.       function GetCookieByName(AName:string):TWABD_Cookie;
  39.       property Items[Index: Integer]:TWABD_Cookie read GetCookie write SetCookie; default;
  40.    end;
  41.  
  42.  
  43. implementation
  44.  
  45. // ************************************************************************
  46. // TWABD_Cookie/TWABD_Cookies
  47. // ************************************************************************
  48.  
  49. uses WABD_HTMLRequest;
  50.  
  51. constructor TWABD_Cookie.Create(Collection: TCollection);
  52. begin
  53.      inherited Create(Collection);
  54.      FExpires:=-1;
  55. end;
  56.  
  57. procedure TWABD_Cookie.AssignTo(Dest: TPersistent);
  58. begin
  59.      if Dest is TWABD_Cookie then
  60.       with TWABD_Cookie(Dest) do
  61.       begin
  62.            Name   :=Self.FName;
  63.            Value  :=Self.FValue;
  64.            Domain :=Self.FDomain;
  65.            Path   :=Self.FPath;
  66.            Expires:=Self.FExpires;
  67.            Secure :=Self.FSecure;
  68.       end
  69.      else
  70.          inherited AssignTo(Dest);
  71. end;
  72.  
  73. function TWABD_Cookie.GetHeaderValue: string;
  74. begin
  75.      Result:=Format('%s=%s',[FName, WABD_EncodeEscapes(FValue)]);
  76.      if Domain<>'' then
  77.         Result:=Result+Format('; domain=%s', [Domain]);
  78.      if Path<>'' then
  79.         Result:=Result+Format('; path=%s', [Path]);
  80.      if Expires>-1 then
  81.         Result:=Result+Format(FormatDateTime('"; expires=%s," dd "%s" yyyy hh:mm:ss "GMT"',Expires),
  82.                            [DayName(Expires), MonthName(Expires)]);
  83.      if Secure then Result:=Result + '; secure';
  84. end;
  85.  
  86. constructor TWABD_Cookies.Create(ItemClass:TCollectionItemClass);
  87. begin
  88.      inherited Create(ItemClass);
  89. end;
  90.  
  91. function TWABD_Cookies.Add(AName,AValue:string): TWABD_Cookie;
  92. begin
  93.      Result:=GetCookieByName(AName);
  94.      if Result=nil then
  95.         Result:=TWABD_Cookie(inherited Add);
  96.      if Result<>nil then
  97.      begin
  98.           Result.Name:=AName;
  99.           Result.Value:=AValue;
  100.      end;
  101. end;
  102.  
  103. function TWABD_Cookies.GetCookieByName(AName:string):TWABD_Cookie;
  104. var
  105.    i:integer;
  106.    c:TWABD_Cookie;
  107. begin
  108.      Result:=nil;
  109.      for i:=0 to Count-1 do
  110.      begin
  111.           c:=TWABD_Cookie(Inherited Items[i]);
  112.           if c.FName = AName then
  113.           begin
  114.                Result:=c;
  115.                break;
  116.           end;
  117.      end;
  118. end;
  119.  
  120. function TWABD_Cookies.GetCookie(Index:Integer):TWABD_Cookie;
  121. begin
  122.      Result:=TWABD_Cookie(inherited Items[Index]);
  123. end;
  124.  
  125. procedure TWABD_Cookies.SetCookie(Index:Integer; Cookie:TWABD_Cookie);
  126. begin
  127.      Items[Index].Assign(Cookie);
  128. end;
  129.  
  130. end.
  131.