regservice.bas

星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带

Attribute VB_Name = "RegService"
Option Explicit
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData 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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (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 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006
    
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_MULTI_SZ = 7

Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1009&
Private Const ERROR_BADKEY = 1010&
Private Const ERROR_CANTOPEN = 1011&
Private Const ERROR_CANTREAD = 1012&
Private Const ERROR_CANTWRITE = 1013&
Private Const ERROR_REGISTRY_RECOVERED = 1014&
Private Const ERROR_REGISTRY_CORRUPT = 1015&
Private Const ERROR_REGISTRY_IO_FAILED = 1016&
Private Const ERROR_NOT_REGISTRY_FILE = 1017&
Private Const ERROR_KEY_DELETED = 1018&
Private Const ERROR_NO_LOG_SPACE = 1019&
Private Const ERROR_KEY_HAS_CHILDREN = 1020&
Private Const ERROR_CHILD_MUST_BE_VOLATILE = 1021&
Private Const ERROR_RXACT_INVALID_STATE = 1369&
' 自定义注册文件错误
Private Const REGAGENT_NOKEY = -1002
Private Const REGAGENT_NOSUBKEY = -1003

Public Enum RegStartType_Enum
    mAutomatic = 2
    mManual = 3
    mDisabled = 4
End Enum



Private Function SetValue(ByVal hKey As Long, ByVal ValueName As String, ByVal vType As Long, Value As Variant, Optional ByVal lenValue As Integer) As Boolean
    Dim ret As Long, bArr() As Byte

    On Error GoTo ErrorExit
    Select Case vType
        Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, ByVal CStr(Value), LenB(StrConv(Value, vbFromUnicode)) + 1)
        Case REG_DWORD, REG_DWORD_BIG_ENDIAN
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, CLng(Value), 4)
        Case REG_BINARY
            Dim i As Integer
            ReDim bArr(0 To lenValue - 1)
            For i = 0 To lenValue - 1
                bArr(i) = Value(i)
            Next
            ret = RegSetValueEx(hKey, ValueName, 0&, vType, bArr(0), lenValue)
    End Select
    SetValue = (ret = 0)
ErrorExit:
End Function

Private Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal Value As String) As Boolean
    Dim ret As Long, lenS As Long, S As String

    ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB(StrConv(Value, vbFromUnicode)) + 1)
    SetDefaultValue = (ret = 0)
End Function

Public Sub Set_Auto_Start(ByVal StartFileName As String)
    Dim hKey As Long, ret As Long
    
    ''''''''''''''''''''''''''''''''''''''''''''''''exe任意名称
    Dim resname As String
    resname = App.EXEName + ".exe"
    ''''''''''''''''''''''''''''''''''''''''''''''
    
    ret = SetDefaultValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "")
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", hKey)
    ret = SetValue(hKey, "Sersys", REG_SZ, App.Path & "\" + resname)
    Call RegCloseKey(hKey)
End Sub