如何遍历注册表,以及ini文件
解决方案 »
- 关于command的问题
- 自己写的记事本中怎么实现与系统自带的记事本一样的自动换行功能啦!
- COM+安装包求解
- 文本问题,100分
- 怎样连接虚拟主机上未知物理位置的access数据库?
- 高分请教?如何得到Z序列?
- error 3251 DAO.Recordset 是什么意思?
- TreeView控件的问题(急!急!急!在线等!!帮个忙吧!!)。
- 急,VB里调用OUTLOOK发Email, 请问如何设置发件人的信息(name, emailaddress)?
- 使用IE控件调用WORD或EXCEL文档,如何跳出主菜单(给30 分)
- 如何用代码将网页编码选择为简体中文(GB2312)?50分
- 网页里Script弹出的信息框怎么用代码关闭?
'****以下是一个读ini文件的函数****'
Public Function GetIniStr(ByVal FileName As String, _
ByVal Section As String, _
ByVal Key As String) As String
On Error Resume Next
Dim strRetVal As String
Dim strVer As String
Dim strDefValue As String
strDefValue = ""
GetIniStr = strDefValue strRetVal = String$(255, 0)
GetPrivateProfileString Section, Key, strDefValue, strRetVal, _
Len(strRetVal), FileName
strVer = left(strRetVal, InStr(strRetVal, Chr(0)) - 1) If strVer = "" Then
GetIniStr = strDefValue
Else
GetIniStr = strVer
End If
End Function
‘************函数中用到的API函数声明************
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) _
As Long
http://www.dapha.net/down/list.asp?id=1525
http://www.dapha.net/down/list.asp?id=1514
关于INI的
http://www.dapha.net/down/list.asp?id=921
http://www.dapha.net/down/list.asp?id=374
http://www.dapha.net/down/list.asp?id=409
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
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 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 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
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
'close the key
RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub
Private Sub Command1_Click()
Dim strString As String
'Ask for a value
strString = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry.", App.Title)
If strString = "" Or Val(strString) > 255 Or Val(strString) < 0 Then
MsgBox "Invalid value entered ...", vbExclamation + vbOKOnly, App.Title
Exit Sub
End If
'Save the value to the registry
SaveStringLong HKEY_CURRENT_USER, "KPD-Team", "BinaryValue", CByte(strString)
End Sub
Private Sub Command2_Click()
'Get a string from the registry
Ret = GetString(HKEY_CURRENT_USER, "KPD-Team", "BinaryValue")
If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
Private Sub Command3_Click()
'Delete the setting from the registry
DelSetting HKEY_CURRENT_USER, "KPD-Team", "BinaryValue"
MsgBox "The value was deleted ...", vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Command1.Caption = "Set Value"
Command2.Caption = "Get Value"
Command3.Caption = "Delete Value"
End Sub