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

Pascal/Delphi Source File | 2001-07-13 | 8.9 KB | 336 lines

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.