FreeBASIC マニュアルのトップに戻る

FreeBASIC Read/Write Registry

目次→フォーラム→FreeBASIC→補足Tips and Tricks←オリジナル・フォーラム

レジストリの読み書き 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

←リンク元に戻る プログラム開発関連に戻る

レジストリの値を表示する関数
レジストリの読み書き

レジストリの値を表示する関数

これは、FreeBASIC Community Forum→Tips and Tricks の下記 Topic の翻訳です。
Windows registry reader function, handles most value types.
https://www.freebasic.net/forum/viewtopic.php?t=15183

レジストリ・キーと、異なる型の値を読む作業が大変なので、これをまとめました。
これは、レジストリのいくつかの x64/64 ビットのキーは、32ビットのアプリでは表示できない、という問題に対処しています。
これは、REG_EXPAND_SZ、REG_MULTI_SZ、REG_BINARY を含むほとんどすべての値の型を取り扱います。

また、このプログラムは、FB で Windows API のいろいろなデータ型を取り扱う方法を示すとともに、情報の相当な数の散らばったビットを引き合わせる方法を示しています。

このプログラムは完璧ではなでしょうが、私が知る限り最も完全なレジストリ読み取り関数と思われ、コンパイル結果は 26K に収まります。
コメント・ブロックの表示は、80 桁で最も見やすくなるように設定しています。

渡辺注:トップキーを、例えば「HKEY_CURRENT_USER」に変更したいときは、下記の行を書き換えます。
test = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subkey, 0, KEY_READ Or &H0100, @hk)
下の ReadRegistry() を使う方が簡単ですね。

/' Get Registry Values by Paul Tice 02-27-2010, お好きに使って下さい

https://www.freebasic.net/forum/viewtopic.php?t=15183

戻り値 String
 REG_BINARY Hex エンコードされた値を返します
 REG_DWORD と REG_QWORD は、As Str(value) で戻ります

対象 REG_SZ, REG_EXPAND_SZ (expanded), REG_DWORD, REG_QWORD, REG_BINARY, 
 REG_MULTI_SZ
   REG_EXPAND_SZ 現在のユーザーのための拡張値
   REG_EXPAND_SZ 値は 4096 bytes 未満です
   REG_MULTI_SZ CHR(0)で区切られた文字列 string を返します
    
Windows x64 のため 64ビットレジストリ出力先変更を扱います
 32ビットのプログラムは、デフォルトではすべてのキーや値を見ることができません、
 そして、WOW632Node を読むと、無限ループにハマります

 32 Bit レジストリ表示のため %syspath%\syswow64\regedit.exe を実行します
  HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID はテストに好都合です
 参照 http://support.microsoft.com/kb/896459
 http://msdn.microsoft.com/en-us/library/aa384232%28VS.85%29.aspx
 http://msdn.microsoft.com/en-us/library/aa384129(VS.85).aspx

対象外 REG_DWORD_BIG_ENDIAN, REG_LINK, REG_NONE, REG_RESOURCE_LIST,
 REG_FULL_RESOURCE_DESCRIPTION, REG_RESOURCE_REQUIREMENTS_LIST

Windows 2000 サポートを期待されても、Windows 2000 は取り扱いません
 WOW64_64KEY、検索/削除 "or &H0100" のためです

利用できる十分なバッファ・スペースがあるか、確認チェックしません、
 マイクロソフトは、レジストリに保存されているファイル名を、
 ロング値(2,048バイト以上)のファイルとして保存する必要がある、と指定します
 しかし、これを強制していません。
 NT 以降の実際の最大値サイズは、_Available Memory_ です!
 これは、単純に、特に REG_BINARY 型の問題かもしれません

トップレベル・キーを、HKEY_LOCAL_MACHINE と別のものに変更したり、
 対象とするトップレベル・キーを渡すために、コード追加できます
'/


#Include Once "windows.bi"    '既に winreg.bi は含まれています

Declare Function getregvalue(subkey As String, value As String) As String
Dim As String RegValue, WhatSubkey, WhatValue


'--- 表示例---
WhatSubkey="SOFTWARE\Microsoft\Windows NT\CurrentVersion" 
WhatValue="DigitalProductID"

RegValue=getregvalue(WhatSubkey,WhatValue)
Print WhatSubkey+"\"+WhatValue+"="
Print RegValue
Print

WhatValue="MultiSZ"
RegValue=getregvalue(WhatSubkey,WhatValue)
Print WhatSubkey+"\"+WhatValue+"="
Print RegValue
Print

WhatSubkey="SOFTWARE\Microsoft\Windows\CurrentVersion"
WhatValue="DevicePath"
RegValue=getregvalue(WhatSubkey,WhatValue)
Print WhatSubkey+"\"+WhatValue+"="
Print RegValue
Print

Print"何かキーを押と終了します"
Sleep


Private Function getregvalue(subkey As String,value As String) As String
    Dim hk As HKEY = Any
    Dim sz As DWORD = Any
    Dim typ As DWORD = Any
    Dim test As Long
    
    test = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subkey, 0, KEY_READ Or &H0100, @hk) 
    '&H0100 は KEY_WOW64_64KEY のビットマスク, &H0200 は KEY_WOW64_32KEY のビットマスク
    If test = ERROR_SUCCESS Then
        test=RegQueryValueEx(hk, value, NULL, @typ, NULL, @sz)
        If test=ERROR_SUCCESS Then
            Select Case typ 
            
            Case 1
                Dim As String buf_sz
                buf_sz = String(sz, 0)   
                test=RegQueryValueEx(hk, value, NULL, @typ, Strptr(buf_sz), @sz) 
                If test = ERROR_SUCCESS Then
                    RegCloseKey(hk)
                    Return Left(buf_sz, sz - 1)
                Else 
                    Return "ERR_"+Str(test)
                End If
            Case 2
                Dim As String buf_sz, buf_exp_sz
                Dim As Long test2
                buf_exp_sz = String(4096, 0)
                buf_sz = String(sz, 0)   
                test=RegQueryValueEx(hk, value, NULL, @typ, Strptr(buf_sz), @sz) 
                If test = ERROR_SUCCESS Then
                    RegCloseKey(hk)
                    test=ExpandEnvironmentStrings(Strptr(buf_sz),Strptr(buf_exp_sz), 1024)
                    If test= ERROR_SUCCESS Then
                        Return "ERR_Expand_Enviroment_Strings_"+Str(test)
                    Else    
                        Return Left(buf_exp_sz,test)
                    End If
                Else 
                    Return "ERR_"+Str(test)
                End If
            Case 3
                Dim buf(sz) As Byte 
                Dim As String buf_binary
                Dim i As Integer
                test=RegQueryValueEx(hk, value, NULL, @typ, @buf(0), @sz)
                If test = ERROR_SUCCESS Then
                    For i = 0 To sz
                        buf_binary+=Hex(buf(i))
                    Next i
                    Return buf_binary
                Else 
                    Return "Err_"+Str(test)
                End If
                
            Case 4
                Dim As dword buf_dword 
                test=RegQueryValueEx(hk, value, NULL, @typ, cast(byte ptr, @buf_dword), @sz)
                If test = ERROR_SUCCESS Then
                    RegCloseKey(hk)
                    Return Str(buf_dword)
                Else 
                    Return "ERR_"+Str(test)
                End If
                
            Case 7
                Dim As String buf_sz
                buf_sz = String(sz, 0)   
                test=RegQueryValueEx(hk, value, NULL, @typ, Strptr(buf_sz), @sz) 
                If test = ERROR_SUCCESS Then
                    RegCloseKey(hk)
                    Return Left(buf_sz, sz)
                Else 
                    Return "ERR_"+Str(test)
                End If

            Case 11 
                Dim buf_qword As Ulongint Ptr 
                test=RegQueryValueEx(hk, value, NULL, @typ, cast(byte ptr, @buf_qword), @sz)
                If test = ERROR_SUCCESS Then
                    RegCloseKey(hk)
                    Return Str(buf_qword)
                Else 
                    Return "ERR_"+Str(test)
                End If
                
            Case Else 
                Return "ERR_REG_TYPE_"+Str(typ)+"Not Handled"
            End Select   
        End If 
        RegCloseKey(hk)
        If test=2 Then 
            Return "ERR_RegQueryValueEx_Value_Not_Found"
        Else 
            If test=5 Then 
                Return "ERR_RegQueryValueEx_AccessDenied"
            Else
                Return "ERR_OpenKey_"+Str(test)
            End If
        End If
    End If
    Return ""
End Function

このページのトップに戻る

レジストリの読み書き

これは、FreeBASIC Community Forum→Tips and Tricks の下記 Topic の翻訳です。
Read/Write Registry (Win)
https://www.freebasic.net/forum/viewtopic.php?t=16455

Windows レジストリの、読み取り、書き込みの、2つの基本関数です。
DWORD、STRING、BINARY キーを読み取ることができます。
STRING と DWORDキーを作成できます。
使用、拡張、改変は、ご自由に。

使用例:
このプログラムを、例えば「Registry_xxx.bas」という名前で保存します。
そして、下の「RegistryReadWrite.bas」を同じフォルダに保存します。
そして、この「Registry_xxx.bas」をコンパイルして実行します。
関数部分のプログラムを、#Include しているので、このプログラムには、関数名を記述するだけで使えます。
#Include "RegistryReadWrite.bas"

Dim regpath As string 
Dim keyname As String 

/'
   キーを読む例
'/

regpath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
keyname = "ProductName"
Print keyname & "=" & ReadRegistry(HKEY_LOCAL_MACHINE,regpath,keyname)

regpath = "Control Panel\Desktop\WindowMetrics"
keyname = "PaddedBorderWidth"
Print keyname & "=" & ReadRegistry(HKEY_CURRENT_USER,regpath,keyname)

keyname = "ScrollWidth"
Print keyname & "=" & ReadRegistry(HKEY_CURRENT_USER,regpath,keyname)

/'
   キーを書く例
'/
regpath = "SOFTWARE\MySoftwareCompany"
keyname = "MyEntry"

WriteRegistry (HKEY_CURRENT_USER,regpath, keyname, ValDword, "25")

Print "実行しました! 何かキーを押して下さい..."
Sleep

このプログラムを「RegistryReadWrite.bas」という名前で保存します。
/'
   基本 Windows Registry Read/Write 関数
   以下の VB6 ソースから移植
      -Vincent DeCampo, 2010
   
   原作者 UNKOWN
'/

#Include "windows.bi"
#Include "vbcompat.bi"

' 可能なレジストリデータ型
Enum InTypes
   ValNull = 0
   ValString = 1
   ValXString = 2
   ValBinary = 3
   ValDWord = 4
   ValLink = 6
   ValMultiString = 7
   ValResList = 8
End Enum

' レジストリ・セクションの定義
'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003
'Const HKEY_PERFORMANCE_DATA = &H80000004
'Const HKEY_CURRENT_CONFIG = &H80000005

Function ReadRegistry(ByVal Group as HKEY, ByVal Section As LPCSTR, ByVal Key As LPCSTR) As String
Dim as DWORD lDataTypeValue, lValueLength
Dim sValue As String * 2048
Dim As String Tstr1, Tstr2  
Dim lKeyValue As HKEY
Dim lResult as Integer
Dim td As Double

   sValue = ""
   
   lResult      = RegOpenKey(Group, Section, @lKeyValue)
   lValueLength = Len(sValue)
   lResult      = RegQueryValueEx(lKeyValue, Key, 0&, @lDataTypeValue, Cast(Byte Ptr,@sValue), @lValueLength)
   
   If (lResult = 0) Then

      Select Case lDataTypeValue
         case REG_DWORD 
            td = Asc(Mid(sValue, 1, 1)) + &H100& * Asc(Mid(sValue, 2, 1)) + &H10000 * Asc(Mid(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid(sValue, 4, 1)))
            sValue = Format(td, "000")
         case REG_BINARY 
            ' Return a binary field as a hex string (2 chars per byte)
            Tstr2 = ""
            For I As Integer = 1 To lValueLength
               Tstr1 = Hex(Asc(Mid(sValue, I, 1)))
               If Len(Tstr1) = 1 Then Tstr1 = "0" & Tstr1
               Tstr2 += Tstr1
            Next
            sValue = Tstr2
         Case Else
            sValue = Left(sValue, lValueLength - 1)
      End Select
   
   End If

   lResult = RegCloseKey(lKeyValue)
   
   Return sValue

End Function

Sub WriteRegistry(ByVal Group as HKEY, ByVal Section As LPCSTR, ByVal Key As LPCSTR, ByVal ValType As InTypes, value As String)
Dim lResult as Integer
Dim lKeyValue As HKEY
Dim lNewVal as DWORD
Dim sNewVal As String * 2048

   lResult = RegCreateKey(Group, Section, @lKeyValue)

   If ValType = ValDWord Then
      lNewVal = CUInt(value)
      lResult = RegSetValueEx(lKeyValue, Key, 0&, ValType, Cast(Byte Ptr,@lNewVal), SizeOf(DWORD))
   Else
      If ValType = ValString Then
         sNewVal = value & Chr(0)
         lResult = RegSetValueEx(lKeyValue, Key, 0&, ValString, Cast(Byte Ptr,@sNewVal), Len(sNewVal))
      EndIf
   End If

   lResult = RegFlushKey(lKeyValue)
   lResult = RegCloseKey(lKeyValue)

End Sub
 
補足 に戻る
←リンク元に戻る プログラム開発関連に戻る
ページ歴史:2016-09-26
日本語翻訳:WATANABE Makoto、原文著作者:lp0cua0 & Roland Chastain & vdecampo & UNKOWN

ホームページのトップに戻る

表示-非営利-継承