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

最近上了一个项目，让我不管通过任何的方法要把一台IIS服务器的所有虚拟主机全部转移到另外一台机，其实很早就因为IIS服务器的问题而伤脑筋，终于在我的努力下通过VBSCRIPT的

脚本实现了这个目标，不敢独想，和广大网友共享。

一：IIS的服务器前期配置(其他的安全就不提了)    (以 freeshare.com.cn为例 )

    1.创建该域的(freeshare.com.cn)计算机用户名，并设置一个安全密码

    2.创建该域的目录文件夹如(D:\Inetpub\freeshare.com.cn)

    3.设置目录访问权限，freeshare.com.cn对该目录完全控制(提供匿名用户访问该网站)

    4.创建一个该域名的描述(公司名) 的单独应用进程池，为每一个虚拟主机创建独立的应用程序进程池，保个别网站的问题不会影响整台服务器的运行。创建进程池时可以单独设定用户名和密码并设置CPU,连接数等。这里采用的是默认的。

     5.创建一个虚拟主机，并选择上面所创建的应用进程池，在目录安全性中选择匿名用户freeshare.com.cn，并设置与计算机创建freeshare.com.cn用户名的密码一致，必须一致，否则无法访问该网站。

    OK，这个就对每个虚拟主机要做的，那么这些是不是需要全部的人工的去完成呢？答案是否定的，WINDOWS下也可以实现脚本编程哦，(呵呵我原来也是不知道的)

    那么即然可以不用去手工完成，用什么呢？用VBSCRIPT脚本吧。

二：用脚本完成上述创建虚拟主机的动作

    保存为createsiglewebsite.vbs

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

   Dim SiteNum,IPAddr,PortNum,LenComputer,WebServerComment,LogDirectory
Dim user_password,GroupName,tmpFolder,UserNameComp,WebServerAutoStart
Dim WebAnonymousUserName
WebServerComment="公司名"'网站描述、计算机用户描述及全名采用这个变量
UserNameComp="freeshare.com.cn"'计算机用户名及用户目录采用这个变量
HostName = ":80:www.freeshare.com.cn"'虚拟主机站点主机名
WebAnonymousUserName = getComputer()&"\"&UserNameComp'虚拟主机匿名用户(前面加了本地计算机名)
user_password = "**********"'计算机用户和匿名用户密码。
GroupName = "Guests"'计算机用户所在的组
IPAddr = ""'计算机IP地址，可以为空
tmpFolder = "D:\inetpub\"&UserNameComp'目标目录
LenComputer = Len(getComputer())+1'计算机名＋'\'的长度
PortNum = "80"'虚拟主机端口
WebServerAutoStart = "true"'创建虚拟主机后是否运行true和false
LogDirectory = ""'日志目录
   '检测是否存在该用户的计算机帐号
   If Not checkUser(UserNameComp) Then
    '添加该计算机用户帐号
    AddUser getComputer(),UserNameComp,user_password,WebServerComment,WebServerComment,GroupName
   Else
    Wscript.echo "该计算机用户名也存在.............."
   End If
   '创建用户主目录
   CreateFileDirectory(tmpFolder)
   '修改用户主目录的访问权限
   SetNTFSDirectoryPerssion(UserNameComp)
   '创建应用进程池
   createAppPool WebServerComment
   '创建虚拟主机站点
   CreateWebSite getComputer(),IPAddr,HostName,tmpFolder,LogDirectory,WebServerComment,UserNameComp,user_password,WebServerAutoStart  
   'BuildNum = BuildNum+1
   'Wscript.echo "=============================================="&BuildNum&"============================================="
'为每个IIS虚拟主机应用程序站点创建站点应用程序池
Function createAppPool(strName)
On Error Resume Next
Err.Clear
   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.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= WebServerComment
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 = WebServerComment
NewDir.AppCreate True
NewDir.AccessScript = True
NewDir.AuthNTLM = True
NewDir.AppIsolated = "2"
NewDir.AppPoolId = WebServerComment
'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*************************

程序完，你只要把上面的程序保存在以 *.vbs windows目录下，就可以直接执行了，

上面用到了一个xcacls的修改NTFS权限的小程序，您可以从微软官方网站下载，你也可以访问http://www.microsoft.com/windows2000/techinfo/reskit/tools/existing/xcacls-o.asp下载安装既可。