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

📄 ftpcache.pas

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

{Cache implementation of Monster FTP Client}
interface

uses Classes, SysUtils, Windows, FtpData, ftpmisc;

{$I mftp.inc}

procedure InitCache;
function LoadFromCache(F: String; D: TStrings; DI: TMFtpFileInfoList; Expire: Integer): Boolean;
procedure SaveToCache(F: String; D: TStrings; DI: TMFtpFileInfoList);

function BuildDateValue(DT: TDateTime): Longint;

implementation

var CacheDirectory: String;
    DayValue: Longint;

procedure InitCache;
begin
   CacheDirectory := GetWindowsDirectory + '\ftpcache\';
   CreateDirectoryA(PChar(CacheDirectory), nil); {ignore errors}
   FileSetAttr(CacheDirectory, faHidden or faSysFile);
   DayValue := BuildDateValue(Now);
end;

function ReplaceInvalidChars(const s: string; RepWith: Char): string;
{ 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;

function LoadFromCache;
var Count, i: Integer;
    R: TSearchRec;
    S: Array[0..4] of String;
    C: TextFile;
    FD: TDateTime;
begin
   try
      F := CacheDirectory + ReplaceInvalidChars(F, '~');

      if FindFirst(F, faHidden + faSysFile, R) <> 0 then
      begin
         Result := False;
         Exit;
      end;

      if Expire > 0 then
      begin
         FD := FileDateToDateTime(R.Time);
         if BuildDateValue(FD) + Expire <= DayValue then
         begin
            Result := False;
            Exit;
         end;
      end;

      AssignFile(C, F);
      Reset(C);

      D.Clear;
      DI.Clear;
      Readln(C, Count);
      for i := 0 to Count - 1 do
      begin
         Readln(C, S[0]);
         D.Add(S[0]);
         Readln(C, S[0]);
         Readln(C, S[1]);
         Readln(C, S[2]);
         Readln(C, S[3]);
         Readln(C, S[4]);
         DI.Add(S[0], S[1], S[2], S[3], S[4]);
      end;

      CloseFile(C);
      Result := True;
   except
      Result := False;
   end;
end;

procedure SaveToCache;
var i: Integer;
    C: TextFile;
begin
   try
      F :=  CacheDirectory + ReplaceInvalidChars(F, '~');

      AssignFile(C, F);
      Rewrite(C);

      Writeln(C, D.Count);
      for i := 0 to D.Count - 1 do
      begin
         Writeln(C, D[i]);
         Writeln(C, DI[i, 0]);
         Writeln(C, DI[i, 1]);
         Writeln(C, DI[i, 2]);
         Writeln(C, DI[i, 3]);
         Writeln(C, DI[i, 4]);
      end;

      CloseFile(C);
      if not IsNT then FileSetAttr(F, faHidden or faSysFile);
   except;
      InitCache;
   end;
end;

function BuildDateValue(DT: TDateTime): Longint;
var Year, Month, Day:Word;
begin
   {$ifdef OPTIMIZATION}
   optimizedDecodeDate(DT, Year, Month, Day);
   {$else}
   DecodeDate(DT, Year, Month, Day);
   {$endif}
   Result := Year * 10000 + Month * 100 + Day;
end;

initialization
   InitCache;
end.

⌨️ 快捷键说明

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