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

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;
  InfoSize: DWORD;
  FileInfo: PVSFixedFileInfo;
  FileInfoSize: DWORD;
  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;
  nSize: DWORD;
  nHandle: DWORD;
  pVerInfo: PVSFIXEDFILEINFO;
  nVerInfoSize: 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;