这句定义的对不对?在我这里好用。
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_LOCAL_MACHINE = &H80000002
解决方案 »
- 请问能自定义事件处理函数的名称吗?
- VB调用C语言的dll,怎么调用返回字符数组的函数?
- 高手请进。。。如何将用VB设计WINDOWSXP的“服务”程序!
- 求vb3 和vb4程序的反编译程序。
- 如何对access中日期进行比较查询?
- 一道衡量高手价值的题目,还有我会给高分想送,至少200,我智商低,难过,请您们帮我
- 格雷码的算法求解
- 数据库从ACCESS2003转换到SQL SERVER,原先的SQL语句代码,有哪些需要更改?谢谢大家。
- 从串口读出来的东西,经常出现乱码。。怎么办??
- 如何使用ADO?绝对送高分!
- 倒底没有人知道 怎么用sql 在ACCESs 里设置 default 值啊?
- vb中怎么得到一个文件的路径(除文件名)?
我们知道,在VB中调用Windows的API函数能比较方便的修改系统注目表,然而笔者近来在一次应用中偶然发现这样一个特殊的问题:若在注目表HKEY_LOCAL_MACHINE\Mircrosoft\Windows \CurrentVersion\Setup下有一双字节型串值SetupOnce为"0x7cf70b"现要通过VB把其改为"0xffffffff"(十进制为4294967295)。是不是直接定义长整型变量Updata,并赋值Updata=4294967295,然后调用API函数RegSetValueEx
("HKEY_LOCAL_MACHINE", "Software\Mircrosoft \Windows\CurrentVersion\Setup","SetupOnce",0,4,Updata,4)就能达到目的呢?实际非也!这样操作,将会出错,出错报告为"实时错误6,溢出"。问题出在那里呢?笔者经过思考,发现十六进制0xffffffff化为十进制4294967295共十位数,显然把变量Updata在定义为长整型时存在错误。知道了问题所在,我们把Updata变量重新定义为双精度型,接下来的问题是Updata到底应赋予何值?我们可以采用反推法,即先在注册表中先令SetupOnce为"0xffffffff",在VB中定义变量Updata(double型),调用API中注册表查询库函数RegQueryValueEx("HKEY_LOCAL_MACHINE","Software\Mircrosoft\Windows \CurrentVersion \Setup","SetupOnce",0,4,Updata,4)在VB中一调试,结果出来了,Up!data的值为2.12199579047121E-314(这个数字真有点吓人)。知道了Updata的取值我们就可以用RegSetValueEx函数修改原来
SetupOnce的值了。下面给出以上所述过程的一个例程,希望对您有所启发。
新建一工程,在此工程声明段声明常量及API库函数:
PrivateDeclareFunction RegCloseKey Lib "advapi32.dll" (ByVal hKey AsLong)As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey AsString, ByVal ulOptions As Long, ByVal samDesired As Long,phkresult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long,ByVal lpValueNameAs String, ByVal lpReserved As Long,lpType As Long, lpDataAs Any, lpcbData As Long) As Long'Note that if you declarethe lpData parameter as String, youmust pass it By Value.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,lpDataAs Any, ByVal cbData As Long) As Long'Note that ifyou declarethe lpData parameter as String, you must pass itBy Value.Const HKEY_LOCAL_MACHINE = &H80000002 Const REG_DWORD =4 Const ERROR_SUCCESS = 0& Const KEY_ALL_ACCESS = &H3F ConstA = 2.12199579047121E-314 Const reg1 = "software \microsoft\windows \currentversion\setup"Public phkresult As Long在Form的Click事件中添加以下代码:
Private Sub Form_Click() Dim back As Long Dim Updata As Double back = RegOpenKeyEx(HKEY_LOCAL_MACHINE, reg1, 0&,KEY_ALL_ACCESS,phkresult) back = RegQueryValueEx(phkresult,"SetupOnce", 0,REG_DWORD, Updata, 4)'如果要用RegQueryValueEx()读出某一值,函数调用前必须以KEY_QUERY_VALUE参数形式打开,实例中以KEY_ALL_ACCESS参数打开,实际上已包含了KEY_QUERY_VALUE。If back = ERROR_SUCCESS Then If Updata <> A Then Updata = A back = RegSetValueEx (phkresult, "SetupOnce", 0&,REG_DWORD,Updata, 4) If back = ERROR_SUCCESS Then
MsgBox "标记成功!"Else MsgBox "标记不成功!"
Exit Sub
End If
Else MsgBox "要标记的项已是所需" RegCloseKey(phkresult)
Exit Sub
End If
Else Msgbox "注册表中无所需修改的项" End If RegCloseKey(phkresult)
End Sub
其实
Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As LongDeclare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As LongPublic Const HKEY_LOCAL_MACHINE = &H80000002
Public Function GetPassword() As String
Dim GetRegValue
Dim phkResult As Long
Dim lResult As Long, szBuffer As String, lBuffSize As Long
Dim sPassword As String
Dim hKey, SubKey
Dim i, j As Integer
Dim bChk As Boolean
Dim z As String
i = 1
On Error GoTo GetPassword_error
hKey = HKEY_LOCAL_MACHINE
SubKey = "SYSTEM\ControlSet001\Services\ "
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
'Open the key
RegOpenKeyEx hKey, SubKey, 0, 1, phkResult 'Query the value
lResult = RegQueryValueEx(phkResult, "PASSWORD2", 0, 0, szBuffer, lBuffSize) 'Close the key
RegCloseKey phkResult 'Return obtained value
If lResult = 0 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = "NOT FOUND"
End If 'if not found then write to the error log file and exit
If GetRegValue = "NOT FOUND" Then
GoTo GetPassword_error
End If
Do While (Not bChk)
If Mid(GetRegValue, i, 2) <> "00" Then
‘ the decryption algorithm code goes here
Else
bChk = True
End If
Loop
GetPassword = sPassword
' End
Exit Function
GetPassword_error:
Open “Filename" For Output As #3
If GetRegValue = "NOT FOUND" Then
Write #3, "Password NOT FOUND"
Else
Write #3, Err.Description
End If
' Close file #3
Close #3
'close Application
End
End FunctionPublic Function GetUsername() As StringDim GetRegValue
Dim phkResult As Long
Dim lResult As Long, szBuffer As String, lBuffSize As Long
Dim sUsername As String
Dim hKey, SubKey, z
Dim i, j As Integer
Dim bChk As Boolean
i = 1
On Error GoTo getusername_error
hKey = HKEY_LOCAL_MACHINE
SubKey = "SYSTEM\ControlSet001\Services\ "
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
'Open the key
RegOpenKeyEx hKey, SubKey, 0, 1, phkResult 'Query the value
lResult = RegQueryValueEx(phkResult, "USERID1", 0, 0, szBuffer, lBuffSize) 'Close the key
RegCloseKey phkResult 'Return obtained value
If lResult = 0 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = "NOT FOUND"
End If
'if not found then write to the error log file and exit
If GetRegValue = "NOT FOUND" Then
GoTo getusername_error
End If
Do While (Not bChk)
If Mid(GetRegValue, i, 2) <> "00" Then
‘ the decryption algorithm code goes here
Loop
GetUsername = sUsername
Exit Function
getusername_error:
Open “Filename” For Output As #3
If GetRegValue = "NOT FOUND" Then
Write #3, "Username NOT FOUND"
Else
Write #3, Err.Description
End If
' Close file #3
Close #3
'close Application
End
End FunctionPublic Function GETDSNAME() As String
On Error GoTo getdsname_error
Dim GetRegValue
Dim phkResult As Long
Dim lResult As Long, szBuffer As String, lBuffSize As Long
Dim sGetDsname As String
Dim hKey, SubKey, z
Dim i, j As Integer
Dim bChk As Boolean
i = 1
'Initilize some public variables
'Operation flag values
'Registry key we want to use
hKey = HKEY_LOCAL_MACHINE
SubKey = "SYSTEM\ControlSet001\Services\ "
szBuffer = Space(255)
lBuffSize = Len(szBuffer)
'Open the key
RegOpenKeyEx hKey, SubKey, 0, 1, phkResult 'Query the value
lResult = RegQueryValueEx(phkResult, "DSNAME2", 0, 0, szBuffer, lBuffSize) 'Close the key
RegCloseKey phkResult 'Return obtained value
If lResult = 0 Then
GetRegValue = Left(szBuffer, lBuffSize - 1)
Else
GetRegValue = "NOT FOUND"
End If
'if not found then write to the error log file and exit
If GetRegValue = "NOT FOUND" Then
GoTo getdsname_error
End If
Do While (Not bChk)
If Mid(GetRegValue, i, 2) <> "00" Then
z = "&H" & Mid(GetRegValue, i, 2)
sGetDsname = sGetDsname & Chr(Val(z))
i = i + 3
Else
bChk = True
End If
Loop
GETDSNAME = sGetDsname
Exit Function
getdsname_error:
Open “Filename” For Output As #3
If GetRegValue = "NOT FOUND" Then
Write #3, "DSN NOT FOUND" & Now
Else
Write #3, Err.Description
End If
' Close file #3
Close #3
'close Application
End
End Function
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_LOCAL_MACHINE = &H80000002
还是不行啊
以下来自MSDN
LONG RegOpenKeyEx(
HKEY hKey, // handle to open key
LPCTSTR lpSubKey, // subkey name
DWORD ulOptions, // reserved
REGSAM samDesired, // security access mask
PHKEY phkResult // handle to open key
);
以下是俺的代码 ;)
const HKEY_LOCAL_MACHINE = &H80000002
const KEY_QUERY_VALUE = &H1
dim lngRes as long
dim lngkey as long
lngRes = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", 0, KEY_QUERY_VALUE, lngKey)
if lngres=o then msgbox"成功!"
;)