⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ftpdata.pas

📁 Monster FTP Client 强大的ftp客户控件,支持Proxy等
💻 PAS
字号:
unit FtpData;

{Infomation management implementation of Monster FTP Client}
interface

uses Classes, SysUtils, Windows, Dialogs, ftpmisc;

{$I mftp.inc}

const
   ItemAttrib    = 0;
   ItemDateTime  = 1;
   ItemSize      = 2;
   ItemSymbolLink = 3;
   ItemDescription = 4;
   ItemDateTimeValue = -1; {for internal use only}

type TMFtpFileInfoList = class(TObject)
   private
      Attribs: TStringList;
      DateTimes: TStringList;
      Sizes: TStringList;
      SymbolLinks: TStringList;
      Descriptions: TStringList;
      DateTimeValues: TStringList;

      procedure Check;
   protected
      function Get(Index, ItemType: Integer): String;
   public
      procedure Clear;
      procedure ClearPart(ItemType: Integer);
      procedure Free;
      procedure Add(Attrib, DateTime, Size, SymbolLink, Description: String);
      property Items[Index, ItemType: Integer]: String read Get; default;

      procedure Put(Index, ItemType: Integer; S: String);
    end;

procedure SortLists(L: TStrings; LI: TMFtpFileInfoList; Base: Integer; Ascending: Boolean);

implementation

procedure TMFtpFileInfoList.Check;
begin
   if Attribs <> nil then Exit;

   Attribs := TStringList.Create;
   DateTimes := TStringList.Create;
   Sizes := TStringList.Create;
   SymbolLinks := TStringList.Create;
   Descriptions := TStringList.Create;
   DateTimeValues := TStringList.Create;
end;

procedure TMFtpFileInfoList.Clear;
begin
   Check;

   Attribs.Clear;
   DateTimes.Clear;
   Sizes.Clear;
   SymbolLinks.Clear;
   Descriptions.Clear;
   DateTimeValues.Clear;
end;

procedure TMFtpFileInfoList.ClearPart(ItemType: Integer);
var i: Integer;
begin
   case ItemType of
      ItemAttrib:
         for i := 0 to Attribs.Count - 1 do
            Attribs[i] := '';
      ItemDateTime:
         for i := 0 to DateTimes.Count - 1 do
            DateTimes[i] := '';
      ItemSize:
         for i := 0 to Sizes.Count - 1 do
            Sizes[i] := '';
      ItemSymbolLink:
         for i := 0 to SymbolLinks.Count - 1 do
            SymbolLinks[i] := '';
      ItemDescription:
         for i := 0 to Descriptions.Count - 1 do
            Descriptions[i] := '';
      ItemDateTimeValue:
         for i := 0 to DateTimeValues.Count - 1 do
            DateTimeValues[i] := '';
   end;
end;

procedure TMFtpFileInfoList.Free;
begin
   Attribs.Free;
   DateTimes.Free;
   Sizes.Free;
   SymbolLinks.Free;
   Descriptions.Free;
   DateTimeValues.Free;
end;

procedure TMFtpFileInfoList.Add;
begin
   Check;

   Attribs.Add(Attrib);
   DateTimes.Add(DateTime);
   Sizes.Add(Size);
   SymbolLinks.Add(SymbolLink);
   Descriptions.Add(Description);
   DateTimeValues.Add('');
end;

function TMFtpFileInfoList.Get;
begin
   Check;

   case ItemType of
      ItemAttrib:
         Result := Attribs[Index];
      ItemDateTime:
         Result := DateTimes[Index];
      ItemSize:
         Result := Sizes[Index];
      ItemSymbolLink:
         Result := SymbolLinks[Index];
      ItemDescription:
         Result := Descriptions[Index];
      ItemDateTimeValue:
         Result := DateTimeValues[Index];
   end;
end;

procedure TMFtpFileInfoList.Put;
begin
   Check;

   case ItemType of
      ItemAttrib:
         Attribs[Index] := S;
      ItemDateTime:
         DateTimes[Index] := S;
      ItemSize:
         Sizes[Index] := S;
      ItemSymbolLink:
         SymbolLinks[Index] := S;
      ItemDescription:
         Descriptions[Index] := S;
      ItemDateTimeValue:
         DateTimeValues[Index] := S;
   end;
end;

procedure SortLists;
var Temp: Word;
   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;

      Year := Copy(S, CP, 2);
      Inc(CP, 3);
      if Year >= '70' then
         Result := '19' + Year + Month + Day
      else
         Result := '20' + Year + Month + Day;

      Result := Result + Copy(S, CP, 2);
      if Result[10] = ':' then
      begin
         Result[10] := Result[9];
         Result[9] := '0';
      end;

      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 Base 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 ExchangeItems(I, J: Integer);
   var S: String;
       t: Integer;
   begin
      S := L[I];
      L[I] := L[J];
      L[J] := S;
      for t := -1 to 4 do
      begin
         S := LI[I, t];
         LI.Put(I, t, LI[J, t]);
         LI.Put(J, t, S);
      end;
   end;
   function GetString(I: Integer): String;
   begin
      if (Base > 4) or (Base < -1) then
         Result := L[I]
      else
         Result := LI[I, Base];
   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
               ExchangeItems(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 L.Count > 0 then
   begin
      if Base = ItemDateTime then
      begin
         for Temp := 0 to L.Count - 1 do
            LI.Put(Temp, ItemDateTimeValue, BuildDateValue(LI[Temp, ItemDateTime]));
         Base := ItemDateTimeValue;
         QuickSort(0, L.Count - 1);
      end
      else
         QuickSort(0, L.Count - 1);
   end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -