// Способ первый
// Данная функция универсальна, она позволяет
// узнать не только версию программы, но и 
// другие данные

const
  TypeInfo: array[0..9] of string = ('CompanyName',
                                     'FileDescription',
                                     'FileVersion',
                                     'InternalName',
                                     'LegalCopyright',
                                     'LegalTrademarks',
                                     'OriginalFilename',
                                     'ProductName',
                                     'ProductVersion',
                                     'Comments');

function FileVersion(AFileName, Info: string): string;
var
  szName: array[0..255] of Char; 
  P: Pointer; 
  Value: Pointer; 
  Len: UINT;
  GetTranslationString: string;
  FFileName: PChar; 
  FValid: Boolean;
  FSize: DWORD; 
  FHandle: DWORD; 
  FBuffer: PChar; 
begin 
  try
    FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
    FValid := False;
    FSize := GetFileVersionInfoSize(FFileName, FHandle);

    if FSize > 0 then
    try
      GetMem(FBuffer, FSize);
      FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
    except
      FValid := False;
      raise;
    end;

    Result := '';

    if FValid then
      VerQueryValue(FBuffer, '\VarFileInfo\Translation', P, Len)
    else
      P := nil;
    if P <> nil then
      GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)),
                                       LoWord(Longint(P^))), 8);

    if FValid then
    begin
      StrPCopy(szName, '\StringFileInfo\' + GetTranslationString + '\' + Info);
      if VerQueryValue(FBuffer, szName, Value, Len) then
        Result := StrPas(PChar(Value));
    end;
  finally
    if FBuffer <> nil then
      FreeMem(FBuffer, FSize);
    StrDispose(FFileName);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FileVersion(ParamStr(0), TypeInfo[2]));
end;

// Способ второй
function GetFileVersion(const FileName: string): string;
type
  PDWORD = ^DWORD;
  PLangAndCodePage = ^TLangAndCodePage;
  TLangAndCodePage = packed record
    wLanguage: WORD;
    wCodePage: WORD;
  end;
  PLangAndCodePageArray = ^TLangAndCodePageArray;
  TLangAndCodePageArray = array[0..0] of TLangAndCodePage;
var
  loc_InfoBufSize: DWORD;
  loc_InfoBuf: PChar;
  loc_VerBufSize: DWORD;
  loc_VerBuf: PChar;
  cbTranslate: DWORD;
  lpTranslate: PDWORD;
  i: DWORD;
begin
  Result := '';

  if (Length(FileName) = 0) or (not FileExists(FileName)) then
    Exit;

  loc_InfoBufSize := GetFileVersionInfoSize(PChar(FileName), loc_InfoBufSize);
  if loc_InfoBufSize > 0 then
  begin
    loc_VerBuf := nil;
    loc_InfoBuf := AllocMem(loc_InfoBufSize);

    try
      if not GetFileVersionInfo(PChar(FileName), 0, loc_InfoBufSize, loc_InfoBuf) then
        Exit;

      if not VerQueryValue(loc_InfoBuf, '\\VarFileInfo\\Translation',
                           Pointer(lpTranslate), DWORD(cbTranslate)) then
        Exit;

      for i := 0 to (cbTranslate div SizeOf(TLangAndCodePage)) - 1 do
      begin
        if VerQueryValue(loc_InfoBuf,
                         PChar(Format('StringFileInfo\0%x0%x\FileVersion',
                                      [PLangAndCodePageArray(lpTranslate)[i].wLanguage,
                                       PLangAndCodePageArray(lpTranslate)[i].wCodePage])),
                         Pointer(loc_VerBuf),
                         DWORD(loc_VerBufSize)) then
         begin
           Result := loc_VerBuf;
           Break;
         end;
       end;
    finally
      FreeMem(loc_InfoBuf, loc_InfoBufSize);
    end;
  end;
end;

// Способ третий
procedure GetFileVersion(FileName: string; var Major1, Major2,
  Minor1, Minor2: Integer);
var
  Info: Pointer;
  FileInfo: PVSFixedFileInfo;
  InfoSize, FileInfoSize, Tmp: DWORD;
begin
  InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp);

  if InfoSize <> 0 then
  begin
    GetMem(Info, InfoSize);
    try
      GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info);
      VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize);
      Major1 := FileInfo.dwFileVersionMS shr 16;
      Major2 := FileInfo.dwFileVersionMS and $FFFF;
      Minor1 := FileInfo.dwFileVersionLS shr 16;
      Minor2 := FileInfo.dwFileVersionLS and $FFFF;
    finally
      FreeMem(Info, FileInfoSize);
    end;
  end;
end;

// Несколько расширенный вариант третьего способа
function GetFileVersion(FileName: string; var Major1, Major2,
  Minor1, Minor2: Integer): string;
var
  pInfo,pPointer: Pointer;
  pVerInfo: PVSFIXEDFILEINFO;
  nSize, nVerInfoSize, nHandle: DWORD;
begin
  Result := '?.?.?.?';
  Major1 := -1;
  Major2 := -1;
  Minor1 := -1;
  Minor2 := -1;

  nSize:=GetFileVersionInfoSize(PChar(FileName), nHandle);

  if nSize <> 0 then
  begin
    GetMem( pInfo,nSize );
    try
      FillChar( pInfo^, nSize, 0 );

      if GetFileVersionInfo(PChar(FileName), nHandle, nSize, pInfo) then
      begin
        nVerInfoSize := SizeOf(VS_FIXEDFILEINFO);
        GetMem(pVerInfo, nVerInfoSize);
        try
          FillChar(pVerInfo^, nVerInfoSize, 0);
          pPointer := Pointer(pVerInfo);
          VerQueryValue(pInfo, '\', pPointer, nVerInfoSize);
          Major1 := PVSFIXEDFILEINFO(pPointer)^.dwFileVersionMS shr 16;
          Major2 := PVSFIXEDFILEINFO(pPointer)^.dwFileVersionMS and $FFFF;
          Minor1 := PVSFIXEDFILEINFO(pPointer)^.dwFileVersionLS shr 16;
          Minor2 := PVSFIXEDFILEINFO(pPointer)^.dwFileVersionLS and $FFFF;

          Result := IntToStr(Major1)+ '.' + IntToStr(Major2) + '.' +
                    IntToStr(Minor1)+ '.' + IntToStr(Minor2);
        finally
          FreeMem(pVerInfo, nVerInfoSize);
        end;
      end;
    finally
      FreeMem(pInfo, nSize);
    end;
  end;
end;

// Способ первый
// подходит только для exe
function GetEXEType(FileName: string): string;
var
  BinaryType: DWORD;
begin
  if GetBinaryType(PChar(FileName), Binarytype) then
    case BinaryType of
      SCS_32BIT_BINARY: Result := 'Win32 executable';       // 32-bit Windows-based
      SCS_WOW_BINARY: Result := 'Win16 executable';         // 16-bit Windows-based
      SCS_DOS_BINARY: Result := 'DOS executable';           // MS-DOS – based
      SCS_PIF_BINARY: Result := 'PIF file';                 // PIF for MS-DOS – based
      SCS_POSIX_BINARY: Result := 'POSIX executable';       // POSIX – based
      SCS_OS216_BINARY: Result := 'OS/2 16 bit executable'; // 16bit-OS/2
      SCS_64BIT_BINARY: Result := 'Win64 executable';       // 64-bit Windows-based
    else
       Result := 'Unknown executable';                      // Wrong Binary File
    end
  else
    Result := 'File is not an executable';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetEXEType('c:\Some.exe'));
end;

// Способ второй
// подходит как для exe, так и для dll
type
  TMachineType = (mtUnknown, mt32Bit, mt64Bit, mtOther);

function GetLibMachineType(const AFileName: string): TMachineType;
var
  oFS: TFileStream;
  iPeOffset: Integer;
  iPeHead: LongWord;
  iMachineType: Word;
begin
  Result := mtUnknown;
  // http://download.microsoft.com/download/9/c/5/9c5b2167-8017-4bae-9fde-d599bac8184a/pecoff_v8.doc
  // Offset to PE header is always at 0x3C.
  // PE header starts with "PE\0\0" = 0x50 0x45 0x00 0x00,
  // followed by 2-byte machine type field (see document above for enum).
  try
     oFS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
     try
       oFS.Seek($3C, soFromBeginning);
       oFS.Read(iPeOffset, SizeOf(iPeOffset));
       oFS.Seek(iPeOffset, soFromBeginning);
       oFS.Read(iPeHead, SizeOf(iPeHead));
       // "PE\0\0", little-endian then

       if iPeHead <> $00004550 then
         Exit;

       oFS.Read(iMachineType, SizeOf(iMachineType));

       case iMachineType of
         $8664, // AMD64
         $0200: // IA64
           Result := mt64Bit;
         $014C: // I386
           Result := mt32Bit;
       else
         Result := mtOther;
       end;
    finally
      oFS.Free;
    end;
  except
    // none
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  case GetLibMachineType('c:\Program Files\PLSQL Developer 12\PlugIns\plsqldoc.dll') of
    mt32Bit: ShowMessage('x32');
    mt64Bit: ShowMessage('x64');
  else
    ShowMessage('не удалось определить');
  end;
end;

uses
  ShellAPI;

procedure TForm1.ShowFileProperties(const FileName: string);
var
  ShellExecuteInfo: TShellExecuteInfo;
begin
  // Инициализация структуры TShellExecuteInfo
  FillChar(ShellExecuteInfo, SizeOf(TShellExecuteInfo), 0);
  // Заполнение структуры TShellExecuteInfo
  ShellExecuteInfo.cbSize := SizeOf(TShellExecuteInfo);
  ShellExecuteInfo.lpFile := PChar(FileName);
  ShellExecuteInfo.lpVerb := 'properties';
  ShellExecuteInfo.fMask := SEE_MASK_INVOKEIDLIST;
  // Отображение свойств файла
  ShellExecuteEx(@ShellExecuteInfo);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowFileProperties('c:\autoexec.bat');
end;

// Или немного иначе
uses
  ShellAPI;

procedure TForm1.ShowPropertiesDialog(FName: string);
var
  SExInfo: TSHELLEXECUTEINFO;
begin
  ZeroMemory(Addr(SExInfo), SizeOf(SExInfo));
  SExInfo.cbSize := SizeOf(SExInfo);
  SExInfo.lpFile := PChar(FName);
  SExInfo.lpVerb := 'properties';
  SExInfo.fMask := SEE_MASK_INVOKEIDLIST;
  ShellExecuteEx(Addr(SExInfo));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowPropertiesDialog('c:\autoexec.bat');
end;

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var 
  SearchRec: TSearchRec;
  Success: integer;
  DT: TFileTime;
  ST: TSystemTime;
begin
  Success := SysUtils.FindFirst('C:\autoexec.bat', faAnyFile, SearchRec);

   if (Success = 0) and
      ((SearchRec.FindData.ftLastAccessTime.dwLowDateTime <> 0) or
      (SearchRec.FindData.ftLastAccessTime.dwHighDateTime <> 0)) then
   begin
     FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime, DT);
     FileTimeToSystemTime(DT, ST);
     Memo1.Lines.Clear;
     Memo1.Lines.Add('AutoExec.Bat последний раз был изменен:');
     Memo1.Lines.Add('Year - ' + IntToStr(st.wYear));
     Memo1.Lines.Add('Month - ' + IntToStr(st.wMonth));
     Memo1.Lines.Add('DayOfWeek - ' + IntToStr(st.wDayOfWeek));
     Memo1.Lines.Add('Day - ' + IntToStr(st.wDay));
     Memo1.Lines.Add('Hour - ' + IntToStr(st.wHour));
     Memo1.Lines.Add('Minute - ' + IntToStr(st.wMinute));
     Memo1.Lines.Add('Second - ' + IntToStr(st.wSecond));
     Memo1.Lines.Add('Milliseconds - ' + IntToStr(st.wMilliseconds));
   end;
   SysUtils.FindClose(SearchRec ;
end;

// Способ второй
function GetFileDate(FileName: string): string;
var
  FHandle: Integer;
begin
  FHandle := FileOpen(FileName, 0);

  try
    Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
  finally
    FileClose(FHandle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetFileDate('c:\autoexec.bat'));
end;

// Способ третий
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(DateTimeToStr(FileDateToDateTime(FileAge('c:\autoexec.bat'))));
end;

// Способ первый
function TForm1.DeleteDir(Dir: string): Boolean;
var
  isFound: Boolean;
  sRec: TSearchRec;
begin
  Result := False;
  ChDir(Dir);

  if IOResult <> 0 then
  begin
    ShowMessage('Не могу войти в каталог: ' + Dir);
    Exit;
  end;

  isFound := FindFirst('*.*', faAnyFile, sRec) = 0;

  while isFound do
  begin
    if (sRec.Name <> '.') and (sRec.Name <> '..') then
      if (sRec.Attr and faDirectory) = faDirectory then
      begin
        if not DeleteDir(sRec.Name) then
          Exit;
      end
      else
        if not DeleteFile(sRec.Name) then
        begin
          ShowMessage('Не могу удалить файл: ' + sRec.Name);
            Exit;
        end;
    isFound := FindNext( sRec ) = 0;
  end;

  FindClose(sRec);
  ChDir('..');
  RmDir(Dir);
  Result := IOResult = 0;
end;

// Способ второй
function ClearDir(Dir: string): Boolean;
var
  isFound: Boolean;
  sRec: TSearchRec;
begin
  Result := False;
  ChDir(Dir);

  if IOResult <> 0 then
  begin
    ShowMessage('Не могу войти в каталог: ' + Dir);
    Exit;
  end;

  if Dir[Length(Dir)] <> '\' then
    Dir := Dir + '\';

  isFound := FindFirst(Dir + '*.*', faAnyFile, sRec) = 0;
  while isFound do
  begin
    if (sRec.Name <> '.') and (sRec.Name <> '..') then
      if (sRec.Attr and faDirectory) = faDirectory then
      begin
        if not ClearDir(Dir + sRec.Name) then
           Exit;

        if (sRec.Name <> '.') and (sRec.Name <> '..') then
          if (Dir + sRec.Name) <> Dir then
          begin
            ChDir('..');
            RmDir(Dir + sRec.Name);
          end;
      end
      else
        if not DeleteFile(Dir + sRec.Name) then
        begin
          ShowMessage('Не могу удалить файл: ' + sRec.Name);
          Exit;
        end;
     isFound := FindNext(sRec) = 0;
  end;

  FindClose(sRec);
  Result := IOResult = 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ClearDir('C:\Windows\Temp');
end;

// Способ третий
// Файлы удаляются в корзину
uses
  ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var
  SH: SHFILEOPSTRUCT; // TSHFileOpStruct
  Error: Integer;
begin
  // ZeroMemory(@SH, SizeOf(SH));
  with SH do
  begin
    Wnd := Handle;
    wFunc := FO_DELETE;
    pFrom := 'c:\dir_name' + #0;
    pTo := nil;
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOERRORUI or FOF_SILENT;
    fAnyOperationsAborted := False;
    hNameMappings := nil;
    lpszProgressTitle := nil;
  end;

  Error := SHFileOperation(SH);

  if Error <> NO_ERROR then
    ShowMessage(SysErrorMessage(Error));
end;

var
  Form1: TForm1;
  tSize: Int64;

procedure TForm1.GetTotalSize(Path: string; var TotalSize: Int64);
var
  sRec: TSearchRec;
  isFound: boolean;
begin
  isFound := FindFirst(Path + '\*.*', faAnyFile, sRec) = 0;

  while isFound do
  begin
    if (sRec.Name <> '.') and (sRec.Name <> '..') then
    begin
      if (sRec.Attr and faDirectory) = faDirectory then
        GetTotalSize(Path + '\' + sRec.Name, TotalSize);
      TotalSize := TotalSize + sRec.Size;
    end;
    isFound := FindNext(sRec) = 0;
  end;
  FindClose(sRec);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  tSize := 0;
  GetTotalSize('C:\WINNT', tSize);
  ShowMessage(IntToStr(tSize));
end;

// Способ первый
procedure TForm1.CopyFiles(FromCopy, ToCopy: string);

  procedure FCopy(Path: string);
  var
    sRec: TSearchRec;
    isFound: Boolean;
    tempPath: string;
  begin
    if not DirectoryExists(ToCopy) then
      CreateDir(ToCopy);

    tempPath := ToCopy;
    isFound := FindFirst(Path + '\*.*', faAnyFile, sRec) = 0;

    while isFound do
    begin
      if ((sRec.Name <> '.') and (sRec.Name <> '..')) and
         ((sRec.Attr and faDirectory) = faDirectory) then
        begin
           tempPath := Path + '\' + sRec.Name;
           Delete(tempPath, 1, Length(FromCopy));
           tempPath := ToCopy + tempPath;
           if not DirectoryExists(tempPath) then
             CreateDir(tempPath);
           FCopy(Path + '\' + sRec.Name);
           Application.ProcessMessages;
        end
        else
        begin
          tempPath := Path + '\' + sRec.Name;
          Delete(tempPath, 1, Length(FromCopy));
          tempPath := ToCopy + tempPath;
          CopyFile(PChar(Path + '\' + sRec.Name),
                   PChar(tempPath), False);
          ProgressBar1.Position := ProgressBar1.Position + sRec.Size;
          Application.ProcessMessages;
        end;
        isFound := FindNext(sRec) = 0;
      Application.ProcessMessages;
    end;
    FindClose(sRec);
  end;
begin
  FCopy(FromCopy);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFiles('c:\откуда', 'd:\куда');
end;

// Способ второй
uses
  ShellAPI;

function CopyDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc := FO_COPY;
    fFlags := FOF_FILESONLY;
    pFrom := PChar(fromDir + #0);
    pTo := PChar(toDir)
  end;
  Result := 0 = ShFileOperation(fos);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  List: TStringList;
begin
  List := TStringList.Create;
  List.Add('Путь к каталогу, который нужно скопировать');
  for i := 0 to List.Count-1 do
    if CopyDir(List.Strings[i], 'C:\') then
      ShowMessage('файлы скопированы');
  List.Free;
end;

uses
  ShellAPI;

procedure OpenFileAs(Path: string);
var
  Err: Integer;
begin
   Err := ShellExecute(Application.Handle, 'open', PChar(Path), nil, nil, SW_SHOW);
   if (Err = SE_ERR_NOASSOC) or (Err = SE_ERR_ASSOCINCOMPLETE) then
   begin
     Path := 'shell32.dll,OpenAs_RunDLL ' + Path;
     ShellExecute(Application.Handle, 'open', 'Rundll32.exe', PChar(Path), nil, SW_SHOW);
  end;
end;

// Способ первый
uses
  ImageHlp;

procedure ComputeChecksum;
var
  M: TMemoryStream;
  I, C: Integer;
begin
  M := TMemoryStream.Create;
  try
    M.LoadFromFile('C:\calc.exe');
    CheckSumMappedFile(M.Memory, M.Size, @I, @C);
    ShowMessageFmt('%x', [C]);
  finally
    M.Free;
  end;
end;

// Способ второй
uses
  ImageHlp;

//function ComputeChecksum(const AFile: string; out AResult: DWORD): Boolean;
//var
//  h, hfm: THandle;
//  pv: Pointer;
//  dwHeaderSum: DWORD;
//begin
//  h := CreateFile(PChar(AFile), GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
//  hfm := CreateFileMapping(h, 0, PAGE_READONLY, 0, 0, 0);
//  pv := MapViewOfFile(hfm, FILE_MAP_READ, 0, 0, 0);
//  CheckSumMappedFile(pv, GetFileSize(h, nil), @dwHeaderSum, @AResult);
//  UnmapViewOfFile(pv);
//  CloseHandle(hfm);
//  CloseHandle(h);
//  Result := True;
//end;

function ComputeChecksum(const AFile: String; out AResult: DWORD): Boolean;
var
  h, hfm: THandle;
  pv: Pointer;
  dwHeaderSum: DWORD;
begin
  Result := False;
  h := CreateFile(PChar(AFile), GENERIC_READ, FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if h <> INVALID_HANDLE_VALUE then
  begin
    hfm := CreateFileMapping(h, 0, PAGE_READONLY, 0, 0, 0);
    if hfm > 0 then
    begin
      pv := MapViewOfFile(hfm, FILE_MAP_READ, 0, 0, 0);
      if Assigned(pv) then
      begin
        if CheckSumMappedFile(pv, GetFileSize(h, nil), @dwHeaderSum, @AResult) <> nil then
          Result := True;
        UnmapViewOfFile(pv);
      end;
      CloseHandle(hfm);
    end;
    CloseHandle(h);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  crc: Cardinal;
begin
  ComputeChecksum('c:\calc.exe', crc);
  ShowMessageFmt('%x', [crc]);
end;

// Способ третий
function GetCheckSum(FileName: string): DWORD;  
var
  F: file of DWORD;  
  P: Pointer;  
  Fsize: DWORD;  
  Buffer: array[0..500] of DWORD;
begin
  FileMode := 0;
  AssignFile(F, FileName);
  Reset(F);
  Seek(F, FileSize(F) div 2);
  Fsize := FileSize(F) - 1 - FilePos(F);
  if Fsize > 500 then Fsize := 500;
  BlockRead(F, Buffer, Fsize);
  Close(F);
  P := @Buffer;
  asm
    xor eax, eax
    xor ecx, ecx
    mov edi , p
    @again:
    add eax, [edi + 4*ecx]
    inc ecx
    cmp ecx, fsize
    jl @again
    mov @result, eax
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(GetCheckSum('c:\SetupDemoDB.exe')));
end;

function GetAttribut(Path: string): string;
var
  Atr: Integer;
begin
  Result := '----';
  Atr := FileGetAttr(Path);
  if (Atr and faReadOnly) = faReadOnly then
    Result[1] := 'r';
  if (Atr and faHidden) = faHidden then
    Result[2] := 'h';
  if (Atr and faSysFile) = faSysFile then
    Result[3] := 's';
  if (Atr and faArchive) = faArchive then
    Result[4] := 'a';
end;