home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / Calmira / Src / UTILS / VERINFO.PAS < prev   
Pascal/Delphi Source File  |  1997-02-15  |  6KB  |  191 lines
  1. {*********************************************************}
  2. {                                                         }
  3. {    Calmira System Library 1.0                           }
  4. {    by Li-Hsin Huang,                                    }
  5. {    released into the public domain January 1997         }
  6. {                                                         }
  7. {*********************************************************}
  8.  
  9. unit VerInfo;
  10.  
  11. { TVersion extracts version information using the functions in VER.DLL.
  12.   Under Windows 3.1, this only finds resources compiled by Microsoft's
  13.   resource compiler.
  14.  
  15.   After calling Create, the HasData property tells you whether any
  16.   information was found.  If it is True, you can access the fields
  17.   using the other properties or the GetVersionInfo function, which
  18.   ever is more convenient.
  19. }
  20.  
  21. interface
  22.  
  23. uses SysUtils, WinTypes, Ver;
  24.  
  25. type
  26.   TVersionInfo = (viCompanyName, viComments, viFileDescription, viFileVersion,
  27.                   viInternalName, viLegalCopyright, viLegalTrademarks,
  28.                   viOriginalFilename, viPrivateBuild, viProductName,
  29.                   viProductVersion, viSpecialBuild);
  30.  
  31. TVersion = class
  32. private
  33.   Handle: Longint;
  34.   BufferSize: Integer;
  35.   Buffer: PChar;
  36.   TransTable: PLongint;
  37.   FixedInfo: ^TVS_FIXEDFILEINFO;
  38.   FHasData: Boolean;
  39.   function GetString(i: Integer): string;
  40.   function GetFileOS: string;
  41.   function GetFileType: string;
  42.   function GetFileSubType: string;
  43. public
  44.   constructor Create(const filename: TFilename);
  45.   destructor Destroy; override;
  46.   function GetVersionInfo(VerKind: TVersionInfo): String;
  47.   property HasData: Boolean read FHasData;
  48.   property CompanyName: string index 0 read GetString;
  49.   property Comments: string index 1 read GetString;
  50.   property FileDescription: string index 2 read GetString;
  51.   property FileVersion: string index 3 read GetString;
  52.   property InternalName: string index 4 read GetString;
  53.   property LegalCopyright: string index 5 read GetString;
  54.   property LegalTrademarks: string index 6 read GetString;
  55.   property OriginalFilename: string index 7 read GetString;
  56.   property PrivateBuild: string index 8 read GetString;
  57.   property ProductName: string index 9 read GetString;
  58.   property ProductVersion: string index 10 read GetString;
  59.   property SpecialBuild: string index 11 read GetString;
  60.   property FileOS: string read GetFileOS;
  61.   property FileType: string read GetFileType;
  62.   property FileSubType: string read GetFileSubType;
  63. end;
  64.  
  65. implementation
  66.  
  67. uses WinProcs;
  68.  
  69. const
  70.   VerNameArray: array[TVersionInfo] of PChar =
  71.   ('\CompanyName', '\Comments', '\FileDescription', '\FileVersion',
  72.    '\InternalName', '\LegalCopyright', '\LegalTrademarks',
  73.    '\OriginalFilename', '\PrivateBuild', '\ProductName',
  74.    '\ProductVersion', '\SpecialBuild');
  75.  
  76.  
  77. constructor TVersion.Create(const filename: TFilename);
  78. var
  79.   filestr : array[0..79] of Char;
  80.   len: word;
  81. begin
  82.   BufferSize := GetFileVersionInfoSize(StrPCopy(filestr, filename), Handle);
  83.   if BufferSize > 0 then begin
  84.     Buffer := AllocMem(BufferSize);
  85.  
  86.     if GetFileVersionInfo(filestr, Handle, BufferSize, Buffer) and
  87.        VerQueryValue(Buffer, '\VarFileInfo\Translation', Pointer(TransTable), len) then
  88.     begin
  89.        FHasData := True;
  90.        VerQueryValue(Buffer, '\', Pointer(FixedInfo), len);
  91.     end;
  92.   end;
  93. end;
  94.  
  95.  
  96. destructor TVersion.Destroy;
  97. begin
  98.   if BufferSize > 0 then FreeMem(Buffer, BufferSize);
  99. end;
  100.  
  101.  
  102. function TVersion.GetVersionInfo(VerKind: TVersionInfo): string;
  103. var
  104.   buf: PChar;
  105.   len: Word;
  106. begin
  107.   Result := '';
  108.   if not FHasData then Exit;
  109.  
  110.   Result := Format('\StringFileInfo\%.4x%.4x%s'#0,
  111.     [LoWord(TransTable^), HiWord(TransTable^), VerNameArray[VerKind]]);
  112.  
  113.   len := 127;
  114.   if VerQueryValue(Buffer, @Result[1], Pointer(buf), len) then
  115.     Result := StrPas(buf)
  116.   else
  117.     Result := '';
  118. end;
  119.  
  120.  
  121. function TVersion.GetString(i: Integer): string;
  122. begin
  123.   if FHasData then Result := GetVersionInfo(TVersionInfo(i))
  124.   else Result := '';
  125. end;
  126.  
  127.  
  128. function TVersion.GetFileOS: string;
  129. var
  130.   OS: Longint;
  131. begin
  132.   Result := '';
  133.   if not FHasData then Exit;
  134.   OS := FixedInfo^.dwFileOS;
  135.   if OS = VOS_UNKNOWN then Result := 'Unknown'
  136.   else if OS = VOS_DOS then Result := 'MS-DOS'
  137.   else if OS = VOS_NT then Result := 'Windows NT'
  138.   else if OS = VOS__WINDOWS16 then Result := 'Windows 3.0 or later'
  139.   else if OS = VOS__WINDOWS32 then Result := '32-bit Windows'
  140.   else if OS = VOS_DOS_WINDOWS16 then Result := 'Windows 3.0 or later with MS-DOS'
  141.   else if OS = VOS_DOS_WINDOWS32 then Result := '32-bit Windows with MS-DOS'
  142.   else if OS = VOS_NT_WINDOWS32 then Result := '32-bit Windows NT'
  143.   else Result := '';
  144. end;
  145.  
  146.  
  147. function TVersion.GetFileType: string;
  148. begin
  149.   Result := '';
  150.   if FHasData then
  151.     case FixedInfo^.dwFileType of
  152.       VFT_UNKNOWN    : Result := 'Unknown';
  153.       VFT_APP        : Result := 'Application';
  154.       VFT_DLL        : Result := 'Dynamic-link library';
  155.       VFT_DRV        : Result := 'Device driver';
  156.       VFT_FONT       : Result := 'Font';
  157.       VFT_VXD        : Result := 'Virtual device';
  158.       VFT_STATIC_LIB : Result := 'Static-link library';
  159.     end;
  160. end;
  161.  
  162. function TVersion.GetFileSubType: string;
  163. begin
  164.   Result := '';
  165.   if not FHasData then Exit;
  166.  
  167.   if FixedInfo^.dwFileType = VFT_DRV then
  168.     case FixedInfo^.dwFileSubType of
  169.       VFT2_UNKNOWN         : Result := 'Unknown';
  170.       VFT2_DRV_COMM        : Result := 'Communications';
  171.       VFT2_DRV_PRINTER     : Result := 'Printer';
  172.       VFT2_DRV_KEYBOARD    : Result := 'Keyboard';
  173.       VFT2_DRV_LANGUAGE    : Result := 'Language';
  174.       VFT2_DRV_DISPLAY     : Result := 'Display';
  175.       VFT2_DRV_MOUSE       : Result := 'Mouse';
  176.       VFT2_DRV_NETWORK     : Result := 'Network';
  177.       VFT2_DRV_SYSTEM      : Result := 'System';
  178.       VFT2_DRV_INSTALLABLE : Result := 'Installable';
  179.       VFT2_DRV_SOUND       : Result := 'Sound';
  180.     end
  181.  
  182.   else if FixedInfo^.dwFileType = VFT_FONT then
  183.     case FixedInfo^.dwFileSubType of
  184.       VFT2_FONT_RASTER   : Result := 'Raster';
  185.       VFT2_FONT_VECTOR   : Result := 'Vector';
  186.       VFT2_FONT_TRUETYPE : Result := 'TrueType';
  187.     end;
  188. end;
  189.  
  190. end.
  191.