modregistry2.bas

Usb Key loock vb soucrse code. ocx not found

Attribute VB_Name = "modRegistry2"
Option Explicit

'Public Const HKEY_CLASSES_ROOT = &H80000000
'Public Const HKEY_CURRENT_USER = &H80000001
'Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&

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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) 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
Public Const REG_SZ = 1 ' Unicode nul terminated String
Public Const REG_DWORD = 4 ' 32-bit number


Public Function RegiSaveKey(ByVal hKey As Long, ByVal strPath As String) As Long
'//***************************************************************************************
'//        扁瓷 : Registry俊 Key甫 历厘茄促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strPath - 技何 版肺
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 角菩沁阑 版快 ERROR_SUCCESS啊 酒囱蔼(0焊促 奴蔼)阑 馆券
'//
'//     荤侩 抗 : Call RegiSaveKey(HKEY_CURRENT_USER, "Software\ORACLE2")
'//
'// 弥檬 累己老 : 2001-12-20
'// 弥辆 荐沥老 : 2001-12-20
'//***************************************************************************************
   
   Dim lngKeyHWnd                       As Long
   
   
   
   RegiSaveKey = RegCreateKey(hKey, strPath, lngKeyHWnd)
   Call RegCloseKey(lngKeyHWnd)
   
End Function


