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

ASP
asp 实现对SQL注入危险字符进行重编码处理的函数
asp下实现对HTML代码进行转换的函数
asp 验证用户名是否包含有非常字符的函数
ASP通用分页样式函数代码
asp 生成任意英文+数字位数长度的随机码函数
asp 取得中文句子头一个字的大写拼音字母的函数
asp实现计算两个时间内的工作日的函数
asp实现过滤关键字的函数
asp实现限制搜索的关键字的函数
asp动态include文件,方便多模板的实现
推荐的用Asp实现屏蔽IP地址访问的代码
XDOWNPAGE ASP版本 分页类
飞云防CC攻击ASP程序代码插件
定期自动运行ASP程式的代码
ASP下Cookie操作的详细讲解
再发几个ASP不错的函数
比较不错的asp模板引终极讲解(WEB开发之ASP模式)
ip138之asp小偷程序代码
在VBScript中实现-函数/方法名作为参数传入另一个函数
asp实现批量插入表单中的数据到数据库的方法

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-11-03   浏览: 220 ::
收藏到网摘: 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