IIS服务器备份转移解决方案(二)

三：导出所要转移IIS服务的所有计算机用名

     因为每台IIS服务器可能不只一两个这样的计算机用户，手动创建是不行的，如果一旦服务器出错了，就没有办法在短时间恢复了。

     把下面的脚本保存为 backusers.vbs

******************************Start*********************************

Dim colGroups
Set colGroups = GetObject("WinNT://" & getComputer() & "/guests,group")
    For Each objUser in colGroups.Members
        Wscript.Echo objUser.Name &"||"& objUser.FullName &"||"& objUser.Description
    Next
Function getComputer()
Dim objNet
Set objNet = CreateObject("WScript.Network")
getComputer= objNet.ComputerName
Set objNet = Nothing
End Function

**************************Finished**********************************

 

执行备份操作只备份的是guests组用户 backupusers.vbs >userback.txt

 

四：导出IIS的虚拟主机配置

    保存以下程序 backupiis.vbs

*******************************Start******************************

 

On Error Resume Next
Set objIIS = GetObject("IIS://" & getComputer() & "/W3SVC")
LenComputer = Len(getComputer())+13'记算IISWEBSERVER的长度
For Each ChildObject in objIIS
If ChildObject.Class = "IIsWebServer" Then
   Bindings = ChildObject.ServerBindings
   'Wscript.echo Bindings(0)
   ChildObjectName = Replace(ChildObject.AdsPath,Left(ChildObject.AdsPath,LenComputer),"")
   If IsNumberic(ChildObjectName) = True Then
    Set iis_webserver = objIIS.GetObject("IIsWebServer",ChildObjectName)
     Err.clear
     If Err <> 0 Then
      wscript.echo "select "&ChildObjectName&" failure...."
     End If
     Err.clear
    Set iis_visualdir = iis_webserver.GetObject("IIsWebVirtualDir","root")
     If Err<> 0 Then
      wscript.echo "select "&ChildObjectName&" failure....2"
     End If
    If (iis_webserver.ServerComment <> "默认网站") Then
     WebServerBindings = Bindings(0)
     If (Bindings(1)) Then
      WebServerBindings = Bindings(0)&"#"&Bindings(1)
     End If
     If (Bindings(2)) Then
        WebServerBindings = Bindings(0)&"#"&Bindings(1)&"#"&Bindings(2)
     End If
     If (Bindings(3)) Then
      WebServerBindings = Bindings(0)&"#"&Bindings(1)&"#"&Bindings(2)&"#"&Bindings(3)
     End If
     If (Bindings(4)) Then
      WebServerBindings = Bindings(0)&"#"&Bindings(1)&"#"&Bindings(2)&"#"&Bindings(3)&"#"&Bindings(4)
     End If
     If (Bindings(5)) Then
      WebServerBindings = Bindings(0)&"#"&Bindings(1)&"#"&Bindings(2)&"#"&Bindings(3)&"#"&Bindings(4)&"#"&Bindings(5)
     End If
     Wscript.echo WebServerBindings&"||"& iis_webserver.ServerComment &"||"& iis_webserver.ServerAutoStart&"||"&iis_visualdir.AnonymousUserName&"||"&iis_visualdir.AnonymousUserPass&"||"&iis_visualdir.AppPoolId&"||"&iis_visualdir.Path
    End If
        Else
     Wscript.echo "failure...."
   End If
Else
    End If
Next
Set iis_visualdir = Nothing
Set iis_webserver = Nothing
Set objIIS = Nothing

Function getComputer()
Dim objNet
Set objNet = CreateObject("WScript.Network")
getComputer= objNet.ComputerName
Set objNet = Nothing
End Function
********************************End********************************

执行backupiis.vbs >backupiis.txt

 

五：导入计算机用户名：

    保存以下脚本为 createusers.vbs

********************************Start*****************************

 

 

Const ForReading = 1,ForWriting = 2, ForApplying = 8
dim fso,f,msg
Dim strComputer,user_password,GroupName
   user_password = "**********"
GroupName = "Guests"
Set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile("C:\Inetpub\tms-bbs.com\backupuser.txt",ForReading)
    Do until f.AtEndOfStream
     strLine = f.readline
     userAttribute = Split(strLine,"||",-1)
     userComputer = userAttribute(0)
     userInfo = userAttribute(1)
     userDescription = userAttribute(2)
   AddUser getComputer(),userComputer,user_password,userInfo,userDescription,GroupName
   Wscript.echo vblf
loop
f.close

