?? getver.pas
字號(hào):
unit getver;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
{ Record to receive charset }
type TTranslation = record
langID : WORD;
charset : WORD;
end;
type
TGetVersionInfoFromFile = class
private
FFileName : String;
FmyVersionStrings : TStringList;
FmyVersionCategories : TStringList;
procedure SetFileName (inp : string);
procedure dontWrite(inp : TStringList);
procedure readVersionFromFile;
protected
{ Protected-Deklarationen}
public
procedure Init();
function getVersionSetting(inp : string): String;
published
property fileName : string read FFileName write SetFileName;
property VersionStrings : TStringList read FmyVersionStrings write dontWrite;
property VersionCategories : TStringList read FmyVersionCategories write dontWrite;
end;
var
fileVer: TGetVersionInfoFromFile;
implementation
{ initialize everything }
Procedure TGetVersionInfoFromFile.Init();
begin
FmyVersionStrings := TStringList.Create;
FmyVersionCategories := TStringList.Create;
FFileName := '';
end;
{ Get filename, check if file exists and read info from file }
procedure TGetVersionInfoFromFile.SetFileName (inp : string);
begin
FmyVersionStrings.clear;
FmyVersionCategories.clear;
if fileexists(inp) then
begin
FFileName := inp;
readVersionFromFile;
end
else
begin
FFileName := '';
end;
end;
{ don磘 do anything }
procedure TGetVersionInfoFromFile.dontWrite(inp : TStringList);
begin
end;
{ read info from file }
procedure TGetVersionInfoFromFile.readVersionFromFile;
var struSize : Dword;
dwBytes,someDummy : Dword;
a,txt : array[0..256] of char;
p : pchar;
i : integer;
pp : pointer;
theFixedInfo : TVSFixedFileInfo;
theTrans : TTranslation;
s : string;
ts : TStringList;
begin
ts := TStringList.Create;
ts.add('CompanyName');
ts.add('FileDescription');
ts.add('FileVersion');
ts.add('InternalName');
ts.add('LegalCopyright');
ts.add('OriginalFilename');
ts.add('ProductName');
ts.add('ProductVersion');
strPCopy(a,FFileName);
{ get size of data }
struSize := GetFileVersionInfoSize(a,someDummy);
if struSize=0 then exit;
p := NIL;
try
{ get memory }
GetMem(p,struSize+10);
{ get data }
GetFileVersionInfo(a,0,struSize,p);
{ get root info }
if not VerQueryValue(p,'\',pp,dwBytes) then exit;
move(pp^,theFixedInfo,dwBytes);
{ get translation info }
if not VerQueryValue(p,'\VarFileInfo\Translation',pp,dwBytes) then exit;
move(pp^,theTrans,dwBytes);
{ iterate over defined items }
for i:=0 to ts.count-1 do
begin
s := '\StringFileInfo\'+inttohex(theTrans.langID,4)+inttohex(theTrans.charset,4)+'\'+ts[i];
StrPCopy(a,s);
if not VerQueryValue(p,a,pp,dwBytes) then exit;
if dwBytes>0 then
begin
move(pp^,txt,dwBytes);
FmyVersionCategories.add(ts[i]);
FmyVersionStrings.add(StrPas(txt));
end;
end;
finally
{ release memory }
FreeMem(p);
end;
end;
{ get single version string }
function TGetVersionInfoFromFile.getVersionSetting(inp : string): String;
var i : integer;
begin
result := '';
for i:= 0 to FmyVersionCategories.Count -1 do
begin
if lowercase(FmyVersionCategories[i])=lowercase(inp) then
begin
result := FmyVersionStrings[i];
break;
end;
end;
end;
end.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -