was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

43 Visitors Online


 
...Versionsinformationen aus einer Datei auslesen?
Autor: Thomas Stutz
[ Tip ausdrucken ]  


Tip Bewertung (49):  
     




uses
  
ShellApi;

type
  
TFileVersionInfo = record
    
FileType,
    CompanyName,
    FileDescription,
    FileVersion,
    InternalName,
    LegalCopyRight,
    LegalTradeMarks,
    OriginalFileName,
    ProductName,
    ProductVersion,
    Comments,
    SpecialBuildStr,
    PrivateBuildStr,
    FileFunction: string;
    DebugBuild,
    PreRelease,
    SpecialBuild,
    PrivateBuild,
    Patched,
    InfoInferred: Boolean;
  end;

function FileVersionInfo(const sAppNamePath: TFileName): TFileVersionInfo;
var
  
rSHFI: TSHFileInfo;
  iRet: Integer;
  VerSize: Integer;
  VerBuf: PChar;
  VerBufValue: Pointer;
  VerHandle: Cardinal;
  VerBufLen: Cardinal;
  VerKey: string;
  FixedFileInfo: PVSFixedFileInfo;

  // dwFileType, dwFileSubtype
  
function GetFileSubType(FixedFileInfo: PVSFixedFileInfo): string;
  begin
    case 
FixedFileInfo.dwFileType of

      
VFT_UNKNOWN: Result    := 'Unknown';
      VFT_APP: Result        := 'Application';
      VFT_DLL: Result        := 'DLL';
      VFT_STATIC_LIB: Result := 'Static-link Library';

      VFT_DRV:
        case
          
FixedFileInfo.dwFileSubtype of
          
VFT2_UNKNOWN: Result         := 'Unknown Driver';
          VFT2_DRV_COMM: Result        := 'Communications Driver';
          VFT2_DRV_PRINTER: Result     := 'Printer Driver';
          VFT2_DRV_KEYBOARD: Result    := 'Keyboard Driver';
          VFT2_DRV_LANGUAGE: Result    := 'Language Driver';
          VFT2_DRV_DISPLAY: Result     := 'Display Driver';
          VFT2_DRV_MOUSE: Result       := 'Mouse Driver';
          VFT2_DRV_NETWORK: Result     := 'Network Driver';
          VFT2_DRV_SYSTEM: Result      := 'System Driver';
          VFT2_DRV_INSTALLABLE: Result := 'InstallableDriver';
          VFT2_DRV_SOUND: Result       := 'Sound Driver';
        end;
      VFT_FONT:
        case FixedFileInfo.dwFileSubtype of
          
VFT2_UNKNOWN: Result       := 'Unknown Font';
          VFT2_FONT_RASTER: Result   := 'Raster Font';
          VFT2_FONT_VECTOR: Result   := 'Vector Font';
          VFT2_FONT_TRUETYPE: Result := 'Truetype Font';
          else;
        end;
      VFT_VXD: Result := 'Virtual Defice Identifier = ' +
          IntToHex(FixedFileInfo.dwFileSubtype, 8);
    end;
  end;


  function HasdwFileFlags(FixedFileInfo: PVSFixedFileInfo; Flag: Word): Boolean;
  begin
    
Result := (FixedFileInfo.dwFileFlagsMask and
      
FixedFileInfo.dwFileFlags and
      
Flag) = Flag;
  end;

  function GetFixedFileInfo: PVSFixedFileInfo;
  begin
    if not 
VerQueryValue(VerBuf, '', Pointer(Result), VerBufLen) then
      
Result := nil
  end
;

  function GetInfo(const aKey: string): string;
  begin
    
Result := '';
    VerKey := Format('\StringFileInfo\%.4x%.4x\%s',
      [LoWord(Integer(VerBufValue^)),
      HiWord(Integer(VerBufValue^)), aKey]);
    if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then
      
Result := StrPas(VerBufValue);
  end;

  function QueryValue(const aValue: string): string;
  begin
    
Result := '';
    // obtain version information about the specified file
    
if GetFileVersionInfo(PChar(sAppNamePath), VerHandle, VerSize, VerBuf) and
      
// return selected version information
      
VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then
      
Result := GetInfo(aValue);
  end;
begin
  
// Initialize the Result
  
with Result do
  begin
    
