FileGuard/StorageUnit.pas

   1 {--- Õðàíèëèùå ôàéëîâ --- - ýòî äèðåêòîðèÿ (æåëàòåëüíî íà äðóãîì âèí÷åñòåðå) èëè
   2   ðàñøàðåííàÿ ñåòåâàÿ ïàïêà ñëåäóþùåé ñòðóêòóðû:
   3   - äëÿ êàæäîé èñõîäíîé ìàøèíû ñîçäàåòñÿ ñâîÿ äèðåêòîðèÿ ñ èìåíåì êîìïüþòåðà;
   4   - èñòîðèÿ äëÿ ôàéëîâ, ñîõðàíÿåòñÿ â ôàéëå ñ èìåíåì NNNNNNNN+èìÿ-ôàéëà.ext;
   5
   6   Ïðè ñîõðàíåíèè âñåé èñòîðèè ôàéëà â ôàéëå õðàíèëèùà ñ èìåíåì
   7   NNNNNNNN+èìÿ-ôàéëà.ext ôîðìàò ñëåäóþùèé:
   8   - äàòà ïîñëåäíåé ìîäèôèêàöèè íà ìîìåíò ñîõðàíåíèÿ (TFileTime, 8 áàéò);
   9   - ðàçìåð ôàéëà íå ñæàòûé, 4 áàéòà;
  10   - êîíòðîëüíàÿ ñóììà, 4 áàéòà;
  11   - òèï çàïèñè: áèò0: 0 - ñàì ôàéë, 1 - äàííûå äëÿ èçìåíåíèÿ
  12                 áèò1: 0 - áåç ñæàòèÿ, 1 - èñïîëüçóåòñÿ ñæàòèå (UPX)
  13   - äëèíà áëîêà = Lc: 4 áàéòà (åñëè ñæàò, òî ñëåäêþùèå 4 áàéòà ñþäà âõîäÿò)
  14   - åñëè áëîê ñæàò, òî äëèíà íåñæàòîãî ñîäåðæèìîãî áëîêà Ln: 4 áàéòà
  15   - áëîê: Lc-4 áàéò åñëè íå ñæàòî, èíà÷å Ln
  16 }
  17 unit StorageUnit;
  18
  19 interface
  20
  21 uses Windows, KOL, FileVersionUnit;
  22
  23 type
  24   TEnumSectionsProc = procedure( FileStream: PStream; const FI: TFileVersionInfo;
  25     SectionType: Byte; SectionLen: DWORD; var Continue: Boolean ) of object;
  26
  27   PStorage = ^TStorage;
  28   TStorage = object( TObj )
  29   private
  30     FPath: String;
  31     FOK: Boolean;
  32     procedure SetPath(const Value: String);
  33   protected
  34     FMachineName: String;
  35     procedure Init; virtual;
  36   public
  37     destructor Destroy; virtual;
  38     property Path: String read FPath write SetPath;
  39     property OK: Boolean read FOK;
  40   public
  41     DirsIndex: PStrListEx;
  42     function DirPrefix( const DirPath: String ): String; // 8 öèôð ïî èìåíè äèðåêòîðèè
  43   public
  44     function CheckFile( const SrcFilePath: String; var ChkSum: DWORD ): Boolean;
  45     // ôàéë èçìåíèëñÿ ñ ïîñëåäíåãî ñîõðàíåíèÿ? Åñëè êîíòðîëüíàÿ ñóììà áûëà
  46     // ïîñ÷èòàíà, òî îíà âîçâðàùàåòñÿ <> 0
  47     procedure UpdateFile( const SrcFilePath: String; ChkSum: DWORD; Action: Integer );
  48     // îáíîâèòü ôàéë â áàçå
  49     function SaveFileHistory( const SrcFilePath: String ): Boolean;
  50     // ïðîñìîòð ñåêöèé àðõèâà îäíîãî ôàéëà
  51   public
  52     FoundLastFullVersionPos: DWORD;
  53     LastInfo: TFileVersionInfo;
  54     LastVersion: PStream;
  55     UnpackError: Boolean;
  56     UnpackingFile: String;
  57     procedure EnumSections( FileStream: PStream; EnumProc: TEnumSectionsProc );
  58     // ïîèñê ïîñëåäíåé ïîëíîé ñåêöèè, ñ êîòîðîé ìîæíî íà÷àòü âîññòàíîâëåíèå
  59     // ïîñëåäíåé ñîõðàíåííîé ñåêöèè
  60     procedure LookForLastFullVersion( FileStream: PStream; const FI: TFileVersionInfo;
  61       SecType: Byte; SecLen: DWORD; var Cont: Boolean );
  62     // ïîèñê è âîññòàíîâëåíèå ñàìîé ïîñëåäíåé ñîõðàíåííîé âåðñèè ôàéëà
  63     procedure LookRestoreLastVersion( FileStream: PStream; const FI: TFileVersionInfo;
  64       SecType: Byte; SecLen: DWORD; var Cont: Boolean );
  65     // ïîèñê èíôîðìàöèè î ïîñëåäíåé ñîõðàíåííîé âåðñèè: äàòà, êîíòðîëüíàÿ ñóììà è ðàçìåð
  66     procedure LookForLastVersionInfo( FileStream: PStream; const FI: TFileVersionInfo;
  67       SecType: Byte; SecLen: DWORD; var Cont: Boolean );
  68     procedure ProgressHandler( Percents, CurrentPosition, TotalSize: Integer;
  69               var Cancel: Boolean );
  70   public
  71     CacheVersionInfo: PStrListEx;
  72     procedure ClearCacheVersionInfo;
  73     procedure PutCachedVersionInfo( const SrcFilePath: String; var FI: TFileVersionInfo );
  74     function GetCachedVersionInfo( const SrcFilePath: String; var FI: TFileVersionInfo ): Boolean;
  75     procedure DelCachedVersionInfo( const SrcFilePath: String );
  76     procedure UpdCachedVersionInfo( const SrcFilePath: String; const ft: TFileTime );
  77   end;
  78
  79 var
  80   Storage: PStorage;
  81
  82 implementation
  83
  84 uses MainUnit, DIUCLStreams, UpdatesUnit;
  85
  86 function CalcFileCheckSum( const FS: PStream; var ChkSum: DWORD ): Boolean;
  87          overload;
  88 var BufSize: Integer;
  89     L: DWORD;
  90     Buf, B: PByte;
  91 begin
  92   Result := FALSE;
  93   BufSize := Min( FS.Size, 65536 * 16 );
  94   GetMem( Buf, BufSize );
  95   ChkSum := 0;
  96   TRY
  97     while FS.Position < FS.Size do
  98     begin
  99       L := Min( BufSize, FS.Size - FS.Position );
 100       if FS.Read( Buf^, L ) <> L then Exit;
 101       B := Buf;
 102       while L > 0 do
 103       begin
 104         ChkSum := (ChkSum shl 1) xor B^;
 105         Inc( B );
 106         Dec( L );
 107       end;
 108     end;
 109     Result := TRUE;
 110   FINALLY
 111     FreeMem( Buf );
 112   END;
 113 end;
 114
 115 function CalcFileCheckSum( const FilePath: String; var ChkSum: DWORD ): Boolean;
 116          overload;
 117 var FS: PStream;
 118 begin
 119   Result := FALSE;
 120   FS := NewReadFileStream( FilePath );
 121   TRY
 122     if FS.Handle = INVALID_HANDLE_VALUE then Exit;
 123     Result := CalcFileCheckSum( FS, ChkSum );
 124   FINALLY
 125     FS.Free;
 126   END;
 127 end;
 128
 129 { TStorage }
 130
 131 function TStorage.CheckFile(const SrcFilePath: String; var ChkSum: DWORD): Boolean;
 132 var P: String;
 133     FN: String;
 134     DL: PDirList;
 135     I, J: Integer;
 136     FI: TFileVersionInfo;
 137     FS: PStream;
 138 begin
 139   ChkSum := 0;
 140   Result := FALSE;
 141   P := DirPrefix( ExtractFilePath( SrcFilePath ) );
 142   FN := ExtractFileName( SrcFilePath );
 143   if P = '' then Exit;
 144   if not FileExists( FPath + P + '+' + FN ) then Exit;
 145
 146   if not GetCachedVersionInfo( SrcFilePath, FI ) then
 147   begin
 148
 149     Log( '-Checking: ' + SrcFilePath );
 150     FS := NewReadFileStream( FPath + P + '+' + FN );
 151     TRY
 152       FillChar( LastInfo, Sizeof( LastInfo ), 0 );
 153       EnumSections( FS, LookForLastVersionInfo );
 154       FI := LastInfo;
 155       PutCachedVersionInfo( SrcFilePath, FI );
 156     FINALLY
 157       FS.Free;
 158     END;
 159
 160   end;
 161
 162   //DL := NewDirList( ExtractFilePath( SrcFilePath ), FN, FILE_ATTRIBUTE_NORMAL );
 163   DL := NewDirList( '', '', 0 );
 164   DL.OnItem := fmMainGuard.AcceptDirItem;
 165   DL.ScanDirectory( ExtractFilePath( SrcFilePath ), FN, FILE_ATTRIBUTE_NORMAL );
 166   TRY
 167     J := -1;
 168     for I := 0 to DL.Count-1 do
 169     begin
 170       if not DL.IsDirectory[ I ] then
 171       if AnsiEq( DL.Names[ I ], FN ) then
 172       begin
 173         J := I; break;
 174       end;
 175     end;
 176     if (J < 0) or (DL.Items[ J ].nFileSizeHigh <> 0) then
 177     begin
 178       //--- âîîáùå-òî ýòî îøèáêà êàêàÿ-òî èëè ôàéë óæå óñïåëè óáðàòü ñ èñõîäíîãî
 179       // äèñêà (èëè íàïðèìåð ïåðåèìåíîâàòü). Èëè ôàéë ñëèøêîì âåëèê.
 180       // Áîëüøå íà íåãî íå ñìîòðåòü è íå ñîõðàíÿòü
 181       Result := TRUE; Exit;
 182     end;
 183     if FI.Sz <> DL.Items[ J ].nFileSizeLow then
 184       Exit; // äëèíà íå ñîâïàëà
 185     if CompareFileTime( DL.Items[ J ].ftLastWriteTime, FI.FT ) <> 0 then
 186       Exit; // âðåìÿ ïîñëåäíåãî èçìåíåíèÿ íå ñîâïàëî
 187     {if not CalcFileCheckSum( SrcFilePath, ChkSum ) then
 188     begin //--- òîæå îøèáêà, èëè ôàéë óñòðàíèëñÿ
 189       Result := TRUE; Exit;
 190     end;
 191     if ChkSum <> FI.ChkSum then
 192       Exit; // êîíòðîëüíàÿ ñóììà íå ñîâïàëà}
 193     Result := TRUE; // âñå ñîâïàëî - ñ÷èòàåì, ÷òî ôàéë íå èçìåíèëñÿ!
 194   FINALLY
 195     DL.Free;
 196     Log( '-Checked(' + Int2Str( Integer( Result ) ) + '): ' + SrcFilePath );
 197   END;
 198 end;
 199
 200 procedure TStorage.ClearCacheVersionInfo;
 201 var I: Integer;
 202 begin
 203   for I := CacheVersionInfo.Count-1 downto 0 do
 204     FreeMem( Pointer( CacheVersionInfo.Objects[ I ] ) );
 205   CacheVersionInfo.Clear;
 206 end;
 207
 208 procedure TStorage.DelCachedVersionInfo(const SrcFilePath: String);
 209 var I: Integer;
 210     S: String;
 211 begin
 212   S := AnsiUpperCase( IncludeTrailingPathDelimiter( SrcFilePath ) );
 213   I := CacheVersionInfo.IndexOf( S );
 214   if I >= 0 then
 215   begin
 216     FreeMem( Pointer( CacheVersionInfo.Objects[ I ] ) );
 217     CacheVersionInfo.Delete( I );
 218   end;
 219 end;
 220
 221 destructor TStorage.Destroy;
 222 begin
 223   FPath := '';
 224   UnpackingFile := '';
 225   DirsIndex.Free;
 226   ClearCacheVersionInfo;
 227   CacheVersionInfo.Free;
 228   inherited;
 229 end;
 230
 231 function TStorage.DirPrefix(const DirPath: String): String;
 232 var I, MaxN: Integer;
 233     //SL: PStrList;
 234 begin
 235   Result := '';
 236   MaxN := 1;
 237   for I := 0 to DirsIndex.Count-1 do
 238   begin
 239     MaxN := max( MaxN, DirsIndex.Objects[ I ] ) + 1;
 240     if AnsiEq( DirsIndex.Items[ I ], DirPath ) then
 241     begin
 242       Result := Format( '%.08d', [ DirsIndex.Objects[ I ] ] );
 243       Exit;
 244     end;
 245   end;
 246   Log( '-Index ' + Format( '%.08d', [ MaxN ] ) + ' allocated for ' + DirPath );
 247   DirsIndex.AddObject( DirPath, MaxN );
 248 end;
 249
 250 procedure TStorage.EnumSections(FileStream: PStream;
 251   EnumProc: TEnumSectionsProc);
 252 var P, P1: DWORD;
 253     FI: TFileVersionInfo;
 254     SecType: Byte;
 255     L: DWORD;
 256     Cont: Boolean;
 257 begin
 258   P := FileStream.Position;
 259   TRY
 260     if FileStream.Position = 0 then
 261       FileStream.ReadStrZ;
 262     while FileStream.Position < FileStream.Size do
 263     begin
 264       if FileStream.Read( FI, Sizeof( FI ) ) < Sizeof( FI ) then Exit;
 265       if FileStream.Read( SecType, 1 ) < 1 then Exit;
 266       if FileStream.Read( L, 4 ) < 4 then Exit;
 267       if FileStream.Position + L > FileStream.Size then Exit;
 268       if Assigned( EnumProc ) then
 269       begin
 270         Cont := TRUE;
 271         P1 := FileStream.Position;
 272         EnumProc( FileStream, FI, SecType, L, Cont );
 273         FileStream.Position := P1;
 274         if not Cont then
 275         begin
 276           P := FileStream.Position + L;
 277           Exit;
 278         end;
 279       end;
 280       FileStream.Position := FileStream.Position + L;
 281       P := FileStream.Position;
 282     end;
 283   FINALLY
 284     FileStream.Position := P;
 285   END;
 286 end;
 287
 288 function TStorage.GetCachedVersionInfo(const SrcFilePath: String;
 289   var FI: TFileVersionInfo): Boolean;
 290 var I: Integer;
 291     S: String;
 292 begin
 293   S := AnsiUpperCase( IncludeTrailingPathDelimiter( SrcFilePath ) );
 294   I := CacheVersionInfo.IndexOf( S );
 295   if I >= 0 then
 296   begin
 297     Result := TRUE;
 298     FI := PFileVersionInfo( Pointer( CacheVersionInfo.Objects[ I ] ) )^;
 299   end
 300     else
 301     Result := FALSE;
 302 end;
 303
 304 procedure TStorage.Init;
 305 var Buf: array[ 0..MAX_COMPUTERNAME_LENGTH ] of Char;
 306     Sz: DWORD;
 307 begin
 308   Sz := MAX_COMPUTERNAME_LENGTH;
 309   GetComputerName( @ Buf[ 0 ], Sz );
 310   Buf[ Sz ] := #0;
 311   FMachineName := Buf;
 312   DirsIndex := NewStrListEx;
 313   CacheVersionInfo := NewStrListEx;
 314 end;
 315
 316 procedure TStorage.LookForLastFullVersion(FileStream: PStream;
 317   const FI: TFileVersionInfo; SecType: Byte; SecLen: DWORD; var Cont: Boolean);
 318 begin
 319   if SecType and 1 = 0 then
 320     FoundLastFullVersionPos := FileStream.Position;
 321 end;
 322
 323 procedure TStorage.LookForLastVersionInfo(FileStream: PStream;
 324   const FI: TFileVersionInfo; SecType: Byte; SecLen: DWORD;
 325   var Cont: Boolean);
 326 begin
 327   LastInfo := FI;
 328 end;
 329
 330 procedure TStorage.LookRestoreLastVersion(FileStream: PStream;
 331   const FI: TFileVersionInfo; SecType: Byte; SecLen: DWORD; var Cont: Boolean);
 332 var L: DWORD;
 333     US: PStream;
 334     OldVersion, CmdStream: PStream;
 335 begin
 336   if SecType and 1 = 0 then
 337   begin // ïîëíàÿ âåðñèÿ çäåñü
 338     LastVersion.Position := 0;
 339     if SecType and 2 = 0 then
 340       Stream2Stream( LastVersion, FileStream, SecLen )
 341     else
 342     begin // ñæàòàÿ ïîëíàÿ âåðñèÿ
 343       FileStream.Read( L, 4 );
 344       US := DIUCLStreams.NewUclDStream( $80000, FileStream, fmMainGuard.UCLOnProgress );
 345       TRY
 346         Stream2Stream( LastVersion, US, L );
 347       FINALLY
 348         US.Free;
 349       END;
 350     end;
 351   end
 352     else
 353   begin // îáíîâëåíèå îò ïðåäûäóùåé âåðñèè çäåñü
 354     OldVersion := NewMemoryStream;
 355     CmdStream := NewMemoryStream;
 356     TRY
 357       if SecType and 2 = 0 then
 358         Stream2Stream( CmdStream, FileStream, SecLen )
 359       else
 360       begin // êîìàíäíûé ïîòîê ñæàò
 361         FileStream.Read( L, 4 );
 362         US := DIUCLStreams.NewUclDStream( $80000, FileStream, fmMainGuard.UCLOnProgress );
 363         TRY
 364           Stream2Stream( CmdStream, FileStream, L );
 365         FINALLY
 366           US.Free;
 367         END;
 368       end;
 369       // òåïåðü ðàñïàêîâêà íîâîé âåðñèè
 370       if CmdStream.Size > 0 then
 371       begin
 372         LastVersion.Position := 0;
 373         Stream2Stream( OldVersion, LastVersion, LastVersion.Size );
 374         OldVersion.Position := 0;
 375         LastVersion.Position := 0;
 376         CmdStream.Position := 0;
 377         if not DoApplyUpdates( LastVersion, OldVersion, CmdStream ) then
 378         begin
 379           Log( 'Error unpacking ' + UnpackingFile );
 380           UnpackError := TRUE;
 381           OldVersion.Position := 0;
 382           LastVersion.Position := 0;
 383           Stream2Stream( LastVersion, OldVersion, OldVersion.Size );
 384           LastVersion.Size := LastVersion.Position;
 385           LastVersion.Position := 0;
 386           Cont := FALSE;
 387         end;
 388       end
 389         else
 390         LastVersion.Position := LastVersion.Size;
 391     FINALLY
 392       OldVersion.Free;
 393       CmdStream.Free;
 394     END;
 395   end;
 396   LastVersion.Size := LastVersion.Position;
 397   LastVersion.Position := 0;
 398 end;
 399
 400 procedure TStorage.ProgressHandler(Percents, CurrentPosition,
 401   TotalSize: Integer; var Cancel: Boolean);
 402 begin
 403   Applet.ProcessMessages;
 404 end;
 405
 406 procedure TStorage.PutCachedVersionInfo(const SrcFilePath: String;
 407   var FI: TFileVersionInfo);
 408 var I: Integer;
 409     FIData: PFileVersionInfo;
 410     S: String;
 411 begin
 412   S := AnsiUpperCase( IncludeTrailingPathDelimiter( SrcFilePath ) );
 413   I := CacheVersionInfo.IndexOf( S );
 414   if I < 0 then
 415   begin
 416     GetMem( FIData, Sizeof( FI ) );
 417     FIData^ := FI;
 418     CacheVersionInfo.AddObject( S, DWORD( FIData ) );
 419   end;
 420 end;
 421
 422 function TStorage.SaveFileHistory(const SrcFilePath: String): Boolean;
 423 var FS, DS, NS, TS: PStream;
 424     FI: TFileVersionInfo;
 425     LS, CS, US: PStream;
 426     WriteFullVersion, AddFullVersion: Boolean;
 427     FN, P: String;
 428     I: Integer;
 429     L: DWORD;
 430 begin
 431   Result := FALSE;
 432   UnpackingFile := SrcFilePath;
 433   FN := ExtractFileName( SrcFilePath );
 434
 435   TS := NewReadFileStream( SrcFilePath );
 436   TRY
 437     if TS.Handle = INVALID_HANDLE_VALUE then Exit;
 438     GetFileTime( TS.Handle, nil, nil, @FI.FT );
 439     FS := NewMemoryStream;
 440     Stream2Stream( FS, TS, TS.Size );
 441   FINALLY
 442     TS.Free;
 443   END;
 444   FS.Position := 0;
 445
 446   DS := nil;
 447   LS := NewMemoryStream;
 448   CS := NewMemoryStream;
 449   TS := NewMemoryStream;
 450   TRY
 451     FI.Sz := FS.Size;
 452     CalcFileCheckSum( FS, FI.ChkSum );
 453     P := DirPrefix( ExtractFilePath( SrcFilePath ) );
 454     DS := NewReadWriteFileStream( FPath + P + '+' + FN );
 455     if DS.Handle = INVALID_HANDLE_VALUE then Exit;
 456     FoundLastFullVersionPos := 0;
 457     EnumSections( DS, LookForLastFullVersion );
 458     WriteFullVersion := TRUE;
 459     AddFullVersion := FALSE;
 460     if FoundLastFullVersionPos > 0 then
 461     begin
 462       DS.Position := FoundLastFullVersionPos - 5 - Sizeof( FI );
 463       LastVersion := LS;
 464       UnpackError := FALSE;
 465       EnumSections( DS, LookRestoreLastVersion );
 466       if UnpackError then
 467         WriteFullVersion := TRUE
 468       else
 469       if DS.Position - FoundLastFullVersionPos < FS.Size * 3 then
 470       begin
 471         MakeUpdates( CS, FS, LS, ProgressHandler );
 472         WriteFullVersion := CS.Size + 1 >= FS.Size;
 473         if not WriteFullVersion then
 474         begin
 475           NS := NewMemoryStream;
 476           TRY
 477             CS.Position := 0;
 478             if not DoApplyUpdates( NS, LS, CS ) then AddFullVersion := TRUE
 479             else if NS.Size <> FS.Size then AddFullVersion := TRUE
 480             else
 481             begin
 482               FS.Position := 0;
 483               Stream2Stream( TS, FS, FS.Size );
 484               if not CompareMem( TS.Memory, NS.Memory, NS.Size ) then
 485                 AddFullVersion := TRUE;
 486             end;
 487           FINALLY
 488             NS.Free;
 489             TS.Size := 0;
 490           END;
 491         end;
 492       end;
 493       if not UnpackError and (DS.Position = DS.Size) and (CS.Size = 0) then
 494       begin
 495         //Result := TRUE; // íå íàäî íè÷åãî çàïèñûâàòü - ôàéë íå èçìåíèëñÿ
 496         Storage.UpdCachedVersionInfo( SrcFilePath, FI.FT );
 497         Exit;
 498       end;
 499     end;
 500     //--------------------------------------------------------------------------
 501     // Ïîäãîòàâëèâàåì çàïèñü íîâîé âåðñèè
 502     if DS.Position = 0 then
 503       DS.WriteStrZ( ExtractFilePath( SrcFilePath ) );
 504     if WriteFullVersion then
 505     begin
 506       CS.Position := 0;
 507       FS.Position := 0;
 508       Stream2Stream( CS, FS, FS.Size );
 509     end;
 510     I := 0;
 511     if CS.Size > 0 then
 512     begin
 513       I := 2;
 514       US := DIUCLStreams.NewUclCStream( 10, $80000, TS, fmMainGuard.UCLOnProgress );
 515       TRY
 516         CS.Position := 0;
 517         Stream2Stream( US, CS, CS.Size );
 518       FINALLY
 519         US.Free;
 520       END;
 521     end;
 522     if (TS.Size >= CS.Size - 4) or (TS.Size = 0) then
 523     begin // íå èñïîëüçîâàòü ñæàòèå
 524       I := 0;
 525     end;
 526     if not WriteFullVersion then Inc( I );
 527     DS.Write( FI, Sizeof( FI ) );
 528     DS.Write( I, 1 );
 529     if I and 2 = 0 then // çàïèñü áåç ñæàòèÿ
 530     begin
 531       L := CS.Size;
 532       DS.Write( L, 4 );
 533       CS.Position := 0;
 534       Stream2Stream( DS, CS, L );
 535     end
 536       else
 537     begin // çàïèñü ñî ñæàòèåì
 538       L := 4 + TS.Size;
 539       DS.Write( L, 4 );
 540       L := CS.Size;
 541       DS.Write( L, 4 );
 542       TS.Position := 0;
 543       Stream2Stream( DS, TS, TS.Size );
 544     end;
 545     if AddFullVersion and not WriteFullVersion then
 546     begin
 547       Log( 'Error checking, full version added: ' + SrcFilePath );
 548       DS.Write( FI, Sizeof( FI ) );
 549       I := 2;
 550       TS.Size := 0;
 551       US := DIUCLStreams.NewUclCStream( 10, $80000, TS, fmMainGuard.UCLOnProgress );
 552       TRY
 553         FS.Position := 0;
 554         Stream2Stream( US, FS, FS.Size );
 555       FINALLY
 556         US.Free;
 557       END;
 558       if (TS.Size >= FS.Size) or (TS.Size = 0) then
 559         I := 0;
 560       DS.Write( I, 1 );
 561       if I and 2 = 0 then
 562       begin
 563         L := FS.Size;
 564         DS.Write( L, 4 );
 565         CS.Position := 0;
 566         Stream2Stream( DS, FS, L );
 567       end
 568         else
 569       begin
 570         L := 4 + TS.Size;
 571         DS.Write( L, 4 );
 572         L := FS.Size;
 573         DS.Write( L, 4 );
 574         TS.Position := 0;
 575         Stream2Stream( DS, TS, TS.Size );
 576       end;
 577     end;
 578     DelCachedVersionInfo( SrcFilePath );
 579     Result := TRUE;
 580   FINALLY
 581     FS.Free;
 582     DS.Free;
 583     LS.Free;
 584     CS.Free;
 585     TS.Free;
 586   END;
 587 end;
 588
 589 procedure TStorage.SetPath(const Value: String);
 590 var F: HFile;
 591     Buf: array[ 0..1023 ] of Char;
 592     DL: PDirList;
 593     I, Prefix: Integer;
 594     SL: PStrList;
 595     S: String;
 596     FS: PStream;
 597 begin
 598   Log( '-Storage path: ' + Value );
 599   FPath := IncludeTrailingPathDelimiter( Value );
 600   FOK := FALSE;
 601   if not DirectoryExists( FPath ) then Exit;
 602
 603   if not DirectoryExists( FPath + FMachineName + '\' ) then
 604   begin
 605     MkDir( FPath + FMachineName + '\' );
 606     if not DirectoryExists( FPath + FMachineName + '\' ) then Exit;
 607   end;
 608   FPath := FPath + FMachineName + '\';
 609
 610   F := FileCreate( FPath + 'FileGuard.dir', ofOpenWrite or ofOpenAlways );
 611   if F = INVALID_HANDLE_VALUE then Exit;
 612   TRY
 613     if FileWrite( F, Buf, 1024 ) <> 1024 then Exit;
 614   FINALLY
 615     FileClose( F );
 616   END;
 617   //--- ïîñòðîåíèå èíäåêñà ñîõðàíåííûõ äèðåêòîðèé
 618   DirsIndex.Clear;
 619   //DL := NewDirList( FPath, '*.*', FILE_ATTRIBUTE_NORMAL );
 620   DL := NewDirList( '', '', 0 );
 621   DL.OnItem := fmMainGuard.AcceptDirItem;
 622   DL.ScanDirectory( FPath, '*.*', FILE_ATTRIBUTE_NORMAL );
 623   SL := NewStrList;
 624   TRY
 625     for I := 0 to DL.Count-1 do
 626       if not DL.IsDirectory[ I ] then
 627       begin
 628         Prefix := Str2Int( DL.Names[ I ] );
 629         if Prefix <> 0 then
 630         begin
 631           if DirsIndex.IndexOfObj( Pointer( Prefix ) ) < 0 then
 632           begin
 633             FS := NewReadFileStream( DL.Path + DL.Names[ I ] );
 634             TRY
 635               S := FS.ReadStrZ;
 636               DirsIndex.AddObject( S, Prefix );
 637             FINALLY
 638               FS.Free;
 639             END;
 640           end;
 641         end;
 642       end;
 643   FINALLY
 644     DL.Free;
 645     SL.Free;
 646   END;
 647   FOK := TRUE;
 648   Log( '-Storage index built OK' );
 649 end;
 650
 651 procedure TStorage.UpdateFile(const SrcFilePath: String; ChkSum: DWORD;
 652   Action: Integer);
 653 var P: String;
 654     FN: String;
 655     Renamed_Delete: Boolean;
 656     Saved_History: Boolean;
 657 begin
 658   Log( '-Updating: ' + SrcFilePath );
 659   P := DirPrefix( ExtractFilePath( SrcFilePath ) );
 660   FN := ExtractFileName( SrcFilePath );
 661   if ChkSum = 0 then
 662     CalcFileCheckSum( SrcFilePath, ChkSum );
 663   if Action = 0 then
 664        // ñîõðàíåíèå âñåé èñòîðèè
 665        Saved_History := SaveFileHistory( SrcFilePath )
 666   else
 667   begin
 668     Renamed_Delete := FALSE;
 669     if FileExists( FPath + P + '+' + FN ) then
 670     begin
 671       if FileExists( FPath + P + '+' + FN + '.old' ) then
 672       begin
 673         if not DeleteFile( PChar( FPath + P + '+' + FN + '.old' ) ) then
 674           Log( '*** Can not delete: ' + FPath + P + '+' + FN + '.old' );
 675       end;
 676       Renamed_Delete :=
 677       MoveFile( PChar( FPath + P + '+' + FN ), PChar( FPath + P + '+' + FN + '.old' ) );
 678       if not Renamed_Delete then
 679         Log( '*** Can not rename ' + FPath + P + '+' + FN + ' to ' +
 680           FPath + P + '+' + FN + '.old' );
 681     end;
 682     Saved_History := SaveFileHistory( SrcFilePath );
 683     if Saved_History then
 684     begin
 685       if Renamed_Delete then
 686       begin
 687         if not DeleteFile( PChar( FPath + P + '+' + FN + '.old' ) ) then
 688            Log( '*** Can not delete: ' + FPath + P + '+' + FN + '.old' );
 689       end;
 690     end
 691       else
 692     begin
 693       if Renamed_Delete then
 694       begin
 695         if not MoveFile( PChar( FPath + P + '+' + FN + '.old' ),
 696                   PChar( FPath + P + '+' + FN ) ) then
 697           Log( '*** Can not rename ' + FPath + P + '+' + FN + '.old' +
 698             ' to ' + FPath + P + '+' + FN );
 699       end;
 700     end;
 701   end;
 702   if Saved_History then
 703   begin
 704     Log( 'Saved: ' + SrcFilePath );
 705     fmMainGuard.StorageTreeChanged := TRUE;
 706   end;
 707 end;
 708
 709 procedure TStorage.UpdCachedVersionInfo(const SrcFilePath: String;
 710   const ft: TFileTime);
 711 var I: Integer;
 712     S: String;
 713     FIData: PFileVersionInfo;
 714 begin
 715   S := AnsiUpperCase( IncludeTrailingPathDelimiter( SrcFilePath ) );
 716   I := CacheVersionInfo.IndexOf( S );
 717   if I >= 0 then
 718   begin
 719     FIData := Pointer( CacheVersionInfo.Objects[ I ] );
 720     FIData.FT := ft;
 721   end;
 722 end;
 723
 724 end.