vershow.dpr

这一系列是我平时收集的pascal深入核心编程

program VerShow;

{$R VerShow.res}

uses Windows, Messages, CommDlg;

type
  TValueList = record
    dwID: DWORD;
    szName: PChar;
  end;

const
 // 模板资源ID
  IDD_VERSHOW = 101;

 // 图标资源ID
  IDI_VERSHOW = 102;

 // 子控件ID..
  IDC_PATHNAME = 1000;
  IDC_FIXEDFILEINFODATA = 1002;
  IDC_TRANSLATIONS = 1003;
  IDC_STRINGS = 1004;
  IDC_SELECTFILE = 1005;  

 // 数组尺寸
  VerBufSize = 2048;

 // 文件类型 
  g_vlFileType: array[0..6] of TValueList = (
   (dwID: VFT_APP; szName: 'Application'),
   (dwID: VFT_DLL; szName: 'Dynamic-link library'),
   (dwID: VFT_DRV; szName: 'Device driver'),
   (dwID: VFT_FONT; szName: 'Font'),
   (dwID: VFT_VXD; szName: 'Virtual device'),
   (dwID: VFT_STATIC_LIB; szName: 'Static library'),
   (dwID: 0; szName: nil)                  );

 // 程序类型
  g_vlFileOSAppType: array[0..4] of TValueList = (
   (dwID: VOS__WINDOWS16; szName: 'Windows (16-bit)'),
   (dwID: VOS__PM16; szName: 'PM (16-bit)'),
   (dwID: VOS__PM32; szName: 'PM (32-bit)'),
   (dwID: VOS__WINDOWS32; szName: 'Windows (32-bit)'),
   (dwID: 0; szName: nil)                       );

 // 运行平台
  g_vlFileOSPlatform: array[0..4] of TValueList = (
   (dwID: VOS_DOS; szName: 'DOS'),
   (dwID: VOS_OS216; szName: 'OS/2 (16-bit)'),
   (dwID: VOS_OS232; szName: 'OS/2 (32-bit)'),
   (dwID: VOS_NT; szName: 'Windows NT'),
   (dwID: 0; szName: nil)               );

 // 驱动类型
  g_vlDriverSubType: array[0..11] of TValueList = (
   (dwID: VFT2_DRV_PRINTER; szName: 'Printer'),
   (dwID: VFT2_DRV_KEYBOARD; szName: 'Keyboard'),
   (dwID: VFT2_DRV_LANGUAGE; szName: 'Language'),
   (dwID: VFT2_DRV_DISPLAY; szName: 'Display'),
   (dwID: VFT2_DRV_MOUSE; szName: 'Mouse'),
   (dwID: VFT2_DRV_NETWORK; szName: 'Network'),
   (dwID: VFT2_DRV_SYSTEM; szName: 'System'),
   (dwID: VFT2_DRV_INSTALLABLE; szName: 'Installable'),
   (dwID: VFT2_DRV_SOUND; szName: 'Sound'),
   (dwID: VFT2_DRV_COMM; szName: 'Comm'),
   (dwID: 11; szName: 'Input method'), // VFT2_DRV_INPUTMETHOD
   (dwID: 0; szName: nil )                        );

 // 字体类型
  g_vlFontSubType: array[0..3] of TValueList = (
   (dwID: VFT2_FONT_RASTER; szName: 'Raster'),
   (dwID: VFT2_FONT_VECTOR; szName: 'Vector'),
   (dwID: VFT2_FONT_TRUETYPE; szName: 'TrueType'),
   (dwID: 0; szName: nil)                      );

 // 返回数组中指定dwID的szName
function VerShow_FindValueString(Values: array of TValueList; dwValue: DWORD): PChar;
var
  nValueIndex: Integer;
begin
  nValueIndex := 0;
  while (Values[nValueIndex].szName <> nil) do
  begin
    if (Values[nValueIndex].dwID = dwValue) then // 找到
    begin
      Result := Values[nValueIndex].szName;
      Exit;
    end;
    Inc(nValueIndex);
  end;
  Result := 'Unknown'; // 没有找到
end;

 // 解析定长信息,填入szBuf