Function AddUser(Computer,UserName,PassWord,FullName,Info,GroupName)
DIM intReturn,FsObject
On Error Resume Next
'执行创建帐号命令
Set ComputerAccoutObj = GetObject("WinNT://"&Computer&"/"&UserName&",user")
if Err.number=0 then
Wscript.echo UserName&"计算机用户已存在...."
Else
Set ComputerObj = GetObject("WinNT://"&Computer)
Set NewUser = ComputerObj.Create( "User" , UserName )
NewUser.SetInfo
'进行帐号设置
NewUser.SetPassword ( PassWord ) '帐号密码
NewUser.FullName = FullName '帐号全名
NewUser.Description = Info '帐号说明
NewUser.UserFlags = &H10000 xor &H0040 '&H20000(使用者下次登入时须变更密码) &H0040(使用者不得变更密码) &H10000(密码永久正确) &H0002(帐户暂时停用)
NewUser.SetInfo
Wscript.echo "帐号"&UserName&"创建成功！"
Set objSeLectGroup = GetObject("WinNT://" & Computer & "/Guests,group")
Set objAddUser = GetObject("WinNT://" & Computer & "/" & UserName &",user")
objSeLectGroup.Add(objAddUser.ADsPath)
End if   
Set ComputerObj=nothing
Set ComputerAccoutObj = nothing
Set ComputerAccoutGroupObj = nothing
End Function

 

Function getComputer()
Dim objNet
Set objNet = CreateObject("WScript.Network")
getComputer= objNet.ComputerName
Set objNet = Nothing
End Function

************************************End****************************

执行createusers.vbs(注意把刚才导出来的计算机用户信息放在程序中指定的位置)

程序自动开始创建计算机用户名：

六：终于到了最后一步了，创建虚拟主机

保存为createwebsite.vbs

*****************************Start*********************************

Const ForReading = 1,ForWriting = 2, ForApplying = 8
Dim SiteNum,IPAddr,PortNum,fso,f,msg,LenComputer,BuildNum
Dim strComputer,user_password,GroupName,tmpFolder
user_password = "*************"
GroupName = "Guests"
IPAddr = ""
tmpFolder = "C:\inetpub\"
LenComputer = Len(getComputer())+1
BuildNum = 1
'PortNum = "80"
Set fso = CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile("C:\Inetpub\tms-bbs.com\iiswebback.txt",ForReading)
Do until f.AtEndOfStream
   strLine = f.readline
   IIsWebVirtualDirAttribute = Split(strLine,"||",-1)
   WebServerBingings = IIsWebVirtualDirAttribute(0)
   WebServerComment = IIsWebVirtualDirAttribute(1)
   WebServerAutoStart = IIsWebVirtualDirAttribute(2)
   WebAnonymousUserName = IIsWebVirtualDirAttribute(3)
   WebAnonymousUserPass = IIsWebVirtualDirAttribute(4)
   WebAppPoolId = IIsWebVirtualDirAttribute(5)
   WebPath = IIsWebVirtualDirAttribute(6)
   SeveralBindings = Split(WebServerBingings,"#",-1)
   UserNameComp = Replace(WebAnonymousUserName,Left(WebAnonymousUserName,LenComputer),"")
   '检测是否存在该用户的计算机帐号
   If Not checkUser(UserNameComp) Then
    '添加该计算机用户帐号
    AddUser getComputer(),UserNameComp,user_password,WebServerComment,WebServerComment,GroupName
   Else
    Wscript.echo "该计算机用户名也存在.............."
   End If
   '创建用户主目录
   CreateFileDirectory(WebPath)
   '修改用户主目录的访问权限
   SetNTFSDirectoryPerssion(UserNameComp)
   '创建应用进程池
   createAppPool WebServerComment,GuestUserName,GuestUserPass
   '创建虚拟主机站点
   CreateWebSite getComputer(),IPAddr,SeveralBindings(0),WebPath,LogDirectory,WebServerComment,WebAnonymousUserName,WebAnonymousUserPass,WebServerAutoStart  
   BuildNum = BuildNum+1
   Wscript.echo "=============================================="&BuildNum&"============================================="
Loop
f.close
Set fso = Nothing

