xversion.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

unit xVersion;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  TypInfo,Registry;

type
{$M+}
//$M+: 公布枚举类型的RTTI信息，以使枚举类型作为字符串用于GetEnumName。
  TVersionType=(vtCompanyName,
                vtFileDescription,
                vtFileVersion,
                vtInternalName,
                vtLegalCopyright,
                vtLegalTradeMark,
                vtOriginalFileName,
                vtProductName,
                vtProductVersion,
                vtComments);
{$M-}
var
    aVerInfo : array[TVersionType] of string;
    RegisteredUser,RegisteredCompany,RegisteredVersion :String;

procedure GetRegisterInfo;
procedure GetVersionInfo;

implementation

//------------------------------------------------------------------//
//取得注册用户及公司名，使用读取注册表的方法。
procedure GetRegisterInfo;
var
    oReg: TRegistry;
    bOpen:Boolean;
begin
    RegisteredUser:='(未知)';
    RegisteredCompany:='(未知)';
    bOpen:=False;

    oReg := TRegistry.Create;
    try
        oReg.RootKey := HKEY_LOCAL_MACHINE;
        case Win32Platform of
        VER_PLATFORM_WIN32_WINDOWS:
                bOpen:=oReg.OpenKey('\Software\Microsoft\Windows\CurrentVersion', False);
        VER_PLATFORM_WIN32_NT:
                bOpen:=oReg.OpenKey('\Software\Microsoft\Windows NT\CurrentVersion', False);
        end;
        if bOpen then
        begin
               RegisteredUser:=oReg.ReadString('RegisteredOwner');
               RegisteredCompany:=oReg.ReadString('RegisteredOrganization');
        end;
    finally
        oReg.CloseKey;
        oReg.Free;
    end;
end;

//------------------------------------------------------------------//
//如果未定义版本信息，所有参数为“(无)”。若未定义版本号，缺省为1.0。
//如果定义了版本信息，则RegisteredVersion与aVerInfo[vtFileVersion]相同。
procedure GetVersionInfo;
var
    n,nSize, nLen: DWORD;
    s,sType      : string;
    pBuf,pValue  : PChar;
begin
    aVerInfo[vtCompanyName]      := '公司名称:';
    aVerInfo[vtFileDescription]  := '文件说明:';
    aVerInfo[vtFileVersion]      := '文件版本:';
    aVerInfo[vtInternalName]     := '内部名称:';
    aVerInfo[vtLegalCopyright]   := '合法版权:';
    aVerInfo[vtLegalTradeMark]   := '合法商标:';
    aVerInfo[vtOriginalFileName] := '原文件名:';
    aVerInfo[vtProductName]      := '产品名称:';
    aVerInfo[vtProductVersion]   := '产品版本:';
    aVerInfo[vtComments]         := '注释:';

    RegisteredVersion:='1.0';    //对于任何未定义版本号的程序，缺省版本为1.0。

    nSize:= GetFileVersionInfoSize(PChar(Application.ExeName),nSize);
    if nSize = 0 then
    begin
        for n := 0 to Ord(High(TVersionType)) do
            aVerInfo[TVersionType(n)]:= aVerInfo[TVersionType(n)] + '(无)';
    end
    else
    begin
        pBuf := AllocMem(nSize);
        GetFileVersionInfo(PChar(Application.ExeName),0,nSize,pBuf);
        for n := 0 to Ord(High(TVersionType)) do
        begin
          sType := GetEnumName(TypeInfo(TVersionType),n);
          sType := Copy(sType,3,length(sType));
          if VerQueryValue(pBuf,PChar('StringFileInfo\080403A8\'+sType), Pointer(pValue),nLen) then
             //aVerInfo[TVersionType(n)] := pValue;
             s:=pValue
          else
             s:='';
          s:=Trim(s);
          if TVersionType(n) = vtFileVersion then RegisteredVersion:=s;
          if Length(s) = 0 then s:='(无)';
          aVerInfo[TVersionType(n)]:= aVerInfo[TVersionType(n)] + s;
        end;
        FreeMem(pBuf,nSize);
    end;
end;

initialization
GetRegisterInfo;
GetVersionInfo;

end.