当前位置: 首页 > 图文教程 > 网络编程 > ASP > 将你的网站设置为客户的信任站点--VB方案

ASP
发送带附件的HTML格式邮件例程
调用winzip命令行对上传的多个文件打包压缩
怎样做自己的二级域名(之一)
怎样做自己的二级域名(之二)
怎样做自己的二级域名(之三)
从新浪提取上海天气的vbs
列出服务器上的打印机
2栏分页显示(附显示的形式[1][2])
2栏分页显示(附显示的形式前页,后页)
购物车范例(购物车页面 )
购物车范例(处理页面)
GB码和BIG5码的互换技术
在ASP中改善动态分页的性能
利用ASP实现对表的分页浏览(上)
利用ASP实现对表的分页浏览(下)
ASP后台快速调用Mysql 数据库
网络寻呼机数据库版发送消息tomessage.asp
网络寻呼机数据库版处理发送消息SubmitMessage.asp
网络寻呼机数据库版显示消息showmessage.asp
网络寻呼机数据库版显示历史消息history.asp

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-11-03   浏览: 93 ::
收藏到网摘: n/a

  发布于: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 = "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

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