Chip 2001 September/Chip_2001-09_cd1.bin/zkuste/delphi/nastroje/d5/MFTP.ZIP/src/FTPMISC.PAS

Pascal/Delphi Source File | 2001-01-07 | 13.0 KB | 628 lines

unit FtpMisc;

interface

uses SysUtils, Windows;

{$I mftp.inc}

{$ifdef OPTIMIZATION}
const
  SumMonthDays: array [Boolean] of TDayTable =
     ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
     (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
{$endif}

const
   EOS = #0;

function fnmatch(Pattern, Filename: PChar; P: Boolean = False): Boolean;

function PrepareURL(S: String): String;
function BuildFTPTopURL(Server: String; Port: Integer; Username, Password: String): String;

function DOSName2UnixName(S: String): String;
function FormatMTime(S: String): String;
function FormatNTime(S: String): String;
function FormatNTTime(D, T: String): String;
function GetTempFilename: String;
function UnformatInteger(S: String): Integer;

function ReplaceInvalidChars(const S: string; RepWith: Char): String; {BDS}

{$ifdef COMPATIBLE}
function FormatInteger(I: Integer): String;
function FormatIntegerStr(S: String): String;
{$endif}

{$ifdef OPTIMIZATION}
function optimizedAnsiCompareText(const S1, S2: String): Integer;
function optimizedEncodeDate(Year, Month, Day: Integer): Integer;
procedure optimizedDecodeDate(Date: TDateTime; var Year, Month, Day: Word);
{$endif}

{$ifndef DELPHI5}
procedure FreeAndNil(var Obj);
{$endif}

function GetWindowsDirectory: String;

implementation

var Temp, CurrentYear: Word;
    TempDir, WinDir, CYS: String;
    PS: PChar;

function PrepareURL;
var i, c: Integer;
begin
   i := Pos('%', S);

   while i > 0 do
   begin
      Result := Result + Copy(S, 1, i - 1);
      Delete(S, 1, i);

      if S = '' then
      begin
         Result := Result + '%';
         Exit;
      end;

      case Ord(S[1]) of
         48..57: c := Ord(S[1]) - 48;
         65..70: c := Ord(S[1]) - 55;
         97..102: c := Ord(S[1]) - 87;
         else
         begin
            c := -1;
            Result := Result + S[1];
         end;
      end;

      Delete(S, 1, 1);

      if (c <> -1) and (S <> '') then
      begin
         case Ord(S[1]) of
            48..57: Result := Result + Chr(c * 16 + (Ord(S[1]) - 48));
            65..70: Result := Result + Chr(c * 16 + (Ord(S[1]) - 55));
            97..102: Result := Result + Chr(c * 16 + (Ord(S[1]) - 87));
            else Result := Result + Chr(c) + S[1];
         end;

         Delete(S, 1, 1);
      end;

      i := Pos('%', S);
   end;

   Result := Result + S;
end;

function BuildFTPTopURL;
begin
   Result := 'ftp://';

   if (not (LowerCase(Username) = 'anonymous')) and (not (LowerCase(Username) = 'ftp')) then
      Result := Result + Username + ':' + Password + '@';

   Result := Result + Server;
   if Port <> 21 then Result := Result + ':' + IntToStr(Port);
end;

function DOSName2UnixName;
begin
   if S[1] = '/' then
   begin
      Result := Copy(S, 4, 999);
   end
   else
   begin
      Result := Copy(S, 3, 999);

      Temp := Pos('\', Result);
      while Temp <> 0 do
      begin
         Result[Temp] := '/';
         Temp := Pos('\', Result);
      end;
   end;
end;

function FormatMTime;
var  P: Integer;
     TS: TTimeStamp;
     TD: TDateTime;
begin
   try
      P := StrToInt(S);
      TS.Time := (P mod 86400) * 1000;
      TS.Date := P div 86400 + 719163;
      TD := TimeStampToDateTime(TS);
      {$ifndef Y2K_DATE}
      Result := FormatDateTime('mm/dd/yy hh:mm', TD);
      {$else}
      Result := FormatDateTime('mm/dd/yyyy hh:mm', TD);
      {$endif}
   except
      Result := DefaultDateTime;
   end;
end;

function FormatNTime;
var Year, Month, Day: String;
    Times: String;
    I: Integer;
begin
   try
      case S[1] of
         'J':
            if S[2] = 'a' then Month := '1' else
            if S[3] = 'n' then Month := '6' else Month := '7';
         'F':
            Month := '2';
         'M':
            if S[3] = 'r' then Month := '3' else Month := '5';
         'A':
            if S[2] = 'p' then Month := '4' else Month := '8';
         'S':
            Month := '9';
         'O':
            Month := '10';
         'N':
            Month := '11';
         'D':
            Month := '12';
      end;

      I := Pos(' ', S);
      Delete(S, 1, I);
      while S[1] = ' ' do Delete(S, 1, 1);
      Day := Trim(Copy(S, 1, 2));
      // if Length(Day) = 1 then Day := Day;

      if S[3] = ' ' then Delete(S, 1, 3) else Delete(S, 1, 2);

      I := Pos(':', S);
      if I = 0 then
      begin
         Year := Trim(S);
         {$ifndef Y2K_DATE}
         Delete(Year, 1, 2);
         {$endif}
         Times := '12:00 AM';
      end
      else
      begin
         Year := CYS;
         Times := Trim(S);
         if Length(Times) = 5 then
         begin
            I := StrToInt(Copy(Times, 1, 2));
            if I > 12 then
            begin
               Delete(Times, 1, 2);
               Times := IntToStr(I - 12) + Times + ' PM';
            end
            else
            begin
               Times := Times + ' AM';
            end;
            if Times[1] = '0' then Delete(Times, 1, 1);
         end
         else
         begin
            Times := Times + ' AM';
         end;
      end;

      Result := Month + '/' + Day + '/' + Year + ' ' + Times;
   except
      Result := DefaultDateTime;
   end;
end;

function FormatNTTime;
begin
   D[3] := '/';
   D[6] := '/';
   Result := D + ' ' + Copy(T, 1, 5) + ' ' + Copy(T, 6, 2);
end;

function GetTempFilename;
var N: LongWord;
begin
   Randomize;
   repeat
      N := Random(1000000000);
      Result := TempDir + IntToStr(N);
   until (not FileExists(Result));
end;

function UnformatInteger;
var R: String;
    I: Integer;
begin
   for I := 1 to Length(S) do
      if S[I] <> ',' then R := R + S[I];

   Result := StrToInt(R);
end;

{$ifdef COMPATIBLE}
function FormatInteger;
begin
   try
      result := FormatIntegerStr(IntToStr(i));
   except
      result := '';
   end;
end;

function FormatIntegerStr;
var s1: string;
    l, p: integer;
begin
   Result := '';
   s1 := Trim(s);
   l := Length(s1);
   for p := 1 to l do
   begin
      Result := s1[l + 1 - p] + Result;
      if (p mod 3 = 0) and (p <> l) then
         Result := ',' + Result;
   end;
end;
{$endif}

function ReplaceInvalidChars;
{ These are Win32 specific. They are bad for Win16, too, but there are
  a lot more in Win16. }
const InvalidChars = ['?', '*', '/', '\', ':', '"'];
var x: integer;
begin
   Result := S;
   for x := 1 to Length(Result) do
   begin
      if Result[x] in InvalidChars then
         if (Result[x] = '/') or (Result[x] = '\') then
            Result[x] := '-'
         else
            Result[x] := RepWith;
   end;
end;

{$ifdef OPTIMIZATION}
function optimizedAnsiCompareText;
asm
   test EAX,EAX
   jne @@nzs1
   test EDX,EDX
   jz @@konec
   dec EAX
   jmp @@konec

@@nzs1:
   test EDX,EDX
   jne @@nzs1s2
   mov EAX,1
   jmp @@konec

@@nzs1s2:
   push -1
   push EDX
   push -1
   push EAX
   push NORM_IGNORECASE
   push LOCALE_USER_DEFAULT
   call CompareString
   sub EAX,2
@@konec:
end;


function optimizedEncodeDate;
asm
   push EBX
   mov EBX, EAX
   imul EAX, EDX, 31
   add EAX, ECX
   mov ECX, EBX
   sub EAX, 396 + DateDelta //31 + 365 + DateDelta
   imul ECX, 365
   add EAX, ECX
   cmp EDX, 3
   jl @@decyear
   imul EDX, 7
   sub EAX, 2
   sar EDX, 4
   sub EAX, EDX
   jmp @@calc
@@decyear:
   dec EBX
@@calc:
   sar EBX, 2
   add EAX, EBX
   imul EBX, 5243
   sar EBX, 17
   sub EAX, EBX
   sar EBX, 2
   add EAX, EBX
   pop EBX
end;

procedure optimizedDecodeDate;
const
   D1 = 365;
   D4 = D1 * 4 + 1;
   D100 = D4 * 25 - 1;
   D400 = D100 * 4 + 1;
var
   Y,M,D: Integer;
begin
   D := Trunc(Date) + (DateDelta - 1);
   if D < 0 then exit;

   asm
      mov EAX, D
      mov ECX, 1
      cmp EAX, 16 * D400
      jb @@za0
      sub EAX, 16 * D400
      add ECX, 16 * 400

   @@za0:
      cmp EAX, 8 * D400
      jb @@za01
      sub EAX, 8 * D400
      add ECX, 8 * 400

   @@za01:
      cmp EAX, 4 * D400
      jb @@za02
      sub EAX, 4 * D400
      add ECX, 4 * 400

   @@za02:
      cmp EAX, 2 * D400
      jb @@za03
      sub EAX, 2 * D400
      add ECX, 2 * 400

   @@za03:
      cmp EAX, D400
      jb @@za04
      sub EAX, D400
      add ECX, 400
   @@za04:

      cmp EAX, 2 * D100
      jb @@za1
      sub EAX, 2 * D100
      add ECX, 2 * 100

   @@za1:
      cmp EAX, D100
      jb @@za11
      sub EAX, D100
      add ECX, 100

   @@za11:
      cmp EAX, 16 * D4
      jb @@za3
      sub EAX, 16 * D4
      add ECX, 16 * 4

   @@za3:
      cmp EAX, 8 * D4
      jb @@za31
      sub EAX, 8 * D4
      add ECX, 8 * 4

   @@za31:
      cmp EAX, 4 * D4
      jb @@za32
      sub EAX, 4 * D4
      add ECX, 4 * 4

   @@za32:
      cmp EAX, 2 * D4
      jb @@za33
      sub EAX,2 * D4
      add ECX,2 * 4

   @@za33:
      cmp EAX, D4
      jb @@za34
      sub EAX, D4
      add ECX, 4

      @@za34:
      cmp EAX, 2 * D1
      jb @@za2
      sub EAX, 2 * D1
      add ECX, 2

   @@za2:
      cmp EAX, D1
      jb @@za21
      sub EAX, D1
      inc ECX

   @@za21:
      mov D, EAX
      mov Y, ECX
   end;
  Year:=Y;
  if ((Y and 3)=0) and ((LongWord(Y) mod LongWord(100)<>0) or (LongWord(Y) mod LongWord(400)=0)) then begin
   if D<182 then begin
    if D<91 then begin
     if D<60 then if D<31 then M:=1 else M:=2 else M:=3;
    end else begin
     if D<152 then if D<121 then M:=4 else M:=5 else M:=6;
    end;
   end else begin
    if D<274 then begin
     if D<244 then if D<213 then M:=7 else M:=8 else M:=9;
    end else begin
     if D<335 then if D<305 then M:=10 else M:=11 else M:=12;
    end;
   end;
   Day:=D-SumMonthDays[true,M]+1;
  end else begin
   if D<181 then begin
    if D<90 then begin
     if D<59 then if D<31 then M:=1 else M:=2 else M:=3;
    end else begin
     if D<151 then if D<120 then M:=4 else M:=5 else M:=6;
    end;
   end else begin
    if D<273 then begin
     if D<243 then if D<212 then M:=7 else M:=8 else M:=9;
    end else begin
     if D<334 then if D<304 then M:=10 else M:=11 else M:=12;
    end;
   end;
   Day:=D-SumMonthDays[false,M]+1;
  end;
  Month:=M;
end;

function optimizedDate: TDateTime;
var SystemTime:TSystemTime;
begin
   GetLocalTime(SystemTime);
   with SystemTime do Result := optimizedEncodeDate(wYear,wMonth,wDay);
end;
{$endif}

function fnmatch;
begin
   if P then
   begin
      if Pattern^ = '?' then
      begin
         Inc(Filename);
      end
      else
      begin
         while Filename^ <> Pattern^ do
         begin
            if Filename^ = EOS then
            begin
               Result := False;
               Exit;
            end;

            Inc(Filename);
         end;
      end;
   end;

   while Filename^ <> EOS do
   begin
      case Pattern^ of
         EOS:
         begin
            Result := (Filename^ = EOS);
            Exit;
         end;

         '?':
         begin
            if Filename^ = EOS then
            begin
               Result := False;
               Exit;
            end;

            Inc(Filename);
         end;

         '*':
         begin
            while Pattern^ = '*' do Inc(Pattern);

            if Pattern^ = EOS then
            begin
               Result := True;
               Exit;
            end;

            while Pattern^ <> EOS do
            begin
               if fnmatch(Pattern, Filename, True) then
               begin
                  Result := True;
                  Exit;
               end
               else
               begin
                  Inc(Filename);
                  if Filename^ = EOS then
                  begin
                     Result := False;
                     Exit;
                  end;
               end;
            end;

            Result := False;
            Exit;
         end;

         else
         begin
            if Filename^ <> Pattern^ then
            begin
               Result := False;
               Exit;
            end;
            Inc(Filename);
         end;
      end;

      Inc(Pattern);
   end;

   Result := (Pattern^ = EOS);
end;

{$ifndef DELPHI5}
procedure FreeAndNil;
var
   P: TObject;
begin
   P := TObject(Obj);
   TObject(Obj) := nil;  // clear the reference before destroying the object
   P.Free;
end;
{$endif}

function GetWindowsDirectory: String;
begin
   Result := WinDir;
end;

initialization
   {$ifdef OPTIMIZATION}
   optimizedDecodeDate(optimizedDate, CurrentYear, Temp, Temp);
   {$else}
   DecodeDate(Date, CurrentYear, Temp, Temp);
   {$endif}
   CYS := IntToStr(CurrentYear);
   {$ifndef Y2K_DATE}
   Delete(CYS, 1, 2);
   {$endif}

   GetMem(PS, 254);
   Windows.GetWindowsDirectory(PS, 254);
   WinDir := StrPas(PS);
   GetTempPath(254, PS);
   TempDir := StrPas(PS);

finalization
   FreeMem(PS);
end.