'为每个IIS虚拟主机应用程序站点创建站点应用程序池
Function createAppPool(strName, strUser, strPass)
On Error Resume Next
Err.Clear
   'If Not checkUser(strUser) Then
      'createAppPool = false
      'Wscript.echo"应用程序"&strName&"无法创建！"
      'Exit Function
   'End If
   Set ObjAppPoolsExist = GetObject("IIS://"&getComputer()&"/W3SVC/AppPools"&strName)
   If Err.number = 0 Then
    wscript.echo "该应用进程池已创建............."
    Set ObjAppPoolsExist = Nothing
    Exit Function
   Else
     Set objAppPools = GetObject("IIS://" & getComputer() & "/W3SVC/AppPools")
     Err.Clear
     Set objAppPool = objAppPools.Create("IIsApplicationPool", strName)
     If err.number = 0 Then
        objAppPool.AppPoolIdentityType    = 2 'runs as NT AUTHORITY\NETWORK 3 Run as specific user account 1 runs as NT AUTHORITY\LOCAL SERVICE 0 runs as NT AUTHORITY\SYSTEM
     'objAppPool.WAMUserName       = strUser
        'objAppPool.WAMUserPass       = strPass
     objAppPool.SetInfo
     If err.Number = 0 Then
       createAppPool = true
             Wscript.echo"应用程序"&strName&"创建成功！"
        Else
       createAppPool = false
          Wscript.echo"应用程序"&strName&"创建失败！"
        End If
     Else
         createAppPool = false
     End If
     End If
   Set objAppPool = Nothing
   Set objAppPools = Nothing
   Set ObjAppPoolsExist = Nothing
End Function

Function CreateWebSite(strComputer,IPAddr,WebServerBingings,WebSiteDirectory,LogDirectory,WebSiteInfo,GuestUserName,GuestUserPass,StartOrStop)
Dim w3svc, WebServer, NewWebServer, NewDir
Dim Bindings, BindingString, NewBindings, SiteNum, SiteObj, bDone
On Error Resume Next
Err.Clear
'检测是否能够加载W3SVC服务（即WEB服务）
Set w3svc = GetObject("IIS://" & getComputer() & "/w3svc")
If Err.Number <> 0 Then '显示错误提示
   Wscript.echo "无法打开: "&"IIS://" & getComputer() & "/w3svc"
   Exit Function
End If
'检测是否有设定相同IP地址、端口及主机名的站点存在  
BindingString = IPAddr & WebServerBingings
For Each WebServer in w3svc
   If WebServer.Class = "IIsWebServer" Then
    Bindings = WebServer.ServerBindings
    If BindingString = Bindings(0) Then
     Wscript.echo "虚拟主机:" & HostName & ",已存在，无法创建......！."
     Exit Function
    End If
   End If
Next

'确定一个不存在的站点编号做为新建站点编号，系统默认WebSite站点编号为1，因此从2开始
SiteNum=2
bDone = False
While (Not bDone)
   Err.Clear
   Set SiteObj = GetObject("IIS://"&getComputer()&"/w3svc/"&SiteNum) '加载指定站点
   If (Err.Number = 0) Then
      'Wscript.echo " Step_1站点"&SiteNum&"存在"
    SiteNum = SiteNum + 1
   Else
    'Wscript.echo " Step_1站点"&SiteNum&"不存在"
    Err.Clear
    Set NewWebServer = w3svc.Create("IIsWebServer",SiteNum) '创建指定站点
    If (Err.Number <> 0) Then
     Wscript.echo SiteNum&"创建失败"
     SiteNum = SiteNum + 1
    Else
     Wscript.echo SiteNum&"创建成功"
     bDone = True
    End If
   End If
   If (SiteNum > 1000) Then '服务器最大创建站点数
    Wscript.echo "超出服务器最大创建站点数，正在创建的站点的序号为： "&SiteNum&"."
    Exit Function
   End If
Wend
'进行站点基本配置
NewBindings = Array(0)
NewBindings(0) = BindingString
NewWebServer.ServerBindings = NewBindings
NewWebServer.ServerComment= WebSiteInfo
NewWebServer.AnonymousUserName= GuestUserName
NewWebServer.AnonymousUserPass= GuestUserPass
NewWebServer.KeyType = "IIsWebServer"
NewWebServer.FrontPageWeb = True
NewWebServer.EnableDefaultDoc = True
NewWebServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp,index.html,default.html"
NewWebServer.LogFileDirectory= LogDirectory
NewWebServer.SetInfo
Set NewDir = NewWebServer.Create("IIsWebVirtualDir", "ROOT")
NewDir.Path = WebSiteDirectory
NewDir.AccessRead = true
NewDir.AppFriendlyName = WebSiteInfo
NewDir.AppCreate True
NewDir.AccessScript = True
NewDir.AuthNTLM = True
NewDir.AppIsolated = "2"
NewDir.AppPoolId = WebSiteInfo
'NewDir.AppCreate3 2,WebSiteInfo,false
NewDir.AuthFlags = "AuthAnonymous | AuthNTLM" '集成windows身份验证
Err.Clear
NewDir.SetInfo
If (Err.Number <> 0) Then
   Wscript.echo "主目录创建时出错."
   Exit Function