Public Function RegiGetString(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As String
'//***************************************************************************************
'//        扁瓷 : Registry狼 巩磊凯阑 掘绰促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strPath - 技何 版肺
'//               strValueName - Key 亲格
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 己傍 : 秦寸窍绰 虐蔼
'//
'//     荤侩 抗 : Text1.Text = RegiGetString(HKEY_CURRENT_USER, "Software\ORACLE", "Path")
'//
'// 弥檬 累己老 : 2001-12-20
'// 弥辆 荐沥老 : 2001-12-20
'//***************************************************************************************
   
   Dim lngKeyHWnd                   As Long
   Dim lngDataType                  As Long
   Dim lngResult                    As Long
   Dim strBuf                       As String
   Dim lngDataBufSize               As Long
   Dim intZeroPos                   As Integer
   
   
   
   Call RegOpenKey(hKey, strPath, lngKeyHWnd)
   lngResult = RegQueryValueEx(lngKeyHWnd, strValueName, 0&, lngDataType, ByVal 0&, lngDataBufSize)

   If lngDataType = REG_SZ Then
       strBuf = String(lngDataBufSize, " ")
       lngResult = RegQueryValueEx(lngKeyHWnd, strValueName, 0&, 0&, ByVal strBuf, lngDataBufSize)

       If lngResult = ERROR_SUCCESS Then
           intZeroPos = InStr(strBuf, Chr$(0))

           If intZeroPos > 0 Then
               RegiGetString = Left$(strBuf, intZeroPos - 1)
           Else
               RegiGetString = strBuf
           End If
       End If
   End If
   
End Function


Public Function RegiSaveString(ByVal hKey As Long, ByVal strPath As String, _
                               ByVal strValueName As String, ByVal strData As String) As Long
'//***************************************************************************************
'//        扁瓷 : Registry俊 巩磊凯阑 历厘茄促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strPath - 技何 版肺
'//               strValueName - Key 亲格
'//               strData - 历厘且 巩磊凯
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 角菩沁阑 版快 ERROR_SUCCESS啊 酒囱蔼(0焊促 奴蔼)阑 馆券
'//
'//     荤侩 抗 : Call RegiSaveString(HKEY_CURRENT_USER, "Software\ORACLE", "Path", "C:\Temp")
'//
'// 弥檬 累己老 : 2001-12-20
'// 弥辆 荐沥老 : 2001-12-20
'//***************************************************************************************
   
   Dim lngKeyHWnd                   As Long
   
   
   
   Call RegCreateKey(hKey, strPath, lngKeyHWnd)
   '// 啊厘 场狼 巩磊凯狼 辨捞何盒(Len())篮 2000捞唱 XP俊辑绰 茄臂篮 2byte肺 牢侥茄促.
   '// 98篮 1byte肺 牢侥窍骨肺 2000捞惑俊辑绰 饭瘤胶飘府俊 蔼阑 历厘且锭 茄臂捞 甸绢啊搁 缔何盒捞 漏赴促.
   RegiSaveString = RegSetValueEx(lngKeyHWnd, strValueName, 0, REG_SZ, ByVal strData, Len(strData))
   Call RegCloseKey(lngKeyHWnd)
   
End Function


Function RegiGetDWord(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
'//***************************************************************************************
'//        扁瓷 : Registry狼 DWord蔼甫 掘绰促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strPath - 技何 版肺
'//               strValueName - Key 亲格
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 己傍 : 秦寸窍绰 虐蔼          角菩 : -1
'//
'//     荤侩 抗 : Text1.Text = RegiGetDWord(HKEY_CURRENT_USER, "Software\ORACLE", "Path")
'//
'// 弥檬 累己老 : 2001-12-20
'// 弥辆 荐沥老 : 2001-12-20
'//***************************************************************************************

    Dim lngResult                   As Long
    Dim lngValueType                As Long
    Dim lngBuf                      As Long
    Dim lngDataBufSize              As Long
    Dim lngKeyHWnd                  As Long
    
    
    
    Call RegOpenKey(hKey, strPath, lngKeyHWnd)
    ' Get length/data type
    lngDataBufSize = 4
    RegiGetDWord = RegQueryValueEx(lngKeyHWnd, strValueName, 0&, lngValueType, lngBuf, lngDataBufSize)
    
    
    If lngResult = ERROR_SUCCESS Then
        If lngValueType = REG_DWORD Then
            RegiGetDWord = lngBuf
        Else
            RegiGetDWord = -1
        End If
    End If
    
    Call RegCloseKey(lngKeyHWnd)

End Function


Public Function RegiSaveDWord(ByVal hKey As Long, ByVal strPath As String, _
                              ByVal strValueName As String, ByVal lngData As Long) As Long
'//***************************************************************************************
'//        扁瓷 : Registry俊 DWord蔼阑 历厘茄促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strPath - 技何 版肺
'//               strValueName - Key 亲格
'//               lngData - 历厘且 蔼
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 角菩沁阑 版快 ERROR_SUCCESS啊 酒囱蔼(0焊促 奴蔼)阑 馆券
'//
'//     荤侩 抗 : Call RegiSaveDWord(HKEY_CURRENT_USER, "Software\ORACLE", "Path", 345)
'//
'// 弥檬 累己老 : 2001-12-20
'// 弥辆 荐沥老 : 2001-12-20
'//***************************************************************************************
   
    Dim lngResult                   As Long
    Dim lngKeyHWnd                  As Long
    
    
    
    Call RegCreateKey(hKey, strPath, lngKeyHWnd)
    RegiSaveDWord = RegSetValueEx(lngKeyHWnd, strValueName, 0&, REG_DWORD, lngData, 4)
    Call RegCloseKey(lngKeyHWnd)

End Function


Public Function RegiDeleteKey(ByVal hKey As Long, ByVal strKey As String) As Long
'//***************************************************************************************
'//        扁瓷 : Registry狼 虐甫 昏力茄促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strKey - 技何 版肺
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 角菩沁阑 版快 ERROR_SUCCESS啊 酒囱蔼(0焊促 奴蔼)阑 馆券
'//
'//     荤侩 抗 : Call RegiDeleteKey(HKEY_CURRENT_USER, "Software\ORACLE")
'//
'// 弥檬 累己老 : 2001-12-19
'// 弥辆 荐沥老 : 2001-12-19
'//***************************************************************************************
   
   RegiDeleteKey = RegDeleteKey(hKey, strKey)
   
End Function


Public Function RegiDeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
'//***************************************************************************************
'//        扁瓷 : Registry狼 蔼甫 昏力茄促.
'//        牢荐 : Hkey - Head Key(老馆狼 急攫俊 惑荐曼炼)
'//               strPath - 技何 版肺
'//               strValueName - Key 亲格
'//
'//   利侩 裹困 : 饭瘤胶飘府狼 葛电 虐蔼
'//      馆券蔼 : 角菩沁阑 版快 ERROR_SUCCESS啊 酒囱蔼(0焊促 奴蔼)阑 馆券
'//
'//     荤侩 抗 : Call RegiDeleteValue(HKEY_CURRENT_USER, "Software\ORACLE", "Path")
'//
'// 弥檬 累己老 : 2001-12-20
'// 弥辆 荐沥老 : 2001-12-20
'//***************************************************************************************
   
    Dim lngKeyHWnd                      As Long
    
    
    
    Call RegOpenKey(hKey, strPath, lngKeyHWnd)
    RegiDeleteValue = RegDeleteValue(lngKeyHWnd, strValueName)
    Call RegCloseKey(lngKeyHWnd)
    
End Function