FileType         := '';
    CompanyName      := '';
    FileDescription  := '';
    FileVersion      := '';
    InternalName     := '';
    LegalCopyRight   := '';
    LegalTradeMarks  := '';
    OriginalFileName := '';
    ProductName      := '';
    ProductVersion   := '';
    Comments         := '';
    SpecialBuildStr  := '';
    PrivateBuildStr  := '';
    FileFunction     := '';
    DebugBuild       := False;
    Patched          := False;
    PreRelease       := False;
    SpecialBuild     := False;
    PrivateBuild     := False;
    InfoInferred     := False;
  end;

  // Get the file type
  
if SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI),
    SHGFI_TYPENAME) <> 0 then
  begin
    
Result.FileType := rSHFI.szTypeName;
  end;

  iRet := SHGetFileInfo(PChar(sAppNamePath), 0, rSHFI, SizeOf(rSHFI), SHGFI_EXETYPE);
  if iRet <> 0 then
  begin
    
// determine whether the OS can obtain version information
    
VerSize := GetFileVersionInfoSize(PChar(sAppNamePath), VerHandle);
    if VerSize > 0 then
    begin
      
VerBuf := AllocMem(VerSize);
      try
        with 
Result do
        begin
          
CompanyName      := QueryValue('CompanyName');
          FileDescription  := QueryValue('FileDescription');
          FileVersion      := QueryValue('FileVersion');
          InternalName     := QueryValue('InternalName');
          LegalCopyRight   := QueryValue('LegalCopyRight');
          LegalTradeMarks  := QueryValue('LegalTradeMarks');
          OriginalFileName := QueryValue('OriginalFileName');
          ProductName      := QueryValue('ProductName');
          ProductVersion   := QueryValue('ProductVersion');
          Comments         := QueryValue('Comments');
          SpecialBuildStr  := QueryValue('SpecialBuild');
          PrivateBuildStr  := QueryValue('PrivateBuild');
          // Fill the VS_FIXEDFILEINFO structure
          
FixedFileInfo := GetFixedFileInfo;
          DebugBuild    := HasdwFileFlags(FixedFileInfo, VS_FF_DEBUG);
          PreRelease    := HasdwFileFlags(FixedFileInfo, VS_FF_PRERELEASE);
          PrivateBuild  := HasdwFileFlags(FixedFileInfo, VS_FF_PRIVATEBUILD);
          SpecialBuild  := HasdwFileFlags(FixedFileInfo, VS_FF_SPECIALBUILD);
          Patched       := HasdwFileFlags(FixedFileInfo, VS_FF_PATCHED);
          InfoInferred  := HasdwFileFlags(FixedFileInfo, VS_FF_INFOINFERRED);
          FileFunction  := GetFileSubType(FixedFileInfo);
        end;
      finally
        
FreeMem(VerBuf, VerSize);
      end
    end
;
  end
end
;

// Test it:

procedure TForm1.Button1Click(Sender: TObject);
var
  
FvI: TFileVersionInfo;
const
  
Tabulator: array[0..0] of Integer = (70);
  BoolValues: array[Boolean] of string = ('No', 'Yes');
begin
  
FvI := FileVersionInfo('C:\FileName.exe');
  ListBox1.TabWidth := 1;
  SendMessage(ListBox1.Handle, LB_SETTABSTOPS, 1, Longint(@Tabulator));
  with FvI, ListBox1.Items do
  begin
    
Add('FileType:'#9 + FileType);
    Add('CompanyName:'#9 + CompanyName);
    Add('FileDescription:'#9 + FileDescription); // siehe Eigenschaftsdialog des Explorers
    
Add('FileVersion:'#9 + FileVersion);
    Add('InternalName:'#9 + InternalName);
    Add('LegalCopyRight:'#9 + LegalCopyRight);
    Add('LegalTradeMarks:'#9 + LegalTradeMarks);
    Add('OriginalFileName:'#9 + OriginalFileName);
    Add('ProductName:'#9 + ProductName);
    Add('ProductVersion:'#9 + ProductVersion);
    Add('SpecialBuildStr:'#9 + SpecialBuildStr);
    Add('PrivateBuildStr:'#9 + PrivateBuildStr);
    Add('FileFunction:'#9 + FileFunction);
    Add('DebugBuild:'#9 + BoolValues[DebugBuild]);
    Add('PreRelease:'#9 + BoolValues[PreRelease]);
    Add('PrivateBuild:'#9 + BoolValues[PrivateBuild]);
    Add('SpecialBuild:'#9 + BoolValues[SpecialBuild]);
  end;
end;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners