ab.com コミュニティ

わからないわからないではなくまずポインタの勉強を先にしてリファレンスをよく読む
検索する。Cのサンプルでもあたること。


正解を書いてもよいのだが力にならないのでヒントだけ提示する。

pathにはmallocしてもその後リテラルを代入しているのだから
これはしてはいけないこと、後のfreeで問題になる

変数reはDWord型にしバッファサイズを代入し
RegQueryValueExの第6引数にポインタを渡すこと

RegQueryValueExの大4引数は型が戻ってくるのでありこちらが指定してはいけない

MessageBox(0,GetWinProductId(),0,0)

Function GetWinProductId() As String
	Dim path As BytePtr
	Dim p_id As BytePtr
	Dim re As DWordPtr
	Dim os As OSVERSIONINFO
	Dim bErr As Long
	Dim hKey As HKEY

	path=malloc(256)
	p_id=malloc(256)

	os.dwOSVersionInfoSize=Len(os)
	bErr=GetVersionEx(os)
	If bErr=FALSE Then
		MessageBox(0,"OSバージョンの取得に失敗","Error",MB_OK or MB_ICONHAND)
		free(path)
		free(p_id)
		Exit Function
	End If

	If os.dwPlatformId=VER_PLATFORM_WIN32_NT Then
    	path="SOFTWARE\Microsoft\Windows NT\CurrentVersion"
	Else
	    path="SOFTWARE\Microsoft\Windows\CurrentVersion"
	End If

	bErr=RegOpenKeyEx(HKEY_LOCAL_MACHINE,path,0,KEY_READ,hKey)
	If bErr<>0 Then
		Error(bErr,1)
		free(path)
		free(p_id)
		Exit Function
	End If

	re=malloc(256)
	re=256
	bErr=RegQueryValueEx(hKey,"ProductId",&0,REG_SZ,p_id,VarPtr(re))
	If bErr<>0 Then
		Error(bErr,2)
/*		free(re)
		free(path)
		free(p_id)
*/		Exit Function
	End If

	bErr=RegCloseKey(hKey)
	bErr=RegQueryValueEx(hKey,"ProductId",&0,REG_SZ,p_id,re)
	If bErr<>0 Then
		Error(bErr,3)
		free(re)
		free(path)
		free(p_id)
		Exit Function
	End If

	free(re)
	free(path)
	free(p_id)

	GetWinProductId=p_id

End Function


Sub Error(msg As Long,num As Long)
	Dim lpMsgBuf As BytePtr
	FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _
	    NULL, _
	    msg, _
	    LANG_USER_DEFAULT, _
	    VarPtr(lpMsgBuf), _
	    0, _
	    NULL)
	MessageBox(0,lpMsgBuf,"Error msg NUM:"+Str$(num),MB_OK)
	LocalFree(lpMsgBuf)
End Sub

RegQueryValueEx(hKey,"ProductId",&0,REG_SZ,p_id,re)

ご無沙汰しております。

今回、WindowsのProductIDを取得しようとして、以下のコードを書きました。
[hide]
[code]

MessageBox(0,GetWinProductId(),0,0)

Function GetWinProductId() As String
Dim path As BytePtr
Dim p_id As BytePtr
Dim re As DWordPtr
Dim os As OSVERSIONINFO
Dim bErr As Long
Dim hKey As HKEY

path=malloc(256)
p_id=malloc(256)

os.dwOSVersionInfoSize=Len(os)
bErr=GetVersionEx(os)
If bErr=FALSE Then
MessageBox(0,"OSバージョンの取得に失敗","Error",MB_OK or MB_ICONHAND)
free(path)
free(p_id)
Exit Function
End If

If os.dwPlatformId=VER_PLATFORM_WIN32_NT Then
path="SOFTWARE\Microsoft\Windows NT\CurrentVersion"
Else
path="SOFTWARE\Microsoft\Windows\CurrentVersion"
End If

bErr=RegOpenKeyEx(HKEY_LOCAL_MACHINE,path,0,KEY_READ,hKey)
If bErr<>0 Then
Error(bErr,1)
free(path)
free(p_id)
Exit Function
End If

re=malloc(256)
re=256
bErr=RegQueryValueEx(hKey,"ProductId",&0,REG_SZ,p_id,VarPtr(re))
If bErr<>0 Then
Error(bErr,2)
/* free(re)
free(path)
free(p_id)
*/ Exit Function
End If

bErr=RegCloseKey(hKey)
bErr=RegQueryValueEx(hKey,"ProductId",&0,REG_SZ,p_id,re)
If bErr<>0 Then
Error(bErr,3)
free(re)
free(path)
free(p_id)
Exit Function
End If

free(re)
free(path)
free(p_id)

GetWinProductId=p_id

End Function


Sub Error(msg As Long,num As Long)
Dim lpMsgBuf As BytePtr
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, _
NULL, _
msg, _
LANG_USER_DEFAULT, _
VarPtr(lpMsgBuf), _
0, _
NULL)
MessageBox(0,lpMsgBuf,"Error msg NUM:"+Str$(num),MB_OK)
LocalFree(lpMsgBuf)
End Sub
[/code]
[/hide]

初めてのレジストリの操作でどきどきしながらデバッグコンパイル。

どうやら、
[code]RegQueryValueEx(hKey,"ProductId",&0,REG_SZ,p_id,re)[/code]
ここで、アクセス違反が起きているようです。

しかし、どうしてかが分かりません。

すいませんが、ご存知の方がいらっしゃいましたら、ご教授ください。
お願いします。