求救？？？？？？？？？？？？？

    VB中如何实现注册表的读写

作者: 于爱武　---- “API”中专门提供了处理注册表的函数，不用说也知道，它们肯定功能强大（因为它们是API），但是它们的难度也是不小的。如果你是一个入门者的话，这大概会令你头痛一阵子。不过VB本身还提供了几个函数，专门用来处理注册表，相对来说它们就简单多了，所以我只对它们做一下说明： SaveSetting appname, section, key, value
---- 这句话的作用是将应用程序的信息存入注册表中。其中四个参数都是必要的，其含义分别为：应用程序名，区段，键，值。比如我们要为我们的程序（名为“测试”）的主窗体的位置进行存储，就可以写成： SaveSetting “测试”,”main”,”
    top”,frmMain.Top
SaveSetting “测试”,”main”,”
    Left”,frmMain.Left
SaveSetting “测试”,”main”,”
    Width”,frmMain.Width
SaveSetting “测试”,”main”,”
    Height”,frmMain.Height
---- 这样，就把当前的主窗体的位置进行了记录，在下次打开这个窗体的时候，我们就可以在把这些值取出来。那么如何才能把我们所存储的值取出来呢？这就要用到另一个函数：GetSetting，它的语法是： GetSetting(appname, section, key[, default])
---- 该函数的各部分的意义均和上面的函数的意义相同，所不同的是多了一个default而少了一个value。这个函数最后返回的结果即value值，而default指的是如果所指定的键不存在时，则以default指定的值为返回结果。如果没指定default，则default的默认值是””，即0长度的字符串。接上例，在程序刚开始的时候，我们应该取出上一次所存储的主窗体的位置，可以写成： frmMain.Top = GetSetting
    (“测试”,”main”,”top”)
frmMain.Left = GetSetting
    (“测试”,”main”,”Left”)
frmMain.Height = GetSetting
   (“测试”,”main”,”Height”)
frmMain.Width = GetSetting
    (“测试”,”main”,”Width”)
---- 好了，到此为止，可以暂且告一段落，让我们打开注册表，看一看我们把信息是记录在什么地方了。按照下面的路径打开： HKEY_CURRENT_USER\Software\VB And VBA Program Settings 你会看到你的“测试”就在里边放着。 ---- 当你的应用程序最终被卸载时，你应该考虑（而且你应该这样做）把你写入注册表中的内容清除掉，因为离开了你的应用程序，它们无疑就是一推垃圾而已。要想将它们删掉，我们可以用函数：DeleteSetting，它的语法如下：DeleteSetting appname, [section[, key]] 在几个参数中，只有appname是必须地，其它两项均可选。比如我们要删除窗体的“高”这键，则可以写成：DeleteSetting “测试”,”main”,”Height”如果我们要将”main”这个段整个去掉，则可以写成DeleteSetting “测试”,”main” 如果我们再彻底一些，想将整个应用程序去掉的话，就干脆直接写成： DeleteSetting  “测试”
---- 这种方法的不足之处是只能把信息记录在指定的位置，即 HKEY_CURRENT_USER\Software\VB
    And VBA Program Settings
---- 如果要写入到别的地方，就要借助于API了。

　
    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
其实,以上例程完全可以用做加密技术。国内某个带"霸"字的软件亦采用了类似的加密技术,当然,只是在加密的表现结果上表现而已。


　
    建立与读取.ini文件

　　'请於form中放3个TextBox，一个CommandBox
Private Declare Function GetPrivateProfileString Lib "kernel32"  _
   Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpDefault As String,  _
   ByVal lpReturnedString As String, ByVal nSize As Long, _
   ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32"  _
   Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
   ByVal lpKeyName As Any, ByVal lpString As Any, _
   ByVal lpFileName As String) As LongPrivate Sub Command1_Click()
Dim success As Long
success = WritePrivateProfileString("MyApp", "text1", Text1.Text, "c:\aa.ini")
'叁数一 Section Name
'叁数二於.ini中的项目
'叁数三项目的内容
'叁数四 .ini文件的名称
success = WritePrivateProfileString("MyApp", "text2", Text2.Text, "c:\aa.ini")
success = WritePrivateProfileString("MyApp2", "text3", Text3.Text, "c:\aa.ini")
End SubPrivate Sub Form_load()
Dim ret As Long
Dim buff As String
buff = String(255, 0)
ret = GetPrivateProfileString("Myapp", "text1", "text1", buff, 256, "c:\aa.ini")
'若.ini MyApp中无text1，则采用叁数三的值
Text1.Text = buff
buff = String(255, 0)
ret = GetPrivateProfileString("Myapp", "text2", "text2", buff, 256, "c:\aa.ini")
Text2.Text = buff
buff = String(255, 0)
ret = GetPrivateProfileString("Myapp2", "text3", "text3", buff, 256, "c:\aa.ini")
Text3.Text = buff
End Sub

调试易

求救？？？？？？？？？？？？？

解决方案 »