ab.com コミュニティ

コード: 全て選択

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