home *** CD-ROM | disk | FTP | other *** search
- unit WABD_Utils;
-
- interface
-
- uses classes,sysutils,Graphics,Windows,Math;
-
- function MonthName(DateTime:TDateTime):string;
- function DayName(DateTime:TDateTime):string;
- function HTML_To_ASCII(const Input: string): string;
- function ASCII_To_HTML(const Input: string): string;
- function URL_To_HTML(const Input: string): string;
- function FindReplace(const str,find,replace:string):string;
- function ColorToHTML(c:TColor; Del:string):string;
- function ValueToHTML(s:string; w:integer):string;
- function GetWord(const Data:string; FromPos,ToPos,MaxLen:integer):string;
- function WABD_Pos(Buffer,Pattern: PChar; MaxLen: LongInt):PChar;
- function FindComponentRecursive(Root: TComponent; AName: string):TComponent;
- procedure WABD_SplitString(Buffer:PChar; Delimiter:char; List:TStringList);
-
-
- const
- WABD_BrowserUnknown=0;
- WABD_BrowserIExplorer=1;
- WABD_BrowserNetScape=2;
-
- WABD_STATUS_OK = 200;
- WABD_STATUS_AUTH = 401;
- WABD_STATUS_REDIRECT = 302;
-
- WABD_Browser : array [WABD_BrowserUnknown..WABD_BrowserNetScape] of string =
- ('Unknown',
- 'MS Internet Explorer',
- 'Netscape'
- );
-
-
- implementation
-
- const
- MonthNames: array[1..12] of string = (
- 'Jan', 'Feb', 'Mar', 'Apr',
- 'May', 'Jun', 'Jul', 'Aug',
- 'Sep', 'Oct', 'Nov', 'Dec');
- DayNames: array[1..7] of string = (
- 'Sun', 'Mon', 'Tue', 'Wed',
- 'Thu', 'Fri', 'Sat');
-
- // ************************************************************************
- // Utility functions
- // ************************************************************************
-
- // Parse URLEncoded null terminated buffer.
- procedure WABD_SplitString(Buffer:PChar; Delimiter:char; List:TStringList);
- var
- pCh:PChar;
- pBuf:PChar;
- lBuf:integer;
- pStart:PChar;
- s:string;
- buf:array [0..8191] of char;
- begin
- pStart:=Buffer;
- pCh:=pStart;
- pBuf:=buf;
- lBuf:=sizeof(buf);
- if pCh^ = #0 then exit;
- while (lBuf>0) do
- begin
- // Field seperator.
- 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;
-
- // Fast string search function.
- function WABD_Pos(Buffer,Pattern:PChar; MaxLen:LongInt):PChar;
- var
- T:array[char] Of Byte;
- p:PChar;
- a,b:byte;
- n:integer;
-
- function LowCase( ch : Char ) : Char;
- asm
- { -> AL Character }
- { <- AL Result }
-
- CMP AL,'A'
- JB @@exit
- CMP AL,'Z'
- JA @@exit
- ADD AL,'a' - 'A'
- @@exit:
- end;
-
- begin
- // If no pattern given.
- if Pattern^=#0 then
- begin
- Result:=Buffer;
- exit;
- end;
-
- // Check if possible to search on pattern.
- b:=strlen(Pattern);
- if (Buffer=nil) or (MaxLen<b) then
- begin
- Result:=nil;
- exit;
- end;
-
- // Convert pattern to uppercase.
- p:=Pattern;
- while (p^ <> #0) do
- begin
- p^:=UpCase(p^);
- inc(p);
- end;
-
- // Prepare jump table.
- FillChar(T,sizeOf(T),b);
- dec(b);
- p:=Pattern;
- while p^ <> #0 do
- begin
- n:=b - (p-Pattern);
- T[p^ ]:=n;
- T[LowCase(p^)]:=n;
- inc(p);
- end;
-
- // Search.
- p:=Buffer;
- repeat
- a:=b;
- while UpCase(p[a]) = Pattern[a] do
- begin
- if a=0 then
- begin
- Result:=p;
- exit;
- end;
- Dec(a)
- end;
- if MaxLen < T[p[a]] then break;
-
- Dec(MaxLen,T[p[a]]);
- Inc(p,Max(1,T[p[a]]))
- until false;
-
- Result:=nil
- end;
-
- function MonthName(DateTime:TDateTime):string;
- var
- Year,Month,Day:Word;
- begin
- DecodeDate(DateTime,Year,Month,Day);
- Result:=MonthNames[Month];
- end;
-
- function DayName(DateTime:TDateTime):string;
- begin
- Result:=DayNames[DayOfWeek(DateTime)];
- end;
-
- {$IFDEF KBM
- function ReplaceInStr(InStr: string; var OutStr : string;
- FindStr, ReplaceStr : string) : integer;
- var
- LenFindStr, LenReplaceStr, LenInStr : integer;
- PtrInStr, PtrOutStr, // pointers to incremental reading and writing
- PInStr, POutStr : PChar; // pointer to start of output string
- begin
- LenInStr := Length(InStr);
- LenFindStr := Length(FindStr);
- LenReplaceStr := Length(ReplaceStr);
- Result := 0;
- PInStr := PChar(InStr);
- PtrInStr := PInStr;
- {find number of occurences to allocate output memory in one chunk}
- while PtrInStr < (PInStr + LenInStr) do begin
- if StrLIComp(PtrInStr, PChar(FindStr), LenFindStr) = 0 then
- inc(Result);
- inc(PtrInStr);
- end;
- {reset pointer}
- PtrInStr := PInStr;
- {allocate the output memory - calculating what is needed}
- GetMem(POutStr, Length(InStr) + (Result * (LenReplaceStr - LenFindStr)) + 1);
- {find and replace the strings}
- PtrOutStr := POutStr;
- while PtrInStr < (PInStr + LenInStr) do begin
- if StrLIComp(PtrInStr, PChar(FindStr), LenFindStr) = 0 then begin
- {write the replacement string to the output string}
- if LenReplaceStr > 0 then begin
- StrLCopy(PtrOutStr, PChar(ReplaceStr), LenReplaceStr);
- inc(PtrInStr, LenFindStr); // increment input pointer
- inc(PtrOutStr, LenReplaceStr); // increment output pointer
- end; {if LenReplaceStr > 0}
- end {if StrLIComp(...) = 0}
- else begin
- {write one char to the output string}
- StrLCopy(PtrOutStr, PtrInStr, 1); // copy character
- inc(PtrInStr);
- inc(PtrOutStr);
- end; {if StrLIComp(...) = 0 else}
- end;
- {copy the output string memory to the provided output string}
- OutStr := StrPas(POutStr);
- FreeMem(POutStr);
- end;
- {$ENDIF}
-
- function FindComponentRecursive(Root: TComponent; AName: string):TComponent;
- var
- i:integer;
- begin
- AName:=LowerCase(AName);
- if (AName<>'') and (Root.ComponentCount<>0) then
- begin
- for i:=0 to Root.ComponentCount-1 do
- begin
- Result:=Root.Components[i];
- if LowerCase(Result.Name)=AName then exit;
- if (Result.ComponentCount<>0) then
- begin
- Result:=FindComponentRecursive(Result,AName);
- if Result<>nil then exit;
- end;
- end;
- end;
- Result:=nil;
- end;
-
- function FindReplace(const str,find,replace:string):string;
- var
- aPos: Integer;
- rslt: String;
- s:string;
- begin
- s:=str;
- aPos := Pos(find, s);
- rslt := '';
- while (aPos <> 0) do
- begin
- rslt := rslt + Copy(s, 1, aPos - 1) + replace;
- Delete(s, 1, aPos);
- aPos := Pos(find, s);
- end;
- Result := rslt + s;
- end;
-
- function HTML_To_ASCII(const Input: string): string;
- begin
- Result:=FindReplace(Input, '&', '&');
- Result:=FindReplace(Result, '<', '<');
- Result:=FindReplace(Result, '>', '>');
- Result:=FindReplace(Result, ':', ':'); // $3A
- Result:=FindReplace(Result, ';', ';'); // Ç3B
- Result:=FindReplace(Result, '$#105', '_');
- Result:=FindReplace(Result, '%3A', ':');
- Result:=FindReplace(Result, '%3B', ';');
- Result:=FindReplace(Result, '%5F', '_');
- end;
-
- function ASCII_To_HTML(const Input: string): string;
- begin
- Result:=FindReplace(Input, '&', '&');
- Result:=FindReplace(Result, '<', '<');
- Result:=FindReplace(Result, '>', '>');
- end;
-
- function URL_To_HTML(const Input: string): string;
- begin
- Result:=FindReplace(Input, ';', ';');
- Result:=FindReplace(Result, ':', ':');
- end;
-
- // Return color in HTML format.
- function ColorToHTML(c:TColor; Del:string):string;
- var
- col : integer;
- rgb : TRGBQuad;
- begin
- col:=colortorgb(c);
- move(col,rgb,sizeof(rgb));
- Result:=format('%s#%0.2x%0.2x%0.2x%s',[Del,rgb.rgbblue,rgb.rgbgreen,rgb.rgbred,Del]);
- end;
-
- // Return width in HTML format.
- function ValueToHTML(s:string; w:integer):string;
- begin
- if w<0 then Result:=' '+s+'='+inttostr(-w)
- else if w>0 then Result:=' '+s+'='+inttostr(w)+'%'
- else Result:='';
- end;
-
- function GetWord(const Data:string; FromPos,ToPos,MaxLen:integer):string;
- var
- s,i,l:integer;
- begin
- l:=length(Data);
- if MaxLen<0 then MaxLen:=l;
- if ToPos<0 then ToPos:=l;
-
- // Remove leading spaces.
- i:=FromPos;
- while (i<ToPos) and (Data[i] in [' ',#10,#13]) do inc(i);
-
- // Get word until space or length.
- s:=i;
- while (i<ToPos) and (not (Data[i] in [' ',#10,#13,'&'])) and (l<MaxLen) do
- begin
- inc(i);
- inc(l);
- end;
-
- Result:=Copy(Data,s,i-s);
- end;
-
- end.
-