[BlueLeaf1336]> PROGRAM>

WindowsのプロダクトIDを取得する

historyTOP

2004/02/14:作成

overviewTOP

タイトルのとおりですが、次の2つのサイトのパクリです。

さらに、Windows2000sp4以外でのテストは一切していません。どちらにしても確かなのは、プロダクトIDはレジストリの次の場所に書いてあるということです(Win2000の場合)。

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductId

とりあえずメモリもパッと見では漏れずに、取得できています。

codeTOP

uses
    Registry;

(*
    ===========================================================================
    Windows のプロダクトIDを取得するユーザー定義関数
    ---------------------------------------------------------------------------
    http://www.ruriplus.com/msaccess/tch/tch_036.html
    http://homepage1.nifty.com/MADIA/delphi/delphi_bbs/200302_03020032.html
    ===========================================================================
*)
function    GetWindowsProductID(): string;
const
    KEY_READ = ((STANDARD_RIGHTS_READ or KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS
                 or KEY_NOTIFY) and (not SYNCHRONIZE));
var
    OSVER: TOSVersionInfo;
    SubKey: string;
    KeyRoot: HKEY;
    buf: PBYTE;
    dwType, dwLen: DWORD;
begin
    Result := '';
    //  初期化
    FillChar(OSVER, SizeOf(OSVER), #0);
    //  サイズ設定
    OSVER.dwOSVersionInfoSize := SizeOf(OSVER);
    //  バージョン情報を取得(失敗で終了)
    if not GetVersionEx(OSVER) then exit;
    //  NT系の場合
    if OSVER.dwPlatformId = VER_PLATFORM_WIN32_NT then
    begin
        //  サブキーを設定
        SubKey := 'SOFTWARE\Microsoft\Windows NT\CurrentVersion';
    end
    //  そうでない場合
    else
    begin
        //  サブキーを設定
        SubKey := 'SOFTWARE\Microsoft\Windows\CurrentVersion';
    end;
    //  レジストリをあけてみる(失敗で終了)
    if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(SubKey), 0, KEY_READ, KeyRoot) <> 0 then exit;
    //  メモリ確保
    buf := GetMemory(255);
    //  確保した長さを設定
    dwLen := 255;
    //  値のタイプを設定
    dwType := REG_SZ;
    //  エントリから値を取り出す
    RegQueryValueEx(KeyRoot, 'ProductId', nil, @dwType, PBYTE(buf), @dwLen);
    //  文字列に変換
    Result := string(PChar(buf));
    //  メモリ解放
    FreeMemory(buf);
    //  レジストリを閉める
    RegCloseKey(KeyRoot);
end;

sample codeTOP

(*
    ===========================================================================
    テスト
    ===========================================================================
*)
procedure TForm1.Button1Click(Sender: TObject);
begin
    ShowMessage(GetWindowsProductID());
end;

EOFTOP