{
IE4以降 Shell32.DLLのバージョン取得が極めて重要になってきています。
 ( MSに振り回されているとも言う (^^; )
そこで Internet Client SDKに載っていた GetShell32Versionを
Delphi用に作ってみました。

Version  Platform  

4.00  Windows 95, Windows NT 4.0, Internet Explorer 3.0, and 
      Internet Explorer 4.0 without Web Integrated Desktop.  
4.71  Internet Explorer 4.0 with Web Integrated Desktop 

}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  PDllGetVersionInfo = ^TDllGetVersionInfo;
  TDllGetVersionInfo = record
    cbSize        : DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber : DWORD;
    dwPlatformID  : DWORD;
  end;
  TDllGetVerInfo = TDllGetVersionInfo;
  PDllGetVerInfo = PDllGetVersionInfo;
  
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  DLLVER_PLATFORM_WINDOWS  =  $00000001;      // Windows 95
  DLLVER_PLATFORM_NT       =  $00000002;      // Windows NT

function GetShell32Version(var dwMajor: DWORD; var dwMinor: DWORD;
                   var dwBNumber: DWORD; var szPtformID: string): HRESULT;
type
  TDllGetVersionProc = function(var pdvi: TDllGetVerInfo): HResult; stdcall;
const
  shell32dll = 'shell32.dll';
var
  hShell32: THandle;
  DllGetVerProc: TDllGetVersionProc;
  dvi: TDllGetVerInfo;
begin
  Result:= E_INVALIDARG;
  if (IsBadWritePtr(@dwMajor, sizeof(DWORD)) or IsBadWritePtr(@dwMinor, 
      sizeof(DWORD)) or IsBadWritePtr(@dwBNumber, sizeof(DWORD))) then
    exit;
  dwMajor  := 0;
  dwMinor  := 0;
  dwBNumber:= 0;
  hShell32:= LoadLibrary(shell32dll);
  if hShell32 <= HINSTANCE_ERROR then
    raise Exception.CreateFmt('%s: %s', [SysErrorMessage(GetLastError), 
                                                         shell32dll]);
  try
    DllGetVerProc:= TDllGetVersionProc(GetProcAddress(hShell32,
                                       'DllGetVersion'));
    if Assigned(DllGetVerProc) then
    begin
      fillchar(dvi, sizeof(dvi), #0);
      dvi.cbSize:= sizeof(dvi);
      if SUCCEEDED(DllGetVerProc(dvi)) then
      begin
        with dvi do
        begin
          dwMajor  := dwMajorVersion;
          dwMinor  := dwMinorVersion;
          dwBNumber:= dwBuildNumber;
          case dwPlatformID of
            DLLVER_PLATFORM_WINDOWS:
              szPtformID:= 'Platform is Windows';
            DLLVER_PLATFORM_NT:
              szPtformID:= 'Platform is Windows NT';
            else
              szPtformID:= 'Platform is not defined';
          end;
          Result:= S_OK;
        end;
      end;
    end;
   finally
     FreeLibrary(hShell32);
  end;
  if Result <> S_OK then
    Result:= E_FAIL;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  dwMajor   : DWORD;
  dwMinor   : DWORD;
  dwBNumber : DWORD;
  szPtformID: string;
begin
  Edit1.Text:= '';
  Edit2.Text:= '';
  if S_OK = GetShell32Version(dwMajor, dwMinor, dwBNumber, szPtformID) then
    Edit1.Text:= Format('%s %d.%d %s %d %s',['Shell32.dll Version ', 
                 dwMajor, dwMinor, 'BuildNumber',dwBNumber, szPtformID]);
  else
    Edit1.Text:= 'DllGetVersion Failed - Cannot determine DLL version.';
end;

end.

でわ〜でわ〜
                                   by ヒシアマゾン
                                   BXC05221@niftyserve.or.jp
                                   ken_fu@mx4.meshnet.or.jp

Original document by ヒシアマゾン    氏 ID:(BXC05221)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。