PRivate Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByRef phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 Sub Form_Load() Call SetTrustedSite(App.EXEName) Unload Me End Sub
'//Set Trust site Private Function SetTrustedSite(ByVal StrSiteName As String) On Error GoTo Errhandle Dim nKeyHandle, KeyValue, Iresult As Long Dim StrkeyPath As String StrkeyPath = "Software/Microsoft/Windows/CurrentVersion/Internet Settings/ZoneMap/Domains/" StrkeyPath = StrkeyPath & SplitSiteName(StrSiteName) KeyValue = 2 Call RegCreateKey(HKEY_CURRENT_USER, StrkeyPath, nKeyHandle) Iresult = RegSetValueEx(nKeyHandle, "http", 0, REG_DWORD, KeyValue, 4) If Iresult = 0 Then MsgBox "You have accept http://" & StrSiteName & " as your Trusted Site!" Else MsgBox "Fail add http://" & StrSiteName & " as your Trusted Site!" End If Call RegCloseKey(nKeyHandle) Exit Function Errhandle: MsgBox "Fail add http://" & StrSiteName & " as your Trusted Site!" End Function
'// Split SiteName '// "A.B.C.D.E" ----> "D.E/A.B.C" '// "A.B.C.D" ----> "C.D/A.B" '// "A.B.C" ----> "B.C/A" '// "A.B" ----> "A.B" '// "A" ----> "A" Private Function SplitSiteName(ByVal StrSiteName As String) As String Dim ArraySiteName Dim IntArrayLen, I As Integer Dim StrSplitSite As String
If IntArrayLen > 1 Then StrSplitSite = ArraySiteName(IntArrayLen - 1) & "." & ArraySiteName(IntArrayLen) & "/" For I = 0 To IntArrayLen - 2 If I = 0 Then StrSplitSite = StrSplitSite & ArraySiteName(I) Else StrSplitSite = StrSplitSite & "." & ArraySiteName(I) End If Next SplitSiteName = StrSplitSite Else SplitSiteName = StrSiteName End If
