Delphi自动获取软件版本信息的类

1. unit untVersion;
2. {-------------------------------------------------------------------------------
3. *Description：自动获取应用程序的版本信息
4. *Create by:   Derry Zhang
5. *Create on:   2008-11-26
6. -------------------------------------------------------------------------------}
8. interface
10. uses
11.   Windows, Forms, SysUtils;
13. type
14.   TVersion = class(TObject)
15.   private
16.     FCompanyName: string;
17.     FFileDescription: string;
18.     FFileVersion: string;
19.     FInternalName: string;
20.     FLegalCopyright: string;
21.     FLegalTradeMarks: string;
22.     FOriginalFileName: string;
23.     FProductName: string;
24.     FProductVersion: string;
25.     procedure GetCodeVersion;
26.   public
27.     constructor Create;
28.     property CompanyName: string read FCompanyName;
29.     property FileDescription: string read FFileDescription;
30.     property FileVersion: string read FFileVersion;
31.     property InternalName: string read FInternalName;
32.     property LegalCopyright: string read FLegalCopyright;
33.     property LegalTradeMarks: string read FLegalTradeMarks;
34.     property OriginalFileName: string read FOriginalFileName;
35.     property ProductName: string read FProductName;
36.     property ProductVersion: string read FProductVersion;
37.   end;
39. implementation
41. constructor TVersion.Create;
42. begin
43.   GetCodeVersion;
44.   inherited;
45. end;
47. procedure TVersion.GetCodeVersion;
48. const
49.   InfoNum = 9;
50.   InfoStr: array[1..InfoNum] of string = (
51.     'ProductName',
52.     'ProductVersion',
53.     'FileDescription',
54.     'LegalCopyright',
55.     'FileVersion',
56.     'CompanyName',
57.     'LegalTradeMarks',
58.     'InternalName',
59.     'OriginalFileName'
60.   );
61. var
62.   S: string;
63.   BufSize, Len: DWORD;
64.   Buf: PChar;
65.   Value: PChar;
66. begin
67.   S := Application.ExeName;
68.   BufSize := GetFileVersionInfoSize(PChar(S), BufSize);
69.   if BufSize > 0 then begin
70.     Buf := AllocMem(BufSize);
71.     GetFileVersionInfo(PChar(S), 0, BufSize, Buf);
72.     //产品名称
73.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[1]), Pointer(Value), Len) then
74.     FProductName := Value;
76.     //产品版本
77.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[2]), Pointer(Value), Len) then
78.     FProductVersion := Value;
80.     //文件描述
81.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[3]), Pointer(Value), Len) then
82.     FFileDescription := Value;
84.     //合法商标
85.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[4]), Pointer(Value), Len) then
86.     FLegalCopyright := Value;
88.     //文件版本-“关于”对话框中版本栏应该使用
89.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[5]), Pointer(Value), Len) then
90.     FFileVersion := Value;
92.     //公司名称
93.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[6]), Pointer(Value), Len) then
94.     FCompanyName := Value;
96.     //合法商标
97.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[7]), Pointer(Value), Len) then
98.     FLegalTrademarks := Value;
100.     //内部名称
101.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[8]), Pointer(Value), Len) then
102.     FInternalName := Value;
104.     //原文件名
105.     if VerQueryValue(Buf, PChar('StringFileInfo/080403A8/' + InfoStr[9]), Pointer(Value), Len) then
106.     FOriginalFilename := Value;
108.     FreeMem(Buf, BufSize);
110.     //OperatingSystem.Caption := GetOSVerInfo;
112.     //SystemMemory.Caption := GetMemStat;
113.   end
114.   else
115.   begin
116.     Application.MessageBox('获取产品信息时遇到致命错误，请尝试重新启动软件。'+ #13 + '若仍未能解决问题，请联系产品服务人员。','错误',MB_OK + MB_ICONSTOP);
117.   end;
118. end;