procedure VerShow_ConstructFixedStr(szBuf: PChar; pVerInfo: Pointer);
var
  pvsffi: PVSFixedFileInfo;
  uLen: UINT;
  szFlags: array[0..1024] of Char;
  szVxdID: array[0..20] of Char;
  szSubType: PChar;
  dwTemp: DWORD;
  ArgList: array[0..18] of DWORD;
begin
  if (pVerInfo = nil) then
  begin
    lstrcpy(szBuf, 'No version information exists');
    Exit;
  end;

 // TVSFixedFileInfo地址
  VerQueryValue(pVerInfo, '\', Pointer(pvsffi), uLen);

 // 解析dwFileFlags
  szFlags[0] := #0;
  dwTemp := pvsffi.dwFileFlags;
  if (dwTemp and VS_FF_DEBUG) <> 0 then lstrcat(szFlags, 'Debug ');
  if (dwTemp and VS_FF_PRERELEASE) <> 0 then lstrcat(szFlags, 'Prerelease ');
  if (dwTemp and VS_FF_PATCHED) <> 0 then lstrcat(szFlags, 'Patched ');
  if (dwTemp and VS_FF_PRIVATEBUILD) <> 0 then lstrcat(szFlags, 'PrivateBuild ');
  if (dwTemp and VS_FF_INFOINFERRED) <> 0 then lstrcat(szFlags, 'InfoInferred ');
  if (dwTemp and VS_FF_SPECIALBUILD) <> 0 then lstrcat(szFlags, 'SpecialBuild ');

 // (进一步的)文件类型
  case (pvsffi.dwFileType) of
    VFT_DRV:
      begin
        szSubType := VerShow_FindValueString(g_vlDriverSubType, pvsffi.dwFileSubtype);
      end;

    VFT_FONT:
      begin
        szSubType := VerShow_FindValueString(g_vlFontSubType, pvsffi.dwFileSubtype);
      end;

    VFT_VXD:
      begin
        wvsprintf(szVxdID, '%ld', @pvsffi.dwFileSubtype);
        szSubType := szVxdID;
      end;

    else
      begin
        szSubType := '';
      end;
  end;

 // 填写转换列表
  ArgList[0] := pvsffi.dwSignature;
  ArgList[1] := HIWORD(pvsffi.dwStrucVersion);
  ArgList[2] := LOWORD(pvsffi.dwStrucVersion);
  ArgList[3] := HIWORD(pvsffi.dwFileVersionMS);
  ArgList[4] := LOWORD(pvsffi.dwFileVersionMS);
  ArgList[5] := HIWORD(pvsffi.dwFileVersionLS);
  ArgList[6] := LOWORD(pvsffi.dwFileVersionLS);
  ArgList[7] := HIWORD(pvsffi.dwProductVersionMS);
  ArgList[8] := LOWORD(pvsffi.dwProductVersionMS);
  ArgList[9] := HIWORD(pvsffi.dwProductVersionLS);
  ArgList[10] := LOWORD(pvsffi.dwProductVersionLS);
  ArgList[11] := pvsffi.dwFileFlagsMask;
  ArgList[12] := DWORD(@szFlags[0]);
  ArgList[13] := DWORD(VerShow_FindValueString(g_vlFileOSAppType, pvsffi.dwFileOS and $0000FFFF));
  ArgList[14] := DWORD(VerShow_FindValueString(g_vlFileOSPlatform, pvsffi.dwFileOS and $FFFF0000));
  ArgList[15] := DWORD(VerShow_FindValueString(g_vlFileType, pvsffi.dwFileType));
  ArgList[16] := DWORD(szSubType);
  ArgList[17] := pvsffi.dwFileDateMS;
  ArgList[18] := pvsffi.dwFileDateLS;

 // 转换至szBuf
  wvsprintf(szBuf,
    '0x%08lX'#13#10 +     // Signature
    '%d.%d'#13#10   +     // Structure version
    '%d.%d.%d.%d'#13#10 + // File version
    '%d.%d.%d.%d'#13#10 + // Product version
    '0x%08lX'#13#10 +     // File flags mask
    '%s'#13#10      +     // File flags
    '%s under %s'#13#10 + // File OS
    '%s'#13#10 +          // File type
    '%s'#13#10 +          // File subtype
    '%d.%d',              // File date converted to something
    @ArgList[0]);
end;

 // 定位#0(字符串尾部)
function SearchEnd(const P: PChar): PChar;
begin
  Result := P;
  while (Result^ <> #0) do Inc(Result);
end;

 // 解析变长信息,填入szBuf
procedure VerShow_ConstructVariableStr(szBuf: PChar; pVerInfo: PChar; uTranslationNum: UINT);
const
  g_szFields: array[0..12] of PChar =(
   'Comments',
   'CompanyName',
   'FileDescription',
   'FileVersion',
   'InternalName',
   'LegalCopyright',
   'LegalTrademarks',
   'OriginalFilename',
   'PrivateBuild',
   'ProductName',
   'ProductVersion',
   'SpecialBuild',
   nil );
var
  szFieldPath: array[0..200] of Char;
  szData: PChar;
  szField: PPChar;
  pdwTranslation: PDWORD;
  uLen: UINT;
  ArgList: array[0..2] of DWORD;
begin
  if (pVerInfo = nil) then
  begin
    lstrcpy(szBuf, 'No version information exists');
    Exit;
  end;

 // 清空目标字符串
  szBuf[0] := #0;

 // 定位到指定语系
  VerQueryValue(pVerInfo, '\VarFileInfo\Translation', Pointer(pdwTranslation), uLen);
  Inc(pdwTranslation, uTranslationNum);

 // 查询各项字符串
  szField := @g_szFields[0];
  while (szField^ <> nil) do
  begin
   // 路径
    ArgList[0] := LOWORD(pdwTranslation^);
    ArgList[1] := HIWORD(pdwTranslation^);
    ArgList[2] := DWORD(szField^);
    wvsprintf(szFieldPath, '\StringFileInfo\%04x%04x\%s', @ArgList[0]);

   // 查询
    if VerQueryValue(pVerInfo, szFieldPath, Pointer(szData), uLen) and (uLen > 0) then
    begin
      ArgList[0] := DWORD(szField^);
      ArgList[1] := DWORD(szData);
      wvsprintf(SearchEnd(szBuf), '%s'#9'%s'#13#10, @ArgList[0]);
    end;

   // Next
    Inc(szField);
  end;
end;

 // 在hWnd显示文件版本信息
procedure VerShow_InitFileVerInfo(hWnd: HWND; pszPathname: PChar);
var
  dwVerSize: DWORD;
  pdwTranslation: PDWORD;
  pVerInfo: Pointer;
  uLen, x: UINT;
  szBuf: array[0..VerBufSize] of Char;
begin
 // 释放以前分配的内存
  pVerInfo := Pointer(GetWindowLong(hWnd, GWL_USERDATA));
  if (pVerInfo <> nil) then
  begin
    FreeMem(pVerInfo);
    pVerInfo := nil;
    SetWindowLong(hWnd, GWL_USERDATA, 0);
  end;

 // 显示文件完整路径
  SetDlgItemText(hWnd, IDC_PATHNAME, pszPathname);
  if (pszPathname = nil) then Exit;

 // 获取版本信息大小
  dwVerSize := GetFileVersionInfoSize(pszPathname, PDWORD(nil)^);
  if (dwVerSize > 0) then
  begin
   // 分配内存,并转入版本信息
    GetMem(pVerInfo, dwVerSize);
    if (pVerInfo <> nil) then
    begin
      GetFileVersionInfo(pszPathname, 0, dwVerSize, pVerInfo);
      SetWindowLong(hWnd, GWL_USERDATA, Integer(pVerInfo));
    end else
    begin
      MessageBox(GetActiveWindow(), 'Insufficient memory.', 'VerShow', 0);
    end;
  end;

 // 更新定长信息
  VerShow_ConstructFixedStr(szBuf, pVerInfo);
  SetDlgItemText(hWnd, IDC_FIXEDFILEINFODATA, szBuf);

 // 更新语系列表
  SendMessage(GetDlgItem(hWnd, IDC_TRANSLATIONS), CB_RESETCONTENT, 0, 0);
  if (pVerInfo <> nil) then
  begin
    VerQueryValue(pVerInfo, '\VarFileInfo\Translation', Pointer(pdwTranslation), uLen);

    x := 0;
    while (x < uLen) do
    begin
     // 语言名称
      VerLanguageName(LOWORD(pdwTranslation^), szBuf, SizeOf(szBuf));
      lstrcat(szBuf, ' -- ');

     // 字符编码
      LoadString(HInstance, HIWORD(pdwTranslation^),
        SearchEnd(szBuf), SizeOf(szBuf) - (SearchEnd(szBuf) - szBuf));

     // 加入列表
      SendMessage(GetDlgItem(hWnd, IDC_TRANSLATIONS), CB_ADDSTRING, 0, Integer(@szBuf[0]));

      Inc(x, 4);
      Inc(pdwTranslation);
    end;

    SendMessage(GetDlgItem(hWnd, IDC_TRANSLATIONS), CB_SETCURSEL, 0, 0);
  end;

 // 更新变长信息
  VerShow_ConstructVariableStr(szBuf, pVerInfo, 0);
  SetDlgItemText(hWnd, IDC_STRINGS, szBuf);
end;

 // WM_INITDIALOG消息处理
function VerShow_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
begin
 // 设置窗体图标
  SendMessage(hWnd, WM_SETICON, ICON_BIG, LoadIcon(HInstance, MakeIntResource(IDI_VERSHOW)));
  
 // 接受默认焦点
  Result := TRUE;
end;

 // WM_COMMAND消息处理
procedure VerShow_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
var
  ofn: TOpenFilename;
  szPathname: array[0..128] of Char;
  szBuf: array[0..VerBufSize] of Char;
begin
  case (id) of
    IDCANCEL:
      begin
       // 释放以前分配的内存
        VerShow_InitFileVerInfo(hWnd, nil);

       // 结束模态对话框
        EndDialog(hWnd, 0);
      end;

    IDC_SELECTFILE:
      begin
       // 初始化ofn结构
        ZeroMemory(@ofn, SizeOf(TOpenFilename));
        ofn.lStructSize := SizeOf(TOpenFilename);
        ofn.hWndOwner := hWnd;
        ofn.lpstrFilter :=
          'Executables (*.exe)'#0'*.EXE'#0 +
          'DLLs (*.dll)'#0'*.DLL'#0 +
          'Device drivers (*.drv)'#0'*.DRV'#0 +
          'Fonts (*.fon)'#0'*.FON'#0 +
          'Virtual devices (*.386)'#0'*.386'#0 +
          'Static libraries (*.lib)'#0'*.LIB'#0 +
          'All files (*.*)'#0'*.*'#0;
        ofn.lpstrFile := szPathname;
        ofn.lpstrFile[0] := #0;
        ofn.nMaxFile := SizeOf(szPathname);
        ofn.Flags := OFN_HIDEREADONLY or OFN_FILEMUSTEXIST or OFN_EXPLORER;

       // 文件选择对话框
        if GetOpenFileName(ofn) then VerShow_InitFileVerInfo(hWnd, ofn.lpstrFile);
      end;

    IDC_TRANSLATIONS:
      begin
       // ComboBox选项改变
        if (codeNotify = CBN_SELCHANGE) then
        begin
         // 当前语系变长信息
          VerShow_ConstructVariableStr(szBuf,
            Pointer(GetWindowLong(hWnd, GWL_USERDATA)),
            SendMessage(hWndCtl, CB_GETCURSEL, 0, 0));

         // 更新 ...
          SetDlgItemText(hWnd, IDC_STRINGS, szBuf);
        end;
      end;
  end;
end;

 // 对话框消息处理回调
function VerShow_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  case (uMsg) of
    WM_INITDIALOG:
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(VerShow_OnInitDialog(hWnd, wParam, lParam))));
      end;

    WM_COMMAND:
      begin
        VerShow_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
        Result := TRUE;
      end;

    else Result := FALSE; // 没有处理
  end;
end;

 // 程序'主线程'入口
begin
  DialogBox(HInstance, MakeIntResource(IDD_VERSHOW), 0, @VerShow_DlgProc);
end.