将你的网站设置为客户的信任站点--VB方案

　　发布于：2002-1-1
将程序生成EXE,文件名即为你的网站名称

Const HKEY_CLASSES_ROOT = -2147483648#
Const HKEY_CURRENT_USER = -2147483647#
Const HKEY_LOCAL_MACHINE = -2147483646#
Const HKEY_USERS = -2147483645#


Const REG_SZ = 1 字符串值
Const REG_BINARY = 3 二?制值
Const REG_DWORD = 4 DWORD 值


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 = SoftwareMicrosoftWindowsCurrentVersionInternet SettingsoneMapDomains
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
Else
MsgBox Fail add
End If
Call RegCloseKey(nKeyHandle)
Exit Function
Errhandle:
MsgBox Fail add
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

ArraySiteName = Split(StrSiteName, .)
IntArrayLen = UBound(ArraySiteName)

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

End Function