End If
If StartOrStop = True Then
   Err.Clear
   Set NewWebServer = GetObject("IIS://" & getComputer() & "/w3svc/" & SiteNum)
   NewWebServer.Start
   If Err.Number <> 0 Then
    Wscript.echo "启动站点时出错!"
    Err.Clear
   End If
End If
   Wscript.echo "站点创建成功，站点编号为："& SiteNum &" ，域名为："& WebServerBingings
'SetCPULimitVar strComputer,SiteNum,100   '调用CPU最大使用程度
End Function

Function getComputer()
Dim objNet
Set objNet = CreateObject("WScript.Network")
getComputer= objNet.ComputerName
Set objNet = Nothing
End Function

Function CreateFileDirectory(UserName)
Set FsObject = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Err.Clear
If Not FsObject.FolderExists(UserName) Then
   FsObject.CreateFolder(UserName)
   If Err.number<>0 Then
    Wscript.echo "创建目录" & UserName & "失败！"
   Else
    Wscript.echo "创建目录" & UserName & "成功！"
   END if
Else
   Wscript.echo"目录" & UserName & "已存在，您不能创建！"
End if
Set FsObject = Nothing
End Function

Function SetNTFSDirectoryPerssion(sourceDirectory)
Dim WshShell,oExec
Dim exeDirectory
exeDirectory = "C:\Program Files\Resource Kit\xcacls.exe C:\Inetpub\"
Orders_exec = exeDirectory&sourceDirectory&" /E /T /G "&sourceDirectory&":F;F"
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec(Orders_exec)
If oExec.status = 0 Then
Wscript.echo " 命令成功执行！"
Else
Wscript.echo " 命令执行失败！权限不够或者该程序无法在DOS状态下运行"
End If
Set WshShell= Nothing
End Function

Function checkUSer(strUser)
   On Error Resume Next
   'Check if domain is already part of username passed to function
   If instr(strUser,"\") = 0 then
      Set objGrp = GetObject("WinNT://" & getComputer() & "/" & strUser & ",user")
   Else
      Set objGrp = GetObject("WinNT://" & replace(strUser,"\","/") & ",user")
   End If
   If err.number = 0 Then
      checkUSer = true
   Else
      checkUSer = false
   End If
   Set objGrp = Nothing
   On Error Goto 0
End Function

Function AddUser(Computer,UserName,PassWord,FullName,Info,GroupName)
DIM intReturn,FsObject
On Error Resume Next
'执行创建帐号命令
Set ComputerAccoutObj = GetObject("WinNT://"&getComputer()&"/"&UserName&",user")
if Err.number=0 then
Wscript.echo UserName&"计算机用户已存在...."
Else
Set ComputerObj = GetObject("WinNT://"&getComputer())
Set NewUser = ComputerObj.Create( "User" , UserName )
NewUser.SetInfo
'进行帐号设置
NewUser.SetPassword ( PassWord ) '帐号密码
NewUser.FullName = FullName '帐号全名
NewUser.Description = Info '帐号说明
NewUser.UserFlags = &H10000 xor &H0040 '&H20000(使用者下次登入时须变更密码) &H0040(使用者不得变更密码) &H10000(密码永久正确) &H0002(帐户暂时停用)
NewUser.SetInfo
Wscript.echo "帐号"&UserName&"创建成功！"
Set objSeLectGroup = GetObject("WinNT://" & getComputer() & "/Guests,group")
Set objAddUser = GetObject("WinNT://" & getComputer() & "/" & UserName &",user")
objSeLectGroup.Add(objAddUser.ADsPath)
End if   
Set ComputerObj=nothing
Set ComputerAccoutObj = nothing
Set ComputerAccoutGroupObj = nothing
End Function
***********************************End*****************************

注意把刚才备份出来的backupiis.txt放在程序读取的位置，

并执行createwebsite.vbs,OK,大功告成了。

 

后记：

    不知道细心的读者是否有认真阅读过程序，认真阅读程序的就会发现还有以下几个问题没有完全解决：

    1.无法完成虚拟主机多个绑定域名的导入(导出也只能有6个)

    2.无法对不符前面的IIS配置的虚拟主机进行判断

期待有人可以来共同探讨。