Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/d3456/KBMWABD.ZIP/WABD_HTMLRequest.pas

Pascal/Delphi Source File | 2001-07-16 | 15.1 KB | 533 lines

unit WABD_HTMLRequest;

interface

uses Classes, SysUtils, Windows, WABD_Request;

type
   TWABD_CustomHTMLRequest = class(TWABD_CustomRequest)
   protected
      FMaxSize:integer;
      FGotSize:integer;

      function GetMultipartChunk(Buffer:PChar; var BufSize:integer):boolean; virtual;
   public
      constructor Create(MaxSize:integer);
      destructor Destroy; override;

      procedure ParseMultipart(Buffer:PChar; BufferSize:integer; Boundary:string; List:TStringList); virtual;
      procedure ParseHeaders(Buffer:PChar; BufferSize:integer; List:TStringList);
      procedure ParseURLEncoded(Buffer:PChar; Delimiter:char; List:TStringList);
      function RemoveQuotes(AString:string):string; virtual;
      procedure ParseCookies; virtual;
   end;

   function  WABD_EncodeEscapes(Input: string): string;
   procedure WABD_DecodeEscapes(var s: string);

implementation

const
   INPUT_BUFFERSIZE=8192;
   //                              0 1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
   Hex2Dec:array[0..31] of byte = (0,10,11,12,13,14,15,0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0);


// Build and load a request from web server.
constructor TWABD_CustomHTMLRequest.Create(MaxSize:integer);
begin
     inherited Create;
     FMaxSize:=MaxSize;
     FGotSize:=0;
end;

destructor TWABD_CustomHTMLRequest.Destroy;
begin
     inherited;
end;

function TWABD_CustomHTMLRequest.GetMultipartChunk(Buffer:PChar; var BufSize:integer):boolean;
begin
     Result:=false;
     bufSize:=0;
end;

// Basic coding/decoding methods.
function WABD_EncodeEscapes(Input: string): string;
var
   i : integer;
   t : string;
