{-----------------------------------------------------------------------------
                          ---> Project DelphiWorks <---
                                  Version 1.4
 -----------------------------------------------------------------------------
 Unit:        dwFiles.pas
 Description: Functions for file properties and operations
 Author:      Codehunter Works
 Release:     1.4
 State:       Stable
 Date:        16.08.2004
 Created:     14.12.2002
 Last mod.:   14.02.2005
 History:     14.09.2004, 16:11:47 - changed dwListFilesRecursive: New routine, new deklaration (backward compatible)
              05.11.2004, 21:39:26 - changed dwCreateDummyFile: faster algortihm /A: Wobbel | wobbel@online.de
              29.12.2004, 16:53:21 - changed dwGetFileSize: improved for files > 4 GB
              02.06.2005, 14:21:52 - changed dwListFiles: Param "ShowPath" renamed to "IncludePath"
              29.06.2006, 17:26:39 - changed dwCopyDirFile: added overload and second function without UserHasCancelled var parameter
-----------------------------------------------------------------------------}


unit dwFiles;

interface

uses dwTypes,
     Classes, Windows;

function dwCopyDirFile(const Src, Dst: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean; overload;
function dwCopyDirFile(const Src, Dst: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean): Boolean; overload;
function dwCreateDummyFile(Filename: String; FileSize: Int64): Int64;
function dwDeleteDirectory(Directory: String; CanUndo, DeleteNotEmpty, GUI: Boolean): Boolean;
function dwDeleteFileOnReboot(const Filename: String): Boolean;
function dwDeleteFiles(Path, Mask: string): Boolean;
function dwDirIsEmpty(Path: String): Boolean;
function dwDirIsSubDir(const Dir, SubDir: String): Boolean;
function dwEmptyRecycleBin(const Confirmation, GUI, Sound: Boolean): Boolean;
function dwExtractDriveFromPath(Path: String): String;
function dwExtractPureFilename(Name: String): String;
function dwFileIsOpen(const Filename: String): Boolean;
function dwFilesInRecycleBin(var FileCount: Int64): Boolean;
function dwGetAssociatedProgram(const Ext: String): String;
function dwGetFileCharSetName(const FileInfo: TDWFileInfo): String;
function dwGetFileCRC32Hex(const Filename: String): String;
function dwGetFileCRC32Int(const Filename: String): DWord;
function dwGetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TDWFileDateTimeStamp): Boolean;
function dwGetFileFlags(const FileInfo: TDWFileInfo): TDWFileFlags;
function dwGetFileIcon(const FileExtension: String; const IconType: TDWIconType): HIcon;
function dwGetFileInfo(const Filename: String): TDWFileInfo;
function dwGetFileLanguageName(const FileInfo: TDWFileInfo): String;
function dwGetFileOS(const FileInfo: TDWFileInfo): TDWFileOSSet;
function dwGetFileProductVersionLS(const FileInfo: TDWFileInfo): TDWVersionBlock;
function dwGetFileProductVersionMS(const FileInfo: TDWFileInfo): TDWVersionBlock;
function dwGetFileSize(Datei: String): Int64;
function dwGetFileStrucVersion(const FileInfo: TDWFileInfo): TDWVersionBlock;
function dwGetFileSubType(const FileInfo: TDWFileInfo): TDWFileSubType;
function dwGetFileType(const FileInfo: TDWFileInfo): TDWFileType;
function dwGetFileVersionLS(const FileInfo: TDWFileInfo): TDWVersionBlock;
function dwGetFileVersionMS(const FileInfo: TDWFileInfo): TDWVersionBlock;
function dwGetIconDimension(const Filename: String; const Index: Integer): TDWDimension;
function dwGetNumberOfIcons(const Filename: String): Integer;
function dwGetSpecialFolder(const SpecialFolder: TDWSpecialFolder): String;
function dwLongPathToShortPath(const LongPath: String): String;
function dwMoveDirFile(const Src, Dst: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean;
function dwNTFSCompressFile(const FileName: String; const ForceCompress: Boolean): Boolean;
function dwNTFSUncompressFile(const FileName: String): Boolean;
function dwReadStringFromFile(const Filename: String): String;
function dwRenameFileOnReboot(const OldFilename, NewFilename: String): Boolean;
function dwSetFileAttrib(const Filename: String; const A,H,R,S: Boolean): Boolean;
function dwSetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TDWFileDateTimeStamp): Boolean;
function dwUnforceDirectories(const Path: String): Boolean;

