'==================================================== ============== 'function name: addWebsiteHostName' function function: Add a new host head in the host header in the existing site to add a new host head 'INDEX site number' newwebtop Host head string 'development member : MMC (mmcgzs@hotmail.com) '======================================== ======================= Public Function AddWebsiteHostName (Index, NewWebtop)
On Error Resume Next Dim tmpwebtop, ztop, oWebServer, tmpstring, Computer Computer = "localhost" Set oWebServer = GetObject ( "IIS: //" & Computer & "/ w3svc /" & index) tmpwebtop = oWebServer.serverbindings' '' Gets Original host head tmpstring = Join (Tmpwebtop, "||") IF INSTR (Tmpstring, "|||" & newwebtop & "||") or ins (TMPSTRING, "|||" & newwebtop) or instr (tmpstring, NewWebTop & "|||") = 1 Then oWebServer.serverbindings = tmpwebtop Else ReDim Preserve tmpwebtop (UBound (tmpwebtop) 1) tmpwebtop (UBound (tmpwebtop)) = NewWebTop oWebServer.serverbindings = tmpwebtop End If oWebServer.SetInfo If Err.Number <> 0 THEN CALL ERRMESSAGE ("accidental error, please contact the administrator.") Err.clerend Function
'==================================================== ============== 'function name: DelwebsiteHostName' function function: Remove a host head 'INDEX Site No.' Webtop Host Head String 'in the Host Head of Sites: MMC (mmcgzs@hotmail.com) '========================================= ====================== Public Function DelwebsiteHostName (Index, Webtop) on Error Resume Next Dim TmpWebtop, Ztop, Oweb Server, Tmpstring, Computer, i Computer = "localhost "Set OweBServer = getObject (" IIS: // "& Computer &" / W3SVC / "& index) TmpWebtop = OwebServer.serverbindings '' gets the original header TmpString = Join (TmpWebtop," || ") if Instr (TMPSTRING, "|||" & Webtop & "|||") or ins (TMPSTRING, "|||" & Webtop) OR INSTR (Tmpstring, Webtop & "||") = 1 for i = 0 To UBound (tmpwebtop) If i> UBound (tmpwebtop) Then Exit For If tmpwebtop (i) = WebTop Then tmpwebtop (i) = tmpwebtop (UBound (tmpwebtop)) ReDim Preserve tmpwebtop (UBound (tmpwebtop) - 1) End If Next owebserver.serverbindings =
Tmpwebtop end if Owebserver.setInfoif err.Number <> 0 THEN CALL ErrMessage ("accident error, please contact your administrator.") Err.clear
END FUNCTION
