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

Pascal/Delphi Source File | 2001-03-05 | 10.2 KB | 433 lines

unit FtpData;

{Infomation management implementation of Monster FTP}

interface

uses Classes, SysUtils, Windows, ShellApi, FtpMisc;

{$I mftp.inc}

const
   MaxItem           =  7;
   ItemAttrib        =  0;
   ItemDateTime      =  1;
   ItemSize          =  2;
   ItemSymbolLink    =  3;
   ItemDescription   =  4;
   ItemFilename      =  5;
   ItemOwner         =  6;
   ItemGroup         =  7;

   { fill in dynamically}
   ItemFileType      =  8;
   ItemDateTimeValue = -1;

type
   MFtpFileInfo = record
      Attrib:              String;
      DateTime:            String;
      DateTimeValue:       String;
      Description:         String;
      Filename:            String;
      Size:                String;
      SymbolLink:          String;
      Owner:               String;
      Group:               String;
   end;

   TGetString = function (I: Integer): String of Object;

   TMFtpFileInfoList = class(TObject)
   private
      FData: Array[-1..MaxItem] of TStringList;

      FCount:               Integer;

      function Get(I: Integer): MFtpFileInfo;
      procedure Put(I: Integer; const P: MFtpFileInfo);

      function gsFilename(I: Integer): String;
      function gsAttrib(I: Integer): String;
      function gsDateTimeValue(I: Integer): String;
      function gsDescription(I: Integer): String;
      function gsFileType(I: Integer): String;
      function gsSize(I: Integer): String;
      function gsOwner(I: Integer): String;
      function gsGroup(I: Integer): String;
   public
      constructor Create;
      destructor Destroy; override;
      procedure Assign(Source: TMFtpFileInfoList);

      procedure Add(S1, S2, S3, S4, S5, S6, S7, S8: String); overload;
      procedure Add(const P: MFtpFileInfo); overload;
      procedure Clear;
      procedure ClearPart(ItemType: Integer);
      procedure Delete(I: Integer);
      procedure MyFree;
      procedure Sort(ItemType: Integer; Ascending: Boolean);
      procedure Swap(I1, I2: Integer);

      function IndexOf(S: String): Integer;

//    function GetData(I, ItemType: Integer): String;
      procedure PutData(I, ItemType: Integer; Value: String);

      property Count: Integer read FCount;
      property Items[Index: Integer]: MFtpFileInfo read Get write Put; default;
   end;

implementation

constructor TMFtpFileInfoList.Create;
var i: Integer;
begin
   inherited Create;

   for i := -1 to MaxItem do FData[i] := TStringList.Create;
end;

destructor TMFtpFileInfoList.Destroy;
begin
   MyFree;

   inherited Destroy;
end;

procedure TMFtpFileInfoList.Assign;
var i: Integer;
begin
   Clear;

   for i := 0 to Source.Count - 1 do
      Add(Source[i].Filename,
          Source[i].Attrib,
          Source[i].DateTime,
          Source[i].Size,
          Source[i].SymbolLink,
          Source[i].Owner,
          Source[i].Group,
          Source[i].Description);
end;

procedure TMFtpFileInfoList.Add(S1, S2, S3, S4, S5, S6, S7, S8: String);
begin
   FData[ItemAttrib].Add(S2);
   FData[ItemDateTime].Add(S3);
   FData[ItemSize].Add(S4);
   FData[ItemSymbolLink].Add(S5);
   FData[ItemDescription].Add(S8);
   FData[ItemFilename].Add(S1);
   FData[ItemOwner].Add(S6);
   FData[ItemGroup].Add(S7);
   FData[ItemDateTimeValue].Add('');

   Inc(FCount);
end;

procedure TMFtpFileInfoList.Add(const P: MFtpFileInfo);
begin
   FData[ItemAttrib].Add(P.Attrib);
   FData[ItemDateTime].Add(P.DateTime);
   FData[ItemSize].Add(P.Size);
   FData[ItemSymbolLink].Add(P.SymbolLink);
   FData[ItemDescription].Add(P.Description);
   FData[ItemFilename].Add(P.Filename);
   FData[ItemOwner].Add(P.Owner);
   FData[ItemGroup].Add(P.Group);
   FData[ItemDateTimeValue].Add('');

   Inc(FCount);
end;

procedure TMFtpFileInfoList.Clear;
var i: Integer;
begin
   FCount := 0;

   for i := -1 to MaxItem do FData[i].Clear;
end;

procedure TMFtpFileInfoList.ClearPart;
var i: Integer;
begin
   for i := 0 to FCount - 1 do
      FData[ItemType].Strings[i] := '';
end;

procedure TMFtpFileInfoList.Delete;
var j: Integer;
begin
   for j := -1 to MaxItem do FData[j].Delete(i);
end;

procedure TMFtpFileInfoList.MyFree;
var i: Integer;
begin
   for i := -1 to MaxItem do
      FreeAndNil(FData[i]);
end;

procedure TMFtpFileInfoList.Swap;
var i: Integer;
begin
   for i := -1 to MaxItem do FData[i].Exchange(I1, I2);
end;

function TMFtpFileInfoList.IndexOf;
begin
   Result := FData[ItemFilename].IndexOf(S);
end;

{
   function TMFtpFileInfoList.GetData;
   begin
   end;
}

procedure TMFtpFileInfoList.PutData;
begin
   FData[ItemType].Strings[i] := Value;
end;

