modregister.bas

一款飞机射击游戏的源代码

Attribute VB_Name = "ModRegister"
Option Explicit
Public Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public 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 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
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Const SYNCHRONIZE = &H100000
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_EXPAND_SZ = 2
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_NONE = 0
Public Const REG_RESOURCE_LIST = 8
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_SZ = 1
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CLASSES_ROOT = &H80000000


Public Sub MapEditRegister(ByVal AppPath As String, ByVal AppName)
    Dim KLA As Long
    Dim SE As SECURITY_ATTRIBUTES
    Dim RegStr As String
    RegCreateKeyEx HKEY_CLASSES_ROOT, ".smp", 0, REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SE, KLA, 0
    RegCreateKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar\DefaultIcon", 0, REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SE, KLA, 0
    RegCreateKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar\shell", 0, REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SE, KLA, 0
    RegCreateKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar\shell\open", 0, REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SE, KLA, 0
    RegCreateKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar\shell\open\command", 0, REG_SZ, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SE, KLA, 0
    
    RegOpenKeyEx HKEY_CLASSES_ROOT, ".smp", 0, KEY_ALL_ACCESS, KLA
        RegSetValueEx KLA, vbNullString, 0, REG_SZ, ByVal "Map for SkyWar", Len("Map for SkyWar")
    RegCloseKey KLA
    
    RegOpenKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar", 0, KEY_ALL_ACCESS, KLA
        RegSetValueEx KLA, vbNullString, 0, REG_SZ, ByVal "天空战记地图", Len("天空战记地图")
    RegCloseKey KLA
    
    RegStr = AppPath & "\ListPro\Icon.ICO"
    RegOpenKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar\DefaultIcon", 0, KEY_ALL_ACCESS, KLA
        RegSetValueEx KLA, vbNullString, 0, REG_SZ, ByVal RegStr, Len(RegStr)
    RegCloseKey KLA
    
    RegStr = AppPath & "\" & AppName & ".exe %1"
    RegOpenKeyEx HKEY_CLASSES_ROOT, "Map for SkyWar\shell\open\command", 0, KEY_ALL_ACCESS, KLA
        RegSetValueEx KLA, vbNullString, 0, REG_SZ, ByVal RegStr, Len(RegStr)
    RegCloseKey KLA
    
    
End Sub