Author: Jonas Bilinkevicius
How do you retrieve the version stamp of a file? I'm getting real tired of setting
versions in the Delphi Project | Options dialog box and then defining a (redundant)
constant for use in my Help | About boxes !
Answer:
Solve 1:
1 procedure TfrmSplash.GetBuildInfo(var v1, v2, v3, v4: Word);
2 var
3 VerInfoSize: DWord;
4 VerInfo: Pointer;
5 VerValueSize: DWord;
6 VerValue: PVSFixedFileInfo;
7 Dummy: DWord;
8 begin
9 VerInfoSize := GetFileVersionInfoSize(PChar(Application.ExeName), dummy);
10 GetMem(VerInfo, VerInfoSize);
11 GetFileVersionInfo(PChar(Application.ExeName), 0, VerInfoSize, VerInfo);
12 VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
13 with VerValue^ do
14 begin
15 v1 := dwFileVersionMS shr 16;
16 v2 := dwFileVersionMS and $FFFF;
17 v3 := dwFileVersionLS shr 16;
18 v4 := dwFileVersionLS and $FFFF;
19 end;
20 FreeMem(VerInfo, VerInfoSize);
21 end;
22
23 function TfrmSplash.GetBuildInfoString: string;
24 var
25 v1, v2, v3, v4: Word;
26 begin
27 GetBuildInfo(v1, v2, v3, v4);
28 Result := Format('%d.%d.%d (Build %d)', [v1, v2, v3, v4]);
29 end;
Solve 2:
This function should do it.
30 uses
31 Windows, SysUtils, { ... };
32
33 function GetFileVersion(const Filename: string): string;
34 var
35 VerInfSize, Sz: Cardinal;
36 VerInfo: Pointer;
37 FxFileInfo: PVSFixedFileInfo;
38
39 function MSLSToString(MS, LS: DWORD): string;
40 begin
41 Result := Format('%d.%d.%d.%d', [MS shr 16, MS and $FFFF, LS shr 16, LS and
42 $FFFF]);
43 end;
44
45 begin
46 Result := '';
47 if FileExists(Filename) then
48 begin
49 VerInfSize := GetFileVersionInfoSize(PCHAR(Filename), Sz);
50 if VerInfSize > 0 then
51 begin
52 VerInfo := Allocmem(VerInfSize);
53 try
54 GetFileVersionInfo(PCHAR(Filename), 0, VerInfSize, VerInfo);
55 VerQueryValue(VerInfo, '\\', POINTER(FxFileInfo), Sz);
56 if Sz > 0 then
57 Result := MSLSToString(FxFileInfo^.dwFileVersionMS,
58 FxFileInfo^.dwFileVersionLS);
59 finally
60 FreeMem(VerInfo);
61 end;
62 end;
63 end;
64 end;
Solve 3:
65 type
66 TFileVersionInfo = record
67 fCompanyName,
68 fFileDescription,
69 fFileVersion,
70 fInternalName,
71 fLegalCopyRight,
72 fLegalTradeMark,
73 fOriginalFileName,
74 fProductName,
75 fProductVersion,
76 fComments: string;
77 end;
78
79 var
80 FileVersionInfo: TFileVersionInfo
81
82 procedure GetAllFileVersionInfo(FileName: string);
83 { proc to get all version info from a file. }
84 var
85 Buf: PChar;
86 fInfoSize: DWord;
87
88 procedure InitVersion;
89 var
90 FileNamePtr: PChar;
91 begin
92 with FileVersionInfo do
93 begin
94 FileNamePtr := PChar(FileName);
95 fInfoSize := GetFileVersionInfoSize(FileNamePtr, fInfoSize);
96 if fInfoSize > 0 then
97 begin
98 ReAllocMem(Buf, fInfoSize);
99 GetFileVersionInfo(FileNamePtr, 0, fInfoSize, Buf);
100 end;
101 end;
102 end;
103
104 function GetVersion(What: string): string;
105 var
106 tmpVersion: string;
107 Len: Dword;
108 Value: PChar;
109 begin
110 Result := 'Not defined';
111 if fInfoSize > 0 then
112 begin
113 SetLength(tmpVersion, 200);
114 Value := @tmpVersion;
115 { If you are not using an English OS, then replace the language and
116 codepage identifier with the correct one. English (U.S.) is 0409 (language)
117 and 04E4 (codepage). See CodePage Identifiers and Language Identifiers in
118 the Win32 help file for info. }
119 if VerQueryValue(Buf, PChar('StringFileInfo\040904E4\' + What),
120 Pointer(Value),
121 Len) then
122 Result := Value;
123 end;
124 end;
125
126 begin
127 Buf := nil;
128 with FileVersionInfo do
129 begin
130 InitVersion;
131 fCompanyName := GetVersion('CompanyName');
132 fFileDescription := GetVersion('FileDescription');
133 fFileVersion := GetVersion('FileVersion');
134 fInternalName := GetVersion('InternalName');
135 fLegalCopyRight := GetVersion('LegalCopyRight');
136 fLegalTradeMark := GetVersion('LegalTradeMark');
137 fOriginalFileName := GetVersion('OriginalFileName');
138 fProductName := GetVersion('ProductName');
139 fProductVersion := GetVersion('ProductVersion');
140 fComments := GetVersion('Comments');
141 end;
142 if Buf <> nil then
143 FreeMem(Buf);
144 end;
145
146 //To use it just call it like
147
148 GetAllFileVersionInfo(ParamStr(0));
Solve 4:
Call GetVersionDetails and specify the filename.
149 { ... }
150
151 type
152 pTransArrar = ^TTransArrar;
153 TTransArrar = record
154 wLanugageID: Word;
155 wCharacterSet: Word;
156 end;
157
158 function DecodeTranslationInfo(Buffer: TTransArrar): string;
159 begin
160 Result := IntToHex(Buffer.wLanugageID, 4) + IntToHex(Buffer.wCharacterSet, 4);
161 end;
162
163 function GetVersionDetails(Filename: string; const LookupString: string =
164 'FileVersion'): string;
165 var
166 ID: DWord;
167 iStructSize: DWord;
168 p: PChar;
169 pbuf: Pointer;
170 plen: DWord;
171 ResponseString: string;
172 begin
173 {get the size of the fileinfo structure}
174 iStructSize := GetFileVersionInfoSize(PChar(Filename), ID);
175 {allocate memory to hold file info data structure}
176 p := stralloc(iStructSize);
177 {retrieve file version details}
178 ResponseString := '';
179 if GetFileVersionInfo(PChar(Filename), 0, istructSize, p) then
180 begin
181 if VerQueryValue(p, pchar('\VarFileInfo\Translation'), pbuf, plen) then
182 begin
183 if VerQueryValue(p, pchar('\StringFileInfo\' +
184 DecodeTranslationInfo(pTransArrar(pbuf)^)
185 + '\' + LookupString), pbuf, plen) then
186 ResponseString := PChar(pbuf);
187 end;
188 end;
189 strdispose(p);
190 Result := ResponseString;
191 end;
Solve 5:
This functions returns the version as a string.
192
193 function GetFileVersion(FileName: string): string;
194 var
195 ResourceSize: Integer;
196 ResourceBuffer: PChar;
197 GetData: Boolean;
198 Ignore: THandle;
199 InfoPtr: Pointer;
200 VerSize: Cardinal;
201 FileInfo: VS_FIXEDFILEINFO;
202 Major, Minor, Rleas, Build, Hex: string;
203 begin
204 ResourceSize := GetFileVersionInfoSize(PChar(FileName), Ignore);
205 if ResourceSize > 0 then
206 begin
207 {You need to allocate the ResourceBuffer before you can fillchar it}
208 GetMem(ResourceBuffer, ResourceSize);
209 GetData := GetFileVersionInfo(PChar(FileName), Ignore, ResourceSize,
210 ResourceBuffer);
211 if GetData then
212 begin
213 GetData := VerQueryValue(ResourceBuffer, '\', InfoPtr, VerSize);
214 if GetData then
215 begin
216 Move(InfoPtr^, FileInfo, sizeof(VS_FIXEDFILEINFO));
217 Hex := IntToHex(FileInfo.dwFileVersionMS, 8) +
218 IntToHex(FileInfo.dwFileVersionLS, 8);
219 Major := '$' + Copy(Hex, 1, 4);
220 Minor := '$' + Copy(Hex, 5, 4);
221 Rleas := '$' + Copy(Hex, 9, 4);
222 Build := '$' + Copy(Hex, 13, 4);
223 Result := IntToStr(StrToInt(Major)) + '.' + IntToStr(StrToInt(Minor)) + '.'
224 + IntToStr(StrToInt(Rleas)) + '.' + IntToStr(StrToInt(Build));
225 end
226 else
227 begin
228 Result := '';
229 end;
230 end
231 else
232 begin
233 Result := '';
234 end;
235 {need this because you allocated it up above}
236 FreeMem(ResourceBuffer);
237 end
238 else
239 begin
240 Result := '';
241 end;
242 end;
|
