用Win2000的朋友请进 ^-^
'---------------------------form1---------------need 2 command and 2 textbox----------
'win98下正常,先按command1 再按command2,command2按下后,text1:"software",text2:"Good! Done" 才算正常,可是win2000下总不正常,谁帮我调试一下?
Private Sub Command1_Click()
SetStringValue HKEY_LOCAL_MACHINE, "software\test", "abc", "software"
End Sub
Private Sub Command2_Click()
Text1.Text = GetStringValue(HKEY_LOCAL_MACHINE, "software\test", "abc")
SetStringValue HKEY_LOCAL_MACHINE, Text1.Text + "\test", "abc", "Good!"
Text2.Text = GetStringValue(HKEY_LOCAL_MACHINE, "software\test", "abc") + " Done!"
Call DeleteKey(HKEY_LOCAL_MACHINE, "software", "test") '然后删除"software\test"
End Sub
'注册表存取API函数及常数声明(范围:全局)
'--------------------Modlue1------------
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hkey As Long, ByVal lpValueName As String) As Long
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_SUCCESS = 0&
Public Const REG_SZ = 1&
Public Const REG_DWORD = 4&
Public Const KEY_QUERY_VALUE = &H1&
Public Const KEY_SET_VALUE = &H2&
Public Const KEY_CREATE_SUB_KEY = &H4&
Public Const KEY_ENUMERATE_SUB_KEYS = &H8&
Public Const KEY_NOTIFY = &H10&
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Public Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Public Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Dim hkey As Long
Dim rtn As Long, lBuffer As Long, sBuffer As String
Dim lBufferSize As Long
Function GetStringValue(ByVal MainKeyHandle As Long, ByVal Subkey As String, entry As String)
'最后整理日期:2001.10.05
'功能:从注册表获取字符串值
rtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_READ, hkey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
sBuffer = Space(255) 'make a buffer
lBufferSize = Len(sBuffer)
rtn = RegQueryValueEx(hkey, entry, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
If rtn = ERROR_SUCCESS Then 'if the value could be retreived then
rtn = RegCloseKey(hkey) 'close the key
sBuffer = Trim(sBuffer)
GetStringValue = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user
Else 'otherwise, if the value couldnt be retreived
GetStringValue = "?" 'return Error to the user
End If
Else 'otherwise, if the key couldnt be opened
GetStringValue = "?" 'return Error to the user
End If
End Function
Sub SetStringValue(ByVal MainKeyHandle As Long, ByVal Subkey As String, ByVal entry As String, ByVal value As String)
'最后整理日期:2001.10.05
'功能:设置注册表字符串值
rtn = RegCreateKey(MainKeyHandle, Subkey, hkey) 'open or create the key
If rtn = ERROR_SUCCESS Then 'if the key was open successfully then
rtn = RegSetValueEx(hkey, entry, 0, REG_SZ, ByVal value, Len(value)) 'write the value
rtn = RegCloseKey(hkey) 'close the key
End If
End Sub
Function DeleteKey(ByVal MainKeyHandle As Long, ByVal Subkey As String, ByVal Keyname As String)
'最后整理日期:2001.10.05
'功能:从注册表删除一个主键
rtn = RegOpenKeyEx(MainKeyHandle, Subkey, 0, KEY_WRITE, hkey) 'open the key
If rtn = ERROR_SUCCESS Then 'if the key could be opened then
rtn = RegDeleteKey(hkey, Keyname) 'delete the key
rtn = RegCloseKey(hkey) 'close the key
End If
End Function
问题点数：133、回复次数：5Top
1 楼dbcontrols（泰山__抛砖引玉）回复于 2001-12-14 13:43:41 得分 30
http://www.wzjcw.net/vbgood/taishan/index.htmlTop
2 楼dingfuhao（丁丁）回复于 2001-12-14 13:47:39 得分 30
我用的是win2000
我试了一下，没有问题啊Top
3 楼DeityFox（逃之11）回复于 2001-12-14 14:02:53 得分 30
TO:MonkeyLin
我用的也是win2000,我copy了你上面的代码，一切正常
先按command1 再按command2,command2按下后,text1:"software",text2:"Good! Done"
我看老兄你还是给分吧Top
4 楼gmc007（江西的佬表）回复于 2001-12-14 14:04:02 得分 23
造成不能得到（Food! Done)的原因是：
API函数在传一个字符串到VB时，这个字符串是以NULL结尾的，
比如，你在取到第一个字符串Good!时，它实际上是Good! 。（注意，它后面的空格，因为NULL字符是不能显示的。）所以就算后面还有什么字符也不能显示出来了。
===============
以上纯属个人意见，如果有误导，。。。。。嘿嘿，概不负责！
下面是我的一段代码，你可以参考一下：
Option Explicit
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Const HKEY_LOCAL_MACHINE = &H80000002
Const MY_SUBKEY = "SOFTWARE\科筑打印监控_客户端"
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const ERROR_SUCCESS = 0&
Dim status As Long
Private Sub Command1_Click()
SetKeyValue HKEY_LOCAL_MACHINE, MY_SUBKEY, "host", Trim(Text1.Text)
End Sub
Public Function GetKeyValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String) As String
Dim llKeyID As Long, llBufferSize As Long, lsKeyValue As String
GetKeyValue = Empty
status = ERROR_SUCCESS
status = RegOpenKey(plKey, psKey, llKeyID)
If status = ERROR_SUCCESS Then
status = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_SZ, 0&, llBufferSize)
If llBufferSize < 2 Then
status = RegCloseKey(llKeyID)
GetKeyValue = "NoValue"
Else
lsKeyValue = String(llBufferSize + 1, " ")
status = RegQueryValueEx(llKeyID, psSubKey, 0&, REG_SZ, ByVal lsKeyValue, llBufferSize)
If status = ERROR_SUCCESS Then
GetKeyValue = Left$(lsKeyValue, llBufferSize - 1)
End If
status = RegCloseKey(llKeyID)
End If
Else
GetKeyValue = "NoSubKey"
End If
End Function
Public Function CreateKey(ByVal plKey As Long, ByVal psKey As String) As Long
Dim llKeyID As Long
status = ERROR_SUCCESS
status = RegCreateKey(plKey, psKey, llKeyID)
If status = ERROR_SUCCESS Then
CreateKey = llKeyID
End If
End Function
Public Sub SetKeyValue(ByVal plKey As Long, ByVal psKey As String, ByVal psSubKey As String, ByVal psKeyValue As String)
Dim llKeyID As Long
status = ERROR_SUCCESS
status = RegOpenKey(plKey, psKey, llKeyID)
If status = ERROR_SUCCESS Then
If LenB(psKeyValue) = 0 Then
status = RegSetValueEx(llKeyID, psSubKey, 0&, REG_SZ, 0&, 0&)
Else
status = RegSetValueEx(llKeyID, psSubKey, 0&, REG_SZ, ByVal psKeyValue, lstrlen(psKeyValue) + 1)
End If
status = RegCloseKey(llKeyID)
End If
End Sub
Private Sub Form_Load()
Text1.Text = GetIPAddress()
If Text1.Text = "127.0.0.1" Then
frmGetIP.Caption = "You are of Line"
Else
frmGetIP.Caption = "You are on Line"
End If
End Sub
Private Sub Command2_Click()
Dim s As String
s = GetKeyValue(HKEY_LOCAL_MACHINE, MY_SUBKEY, "host")
If Right(s, 1) = vbNullChar Then s = Left(s, Len(s) - 1)
Text2.Text = s & "|"
End Sub
Top
5 楼gmc007（江西的佬表）回复于 2001-12-14 14:06:44 得分 20
Private Sub Form_Load()
Text1.Text = GetIPAddress()
If Text1.Text = "127.0.0.1" Then
frmGetIP.Caption = "You are of Line"
Else
frmGetIP.Caption = "You are on Line"
End If
End Sub
上面一段去掉！Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
