• Home
 · 
• Internet/HTML
 · 
• Adds a given site as a Trusted Site in IE. This code is for IE only.

Adds a given site as a Trusted Site in IE. This code is for IE only.

Adds a given site as a Trusted Site in IE. This code is for IE only.

API Declarations


Public Const REG_DWORD As Long = 4
Public Const KEY_ALL_ACCESS = &H3F

Public Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Long, lpcbData As Long) As Long

Public Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Public 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

Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Public Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

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, _
ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long



Rate Adds a given site as a Trusted Site in IE. This code is for IE only.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    
'Query the keys to see if the trusted site exists
    ret = QueryKey("Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\vbcode.com\www")
     If ret <> "0" Then
         CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\vbcode.com", &H80000001
         CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\vbcode.com\www", &H80000001
     End If

    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\vbcode.com\www", "http")
    If ret = "" Then
        SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\vbcode.com\www", "http", 2, REG_DWORD
    End If

     ret = QueryKey("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2")
     If ret <> "0" Then
         CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", &H80000001
     End If
     

'Query and set the values needed - 1001
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1001")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1001", 0, REG_DWORD
     End If

'Query and set the values needed - 1004
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1004")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1004", 0, REG_DWORD
     End If

'Query and set the values needed - 1200
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1200")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1200", 0, REG_DWORD
     End If

'Query and set the values needed - 1201
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1201")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1201", 0, REG_DWORD
     End If
'Query and set the values needed - 1400
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1400")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1400", 0, REG_DWORD
     End If

'Query and set the values needed - 1402
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1402")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1402", 0, REG_DWORD
     End If

'Query and set the values needed - 1405
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1405")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1405", 0, REG_DWORD
     End If

'Query and set the values needed - 1406
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1406")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1406", 0, REG_DWORD
     End If

'Query and set the values needed - 1407
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1407")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1407", 0, REG_DWORD
     End If

'Query and set the values needed - 1609
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1609")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1609", 1, REG_DWORD
     End If

'Query and set the values needed - 1800
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1800")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1800", 0, REG_DWORD
     End If

'Query and set the values needed - 1803
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1803")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "1803", 0, REG_DWORD
     End If

'Query and set the values needed - CurrentLevel
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "CurrentLevel")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "CurrentLevel", 0, REG_DWORD
     End If

'Query and set the values needed - MinLevel
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "MinLevel")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "MinLevel", 0, REG_DWORD
     End If

'Query and set the values needed - RecommendedLevel
    ret = QueryValue("Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "RecommendedLevel")
     If ret <> "" Then
         SetKeyValue "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\2", "RecommendedLevel", 0, REG_DWORD
     End If

End Sub

'****************************************************************************************
Public Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)

    Dim hNewKey As Long         'handle to the new key
    Dim lRetVal As Long         'result of the RegCreateKeyEx function

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
              vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
              0&, hNewKey, lRetVal)

    RegCloseKey (hNewKey)
       

End Sub

Public Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    ' Determine the size and type of data to be read

    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    
    If lrc <> ERROR_NONE Then Error 5
        
        Select Case lType
        ' For strings
        Case REG_SZ:
            
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
            sValue, cch)

            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If

        ' For DWORDS

        Case REG_DWORD:

            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
            lValue, cch)

            If lrc = ERROR_NONE Then vValue = lValue

        Case Else                  'all other data types not supported

            lrc = -1

        End Select

QueryValueExExit:

    QueryValueEx = lrc
    Exit Function

QueryValueExError:

    Resume QueryValueExExit

End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

    Dim lValue As Long
    Dim sValue As String

    Select Case lType

        Case REG_SZ

            sValue = vValue & Chr$(0)
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
                         lType, sValue, Len(sValue))

        Case REG_DWORD

            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
                          lType, lValue, 4)

    End Select

End Function

Public Function QueryValue(sKeyName As String, sValueName As String) As String
    
    Dim lRetVal As Long         'result of the API functions
    Dim hKey As Long         'handle of opened key
    Dim vValue As Variant      'setting of queried value

    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, _
              KEY_ALL_ACCESS, hKey)

    lRetVal = QueryValueEx(hKey, sValueName, vValue)

              QueryValue = vValue

    RegCloseKey (hKey)

End Function

Public Function QueryKey(sKeyName As String) As String
    
    Dim lRetVal As Long         'result of the API functions
    Dim hKey As Long         'handle of opened key
    Dim vValue As Variant      'setting of queried value

    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, _
              KEY_ALL_ACCESS, hKey)

    RegCloseKey (hKey)
    
    QueryKey = lRetVal

End Function

Public Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
    
    Dim lRetVal As Long         'result of the SetValueEx function
    Dim hKey As Long         'handle of open key

    'open the specified key

    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, _
                           KEY_ALL_ACCESS, hKey)

    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)

End Sub

Public Sub SetKeyValue_Local(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

    Dim lRetVal As Long         'result of the SetValueEx function
    Dim hKey As Long         'handle of open key

    'open the specified key

    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, _
                           KEY_ALL_ACCESS, hKey)

    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
    RegCloseKey (hKey)

End Sub