function TMFtpFileInfoList.Get;
begin
   Result.Attrib := FData[ItemAttrib].Strings[I];
   Result.DateTime := FData[ItemDateTime].Strings[I];
   Result.Size := FData[ItemSize].Strings[I];
   Result.SymbolLink := FData[ItemSymbolLink].Strings[I];
   Result.Description := FData[ItemDescription].Strings[I];
   Result.Filename := FData[ItemFilename].Strings[I];
   Result.Owner := FData[ItemOwner].Strings[I];
   Result.Group := FData[ItemGroup].Strings[I];
end;

procedure TMFtpFileInfoList.Put;
begin
   FData[ItemAttrib].Strings[I] := P.Attrib;
   FData[ItemDateTime].Strings[I] := P.DateTime;
   FData[ItemSize].Strings[I] := P.Size;
   FData[ItemSymbolLink].Strings[I] := P.SymbolLink;
   FData[ItemDescription].Strings[I] := P.Description;
   FData[ItemFilename].Strings[I] := P.Filename;
   FData[ItemOwner].Strings[I] := P.Owner;
   FData[ItemGroup].Strings[I] := P.Group;
end;

function TMFtpFileInfoList.gsFilename;
begin
   Result := FData[ItemFilename].Strings[I];
end;

function TMFtpFileInfoList.gsAttrib;
begin
   Result := FData[ItemAttrib].Strings[I];
end;

function TMFtpFileInfoList.gsDateTimeValue;
begin
   Result := FData[ItemDateTimeValue].Strings[I];
end;

function TMFtpFileInfoList.gsDescription;
begin
   Result := FData[ItemDescription].Strings[I];
end;

function TMFtpFileInfoList.gsFileType;
var
   ShInfo: TSHFileInfo;
begin
   SHGetFileInfo(PChar(FData[ItemFilename].Strings[I]), 0, ShInfo, SizeOf(TSHFileInfo),
                 SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES);
   Result := ShInfo.szTypeName;
end;

function TMFtpFileInfoList.gsSize;
begin
   Result := FData[ItemSize].Strings[I];
end;

function TMFtpFileInfoList.gsOwner;
begin
   Result := FData[ItemOwner].Strings[I];
end;

function TMFtpFileInfoList.gsGroup;
begin
   Result := FData[ItemGroup].Strings[I];
end;

procedure TMFtpFileInfoList.Sort;
var Temp: Word;
    GetString: TGetString;
   function BuildDateValue(S: String): String;
   var Year, Month, Day: String;
       CP: Word;
   begin
      Month := Copy(S, 1, 2);

      if Month[2] = '/' then
      begin
         Month[2] := Month[1];
         Month[1] := '0';
         CP := 3;
      end
      else
      begin
         CP := 4;
      end;

      Day := Copy(S, CP, 2);
      if Day[2] = '/' then
      begin
         Day[2] := Day[1];
         Day[1] := '0';
         Inc(CP, 2);
      end
      else
      begin
         Inc(CP, 3);
      end;

      {$ifndef Y2K_DATE}
      Year := Copy(S, CP, 2);
      Inc(CP, 3);
      if Year >= '70' then
         Result := '19' + Year + Month + Day
      else
         Result := '20' + Year + Month + Day;
      {$else}
      Year := Copy(S, CP, 4);
      Inc(CP, 5);
      Result := Year + Month + Day;
      {$endif}

      {$ifndef Y2K_DATE}
      Result := Result + Copy(S, CP, 2);
      if Result[10] = ':' then
      begin
         Result[10] := Result[9];
         Result[9] := '0';
      end;
      {$else}
      Result := Result + Copy(S, CP, 2);
      if Result[12] = ':' then
      begin
         Result[12] := Result[11];
         Result[11] := '0';
      end;
      {$endif}

      Result := Result + Copy(S, Length(S) - 4, 5);
   end;
   function Compare(S, S1: String): Integer;
   var I1, I2: Integer;
   begin
      if S = S1 then
      begin
         Result := 0;
         Exit;
      end;
      case ItemType of
         ItemSize:
         begin
            I1 := StrToInt(S);
            I2 := StrToInt(S1);
            if I1 < I2 then
               Result := -1
            else
               Result := 1;
         end;
         else
         begin
            {$ifdef OPTIMIZATION}
            Result := optimizedAnsiCompareText(S, S1);
            {$else}
            Result := AnsiCompareText(S, S1);
            {$endif}
         end;
      end;
      if not Ascending then Result := -Result;
   end;
   procedure QuickSort(L, R: Integer);
   var I, J: Integer;
       P: string;
   begin
      repeat
         I := L;
         J := R;
         P := GetString((L + R) shr 1);
         repeat
            while Compare(GetString(I), P) < 0 do Inc(I);
            while Compare(GetString(J), P) > 0 do Dec(J);
            if I <= J then
            begin
               Swap(I, J);
               Inc(I);
               Dec(J);
            end;
         until I > J;
         if L < J then QuickSort(L, J);
         L := I;
      until I >= R;
   end;
begin
   if FCount > 1 then
   begin
      case ItemType of
         ItemFilename:
         begin
            GetString := gsFilename;
         end;

         ItemAttrib:
         begin
            GetString := gsAttrib;
         end;

         ItemDateTime:
         begin
            for Temp := 0 to FCount - 1 do
               FData[ItemDateTimeValue].Strings[Temp] := BuildDateValue(FData[ItemDateTime].Strings[Temp]);
            GetString := gsDateTimeValue;
         end;

         ItemDescription:
         begin
            GetString := gsDescription;
         end;

         ItemFileType:
         begin
            GetString := gsFileType;
         end;

         ItemSize:
         begin
            GetString := gsSize;
         end;

         ItemOwner:
         begin
            GetString := gsOwner;
         end;

         ItemGroup:
         begin
            GetString := gsGroup;
         end;

         else
         begin
            Exit;
         end;
      end;
      QuickSort(0, FCount - 1);
   end;
end;

end.