[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]