begin
     t:='';
     for i:=1 to Length(Input) do
     begin
          if Input[i]=' ' then
          begin
               t:=t+'+';
               continue;
          end;
          if not (Input[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then
          begin
               t:=t + Format('%%%0.2x', [Ord(Input[i])]);
               continue;
          end;
          t:=t + Input[i];
     end;
     Result:=t;
end;

procedure WABD_DecodeEscapes(var s: string);
var
   New    : string;
   hexstr : string;
   c      : byte;
   i      : integer;
begin
     i:=1;
     repeat
           if s[i]='+' then
              New:=New+' '
           else if s[i]='%' then
           begin
                hexstr:=Copy(s, i+1, 2);
                c:=StrToInt('$'+hexstr);
                New:=New + char(c);
                i:=i + 2;
           end
           else
               New:=New + s[i];
           i:=i + 1;
     until i>Length(s);

     s:=New;
end;

// Extract headers from buffer. Only look at the supplied buffer.
procedure TWABD_CustomHTMLRequest.ParseHeaders(Buffer:PChar; BufferSize:integer; List:TStringList);
var
   s:string;
   p:integer;
   pCh:PChar;
   pStartLine:PChar;
   cnt:integer;
begin
     // Deciphre header part.
     if Buffer=nil then exit;
     cnt:=BufferSize;
     pStartLine:=Buffer;
     pCh:=pStartLine;
     while true do
     begin
          // Check if end of line.
          if pCh^ in [#10,#13,#0] then
          begin
               // Check if empty line. Then end of header list.
               if pCh=pStartLine then break;

               // Get string.
               SetString(s,pStartLine,pCh-pStartLine);
               p:=pos(':',s);
               if p>0 then s[p]:='=';
               List.Add(s);

               // No more data to parse.
               if pCh^=#0 then break;

               // Prepare for next char.
               inc(pCh);
               dec(cnt);

               // Skip optional #10
               if (cnt>0) and (pCh^ = #10) then
               begin
                    inc(pCh);
                    dec(cnt);
               end;
               pStartLine:=pCh;
               continue;
          end;
          inc(pCh);
          dec(cnt);
     end;
end;

// Parse URLEncoded null terminated buffer.
procedure TWABD_CustomHTMLRequest.ParseURLEncoded(Buffer:PChar; Delimiter:char; List:TStringList);
var
   ch:Char;
   pCh:PChar;
   pBuf:PChar;
   lBuf:integer;
   pStart:PChar;
   s:string;
   buf:array [0..8191] of char;
begin
     if Buffer=nil then exit;
     pStart:=Buffer;
     pCh:=pStart;
     pBuf:=buf;
     lBuf:=sizeof(buf);
     if pCh^ = #0 then exit;
     while (lBuf>0) do
     begin
          // Decode space.
          if pCh^ = '+' then
          begin
               pBuf^:=' ';
               inc(pBuf);
               dec(lBuf);
          end

          // Decode Hex.
          else if pCh^='%' then
          begin
               inc(pCh);
               ch:=Char(Hex2Dec[ord(pCh^) and $1F] shl 4);
               inc(pCh);
               inc(ch,Hex2Dec[ord(pCh^) and $1F]);
               pBuf^:=ch;
               inc(pBuf);
               dec(lBuf);
          end

          // Field seperator.
          else if (pCh^ = Delimiter) or (pCh^ = #0) then
          begin
               SetString(s,buf,pBuf-buf);
               List.Add(trim(s));
               if pCh^=#0 then break;
               pBuf:=buf;
               lBuf:=sizeof(buf);
          end
          else
          begin
               pBuf^:=pCh^;
               inc(pBuf);
               dec(lBuf);
          end;
          inc(pCh);
     end;
end;

function TWABD_CustomHTMLRequest.RemoveQuotes(AString:string):string;
begin
     Result:=Trim(AString);
     if length(Result)=0 then exit;
     if Result[1]<>'"' then exit;
     Result:=copy(Result,2,length(Result)-2);
end;

procedure TWABD_CustomHTMLRequest.ParseMultipart(Buffer:PChar; BufferSize:integer; Boundary:string; List:TStringList);
var
   Stream:TStream;
   pBuffer:PChar;
   Name,LocalFileName,Entity,Line,Mime:string;
   Fn:string;
   lst:TStringList;
   DoStore:boolean;
   Drop:boolean;
   n:integer;
   InputBuf:array [0..8191] of char;

   function GetChunk:boolean;
   begin
        // Check if should be more.
        if FGotSize>=Size then
        begin
             Result:=false;
             exit;
        end;

        // Get next chunk.
        BufferSize:=sizeof(InputBuf);

        // If nothing more, break.
        Result:=GetMultipartChunk(InputBuf,BufferSize) and (BufferSize>0);
        if Result then FGotSize:=FGotSize+BufferSize;
        pBuffer:=InputBuf;
   end;

   function GetLine:string;
   var
      GotEOL,ExitLoop:boolean;
   begin
        Result:='';
        GotEOL:=false;
        ExitLoop:=false;
        while not ExitLoop do
        begin
             // Check if data in buffer.
             if (BufferSize<=0) and not GetChunk then break;

             // Look for #10 or #13 (EOL).
             while (BufferSize>0) do
             begin
                  if pBuffer^ in [#10,#13] then
                  begin
                       if GotEOL then
                       begin
                            ExitLoop:=true;
                            inc(pBuffer);
                            dec(BufferSize);
                            break;
                       end;
                       GotEOL:=true;
                  end
                  else
                  begin
                       if GotEOL then
                       begin
                            ExitLoop:=true;
                            break;
                       end;
                       Result:=Result+pBuffer^;
                  end;
                  inc(pBuffer);
                  dec(BufferSize);
             end;
        end;
   end;

   function SearchBoundary(Store:boolean):boolean;
   var
      ch:char;
      pStartBuffer,pBoundaryCandidate:PChar;
      pBoundary:PChar;
      lBoundary:integer;
      lMatch:integer;
      found:boolean;
      p:PChar;
   begin
        pStartBuffer:=pBuffer;
        pBoundaryCandidate:=nil;
        lBoundary:=length(Boundary);
        pBoundary:=PChar(Boundary);
        lMatch:=0;
        found:=false;
        while not found do
        begin
             // Check if data in buffer.
             if (BufferSize<=0) then
             begin
                  // Check if to store data until just before half processed boundary match.
                  if Store then
                  begin
                     if pBoundaryCandidate<>nil then
                        Stream.Write(pStartBuffer^,pBoundaryCandidate-pStartBuffer)
                     else
                        Stream.Write(pStartBuffer^,pBuffer-pStartBuffer);
                  end;
                  if not GetChunk then break;
                  pStartBuffer:=pBuffer;
                  pBoundaryCandidate:=nil;
             end;

             // Check for boundary.
             ch:=pBuffer^;
             if pBoundary^ = ch then
             begin
                  if lMatch=0 then pBoundaryCandidate:=pBuffer;
                  inc(lMatch);
                  inc(pBoundary);
                  if (lMatch=lBoundary) then
                  begin
                       if Store then
                       begin
                            // Dont write ending #10#13 pair.
                            p:=pBoundaryCandidate;
                            if (p>pStartBuffer) then
                            begin
                                 // Check if previous 2 chars was #10 or #13.
                                 dec(p);
                                 if not (p^ in [#10,#13]) then inc(p)
                                 else
                                 begin
                                      dec(p);
                                      if p>pStartBuffer then
                                         if not (p^ in [#10,#13]) then inc(p);
                                 end;
                            end;
                            n:=p-pStartBuffer;
                            if n>0 then
                               Stream.Write(pStartBuffer^,n);
                       end;

                       found:=true;
                  end;
             end
             else
             begin
                  // Check if not matching boundary candidate to be written.
                  if lMatch>0 then
                  begin
                       if Store then
                       begin
                            Stream.Write(pStartBuffer^,pBoundaryCandidate-pStartBuffer);
                            Stream.Write(PChar(Boundary)^,lMatch);
                       end;
                       pStartBuffer:=pBuffer;
                       lMatch:=0;
                       pBoundaryCandidate:=nil;
                  end;
                  pBoundary:=PChar(Boundary);
             end;
             inc(pBuffer);
             Dec(BufferSize);
        end;
        Result:=found;
   end;

begin
     // Check if to request chunk right away. Otherwise start with what we've got.
     if Buffer=nil then exit;
     pBuffer:=Buffer;
     FGotSize:=BufferSize;
     if (pBuffer=nil) or (BufferSize=0) then
        if not GetChunk then exit;
     Drop:=true;

     // Prepare entity line list.
     lst:=TStringList.Create;
     try

        // While data available loop.
        while true do
        begin
             // Boundary end mark or ending CR/LF.
             if not SearchBoundary(Drop) then break;
             if (BufferSize>=2) then
             begin
                  if (pBuffer[0]='-') and (pBuffer[1]='-') then break;
             end;

             // Get empty line.
             Line:=GetLine;

             // Get entity line.
             Entity:=GetLine;

             // Parse line.
             lst.Clear;
             ParseURLEncoded(PChar(Entity),';',lst);

             // Get entity name.
             Name:=RemoveQuotes(lst.Values['name']);

             // If contains filename, save data.
             if pos('filename=',lowercase(Entity))>0 then
             begin
                  Fn:=RemoveQuotes(lst.Values['filename']);
                  DoStore:=Fn<>'';

                  // Local filename.
                  if DoStore then LocalFileName:='WABD_'+FormatDateTime('yyyymmdd_hhnnss',now)+'_'+ExtractFileName(Fn)
                  else LocalFileName:='';

                  // Get MIME type for file.
                  Mime:=RemoveQuotes(GetLine);
                  n:=pos(' ',Mime);
                  if n>0 then Mime:=Copy(Mime,n+1,length(Mime));

                  // Get empty line.
                  Line:=GetLine;

                  List.Add(Name+'='+LocalFileName+'; Filename='+Fn+'; Mime='+Mime);

                  // Get file contents.
                  if DoStore then
                  begin
                       Stream:=TFileStream.Create(LocalFileName,fmCreate);
                       try
                          Stream.Position:=0;
                          SearchBoundary(true);
                       finally
                          Stream.Free;
                       end;
                  end
                  else
                      Drop:=false;
             end
             else
             begin
                  // Get empty line.
                  Line:=GetLine;

                  // Get Value line.
                  Line:=GetLine;
                  List.Add(Name+'='+Line);

                  // Search boundary.
                  Drop:=false;
             end;
        end;
     finally
        lst.Free;
     end;
end;

procedure TWABD_CustomHTMLRequest.ParseCookies;
var
   ch:Char;
   pCh:PChar;
   pBuf:PChar;
   pStart:PChar;
   lBuf:integer;
   s,sCookies:string;
   p:integer;
   InputBuf:array [0..8191] of char;
begin
     sCookies:=Headers.Values['COOKIE'];
     if sCookies='' then exit;

     // Parse cookie string.
     pStart:=PChar(sCookies);
     pCh:=pStart;
     pBuf:=InputBuf;
     lBuf:=sizeof(InputBuf);
     while (lBuf>0) do
     begin
          // Decode space.
          if pCh^ = '+' then
          begin
               pBuf^:=' ';
               inc(pBuf);
               dec(lBuf);
          end

          // Decode Hex.
          else if pCh^='%' then
          begin
               inc(pCh);
               ch:=Char(Hex2Dec[ord(pCh^) and $1F] shl 4);
               inc(pCh);
               inc(ch,Hex2Dec[ord(pCh^) and $1F]);
               pBuf^:=ch;
               inc(pBuf);
               dec(lBuf);
          end

          // Field seperator.
          else if (pCh^ = ';') or (pCh^ = #0) then
          begin
               SetString(s,InputBuf,pBuf-InputBuf);
               p:=Pos('=',s);
               if p>0 then
                  Cookies.Add(trim(copy(s,1,p-1)),copy(s,p+1,length(s)))
               else
                   Cookies.Add(trim(s),'');
               pBuf:=InputBuf;
               lBuf:=sizeof(InputBuf);
               if pCh^=#0 then break;
          end
          else
          begin
               pBuf^:=pCh^;
               inc(pBuf);
               dec(lBuf);
          end;
          inc(pCh);
     end;
end;

end.