Chip 2002 November/Chip_2002-11_cd1.bin/zkuste/delphi/unity/d56/DW/DW10242.ZIP/FileWorks.pas

Pascal/Delphi Source File | 2002-08-08 | 25KB | 746 lines

(*-------------------------------FileWorks.pas--------------------------
 V1.0.242 - 01.07.2002 current release
------------------------------------------------------------------------
*)

unit FileWorks;

interface

uses Windows, Classes, SysUtils, ShellAPI, StringWorks, FileCtrl;

type
   TFileDateTimeStamp = packed record
      Creation,
      LastAccess,
      LastWrite: TDateTime;
   end;

//V1.0.242
function GetFileCRC32Int(const Filename: String): DWord;
function GetFileCRC32Hex(const Filename: String): String;

//V1.0.241
function FileIsOpen(const Filename: String): Boolean;
function CopyDirectory(const Directory, DestinationFolder: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean;

//V1.0.240
function NTFSCompressFile(const FileName: String; const ForceCompress: Boolean): Boolean;
function NTFSUncompressFile(const FileName: String): Boolean;

//V1.0.239
function GetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TFileDateTimeStamp): Boolean;
function SetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TFileDateTimeStamp): Boolean;

function CreateDummyFile(Filename: String; FileSize: Int64): Int64;
function DeleteDirectory(Directory: String; CanUndo, DeleteNotEmpty, GUI: Boolean): Boolean;
function DeleteFiles(Path, Mask: string): Boolean;
function DeleteFilesRecursive(Path, Mask: string): Boolean;
function DirIsEmpty(Path: String): Boolean;
function ExtractDriveFromPath(Path: String): String;
function ExtractPureFilename(Name: String): String;
function ExtractFileExtension(Name: String): String;
function FileAttrib(Filename: String; A,H,R,S: Boolean): Boolean;
function FileCopy(Source, Destination: String): Integer;
function GetFileSize(Datei: String): Int64;
function ITB(Directory: String): String;
procedure ListFiles(const Path, Mask: string; var List: TStringList; const ShowPath: Boolean);
function ListFilesRecursive(Path, Mask: string; ShowPath: Boolean): TStringList;
//function ListFilesRecursive2(Path, Mask: String; ShowPath: Boolean): TStringList;
function ListFolders(Path: string; ShowPath: boolean): TStringlist;
procedure PatchFile(filename:string;data:array of byte;offset,count:longint);
function RenameDirectory(OldPath, NewPath: String): Boolean;
function MoveDirectory(const Directory, DestinationFolder: String; const GUI, SimpleGUI, MoveConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean;
function ReadStringFromFile(const Filename: String): String;
procedure SaveStringToFile(const Str, Filename: String);

implementation

function GetFileCRC32Int(const Filename: String): DWord;
const
  dwCRC32Table: array[0..255] of DWORD =
   ($00000000, $77073096, $EE0E612C, $990951BA,
    $076DC419, $706AF48F, $E963A535, $9E6495A3,
    $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
    $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
    $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
    $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
    $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
    $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
    $3B6E20C8, $4C69105E, $D56041E4, $A2677172,
    $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
    $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
    $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
    $26D930AC, $51DE003A, $C8D75180, $BFD06116,
    $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
    $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
    $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
    $76DC4190, $01DB7106, $98D220BC, $EFD5102A,
    $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
    $7807C9A2, $0F00F934, $9609A88E, $E10E9818,
    $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
    $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
    $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
    $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
    $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
    $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
    $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
    $4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
    $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
    $5005713C, $270241AA, $BE0B1010, $C90C2086,
    $5768B525, $206F85B3, $B966D409, $CE61E49F,
    $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
    $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
    $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
    $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
    $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
    $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
    $F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
    $F762575D, $806567CB, $196C3671, $6E6B06E7,
    $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
    $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
    $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
    $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
    $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
    $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
    $CB61B38C, $BC66831A, $256FD2A0, $5268E236,
    $CC0C7795, $BB0B4703, $220216B9, $5505262F,
    $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
    $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
    $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
    $9C0906A9, $EB0E363F, $72076785, $05005713,
    $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
    $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
    $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
    $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
    $88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
    $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
    $A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
    $A7672661, $D06016F7, $4969474D, $3E6E77DB,
    $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
    $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
    $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
    $BAD03605, $CDD70693, $54DE5729, $23D967BF,
    $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
    $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
var
  F: file;
  BytesRead: DWORD;
  Buffer: array[1..65521] of Byte;
  i: Word;
begin
  FileMode := 0;
  result    := $ffffffff;
  {$I-}
  AssignFile(F, FileName);
  Reset(F, 1);
  if IOResult = 0 then
  begin
    repeat
      BlockRead(F, Buffer, SizeOf(Buffer), BytesRead);
      for i := 1 to BytesRead do
        result := (result shr 8) xor dwCRC32Table[Buffer[i] xor (result and $000000FF)];
    until BytesRead = 0;
  end;
  CloseFile(F);
  {$I+}
  result := not result;
end;

function GetFileCRC32Hex(const Filename: String): String;
begin
   result:= IntToHex(GetFileCRC32Int(Filename), 6);
end;

function FileIsOpen(const Filename: String): Boolean;
var
   Datei: TFileStream;
begin
  result:= FALSE;
  if FileExists(Filename) then begin
    try
      Datei:= TFileStream.Create(Filename, fmOpenRead);
      Datei.Free;
    except
      on EFOpenError do result:= true;
    end;
  end;
end;


function CopyDirectory(const Directory, DestinationFolder: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean;
var
  FOS : TSHFileOpStruct;
  Flags: Word;
begin
   Flags:= 0;
   if GUI then if SimpleGUI then Flags:= Flags or FOF_SIMPLEPROGRESS
          else                   Flags:= Flags or FOF_SILENT;
   if not CopyConfirmation  then Flags:= Flags or FOF_NOCONFIRMATION;
   if not MkDirConfirmation then Flags:= Flags or FOF_NOCONFIRMMKDIR;
   if not ErrorGUI          then Flags:= Flags or FOF_NOERRORUI;
   ZeroMemory(@FOS,SizeOf(FOS));
   with FOS do begin
      wFunc := FO_COPY;
      fFlags := Flags;
      pFrom := PChar(Directory + #0);
      pTo := PChar(DestinationFolder)
   end;
   RESULT := (0 = ShFileOperation(FOS));
   UserHasCancelled:= FOS.fAnyOperationsAborted;
end;

function NTFSCompressFile(const FileName: String; const ForceCompress: Boolean): Boolean;
const
  COMPRESSION_FORMAT_NONE = 0;
  COMPRESSION_FORMAT_DEFAULT = 1;
  FILE_DEVICE_FILE_SYSTEM = 9;
  METHOD_BUFFERED       = 0;
  FILE_READ_DATA        = 1;
  FILE_WRITE_DATA       = 2;
  FSCTL_SET_COMPRESSION = (FILE_DEVICE_FILE_SYSTEM shl 16) or
    ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or (16 shl 2) or METHOD_BUFFERED;
var
  hnd:  Integer;
  Comp: SHORT;
  res:  DWORD;
  pcFilename: PChar;
begin
  pcFilename:= PChar(Filename);
  if forceCompress or ((GetFileAttributes(PChar(ExtractFilePath(FileName))) and
    FILE_ATTRIBUTE_COMPRESSED) <> 0) then
  begin
    Result := False;
    if (GetFileAttributes(pcFileName) and FILE_ATTRIBUTE_COMPRESSED) = 0 then
    begin
      hnd := CreateFile(pcFileName, GENERIC_READ or GENERIC_WRITE, 0,nil, OPEN_EXISTING, 0,0);
      try
        Comp := COMPRESSION_FORMAT_DEFAULT;
        if not DeviceIoControl(hnd, FSCTL_SET_COMPRESSION, @Comp,
          SizeOf(SHORT), nil, 0, res, nil) then Exit;
      finally
        CloseHandle(hnd);
      end;
    end;
    Result := True;
  end
  else
    Result := True;
end;

function NTFSUncompressFile(const FileName: String): Boolean;
const
  COMPRESSION_FORMAT_NONE = 0;
  COMPRESSION_FORMAT_DEFAULT = 1;
  FILE_DEVICE_FILE_SYSTEM = 9;
  METHOD_BUFFERED       = 0;
  FILE_READ_DATA        = 1;
  FILE_WRITE_DATA       = 2;
  FSCTL_SET_COMPRESSION = (FILE_DEVICE_FILE_SYSTEM shl 16) or
    ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or (16 shl 2) or METHOD_BUFFERED;
var
  hnd:  Integer;
  Comp: SHORT;
  res:  DWORD;
  pcFilename: PChar;
begin
  pcFilename:= PChar(Filename);
  Result := False;
  if (GetFileAttributes(pcFileName) and FILE_ATTRIBUTE_COMPRESSED) <> 0 then
  begin
    hnd := CreateFile(pcFileName, GENERIC_READ or GENERIC_WRITE, 0,nil, OPEN_EXISTING, 0,0);
    try
      Comp := COMPRESSION_FORMAT_NONE;
      if not DeviceIoControl(hnd, FSCTL_SET_COMPRESSION, @Comp,
        SizeOf(SHORT), nil, 0, res, nil) then Exit;
    finally
      CloseHandle(hnd);
    end;
    Result := True;
  end
  else
    Result := True;
end;

function GetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TFileDateTimeStamp): Boolean;
var
   hFile: THandle;
   ftCreation,
   ftLastAccess,
   ftLastWrite,
   ftlCreation,
   ftlLastAccess,
   ftlLastWrite: TFileTime;
   stCreation,
   stLastAccess,
   stLastWrite: TSystemTime;
begin
   result:= FALSE;
   with FileDateTimeStamp do begin
      Creation:= 0;
      LastAccess:= 0;
      LastWrite:= 0;
   end;
   hFile:= CreateFile(PChar(Filename),
                      GENERIC_READ or GENERIC_WRITE,
                      FILE_SHARE_READ,
                      nil,
                      OPEN_EXISTING,
                      FILE_FLAG_BACKUP_SEMANTICS
                      or FILE_ATTRIBUTE_DIRECTORY, 0);
   if (hFile = INVALID_HANDLE_VALUE) then begin
      CloseHandle(hFile);
      exit;
   end else
   try
      if GetFileTime(hFile, @ftCreation,
                            @ftLastAccess,
                            @ftLastWrite) then begin
         if  FileTimeToLocalFileTime(ftCreation, ftlCreation)
         and FileTimeToLocalFileTime(ftLastAccess, ftlLastAccess)
         and FileTimeToLocalFileTime(ftLastWrite, ftlLastWrite) then begin
            if  FileTimeToSystemTime(ftlCreation, stCreation)
            and FileTimeToSystemTime(ftlLastAccess, stLastAccess)
            and FileTimeToSystemTime(ftlLastWrite, stLastWrite) then begin
               FileDateTimeStamp.Creation:= SystemTimeToDateTime(stCreation);
               FileDateTimeStamp.LastAccess:= SystemTimeToDateTime(stLastAccess);
               FileDateTimeStamp.LastWrite:= SystemTimeToDateTime(stLastWrite);
               result:= TRUE;
            end;
         end;
      end;
   finally
      CloseHandle(hFile);
   end;
end;

function SetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TFileDateTimeStamp): Boolean;
var
   hFile: THandle;
   ftCreation,
   ftLastAccess,
   ftLastWrite,
   ftlCreation,
   ftlLastAccess,
   ftlLastWrite: TFileTime;
   stCreation,
   stLastAccess,
   stLastWrite: TSystemTime;
begin
   result:= FALSE;
   with FileDateTimeStamp do begin
      Creation:= 0;
      LastAccess:= 0;
      LastWrite:= 0;
   end;
   hFile:= CreateFile(PChar(Filename),
                      GENERIC_READ or GENERIC_WRITE,
                      FILE_SHARE_READ,
                      nil,
                      OPEN_EXISTING,
                      FILE_FLAG_BACKUP_SEMANTICS
                      or FILE_ATTRIBUTE_DIRECTORY, 0);
   if (hFile = INVALID_HANDLE_VALUE) then begin
      CloseHandle(hFile);
      exit;
   end else
   try
      with FileDateTimeStamp do begin
         DateTimeToSystemTime(Creation, stCreation);
         DateTimeToSystemTime(LastAccess, stLastAccess);
         DateTimeToSystemTime(LastWrite, stLastWrite);
         if SystemTimeToFileTime(stCreation, ftlCreation) and
            SystemTimeToFileTime(stLastAccess, ftlLastAccess) and
            SystemTimeToFileTime(stLastWrite, ftlLastWrite) then begin
            if LocalFileTimeToFileTime(ftlCreation, ftCreation) and
               LocalFileTimeToFileTime(ftlLastAccess, ftLastAccess) and
               LocalFileTimeToFileTime(ftlLastWrite, ftLastWrite) then begin
               result:= SetFileTime(hFile, @ftCreation, @ftLastAccess, @ftLastWrite);
            end;
         end;
      end;
   finally
      CloseHandle(hFile);
   end;
end;

function CreateDummyFile(Filename: String; FileSize: Int64): Int64;
var
   FS: TFileStream;
   I: Integer;
   FillChr: Char;
   SizeF: Integer;
begin
   result:= -1;
   SizeF:= 1;
   randomize;
   if FileExists(Filename) then exit;
   FS:= TFileStream.Create(Filename, fmCreate);
   for I:=0 to FileSize - 1 do begin
      FillChr:= Chr(I-Random(255)+1);
      FS.Write(FillChr ,SizeF);
   end;
   FS.Free;
end;

function ExtractPureFilename(Name: String): String;
var
   Dots, DotPos: Integer;
begin
   Dots:= StringCountInStr('.', Name);
   DotPos:= SubPositionByIndex(Name, '.', Dots);
   result:= StrLeft(Name, DotPos - 1);
end;

function ExtractFileExtension(Name: String): String;
var
   Dots, DotPos, StrLn: Integer;
begin
   Dots:= StringCountInStr('.', Name);
   StrLn:= StrLen(PChar(Name));
   DotPos:= SubPositionByIndex(Name, '.', Dots);
   result:= Copy(Name, DotPos + 1, StrLn);
end;

function FileCopy(Source, Destination: String): Integer;
var
  Q, Z: TFileStream;
begin
   if not FileExists(Source) then begin
      result:= -2; (* Fehlercode fⁿr "Quelle nicht gefunden" *)
      exit;
   end;
   if FileExists(Destination) then begin
      result:= -3; (* Fehlercode fⁿr "Zieldatei vorhanden" *)
      exit;
   end;
   try
      Q := TFileStream.Create(Source, fmOpenRead);
      Z := TFileStream.Create(Destination, fmCreate);
      Z.CopyFrom(Q, Q.Size);
      Q.Free;
      Z.Free;
      result:= 0; (* Fehlercode 0 fⁿr erfolgreiche Ausfⁿhrung *)
   except
      result:= -4; (* Fehlercode fⁿr "Datei konnte nicht kopiert werden" *)
   end;
end;

function FileMove(Source, Destination: String): Integer;
var
  Q, Z: TFileStream;
begin
   if not FileExists(Source) then begin
      result:= -2; (* Fehlercode fⁿr "Quelle nicht gefunden" *)
      exit;
   end;
   if FileExists(Destination) then begin
      result:= -3; (* Fehlercode fⁿr "Zieldatei vorhanden" *)
      exit;
   end;
   try
      Q := TFileStream.Create(Source, fmOpenRead);
      Z := TFileStream.Create(Destination, fmCreate);
      Z.CopyFrom(Q, Q.Size);
      Q.Free;
      Z.Free;
      if not DeleteFile(PChar(Source)) then begin
         result:= -5; (* Fehlercode fⁿr "Quelldatei kann nicht entfernt werden" *)
         exit;
      end;
   result:= 0; (* Fehlercode 0 fⁿr erfolgreiche Ausfⁿhrung *)
   except
      result:= -4; (* Fehlercode fⁿr "Datei konnte nicht kopiert werden" *)
   end;
end;

procedure ListFiles(const Path, Mask: string; var List: TStringList; const ShowPath: Boolean);
var
  SRec: TSearchRec;
  sPath, sSearch: String;
begin
   sPath:=IncludeTrailingBackslash(Path);
   sSearch:=sPath + Mask;
   if not ShowPath then sPath:= '';
   if FindFirst(sSearch, faAnyFile-faDirectory, SRec)=0 then
   repeat
      List.Add(sPath+sRec.Name);
   until FindNext(SRec)<>0;
   FindClose(SRec);
end;

function ListFolders(Path: string; ShowPath: boolean): TStringlist;
var
  SRec: TSearchRec;
  SL: TStringList;
begin
   (* ++++++++++++++++ Code sample by Pumi ++++++++++++++++++ *)
   SL := TStringList.Create;
   result:= TStringList.Create;
   FindFirst(Path + '*.*', {not faAnyFile +
                           not faSysFile +
                           not faHidden +
                           not faReadOnly}
                           faDirectory,
                           SRec);
   if ShowPath then
      SL.Add(Path + SRec.Name)
   else
      SL.Add(SRec.Name);
   while FindNext(SRec) = 0 do
      if ShowPath then
         SL.Add(Path + SRec.Name)
      else
         SL.Add(SRec.Name);
   FindClose(SRec);
   Result.Assign(SL);
end;

function DeleteFiles(Path, Mask: string): Boolean;
var
  SRec: TSearchRec;
  SL: TStringList;
  I: Integer;
begin
   (* ++++++++++++++++ Code based on Assarbad ++++++++++++++++++ *)
   result:= FALSE;
   SL := TStringList.Create;
   FindFirst(Path + Mask, not faDirectory, SRec);
   SL.Add(Path + SRec.Name);
   while FindNext(SRec) = 0 do SL.Add(Path + SRec.Name);
   FindClose(SRec);
   if SL.Count < 1 then exit;
   for I:= 0 to SL.Count - 1 do begin
      DeleteFile(PChar(SL[I]));
   end;
   result:= TRUE;
end;

{ -------- This version has a bug in recursive search---------
function ListFilesRecursive(Path, Mask: string; ShowPath: Boolean): TStringList;
var SR: TSearchRec;
    err, I: Integer;
    dummy: String;
    TempList: TStringList;
begin
   (* ++++++++++++++++ Code sample by Assarbad ++++++++++++++++++ *)
     err:=FindFirst(Path+Mask, faAnyFile, SR);
     Path:= IncludeTrailingBackslash(Path);
     result:= TStringList.Create;
     TempList:= TStringList.Create;
     while err=0 do begin
           if (sr.name<>'.') and (sr.name<>'..') then
              if ((sr.Attr and fadirectory)<>0) then begin
                 dummy:=path+sr.name+'\';
                 TempList.Assign(ListFilesRecursive(dummy, mask, ShowPath));
                 for I:= 0 to TempList.Count - 1 do begin
//                    if ShowPath then result.Add(Dummy + TempList[I]) else
                       result.Add(TempList[I]);
                 end;
              end else if ShowPath then result.Append(Path + sr.name) else
                 result.Append(sr.name);
           err:=findnext(sr);
     end;
     FindClose(SR);
     TempList.Free;
end;}

function ListFilesRecursive(Path, Mask: String; ShowPath: Boolean): TStringList;
var SR: TSearchRec;
    Erg, I: Integer;
    RelDir, TempStr : String;
    TempList: TStringList;
begin
   IncludeTrailingBackslash(Path);
   RelDir := ExtractFilePath(Mask);
   Mask := ExtractFileName(Mask);
   result:= TStringList.Create;
   TempList:= TStringList.Create;
   Erg := FindFirst(Path+RelDir+'*.*', faDirectory, SR);
   while Erg = 0 do
   begin
      if (SR.attr and faDirectory) <> 0 then
         if SR.Name[1] <> '.' then begin
            TempList.Assign(ListFilesRecursive(Path, RelDir+SR.Name+'\'+Mask, ShowPath));
            for I:= 0 to TempList.Count - 1 do begin
               TempStr:= TempList[I];
               if ShowPath and not (TempStr[2] = ':') then TempStr:= Path + TempStr;
               result.Add(TempList[I]);
            end;
         end;
      Erg := FindNext(SR);
   end;
   Erg := FindFirst(Path+RelDir+Mask, $27, SR);
   {Das Attribut $27 bedeutet
   alle echten Dateien}
   while Erg = 0 do
   begin
      if not ShowPath then
         result.Add(RelDir+SR.Name)
      else
      result.Add(Path+RelDir+SR.Name);
      Erg := FindNext(SR);
   end;
   FindClose(SR);
   TempList.Free;
end;

function DeleteFilesRecursive(Path, Mask: string): Boolean;
var SR: TSearchRec;
    err, I:integer;
    dummy:string;
    SL: TStringList;
begin
   (* ++++++++++++++++ Code based on Assarbad ++++++++++++++++++ *)
     result:= FALSE;
     err:=FindFirst(Path+Mask, faAnyFile, SR);
     SL:= TStringList.Create;
     while err=0 do begin
           if (sr.name<>'.') and (sr.name<>'..') then
              if ((sr.Attr and fadirectory)<>0) then begin
                 dummy:=path+sr.name+'\';
                 ListFilesRecursive(dummy, Mask, TRUE);
              end else SL.Append(sr.name);
           err:=findnext(sr);
     end;
     FindClose(SR);
     if SL.Count < 1 then exit;
     for I:= 0 to SL.Count - 1 do begin
        DeleteFile(PChar(SL[I]));
     end;
     result:= TRUE;
end;

function DirIsEmpty(Path: String): Boolean;
var
   SL: TStringList;
begin
   SL:= ListFilesRecursive(ITB(Path), '*.*', TRUE);
   result:= (SL.Count < 1);
end;

function ExtractDriveFromPath(Path: String): String;
begin
   if (StrLen(PChar(Path)) > 0) then result:= Copy(Path, 1, 1) else result:= '';
end;

function ITB(Directory: String): String;
begin
   result:= UpperCase(IncludeTrailingBackslash(Directory));
end;

function RenameDirectory(OldPath, NewPath: String): Boolean;
begin
   result:= FALSE;
   if not (ExtractDriveFromPath(OldPath) = ExtractDriveFromPath(NewPath)) then
      exit;
   result:= MoveFile(PChar(OldPath), PChar(NewPath));
end;

function MoveDirectory(const Directory, DestinationFolder: String; const GUI, SimpleGUI, MoveConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean;
var
  FOS : TSHFileOpStruct;
  Flags: Word;
begin
   Flags:= 0;
   if GUI then if SimpleGUI then Flags:= Flags or FOF_SIMPLEPROGRESS
          else                   Flags:= Flags or FOF_SILENT;
   if not MoveConfirmation  then Flags:= Flags or FOF_NOCONFIRMATION;
   if not MkDirConfirmation then Flags:= Flags or FOF_NOCONFIRMMKDIR;
   if not ErrorGUI          then Flags:= Flags or FOF_NOERRORUI;
   ZeroMemory(@FOS,SizeOf(FOS));
   with FOS do begin
      wFunc := FO_MOVE;
      fFlags := Flags;
      pFrom := PChar(Directory + #0);
      pTo := PChar(DestinationFolder)
   end;
   RESULT := (0 = ShFileOperation(FOS));
   UserHasCancelled:= FOS.fAnyOperationsAborted;
end;

function DeleteDirectory(Directory: String; CanUndo, DeleteNotEmpty, GUI: Boolean): Boolean;
var
  FOS : TSHFileOpStruct;
  FOS_FLAG: DWORD;
begin
   result:= FALSE;
   Directory:= ITB(Directory);
   if not DirectoryExists(Directory) then exit;
   if not DeleteNotEmpty then begin
      if not DirIsEmpty(Directory) then exit;
   end;
   ZeroMemory(@FOS,SizeOf(FOS));
   if CanUndo then FOS_FLAG:= FOF_ALLOWUNDO else FOS_FLAG:= 0;
   if not GUI then FOS_FLAG:= FOS_FLAG + FOF_NOCONFIRMATION;
   with FOS do begin
      wFunc := FO_DELETE;
      fFlags := FOS_FLAG;
      pFrom := PChar(Directory + #0);
   end;
   RESULT := (0 = ShFileOperation(FOS));
end;

function  GetFileSize(Datei: String): Int64;
var
   TempFileSize: Int64;
   SR: TSearchRec;
begin
     TempFileSize:= 0;
     if FindFirst(Datei,faAnyFile,SR) = 0 then
     TempFileSize:= SR.Size;
     FindClose(SR);
     result:= TempFileSize;
end;

procedure SaveStringToFile(const Str, Filename: String);
var
   TF: TextFile;
begin
   AssignFile(TF, Filename);
   Rewrite(TF);
   Write(TF, Str);
   Close(TF);
end;

function ReadStringFromFile(const Filename: String): String;
var
   TF: TextFile;
begin
   if not FileExists(Filename) then begin
      result:= '';
      exit;
   end;
   AssignFile(TF, Filename);
   Reset(TF);
   Read(TF, result);
   Close(TF);
end;

function FileAttrib(Filename: String; A,H,R,S: Boolean): Boolean;
var
   Attrbs: DWord;
begin
   Attrbs:= 0;
   if A then Attrbs:= Attrbs and FILE_ATTRIBUTE_ARCHIVE;
   if H then Attrbs:= Attrbs and FILE_ATTRIBUTE_HIDDEN;
   if R then Attrbs:= Attrbs and FILE_ATTRIBUTE_READONLY;
   if S then Attrbs:= Attrbs and FILE_ATTRIBUTE_SYSTEM;
   result:= SetFileAttributes(PChar(Filename), Attrbs);
end;
procedure PatchFile(filename:string;data:array of byte;offset,count:longint);
var
  f:file;
begin
  assignfile(f,filename);
  {$i-}reset(f,1);{$i+}if ioresult<>0 then exit;
  seek(f,offset);
  blockwrite(f,data,count);
  closefile(f);
end;




end.