广告：
网页制作参考
千千学园
雨路开发频道
雨路技术文档
技术问答
编程技术

作者： unknow

将程序生成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