procedure dwAddRecentDocument(const Filename: String);
procedure dwListFilesRecursive(const APath, AMask: String; AShowPath: Boolean; AList: TStrings);
procedure dwListFiles(const Path, Mask: string; List: TStrings; const IncludePath: Boolean);
procedure dwListFolders(const Path: String; const ShowPath: Boolean; var List: TStrings);
procedure dwPatchFile(Filename: String; Data: array of Byte; Offset, Count: LongInt);
procedure dwSaveStringToFile(const Str, Filename: String);

implementation

uses dwConsts, dwConvert, dwDrives, dwInternal, dwStrings, dwWinSystem,
     Dialogs, FileCtrl, Graphics, Registry, ShellAPI, ShlObj, SysUtils;

function dwCopyDirFile(const Src, Dst: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean; var UserHasCancelled: Boolean): Boolean; overload;
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(ExcludeTrailingBackslash(Src) + #0);
      pTo := PChar(ExcludeTrailingBackslash(Dst));
   end;
   RESULT := (0 = ShFileOperation(FOS));
   UserHasCancelled:= FOS.fAnyOperationsAborted;
end;

function dwCopyDirFile(const Src, Dst: String; const GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI: Boolean): Boolean; overload;
var
	Dummy: Boolean;
begin
  result:= dwCopyDirFile(Src, Dst, GUI, SimpleGUI, CopyConfirmation, MkDirConfirmation, ErrorGUI, Dummy);
end;

function dwCreateDummyFile(Filename: String; FileSize: Int64): Int64;
const
   SIZEF = 1;
var
   FS: TFileStream;
   Drive, FillChr: Char;
   I, J, Clusters, ClusterSize, BytesInLastCluster: Integer;
   FreeClusters, FreeDiskSpace: Int64;
   CharArr: Array of Char;
begin
   result := -1;
   if not FileExists(Filename) then
   begin
      FS := TFileStream.Create(ExpandFilename(Filename), fmCreate);
      try
         result := 0;
         Drive:= ExpandFilename(ExpandFilename(Filename))[1];
         ClusterSize := dwDriveBytesPerCluster(Drive);
         FreeClusters := dwDriveFreeClusters(Drive);
         FreeDiskSpace := FreeClusters*Clustersize;
         if FileSize < 0 then
             FileSize := FreeDiskSpace
         else
            if FileSize < ClusterSize then
               ClusterSize := FileSize;
         if not (Filesize = 0) then
         begin
            if FileSize > FreeDiskSpace then
               FileSize := FreeDiskSpace;
            SetLength(CharArr, ClusterSize);
            Clusters := FileSize div ClusterSize;
            BytesInLastCluster := FileSize mod ClusterSize;
            randomize;
            for I := 0 to Clusters - 1 do
            begin
               for J := 0 to ClusterSize - 1 do
                  CharArr[J] := Chr(I - Random(255) + 1);
               Inc(result, FS.Write(CharArr, ClusterSize));
            end;
            for I := 0 to BytesInLastCluster - 1 do
            begin
               FillChr := Chr(I - Random(255) + 1);
               Inc(result, FS.Write(FillChr, SIZEF));
            end;
         end;
      finally
         FS.Free;
         CharArr := nil;
      end;
   end;
end;

(*function dwCreateDummyFile(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 dwDeleteDirectory(Directory: String; CanUndo, DeleteNotEmpty, GUI: Boolean): Boolean;
var
  SHFileOpStruct : TSHFileOpStruct;
  FOS_FLAG: DWORD;
  FromBuf, ToBuf: Array [0..255] of Char;
begin
   result:= FALSE;
   if not DirectoryExists(Directory) then exit;
   if not DeleteNotEmpty then begin
      if not dwDirIsEmpty(Directory) then exit;
   end;
    Fillchar(SHFileOpStruct, Sizeof(SHFileOpStruct), 0);
    FillChar(FromBuf,        Sizeof(FromBuf),        0);
    FillChar(ToBuf,          Sizeof(ToBuf),          0);
    StrPCopy(FromBuf,        Directory);
    StrPCopy(ToBuf,          String(''));
   if CanUndo then FOS_FLAG:= FOF_ALLOWUNDO else FOS_FLAG:= 0;
   if not GUI then FOS_FLAG:= FOS_FLAG or FOF_NOCONFIRMATION;
   with SHFileOpStruct do begin
      Wnd:= 	0;
      wFunc:= 	FO_DELETE;
      pFrom:= 	@FromBuf;
      pTo:= 	@ToBuf;
      fFlags:= FOS_FLAG;
   end;
   result:= (ShFileOperation(SHFileOpStruct)=0);
end;

function dwDeleteFileOnReboot(const Filename: String): Boolean;
var
  WinDir, WinInit: String;
begin
   if dwIsNTMachine then begin
      result := MoveFileEx(PChar(Filename), nil, MOVEFILE_DELAY_UNTIL_REBOOT);
   end else begin
      WinDir := dwGetSpecialFolder(dwspfWindows);
      WinDir:= IncludeTrailingBackslash(WinDir);
      WinInit := WinDir+'WININIT.INI';
      result := WritePrivateProfileString('Rename',
                                          'NUL',
                                          PChar(Filename),
                                          PChar(WinInit));
   end;
end;

function dwDeleteFiles(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);
   SysUtils.FindClose(SRec);
   if SL.Count < 1 then exit;
   for I:= 0 to SL.Count - 1 do begin
      DeleteFile(PChar(SL[I]));
   end;
   result:= TRUE;
   SL.Free;
end;

function dwDirIsEmpty(Path: String): Boolean;
var
   SL: TStringList;
begin
   SL:= TStringList.Create;
   dwListFilesRecursive(IncludeTrailingBackslash(Path), '*.*', TRUE, SL);
   result:= (SL.Count < 1);
   SL.Free;
end;

function dwDirIsSubDir(const Dir, SubDir: String): Boolean;
var
	sDir, sSubDir: String;
begin
	sDir:= dwLongPathToShortPath(Dir);
   sSubDir:= dwLongPathToShortPath(SubDir);
   result:= (AnsiPos(sDir, sSubDir)=1);
end;

function dwEmptyRecycleBin(const Confirmation, GUI, Sound: Boolean): Boolean;
var
  SHEmptyRecycleBin: TSHEmptyRecycleBin;
  LibHandle: THandle;
  Flags: DWord;
begin  { EmptyRecycleBin }
  result:= FALSE;
  Flags:= 0;
  if not Confirmation then Flags:= Flags or SHERB_NOCONFIRMATION;
  if not GUI          then Flags:= Flags or SHERB_NOPROGRESSUI;
  if not Sound        then Flags:= Flags or SHERB_NOSOUND;
  LibHandle := LoadLibrary(PChar('Shell32.dll'));
  if LibHandle <> 0 then @SHEmptyRecycleBin :=
      GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
  else
  begin
    MessageDlg('Shell32.dll konnte nicht geladen werden.', mtError, [mbOK], 0);
    Exit;
  end;
  if @SHEmptyRecycleBin <> nil then result:= (SHEmptyRecycleBin(GetCurrentProcess, nil, Flags)=S_OK);
  FreeLibrary(LibHandle); @SHEmptyRecycleBin := nil;
end;

function dwExtractDriveFromPath(Path: String): String;
begin
   if (StrLen(PChar(Path)) > 0) then result:= Path[1] else result:= '';
end;

function dwExtractPureFilename(Name: String): String;
var
   Dots, DotPos: Integer;
begin
   if pos(PathDelim,Name)<>0 then
     Name:=ExtractFileName(Name);
   Dots:= dwStringCountInStr('.', Name);
   if Dots=0 then
     result:=name
   else
   begin
     DotPos:= dwSubPositionByIndex(Name, '.', Dots);
     result:= dwStrLeft(Name, DotPos - 1);
   end;
end;

function dwFileIsOpen(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 dwFilesInRecycleBin(var FileCount: Int64): Boolean;
type
  _SHQUERYRBINFO = record
     cbSize: DWord;
     i64Sizelow, i64Sizehigh,
     i64NumItemslow, i64NumItemshigh: DWord;
  end;
  TPSHQUERYRBINFO = ^_SHQUERYRBINFO;
  TSHQueryRecycleBin = function(pszRootPath: PChar;
                                var pSHQueryRBInfo: TPSHQUERYRBINFO): HRESULT;  stdcall;
var
  SHQueryRecycleBin: TSHQueryRecycleBin;
  SHQueryRBInfo: _SHQUERYRBINFO;
  pSHQueryRBInfo : TPSHQUERYRBINFO;
  LibHandle: THandle;
begin  { EmptyRecycleBin }
  result:= FALSE;
  SHQueryRBInfo.cbSize:= SizeOf(SHQueryRBInfo);
  LibHandle := LoadLibrary(PChar('Shell32.dll'));
  if LibHandle <> 0 then @SHQueryRecycleBin :=
      GetProcAddress(LibHandle, 'SHQueryRecycleBinA')
  else
  begin
    MessageDlg('Shell32.dll konnte nicht geladen werden.', mtError, [mbOK], 0);
    Exit;
  end;
  if not Assigned(SHQueryRecycleBin) then begin
    MessageDlg('Shell32.dll konnte nicht geladen werden.', mtError, [mbOK], 0);
    Exit;
  end;

  pSHQueryRBInfo := @SHQueryRBInfo;
  SHQueryRBInfo.cbSize := sizeof(SHQueryRBInfo);
  SHQueryRBInfo.i64numitemslow := 0;
  SHQueryRBInfo.i64numitemshigh := 0;

  result:= ( SHQueryRecycleBin(PChar('c:'), pSHQueryRBInfo)=S_OK);
  filecount := SHQueryRBInfo.i64numitemslow;
  FreeLibrary(LibHandle); @SHQueryRecycleBin := nil;
end;

function dwGetAssociatedProgram(const Ext: String): String;
var
  {$IFDEF WIN32}
  reg: TRegistry;
  s: string;
  {$ELSE}
  WinIni: TIniFile;
  WinIniFileName: array[0..MAX_PATH] of Char;
  s: string;
  {$ENDIF}
begin
  {$IFDEF WIN32}
  s := '';
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  if reg.OpenKey('.' + ext + '\shell\open\command',
    False) <> False then
  begin
    {The open command has been found}
    s := reg.ReadString('');
    reg.CloseKey;
  end
  else
  begin
    {perhaps thier is a system file pointer}
    if reg.OpenKey('.' + ext,
      False) <> False then
    begin
      s := reg.ReadString('');
      reg.CloseKey;
      if s <> '' then
      begin
        {A system file pointer was found}
        if reg.OpenKey(s + '\shell\open\command',
          False) <> False then
          {The open command has been found}
          s := reg.ReadString('');
        reg.CloseKey;
      end;
    end;
  end;
  {Delete any command line, quotes and spaces}
  if Pos('%', s) > 0 then
    Delete(s, Pos('%', s), Length(s));
  if ((Length(s) > 0) and
    (s[1] = '"')) then
    Delete(s, 1, 1);
  if ((Length(s) > 0) and
    (Pos('"', s) > 0)) then
    Delete(s, Pos('"', s), Length(s));
  while ((Length(s) > 0) and
    (s[Length(s)] = #32)) do
    Delete(s, Length(s), 1);
  {$ELSE}
  GetWindowsDirectory(WinIniFileName, SizeOf(WinIniFileName));
  StrCat(WinIniFileName, '\win.ini');
  WinIni := TIniFile.Create(WinIniFileName);
  s  := WinIni.ReadString('Extensions',ext,'');
  WinIni.Free;
  {Delete any command line}
  if Pos(' ^', s) > 0 then
    Delete(s, Pos(' ^', s), Length(s));
  {$ENDIF}
  Result := s;
end;

function dwGetFileCharSetName(const FileInfo: TDWFileInfo): String;
var
   LngName: Array[0..255] of Char;
begin
   LngName:= '';
   VerLanguageName(FileInfo.dwFileCharSet, LngName, Length(LngName));
   result:= LngName;
end;

function dwGetFileCRC32Hex(const Filename: String): String;
begin
   result:= IntToHex(dwGetFileCRC32Int(Filename), 6);
end;

function dwGetFileCRC32Int(const Filename: String): DWord;
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 dwGetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TDWFileDateTimeStamp): Boolean;
begin
   with FileDateTimeStamp do begin
      LastWrite:= 0;
      Creation:= 0;
      dwiReadDateTime(Filename, LastWrite);
      dwiReadCreateDateTime(Filename, Creation);
      result:= ((LastWrite<>0) and (Creation<>0));
   end;
end;

function dwGetFileFlags(const FileInfo: TDWFileInfo): TDWFileFlags;
begin
   case FileInfo.dwFileFlags of
   VS_FF_DEBUG:         result:= dwffDebug;
   VS_FF_INFOINFERRED:  result:= dwffInfoInferred;
   VS_FF_PATCHED:       result:= dwffPatched;
   VS_FF_PRERELEASE:    result:= dwffPrerelease;
   VS_FF_PRIVATEBUILD:  result:= dwffPrivateBuild;
   VS_FF_SPECIALBUILD:  result:= dwffSpecialBuild;
   else                 result:= dwffPrivateBuild;
   end;
end;

function dwGetFileIcon(const FileExtension: String; const IconType: TDWIconType): HIcon;
var
  Info: TSHFileInfo;
  Flags: Cardinal;
begin
  Flags:= 0;
  case IconType of
  dwitSmall: Flags:= 		  SHGFI_ICON or
  									  SHGFI_SMALLICON or
                             SHGFI_USEFILEATTRIBUTES;
  dwitLarge: Flags:= 		  SHGFI_ICON or
  									  SHGFI_LARGEICON or
                             SHGFI_USEFILEATTRIBUTES;
  dwitShellSetting:	Flags:= SHGFI_ICON or
                             SHGFI_SHELLICONSIZE or
                             SHGFI_USEFILEATTRIBUTES;
  end;
  SHGetFileInfo(PChar(FileExtension),
                FILE_ATTRIBUTE_NORMAL,
                Info,
                SizeOf(TSHFileInfo), Flags);
  Result := Info.hIcon;
end;

function dwGetFileInfo(const Filename: String): TDWFileInfo;
type
   pFixedFileInfo = ^TDWFixedFileInfo;
   pLangCharSet = ^TDWLangCharSet;
var
   Size, TmpSize: DWord;
   cFilename,
   Buffer: PChar;
   Ptr: Pointer;
   FixedInfo: TDWFixedFileInfo;
   PLCSet: pLangCharSet;
   Translation: String;
begin
   cFilename := StrAlloc(Length(FileName) + 1);
   StrPCopy(cFilename, FileName);
   Size:= GetFileVersionInfoSize(cFilename, TmpSize);
   ZeroMemory(@PLCSet, SizeOf(pLangCharSet));
   if Size > 0 then
   begin
      Buffer := StrAlloc(Size);
      if GetFileVersionInfo(cFilename, TmpSize, Size, Buffer) then
      begin
         VerQueryValue(Buffer, '\', Ptr, Size);
         FixedInfo := pFixedFileInfo(Ptr)^;
         VerQueryValue(Buffer, '\VarFileInfo\Translation', Ptr, Size);
         PLCSet := pLangCharSet(Ptr);
         Translation := Format('%4.4x%4.4x',[PLCSet^.dwLang, PLCSet^.dwCharSet]);
         with result do begin
            dwComments:=         dwQueryCopyrightString('Comments',
                                                      Translation,
                                                      Buffer);
            dwCompanyName:=      dwQueryCopyrightString('CompanyName',
                                                      Translation,
                                                      Buffer);
            dwFileDescription:=  dwQueryCopyrightString('FileDescription',
                                                      Translation,
                                                      Buffer);
            dwFileVersion:=      dwQueryCopyrightString('FileVersion',
                                                      Translation,
                                                      Buffer);
            dwInternalName:=     dwQueryCopyrightString('InternalName',
                                                      Translation,
                                                      Buffer);
            dwLegalCopyright:=   dwQueryCopyrightString('LegalCopyright',
                                                      Translation,
                                                      Buffer);
            dwLegalTrademarks:=  dwQueryCopyrightString('LegalTrademarks',
                                                      Translation,
                                                      Buffer);
            dwOriginalFilename:= dwQueryCopyrightString('OriginalFilename',
                                                      Translation,
                                                      Buffer);
            dwPrivateBuild:=     dwQueryCopyrightString('PrivateBuild',
                                                      Translation,
                                                      Buffer);
            dwProductName:=      dwQueryCopyrightString('ProductName',
                                                      Translation,
                                                      Buffer);
            dwProductVersion:=   dwQueryCopyrightString('ProductVersion',
                                                      Translation,
                                                      Buffer);
            dwSpecialBuild:=     dwQueryCopyrightString('SpecialBuild',
                                                      Translation,
                                                      Buffer);
         end;
      end;
   end;
   StrDispose(cFilename);
   with result do begin
      dwSignature:=        FixedInfo.dwSignature;
      dwStrucVersion:=     FixedInfo.dwStrucVersion;
      dwFileVersionMS:=    FixedInfo.dwFileVersionMS;
      dwFileVersionLS:=    FixedInfo.dwFileVersionLS;
      dwProductVersionMS:= FixedInfo.dwProductVersionMS;
      dwProductVersionLS:= FixedInfo.dwProductVersionLS;
      dwFileFlagsMask:=    FixedInfo.dwFileFlagsMask;
      dwFileFlags:=        FixedInfo.dwFileFlags;
      dwFileOS:=           FixedInfo.dwFileOS;
      dwFileType:=         FixedInfo.dwFileType;
      dwFileSubtype:=      FixedInfo.dwFileSubtype;
      dwFileDateMS:=       FixedInfo.dwFileDateMS;
      dwFileDateLS:=       FixedInfo.dwFileDateLS;
      dwFileLanguage:=     PLCSet^.dwLang;
      dwFileCharSet:=      PLCSet^.dwCharSet;
   end;
end;

function dwGetFileLanguageName(const FileInfo: TDWFileInfo): String;
var
   LngName: Array[0..255] of Char;
begin
   LngName:= '';
   VerLanguageName(FileInfo.dwFileLanguage, LngName, Length(LngName));
   result:= LngName;
end;

function dwGetFileOS(const FileInfo: TDWFileInfo): TDWFileOSSet;
begin
   if (FileInfo.dwFileOS and VOS_DOS)>0
      then Include(result, dwfosDOS);
   if (FileInfo.dwFileOS and VOS_DOS_WINDOWS16)>0
      then Include(result, dwfosDOS_Windows16);
   if (FileInfo.dwFileOS and VOS_DOS_WINDOWS32)>0
      then Include(result, dwfosDOS_Windows32);
   if (FileInfo.dwFileOS and VOS_NT)>0
      then Include(result, dwfosNT);
   if (FileInfo.dwFileOS and VOS_NT_WINDOWS32)>0
      then Include(result, dwfosNT_Windows32);
   if (FileInfo.dwFileOS and VOS_OS216)>0
      then Include(result, dwfosOS2_16);
   if (FileInfo.dwFileOS and VOS_OS216_PM16)>0
      then Include(result, dwfosOS2_16_PM16);
   if (FileInfo.dwFileOS and VOS_OS232)>0
      then Include(result, dwfosOS2_32);
   if (FileInfo.dwFileOS and VOS_OS232_PM32)>0
      then Include(result, dwfosOS2_32_PM32);
   if (FileInfo.dwFileOS and VOS__WINDOWS16)>0
      then Include(result, dwfosWindows16);
   if (FileInfo.dwFileOS and VOS__WINDOWS32)>0
      then Include(result, dwfosWindows32);
   if (FileInfo.dwFileOS and VOS__PM16)>0
      then Include(result, dwfosPM16);
   if (FileInfo.dwFileOS and VOS__PM32)>0
      then Include(result, dwfosPM32);
   if result = [] then result:= [dwfosUnknown];
end;

function dwGetFileProductVersionLS(const FileInfo: TDWFileInfo): TDWVersionBlock;
begin
   result.dwVersionMajor:= (FileInfo.dwProductVersionLS and $FFFF0000) shr $10;
   result.dwVersionMinor:=  FileInfo.dwProductVersionLS and $FFFF;
end;

function dwGetFileProductVersionMS(const FileInfo: TDWFileInfo): TDWVersionBlock;
begin
   result.dwVersionMajor:= (FileInfo.dwProductVersionMS and $FFFF0000) shr $10;
   result.dwVersionMinor:=  FileInfo.dwProductVersionMS and $FFFF;
end;

{function dwGetFileSize(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;}

function dwGetFileSize(Datei: String): Int64;
var
   SR: _WIN32_FIND_DATA;
   FileHandle: THandle;
const
   MaxLongWord : Int64 = 4294967296;
begin
 if FileExists(Datei)then begin
    FileHandle:= FindFirstFile(PChar(Datei), SR);
    result:= INT64((SR.nFileSizeHigh) * MaxLongWord + Sr.nFileSizeLow);
    Windows.FindClose(FileHandle);
 end else begin
   result := -1;
 end;
end;

function dwGetFileStrucVersion(const FileInfo: TDWFileInfo): TDWVersionBlock;
begin
   result.dwVersionMajor:= (FileInfo.dwStrucVersion and $FFFF0000) shr $10;
   result.dwVersionMinor:=  FileInfo.dwStrucVersion and $FFFF;
end;

function dwGetFileSubType(const FileInfo: TDWFileInfo): TDWFileSubType;
begin
   if (FileInfo.dwFileType = VFT_FONT) then begin
      case FileInfo.dwFileSubtype of
      VFT2_FONT_RASTER:   result:= dwfstFontRaster;
      VFT2_FONT_TRUETYPE: result:= dwfstFontTruetype;
      VFT2_FONT_VECTOR:   result:= dwfstFontVector;
      else                result:= dwfstUnknown;
      end;
      exit;
   end;
   case FileInfo.dwFileSubtype of
   VFT2_DRV_COMM:        result:= dwfstCOMM;
   VFT2_DRV_DISPLAY:     result:= dwfstDisplay;
   VFT2_DRV_INSTALLABLE: result:= dwfstInstallable;
   VFT2_DRV_KEYBOARD:    result:= dwfstKeyboard;
   VFT2_DRV_LANGUAGE:    result:= dwfstLanguage;
   VFT2_DRV_MOUSE:       result:= dwfstMouse;
   VFT2_DRV_NETWORK:     result:= dwfstNetwork;
   VFT2_DRV_PRINTER:     result:= dwfstPrinter;
   VFT2_DRV_SOUND:       result:= dwfstSound;
   VFT2_DRV_SYSTEM:      result:= dwfstSystem;
   VFT2_UNKNOWN:         result:= dwfstUnknown;
   else                  result:= dwfstUnknown;
   end;
end;

function dwGetFileType(const FileInfo: TDWFileInfo): TDWFileType;
begin
   case FileInfo.dwFileType of
   VFT_UNKNOWN:    result:= dwftUnknown;
   VFT_APP:        result:= dwftApp;
   VFT_DLL:        result:= dwftDLL;
   VFT_DRV:        result:= dwftDRV;
   VFT_FONT:       result:= dwftFont;
   VFT_VXD:        result:= dwftVXD;
   VFT_STATIC_LIB: result:= dwftStaticLib
   else            result:= dwftUnknown;
   end;
end;

function dwGetFileVersionLS(const FileInfo: TDWFileInfo): TDWVersionBlock;
begin
   result.dwVersionMajor:= (FileInfo.dwFileVersionLS and $FFFF0000) shr $10;
   result.dwVersionMinor:=  FileInfo.dwFileVersionLS and $FFFF;
end;

function dwGetFileVersionMS(const FileInfo: TDWFileInfo): TDWVersionBlock;
begin
   result.dwVersionMajor:= (FileInfo.dwFileVersionMS and $FFFF0000) shr $10;
   result.dwVersionMinor:=  FileInfo.dwFileVersionMS and $FFFF;
end;

function dwGetIconDimension(const Filename: String; const Index: Integer): TDWDimension;
var
   iIcon: TIcon;
begin
   iIcon:= TIcon.Create;
   iIcon.Handle:= ExtractIcon(GetCurrentProcess, PChar(Filename), Index);
   with result do begin
      Height:= iIcon.Height;
      Width:=  iIcon.Width;
   end;
   iIcon.free;
end;

function dwGetNumberOfIcons(const Filename: String): Integer;
begin
   result:= ExtractIcon(GetCurrentProcess, PChar(Filename), UINT(-1));
end;

function dwGetSpecialFolder(const SpecialFolder: TDWSpecialFolder): String;
var
   pPath: PChar;
   Len: DWord;
begin
   GetMem(pPath, MAX_PATH);
   case SpecialFolder of
   dwspfSystem:   GetSystemDirectory(pPath, MAX_PATH);
   dwspfTempDir:  begin
                     Len:= GetTempPath(MAX_PATH, pPath);
                     if Len > MAX_PATH then GetTempPath(Len - 1, pPath);
                  end;
   dwspfWindows:  GetWindowsDirectory(pPath, MAX_PATH);
   else           SHGetSpecialFolderPath(GetCurrentProcess,
                                         pPath,
                                         dwSpecialFolderToCSIDL(SpecialFolder),
                                         FALSE);
   end;

   result:= IncludeTrailingBackslash(pPath);
   FreeMem(pPath, MAX_PATH);
end;

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

procedure dwListFilesRecursive(const APath, AMask: String; AShowPath: Boolean; AList: TStrings);
var
  SR: TSearchRec;
  slDir: TStringList;
  IsFound: Boolean;
  I: integer;
  SPath: String;
begin
   if not Assigned(AList) then exit;
   AList.BeginUpdate;
SPath:= IncludeTrailingBackslash(APath);
   IsFound:= (FindFirst(SPath + AMask, faAnyFile - faDirectory, SR) = 0);
   while IsFound do begin
      if AShowPath then begin
   AList.Add(SPath + SR.Name);
      end else begin
      AList.Add(SR.Name);
      end;
     IsFound := FindNext(SR) = 0;
   end;
   FindClose(SR);
   slDir := TStringList.Create;
   IsFound := FindFirst(SPath + '*.*', faAnyFile, SR) = 0;
   while IsFound do begin
      if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') then begin
      slDir.Add(SPath + SR.Name);
      end;
      IsFound := FindNext(SR) = 0;
   end;
   FindClose(SR);
   for I:= 0 to slDir.Count - 1 do begin
      dwListFilesRecursive(slDir[I], AMask, AShowPath, AList);
   end;
   slDir.Free;
   AList.EndUpdate;
end;

procedure dwListFolders(const Path: String; const ShowPath: Boolean; var List: TStrings);
var
  SRec: TSearchRec;
begin
   (* ++++++++++++++++ Code sample by Pumi ++++++++++++++++++ *)
   if not Assigned(List) then List:= TStringList.Create;
   FindFirst(Path + '*.*', {not faAnyFile +
                           not faSysFile +
                           not faHidden +
                           not faReadOnly}
                           faDirectory,
                           SRec);
   if ShowPath then
      List.Add(Path + SRec.Name)
   else
      List.Add(SRec.Name);
   while FindNext(SRec) = 0 do
      if ShowPath then
         List.Add(Path + SRec.Name)
      else
         List.Add(SRec.Name);
   FindClose(SRec);
end;

function dwLongPathToShortPath(const LongPath: String): String;
var
  buffer: array[0..MAX_PATH] of char;
  res: dword;
begin
   if LongPath = '' then exit;
   res := GetShortPathName(PChar(LongPath), buffer, sizeof(buffer));
   if res <= 0 then
      result := ''
   else
      result := buffer;
end;

function dwNTFSCompressFile(const FileName: String; const ForceCompress: Boolean): Boolean;
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 dwNTFSUncompressFile(const FileName: String): Boolean;
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;

procedure dwPatchFile(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;

function dwReadStringFromFile(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 dwRenameFileOnReboot(const OldFilename, NewFilename: String): Boolean;
var
  WinDir, WinInit, fFrom, fTo: String;
  bResult: Boolean;
begin
   if dwIsNTMachine then begin
      bResult:= MoveFileEx(PChar(NewFilename),
                           nil,
                           MOVEFILE_DELAY_UNTIL_REBOOT);
      result:= bResult and MoveFileEx(PChar(OldFilename),
                                      PChar(NewFilename),
                                      MOVEFILE_DELAY_UNTIL_REBOOT);
   end else begin
      fFrom:= dwLongPathToShortPath(OldFilename);
      fTo:= dwLongPathToShortPath(NewFilename);
      WinDir:= dwGetSpecialFolder(dwspfWindows);
      WinDir:= IncludeTrailingBackslash(WinDir);
      WinInit:= WinDir+'WININIT.INI';
      bResult:= WritePrivateProfileString('Rename',
                                          'NUL',
                                          PChar(fTo),
                                          PChar(WinInit));
      result:= bResult and WritePrivateProfileString('Rename',
                                                     PChar(fTo),
                                                     PChar(fFrom),
                                                     PChar(WinInit));
   end;
end;

function dwMoveDirFile(const Src, Dst: 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_MOVE;
      fFlags := Flags;
      pFrom := PChar(ExcludeTrailingBackslash(Src) + #0);
      pTo := PChar(ExcludeTrailingBackslash(Dst));
   end;
   RESULT := (0 = ShFileOperation(FOS));
   UserHasCancelled:= FOS.fAnyOperationsAborted;
end;

procedure dwAddRecentDocument(const Filename: String);
begin
	SHAddToRecentDocs(SHARD_PATH, PChar(Filename));
end;

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

function dwSetFileAttrib(const Filename: String; const 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;

function dwSetFileDateTimeStamp(const Filename: String; var FileDateTimeStamp: TDWFileDateTimeStamp): Boolean;
begin
   result:= (dwiWriteCreateDateTime(Filename, FileDateTimeStamp.Creation));
end;

function dwUnforceDirectories(const Path: String): Boolean;
var
   I: Integer;
   Str: String;
begin
   result:= FALSE;
   Str:= ExcludeTrailingBackslash(ExtractFilePath(Path));
   if (Pos('\', Path) = 0) or (not DirectoryExists(Str)) then exit;
   result:= RemoveDir(Str);
   if not result then exit;
   for I:= 0 to dwCountCharInStr(Str, '\') - 2 do begin
      Str:= Copy(Str, 1, dwHighPos(Str, '\')-1);
      if DirectoryExists(Str) then {result:= }RmDir(Str);
      if not result then exit;
   end;
end;

end.