2013-01-23 131 views

回答

0

這裏是如何做到這一點在VB6,需要將其轉換

Const REG_SZ As Long = 1 
Const HKEY_CURRENT_USER = &H80000001 
Const HKEY_LOCAL_MACHINE = &H80000002 
Const KEY_SET_VALUE = &H2 
Const KEY_ALL_ACCESS = &H3F 
Const REG_OPTION_NON_VOLATILE = 0 
Const HWND_BROADCAST = &HFFFF 
Const WM_SETTINGCHANGE = &H1A 



Private Declare Function RegCloseKey Lib "advapi32.dll" _ 
    (ByVal hKey As Long) As Long 
Private 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, ByVal lpSecurityAttributes As Long, _ 
    phkResult As Long, lpdwDisposition As Long) As Long 
Private 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 
Private Declare Function RegSetValueExString Lib "advapi32.dll" _ 
    Alias "RegSetValueExA" (ByVal hKey As Long, _ 
    ByVal lpValueName As String, ByVal Reserved As Long, _ 
    ByVal dwType As Long, ByVal lpValue As String, _ 
    ByVal cbData As Long) As Long 
Private Declare Function SendMessage Lib "user32" _ 
    Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _ 
    ByVal wParam As Long, lparam As String) As Long 
Public Function SetClient(iClient As Integer, sDisplayName As String, _ 
    sClientCommandLine As String, sClientResourceDLL As String, _ 
    iLocalization As Integer, bGlobalClient As Boolean, _ 
    Optional sCLParameters As String, Optional bMakeDefault As Boolean) As Integer 

    ' iClient - 1 for internet browser, 2 for e-mail client 
    ' sDisplayName - the name to be displayed on the menu for the client 
    ' sClientCommandLine - the path and filename of the e-mail client 
    ' 
    ' The next two parameters are included for localization of the client. 
    ' For backwards compatibility with applications that do not support localized 
    ' strings, the name of the application in the installed language should be set 
    ' as the Default value for the key. 
    ' sClientResourceDLL - provides a path to an EXE or DLL containing the 
    ' localized strings for the client. 
    ' iLocalization - a string resource ID within the DLL whose value is 
    ' to be displayed to the user allowing the same registration to 
    ' be used for multiple languages. For each language, provide a 
    ' different Resource DLL, and the dynamic loading of the string 
    ' from the DLL results in the correct strings being displayed, depending 
    ' on the language. 
    ' 
    ' bGlobalClient - sets the value for either all users (True) or the 
    ' current user (False) 
    ' sCLParameters - additional parameters on the command line to be passed to the 
    ' browser or e-mail client. 
    ' bMakeDefault - (Optional) set the browser or e-mail application as the default 

    Dim iStatus As Integer 
    Dim hHandle As Long 
    Dim hGRegKey As String 
    Dim hLRegKey As String 
    Dim sCommand As String 
    Dim sKey As String 
    Dim sAll As String 
    Dim sRoot As String 
    Dim hKey As Long 
    Dim sLoc As String 
    hGRegKey = HKEY_LOCAL_MACHINE 
    hLRegKey = HKEY_CURRENT_USER 


    If iClient = 1 Then 
    sRoot = "Software\Clients\StartMenuInternet" 
    Else 
    sRoot = "Software\Clients\Mail" 
    End If 

    ' Create and null terminate needed strings 
    sCommand = "shell\open\command" 
    sKey = sRoot & "\" & sDisplayName 
    sAll = sKey & "\" & sCommand 
    sLoc = "@" & sClientResourceDLL & "," & iLocalization & Chr$(0) 
    sClientLocation = """" & sClientCommandLine & """" & _ 
    IIf(sCLParameters <> "", " ", "") & Trim(sCLParameters) & Chr$(0) 
    sDisplayName = sDisplayName & Chr$(0) 

    ' Create a registry key for the new client 
    iStatus = RegCreateKeyEx(hGRegKey, sKey, 0&, vbNullString, _ 
    REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal) 
    iStatus = RegCreateKeyEx(hGRegKey, sAll, 0&, vbNullString, _ 
    REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal) 
    If iStatus = ERROR_NONE Then 
    iStatus = RegOpenKeyEx(hGRegKey, sAll, 0, KEY_SET_VALUE, hKey) 
    iStatus = RegSetValueExString(hKey, "", 0&, REG_SZ, sClientLocation, _ 
     Len(sClientLocation)) 
    iStatus = RegCloseKey(hKey) 
    iStatus = RegOpenKeyEx(hGRegKey, sKey, 0, KEY_SET_VALUE, hKey) 
    iStatus = RegSetValueExString(hKey, "", 0&, REG_SZ, sDisplayName, _ 
     Len(sDisplayName)) 
    ' Add the localization string 
    iStatus = RegSetValueExString(hKey, "LocalizedString", 0&, REG_SZ, _ 
     sLoc, Len(sLoc)) 
    iStatus = RegCloseKey(hKey) 
    Else 
    SetClient = iStatus 
    Exit Function 
    End If 

    ' Sets browser as local or global default if specified 
    If bMakeDefault Then 
    If bGlobalClient Then 
     iStatus = RegOpenKeyEx(hGRegKey, sRoot, 0, KEY_SET_VALUE, hKey) 
     iStatus = RegSetValueExString(hKey, "", 0&, REG_SZ, sDisplayName, _ 
     Len(sDisplayName)) 
     iStatus = RegCloseKey(hKey) 
    Else 
     iStatus = RegCreateKeyEx(hLRegKey, sRoot, 0&, vbNullString, _ 
     REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal) 
     iStatus = RegSetValueExString(hNewKey, "", 0&, REG_SZ, _ 
     sDisplayName, Len(sDisplayName)) 
     iStatus = RegCloseKey(hNewKey) 
    End If 
    UpdateMenus 
    End If 
End Function 
Private Sub UpdateMenus() 
    ' Refresh the menu choices with the updated client 
    Dim iRetVal As Integer 
    iRetVal = SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, _ 
    "SOFTWARE\Clients\mail") 
    iRetVal = SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, _ 
    "SOFTWARE\Clients\StartMenuInternet") 
End Sub 

Microsoft