home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / nastroje / d5 / MFTP.ZIP / src / FTPCache.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-03-05  |  4.2 KB  |  182 lines
  1. unit FtpCache;
  2.  
  3. {Cache implementation of Monster FTP}
  4.  
  5. interface
  6.  
  7. uses Classes, SysUtils, Windows, FtpData, ftpmisc;
  8.  
  9. {$I mftp.inc}
  10.  
  11. procedure InitCache;
  12. function GetCacheFilename(Server, FUser, FDirectory: String; Port: Integer; Folder: Boolean): String;
  13.  
  14. function LoadFromCache(F: String; D: TMFtpFileInfoList; Expire: Integer): Boolean;
  15. procedure SaveToCache(F: String; D: TMFtpFileInfoList);
  16.  
  17. function BuildDateValue(DT: TDateTime): Longint;
  18.  
  19. function CleanCache(CleanDirectory, CleanFile: Boolean; Expire: Integer): Integer;
  20.  
  21. implementation
  22.  
  23. {$ifdef USE_MSDPE}
  24. uses ImageHlp;
  25. {$endif}
  26.  
  27. var CacheDirectory: String;
  28.     DayValue: Longint;
  29.  
  30. procedure InitCache;
  31. begin
  32.    CacheDirectory := GetWindowsDirectory + '\ftpcache\';
  33.    {$ifndef USE_MSDPE}
  34.       CreateDirectoryA(PChar(CacheDirectory), nil); {ignore errors}
  35.    {$else}
  36.       MakeSureDirectoryPathExists(PChar(CacheDirectory));
  37.    {$endif}
  38.    FileSetAttr(CacheDirectory, faHidden or faSysFile);
  39.  
  40.    DayValue := BuildDateValue(Now);
  41. end;
  42.  
  43. function GetCacheFilename;
  44. var S: String;
  45. begin
  46.    if (LowerCase(FUser) = 'ftp') or (LowerCase(FUser) = 'anonymous') then
  47.       S := Server +  '[' + IntToStr(Port) + ']-' + FDirectory
  48.    else
  49.       S := Server +  '[' + IntToStr(Port) + ']-' + '(' + FUser + ')-' + FDirectory;
  50.  
  51.    Result := CacheDirectory + ReplaceInvalidChars(S, '~') + '.cache';
  52.  
  53.    if Folder then
  54.       Result := Result + 'd'
  55.    else
  56.       Result := Result + 'f';
  57. end;
  58.  
  59. function LoadFromCache;
  60. var Count, i: Integer;
  61.     R: TSearchRec;
  62.     S: Array[0..7] of String;
  63.     C: TextFile;
  64.     FD: TDateTime;
  65. begin
  66.    try
  67.       if FindFirst(F, faHidden + faSysFile, R) <> 0 then
  68.       begin
  69.          Result := False;
  70.          Exit;
  71.       end;
  72.  
  73.       if Expire > 0 then
  74.       begin
  75.          FD := FileDateToDateTime(R.Time);
  76.          if BuildDateValue(FD) + Expire <= DayValue then
  77.          begin
  78.             Result := False;
  79.             Exit;
  80.          end;
  81.       end;
  82.  
  83.       AssignFile(C, F);
  84.       Reset(C);
  85.  
  86.       D.Clear;
  87.       Readln(C, Count);
  88.       for i := 0 to Count - 1 do
  89.       begin
  90.          Readln(C, S[0]);
  91.          Readln(C, S[1]);
  92.          Readln(C, S[2]);
  93.          Readln(C, S[3]);
  94.          Readln(C, S[4]);
  95.          Readln(C, S[5]);
  96.          Readln(C, S[6]);
  97.          Readln(C, S[7]);
  98.          D.Add(S[0], S[1], S[2], S[3], S[4], S[5], S[6], S[7]);
  99.       end;
  100.  
  101.       CloseFile(C);
  102.       Result := True;
  103.    except
  104.       Result := False;
  105.    end;
  106. end;
  107.  
  108. procedure SaveToCache;
  109. var i: Integer;
  110.     C: TextFile;
  111. begin
  112.    try
  113.       AssignFile(C, F);
  114.       Rewrite(C);
  115.  
  116.       Writeln(C, D.Count);
  117.       for i := 0 to D.Count - 1 do
  118.       begin
  119.          Writeln(C, D[i].Filename);
  120.          Writeln(C, D[i].Attrib);
  121.          Writeln(C, D[i].DateTime);
  122.          Writeln(C, D[i].Size);
  123.          Writeln(C, D[i].SymbolLink);
  124.          Writeln(C, D[i].Owner);
  125.          Writeln(C, D[i].Group);
  126.          Writeln(C, D[i].Description);
  127.       end;
  128.  
  129.       CloseFile(C);
  130. //    if not Win32Platform <> VER_PLATFORM_WIN32_NT then FileSetAttr(F, faHidden or faSysFile);
  131.    except;
  132.       InitCache;
  133.    end;
  134. end;
  135.  
  136. function CleanCache;
  137. var i: Integer;    
  138.     FD: TDateTime;
  139.     R: TSearchRec;
  140.     S: String;
  141. begin
  142.    Result := 0;
  143.    if (CleanFile = False) and (CleanDirectory = False) then Exit;
  144.  
  145.    i := FindFirst(CacheDirectory + '*.*', faHidden + faSysFile, R);
  146.  
  147.    while i = 0 do
  148.    begin
  149.       if ((CleanDirectory) and (Pos('.cached', R.Name) > 0)) or
  150.          ((CleanFile) and (Pos('.cachef', R.Name) > 0)) then
  151.       begin
  152.          if Expire > 0 then
  153.          begin
  154.             FD := FileDateToDateTime(R.Time);
  155.             if BuildDateValue(FD) + Expire <= DayValue then
  156.             begin
  157.                S := CacheDirectory + String(R.Name);
  158.                if DeleteFile(PChar(S)) then Inc(Result);
  159.             end;
  160.          end;
  161.       end;
  162.  
  163.       i := FindNext(R);
  164.    end;
  165. end;
  166.  
  167. function BuildDateValue(DT: TDateTime): Longint;
  168. var Year, Month, Day:Word;
  169. begin
  170.    {$ifdef OPTIMIZATION}
  171.    optimizedDecodeDate(DT, Year, Month, Day);
  172.    {$else}
  173.    DecodeDate(DT, Year, Month, Day);
  174.    {$endif}
  175.    Result := Year * 10000 + Month * 100 + Day;
  176. end;
  177.  
  178. initialization
  179.    FileMode := 2;
  180.    InitCache;
  181. end.
  182.