[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]

unit PostCont;

{ Class to parse the data from a web server's QUERY_STRING variables and the
  stdin data during a POST.  The .Create method used determines how this
  loads the data.

  by Dave Wedwick
}  

interface

uses SysUtils, Classes;

type
  EPostContentError = class(Exception);

  TPostContent = class
    private
      FList: TList;
      function GetValue(Index: Integer): String;
      function GetKey(Index: Integer): String;
      function GetCount: Word;
      procedure ParseStream(MemStr: TMemoryStream);
      procedure FreeItems;
    public
      constructor Create(ContentLen: Integer);
      constructor CreateFromString(Str: String);
      destructor  Destroy; override;

      property Value[Index: Integer]: String read GetValue;
      property Key[Index: Integer]: String read GetKey;
      property Count: Word read GetCount;

      function ValueForKey(Key: String; Occurance: Word): String;
  end;

implementation

type
  PValueRec = ^ValueRec;

  ValueRec = record
    Name: String[100];
    Value: String[200];
  end;

{ Support functions }
function StrToHex(const HexVal: String): Char;
const
  StartingLetter = ord('A');
  StartingNumber = ord('0');

var
  Val, Counter: Byte;

begin

  { Find the hex value of the passed two byte string }
  Val := 0;
  for Counter := 1 to 2 do begin
    if Counter = 2 then
      Val := Val shl 4;

    case HexVal[Counter] of
      '0'..'9':  Val := Val + (ord(HexVal[Counter]) - StartingNumber);
      'A'..'F':  Val := Val + (ord(HexVal[Counter]) - StartingLetter + 10);
    end;
  end;

  Result := Char(Val);
end;

{ Class methods }
constructor TPostContent.Create(ContentLen: Integer);
var
  MemStr: TMemoryStream;
  Counter: Word;
  NextChar: Char;

begin
  FList := TList.Create;
  MemStr := TMemoryStream.Create;

  Counter := 1;
  while Counter <= ContentLen do begin
    Read(NextChar);
    MemStr.Write(NextChar, 1);

    { Add one to the count }
    Inc(Counter);
  end;

  ParseStream(MemStr);

  MemStr.Free;
end;

constructor TPostContent.CreateFromString(Str: String);
{ This creates the value pairs by parsing out a string, rather than
  reading from stdin.  Used with the QUERY_STRING. }
var
  MemStr: TMemoryStream;
  StartPos: Word;

begin
  FList := TList.Create;
  MemStr := TMemoryStream.Create;

  { The query data starts after the ? in the query.  If none is found, start
    at position 1.  Convenient, since Pos returns 0 if not found. }
  StartPos := Pos('?', Str) + 1;

  MemStr.Write(Str[StartPos], Length(Str)-StartPos+1);

  ParseStream(MemStr);

  MemStr.Free;
end;

destructor TPostContent.Destroy;
begin

  FreeItems;   { See below }
  FList.Free;

  inherited;
end;

procedure TPostContent.ParseStream(MemStr: TMemoryStream);
type
  InType = (itName, itValue);

var
  VRecPtr: PValueRec;
  NextChar: Char;
  Counter: Word;
  CurrType: InType;
  VRec: ValueRec;
  HexVal: String[2];

begin
  Counter  := 1;
  CurrType := itName;

  { Clear the structure to where the value are going to go }
  VRec.Name := '';
  VRec.Value := '';

  MemStr.Seek(0, soFromBeginning);	
  while Counter <= MemStr.Size do begin
    { Get the next character from the stream }
    MemStr.Read(NextChar, 1);

    { Plus signs are spaces }
    if NextChar = '+' then
      NextChar := ' ';

    case NextChar of
      '=': CurrType := itValue;

      '%':
        begin
          { The next two bytes are a hex value for an ASCII character.  Decode
            the character, add it to the appropriate place, and increment
            the counter by three}

          HexVal := '';
          MemStr.Read(NextChar, 1);   HexVal := HexVal + NextChar;
          MemStr.Read(NextChar, 1);   HexVal := HexVal + NextChar;

          NextChar := StrToHex(HexVal);

          if CurrType = itName then
            VRec.Name := VRec.Name + NextChar
          else
            VRec.Value := VRec.Value + NextChar;

          { Add two to the counter here -- there is one more added below
            at the bottom of the loop, making a total of three added }
          Inc(Counter, 2);
        end;

      '&':
        begin
          { Finished with this variable name/value pair.  Allocate memory
            and add it to the list }
          New(VRecPtr);
          VRecPtr^ := VRec;
          FList.Add(VRecPtr);

          { Get ready for the next values }
          CurrType := itName;
          VRec.Name := '';
          VRec.Value := '';
        end;

    else
      with VRec do begin
        if CurrType = itName then
          Name := Name + NextChar
        else
          Value := Value + NextChar;
      end;
    end;

    { Add one to the count }
    Inc(Counter);
  end;

  { Add the last one }
  if MemStr.Size > 0 then begin
    New(VRecPtr);
    VRecPtr^ := VRec;
    FList.Add(VRecPtr);
  end;
end;

procedure TPostContent.FreeItems;
var
  Counter: Word;

begin
  { Free all items in the list }
  for Counter := 1 to FList.Count do
    Dispose(PValueRec(FList[Counter-1]));

end;

function TPostContent.GetValue(Index: Integer): String;
begin
  if Index < 0 then
    raise EPostContentError.Create('Can''t have negative numbers');

  if Index > FList.Count-1 then
    raise EPostContentError.Create('Index value too high');

  Result := PValueRec(FList[Index])^.Value;
end;

function TPostContent.GetKey(Index: Integer): String;
begin
  if Index < 0 then
    raise EPostContentError.Create('Can''t have negative numbers');

  if Index > FList.Count-1 then
    raise EPostContentError.Create('Index value too high');

  Result := PValueRec(FList[Index])^.Name;
end;

function TPostContent.GetCount: Word;
begin
  Result := FList.Count;
end;

function TPostContent.ValueForKey(Key: String; Occurance: Word): String;
var
  Counter, HitCount: Word;

begin
  { Find the Occurance of Key in the list }
  if Occurance < 1 then
    raise EPostContentError.Create('Occurance value must be > 0');

  Result := '';

  HitCount := 0;
  for Counter := 1 to FList.Count do begin
    with PValueRec(FList[Counter-1])^ do begin
      { If the key passed matches the name of the value, and the occurance
        is found, return the value } 
      if UpperCase(Key) = UpperCase(Name) then begin
        Inc(HitCount);

        if HitCount = Occurance then begin
          Result := Value;
          Exit;
        end;
      end;
    end;
  end;

  { If we're here, then we didn't find the value for the key -- raise
    an exception }
  raise EPostContentError.Create('Key not found');
end;

end.

[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]