批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[转贴] VBS脚本检查网站是否使用ASP.NET

  1. Const AspNetExt="aspx"
  2. Dim Obj,Fso,F,Val,i
  3. Set Obj=New IISClass
  4. Set Fso=CreateObject("Scripting.FileSystemObject")
  5. Set F = Fso.CreateTextFile("是否有Net程序.txt", True)
  6. Obj.GetIIS
  7. i=0
  8. For Each Val In Obj.Site
  9. i=i+1
  10. WScript.Echo Fill(i,4) & "正在检测站点 " & Val.Name & " 是否有" & AspNetExt & "文件:"
  11. Path=Val.Path
  12. If CheckAspNet(Path) Then
  13.   WScript.Echo vbTab & "有"
  14.   F.WriteLine Fill(Val.Name,25) & Path
  15. Else
  16.   WScript.Echo vbTab & "没有"
  17. End If
  18. Next
  19. F.Close()
  20. Set Fso=Nothing
  21. Set Obj=Nothing
  22. Function CheckAspNet(ByRef Path)
  23. Dim F,Folder,Files,fName,ExtName,dPath
  24. Dim Fso
  25. Set Fso=CreateObject("Scripting.FileSystemObject")
  26. Set F=Fso.GetFolder(Path)
  27. CheckAspNet=False
  28. For Each Files In F.Files
  29.   fName=Files.Name
  30.   ExtName=Fso.GetExtensionName(Path & "\" & fName)
  31.   If LCase(ExtName)=LCase(AspNetExt) Then
  32.    CheckAspNet=True
  33.    Exit Function
  34.   End If
  35. Next
  36. For Each Folder In F.SubFolders
  37.   dPath=Path & "\" & Folder.Name
  38.   If CheckAspNet(dPath) Then
  39.    CheckAspNet=True
  40.    Exit Function
  41.   End If
  42. Next
  43. Set F=Nothing
  44. Set Fso=Nothing
  45. End Function
  46. Function Fill(byRef Str,byRef L)
  47. Dim Tmp
  48. If CLng(L)<=Len(Str) Then
  49.   Fill=Str
  50.   Exit Function
  51. End If
  52. Tmp=Str & Space(L)
  53. Fill=Left(Tmp,L)
  54. End Function
  55. 'IIS操作类,包含创建应用程序池、站点和用户的功能
  56. Class IISClass
  57. Public Site()
  58. Public AppPool()
  59. Private SiteN,PoolN
  60. Private AnonyMouseName,ComputerName
  61. Private AppPoolAndIIsSplitStr,SplitStr
  62. Private CreateSiteTmpNum
  63. Private Sub Class_Initialize()
  64.   SiteN=0
  65.   PoolN=0
  66.   ComputerName=GetComputerName
  67.   AnonyMouseName="IUSR_" & ComputerName
  68.   AppPoolAndIIsSplitStr=vbCrlf & "|AppPoolEndIIsStart|" & vbCrLf  '生成备份文件时,应用程序池和IIS站点信息的分隔线
  69.   SplitStr="<|>"
  70.   CreateSiteTmpNum=0
  71. End Sub
  72. '获取当前计算机的名称
  73. Private Function GetComputerName()
  74.   Dim ObjNetWork,NetworkStr
  75.   NetworkStr="Wscript.Network"
  76.   Set objNetwork = CreateObject(NetworkStr)
  77.   GetComputerName = objNetwork.ComputerName
  78.   Set ObjNetWork=Nothing
  79. End Function
  80. '把域名绑定的对象转换成数组的原始数据
  81. Private Function DomainObjToArr(ByRef Obj)
  82.   Dim Tmp(),Val,i,s
  83.   i=0
  84.   s=""
  85.   For Each Val In Obj
  86.    ReDim Preserve Tmp(i)
  87.    s=Val.IP & ":" & Val.Port & ":" & Val.Domain
  88.    Tmp(i)=s
  89.    i=i+1
  90.   Next
  91.   DomainObjToArr=Tmp
  92. End Function
  93. '把用户添加到指定的组中
  94. Public Function AddUserToGroup(byRef UserName,byRef GroupName,ByRef ErrMsg)
  95.   Dim Obj,GroupObj
  96.   AddUserToGroup=False
  97.   On Error Resume Next
  98.   Err.Clear
  99.   Set Obj=GetObject("WinNT://" & ComputerName)
  100.   If Err.number<>0 Then
  101.    ErrMsg="无法使用ADSI功能"
  102.    Exit Function
  103.   End If
  104.   Err.Clear
  105.   Set GroupObj=Obj.GetObject("Group",GroupName)
  106.   If Err.number<>0 Then
  107.    ErrMsg="控制用户组失败,请检查组的名称是否正确"
  108.    Exit Function
  109.   End If
  110.   Err.Clear
  111.   GroupObj.add("WinNT://" & ComputerName & "/" & UserName)
  112.   If Err.number<>0 Then
  113.    ErrMsg="在把用户添加到组中时出现错误,可能是该组中已存在此用户"
  114.    Exit Function
  115.   End If
  116.   AddUserToGroup=True
  117.   Set Obj=Nothing
  118.   Set GroupObj=Nothing
  119. End Function
  120. '创建一个用户
  121. Function CreateUser(byRef UserName,byRef UserPass,byRef FullName,byRef ExtInfo,ByRef ErrMsg)
  122.   Dim ComputerObj,NewUser
  123.   CreateUser=False
  124.   On Error Resume Next
  125.   Err.Clear
  126.   Set ComputerObj = GetObject("WinNT://"& ComputerName)
  127.   If Err.number<>0 Then
  128.    ErrMsg="无法使用ADSI功能"
  129.    Exit Function
  130.   End If
  131.   Err.Clear
  132.   Set NewUser = ComputerObj.Create("User" , UserName)
  133.   NewUser.SetInfo
  134.   If Err.number<>0 Then
  135.    ErrMsg="创建用户出错" & Err.Description
  136.    Exit Function
  137.   End If
  138.   Err.Clear
  139.   '进行帐号设置
  140.   NewUser.SetPassword UserPass '帐号密码
  141.   NewUser.FullName=FullName  '帐号全名
  142.   NewUser.Description=ExtInfo  '帐号说明
  143.   NewUser.UserFlags=&H10040  '&H20000(使用者下次登入时须变更密码) &H0040(使用者不得变更密码) &H10000(密码永久正确) &H0002(帐户暂时停用)
  144.   NewUser.SetInfo
  145.   If Err.number<>0 Then
  146.    ErrMsg="设置用户信息时出错" & Err.Description
  147.    Exit Function
  148.   End If
  149.   Set ComputerObj=nothing
  150.   CreateUser=True
  151. End Function
  152. '创建一个应用程序池
  153. Public Function CreateAppPool(ByRef AppPoolObj,ByRef ErrMsg)
  154.   Dim ServerObj, AppObj
  155.   CreateAppPool=False
  156.   On Error Resume Next
  157.   Set ServerObj = GetObject("IIS://Localhost/W3SVC/AppPools")
  158.   Err.Clear
  159.   Set AppObj = ServerObj.Create("IIsApplicationPool", AppPoolObj.Name)
  160.   AppObj.SetInfo
  161.   If Err.Number <> 0 Then
  162.    ErrMsg="创建应用程序池出错" & Err.Description
  163.    Exit Function
  164.   End If
  165.   Set AppObj=Nothing
  166.   Set ServerObj=Nothing
  167.   CreateAppPool=True
  168. End Function
  169. '设置站点的应用程序池
  170. Public Function SetSiteAppPool(ByRef SiteObj,ByRef ErrMsg)
  171.   Dim WWWServer,Obj
  172.   SetSiteAppPool=False
  173.   On Error Resume Next
  174.   Err.Clear
  175.   Set WWWServer = GetObject(SiteObj.AdsPath & "/ROOT")
  176.   WWWServer.AppPoolId=SiteObj.AppPool
  177.   WWWServer.SetInfo
  178.   If Err.Number<>0 Then
  179.    ErrMsg="设置站点的应用程序池时出错"
  180.    Exit Function
  181.   End If
  182.   Set WWWServer=Nothing
  183.   SetSiteAppPool=True
  184. End Function
  185. '设置站点的用户名和密码
  186. Public Function SetSiteUser(ByRef SiteObj,ByRef ErrMsg)
  187.   Dim WWWServer,Obj
  188.   SetSiteUser=False
  189.   If SiteObj.User<>"" And SiteObj.Password<>"" Then
  190.    On Error Resume Next
  191.    Err.Clear
  192.    Set WWWServer = GetObject(SiteObj.AdsPath & "/ROOT")
  193.    WWWServer.AnonymousUserName=SiteObj.User
  194.    WWWServer.AnonymousUserPass=SiteObj.Password
  195.    WWWServer.SetInfo
  196.    If Err.Number<>0 Then
  197.     ErrMsg="设置站点的用户名和密码时出错"
  198.     Exit Function
  199.    End If
  200.    Set WWWServer=Nothing
  201.   Else
  202.    ErrMsg="没有设置用户名和密码"
  203.    Exit Function
  204.   End If
  205.   SetSiteUser=True
  206. End Function
  207. '创建一个站点,由于便与分析出错信息,此处创建站点只创建最基本的属性(站点名称,绑定域名,站点目录)
  208. Public Function CreateSite(ByRef SiteObj,ByRef ErrMsg)
  209.   '默认从配置文件中获取的信息不会出错,不再写容错处理程序
  210.   Dim WWWServer,IIsAdsNum,TmpObj,VDirObj,ServerObj
  211.   CreateSite=False
  212.   On Error Resume Next
  213.   Set WWWServer = GetObject("IIS://Localhost/W3SVC")
  214.   IIsAdsNum=SiteObj.AdsNum
  215.   Err.Clear
  216.   Set TmpObj = WWWServer.GetObject("IIsWebServer", IIsAdsNum)
  217.   If Err.Number = 0 Then
  218.    Err.Clear
  219.    '程序执行没有出错说明该站点已存在
  220.    ErrMsg = "该服务器已经存在和此站点AdsPath相同的站点"
  221.    Exit Function
  222.   End If
  223.   '开始创建站点
  224.   Err.Clear
  225.         Set ServerObj = WWWServer.Create("IIsWebServer", IIsAdsNum)
  226.   If Err.Number <> 0 Then
  227.    ErrMsg = "创建站点失败"
  228.    Exit Function
  229.   End If
  230.   '配置站点
  231.   Err.Clear
  232.   ServerObj.ServerComment = SiteObj.Name
  233.   ServerObj.LogType=SiteObj.LogType
  234.   If SiteObj.LogType Then
  235.    ServerObj.LogFileDirectory=SiteObj.LogDir
  236.   End If
  237.   ServerObj.ServerBindings = DomainObjToArr(SiteObj.Domains)
  238.   ServerObj.SetInfo
  239.   If Err.Number <> 0 Then
  240.    ErrMsg = "配置站点时出错"
  241.    Exit Function
  242.   End If
  243.   '建立ROOT虚拟目录
  244.   Err.Clear
  245.   Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")
  246.   If Err.Number <> 0 Then
  247.    ErrMsg = "创建ROOT虚拟目录失败"
  248.    Exit Function
  249.   End If
  250.   '默认ROOT信息
  251.   Err.Clear
  252.   VDirObj.Path=SiteObj.Path
  253.   VDirObj.DefaultDoc=SiteObj.DefaultDoc
  254.   VDirObj.SetInfo
  255.   If Err.Number <> 0 Then
  256.    ErrMsg = "配置站点时出错"
  257.    Exit Function
  258.   End If
  259.   Err.Clear
  260.   VDirObj.AppFriendlyName = "默认应用程序"
  261.   VDirObj.SetInfo
  262.   VDirObj.AppCreate2 2
  263.   VDirObj.SetInfo
  264.   VDirObj.AccessScript = True
  265.   VDirObj.AccessFlags = 513
  266.   VDirObj.SetInfo
  267.   If Err.Number <> 0 Then
  268.    ErrMsg = "配置ROOT虚拟目录时出错"
  269.    Exit Function
  270.   End If
  271.   If CInt(SiteObj.Stat)=2 Then
  272.    ServerObj.Start
  273.   Else
  274.    ServerObj.Stop
  275.   End If
  276.   Set VDirObj = Nothing
  277.   Set TmpObj = Nothing
  278.   Set ServerObj = Nothing
  279.   Set WWWServer = Nothing
  280.   CreateSite = True
  281. End Function
  282. '创建一个FTP
  283. Public Function CreateFTP(ByRef SiteObj,ByRef ErrMsg)
  284.   Dim FtpObj,RootObj,VirObj
  285.   On Error Resume Next
  286.   CreateFTP=False
  287.   If SiteObj.User<>"" And SiteObj.Password<>"" Then
  288.    Err.Clear
  289.    Set FtpObj= GetObject("IIS://Localhost/MSFTPSVC/1")
  290.    Set RootObj=FtpObj.GetObject("IIsFtpVirtualDir", "ROOT")
  291.    Set VirObj=RootObj.Create("IIsFtpVirtualDir",SiteObj.User)
  292.    VirObj.AccessFlags=3
  293.    VirObj.DontLog=0
  294.    VirObj.Path=SiteObj.Path
  295.    VirObj.SetInfo
  296.    If Err.Number<>0 Then
  297.     ErrMsg="创建站点失败" & Err.Description
  298.     Exit Function
  299.    End If
  300.    Set VirObj=Nothing
  301.    Set RootObj=Nothing
  302.    Set FtpObj=Nothing
  303.   End If
  304.   CreateFTP=True
  305. End Function
  306. '把IIS信息整合成文本内容
  307. Public Function BackUP()
  308.   Dim Str,s,v
  309.   Str=""
  310.   s=""
  311.   For Each v In AppPool
  312.    If s="" Then
  313.     s=v.Name
  314.    Else
  315.     s=s & "," & v.Name
  316.    End If
  317.   Next
  318.   Str=s & AppPoolAndIIsSplitStr
  319.   '以上为应用程序池的保存
  320.   '下面保存IIS的信息
  321.   s=""
  322.   Dim Tmp,D,DStr
  323.   Tmp=""
  324.   For Each v In Site
  325.    If CLng(v.AdsNum)<>1 Then
  326.     DStr=""
  327.     For Each D In v.Domains
  328.      If DStr="" Then
  329.       DStr=D.IP & ":" & D.Port & ":" & D.Domain
  330.      Else
  331.       DStr=DStr & "," & D.IP & ":" & D.Port & ":" & D.Domain
  332.      End If
  333.     Next
  334.     Tmp=v.Name & SplitStr & _
  335.      v.Path & SplitStr & _
  336.      v.User & SplitStr & _
  337.      v.Password & SplitStr & _
  338.      v.AppPool & SplitStr & _
  339.      v.DefaultDoc & SplitStr & _
  340.      v.LogType & SplitStr & _
  341.      v.LogDir & SplitStr & _
  342.      v.AdsPath & SplitStr & _
  343.      v.AdsNum & SplitStr & _
  344.      v.Stat & SplitStr & _
  345.      DStr
  346.     If s="" Then
  347.      s=Tmp
  348.     Else
  349.      s=s & vbCrLf & Tmp
  350.     End If
  351.    End If
  352.   Next
  353.   Str=Str & s
  354.   Backup=Str
  355. End Function
  356. '从以前备份的IIS内容中读出信息
  357. Public Sub ReadFromFile(ByRef Content)
  358.   Dim Arr,PoolStr,IIsStr,Pool,S,TmpArr,Val
  359.   Arr=Split(Content,AppPoolAndIIsSplitStr)
  360.   PoolStr=Arr(0)
  361.   IIsStr=Arr(1)
  362.   For Each Pool In Split(PoolStr,",")
  363.    ReDim Preserve AppPool(PoolN)
  364.    Set AppPool(PoolN)=New AppPoolTypes
  365.    AppPool(PoolN).Name=Pool
  366.    PoolN=PoolN+1
  367.   Next
  368.   For Each S In Split(IIsStr,vbCrLf)
  369.    ReDim Preserve Site(SiteN)
  370.    Set Site(SiteN)=New IIsTypes
  371.    TmpArr=Split(S,SplitStr)
  372.    With Site(SiteN)
  373.     .Name=TmpArr(0)
  374.     .Path=TmpArr(1)
  375.     .User=TmpArr(2)
  376.     .Password=TmpArr(3)
  377.     .AppPool=TmpArr(4)
  378.     .DefaultDoc=TmpArr(5)
  379.     .LogType=TmpArr(6)
  380.     .LogDir=TmpArr(7)
  381.     .AdsPath=TmpArr(8)
  382.     .AdsNum=TmpArr(9)
  383.     .Stat=TmpArr(10)
  384.     For Each Val In Split(TmpArr(11),",")
  385.      .AddDomain Val
  386.     Next
  387.    End With
  388.    SiteN=SiteN+1
  389.   Next
  390. End Sub
  391. '从当前服务器上IIS中读取应用程序池的列表
  392. Public Sub GetPool()
  393.   Dim WWWObj,AppObj
  394.   Set WWWObj=GetObject("IIS://Localhost/W3SVC/AppPools")
  395.   For Each AppObj In WWWObj
  396.    ReDim Preserve AppPool(PoolN)
  397.    Set AppPool(PoolN)=New AppPoolTypes
  398.    AppPool(PoolN).Name=AppObj.name
  399.    PoolN=PoolN+1
  400.   Next
  401.   Set WWWObj=Nothing
  402. End Sub
  403. '从当前服务器上IIS中读取站点的列表
  404. Public Sub GetIIS()
  405.   Dim WWWObj,SiteObj,Obj,UserName,UserPass,SiteName
  406.   Dim Binds,AppPool,VirObj
  407.   '从IIS站点中获取所有IIS信息
  408.   Set WWWObj=GetObject("IIS://Localhost/w3svc")
  409.   For Each SiteObj In WWWObj
  410.    If SiteObj.Class="IIsWebServer" Then
  411.     Binds=SiteObj.ServerBindings
  412.     SiteName=SiteObj.ServerComment
  413.     Set Obj=SiteObj.GetObject("IIsWebVirtualDir","ROOT")
  414.     UserName=Obj.AnonymousUserName
  415.     UserPass=Obj.AnonymousUserPass
  416.     AppPool=Obj.AppPoolId
  417.     '处理一下用户名的信息
  418.     UserName=Replace(UserName,ComputerName & "\","")
  419.     UserName=Replace(UserName,AnonyMouseName,"")
  420.     If UserName="" Then
  421.      UserName=""
  422.      UserPass=""
  423.     End If
  424.     ReDim Preserve Site(SiteN)
  425.     Set Site(SiteN)=New IIsTypes
  426.     With Site(SiteN)
  427.      .Name=SiteName
  428.      .Path=Obj.Path
  429.      .DefaultDoc=Obj.DefaultDoc
  430.      .LogType=SiteObj.LogType
  431.      .LogDir=SiteObj.LogFileDirectory
  432.      For Each Val In Binds
  433.       .AddDomain Val
  434.      Next
  435.      .User=UserName
  436.      .Password=UserPass
  437.      .AppPool=AppPool
  438.      .AdsPath=SiteObj.AdsPath
  439.      .AdsNum=SiteObj.Name
  440.      .Stat=SiteObj.Status
  441.     End With
  442.     SiteN=SiteN+1
  443.    End If
  444.   Next
  445.   Set WWWObj=Nothing
  446. End Sub
  447. End Class
  448. '站点绑定信息数据类型
  449. Class BindsTypes
  450. Public IP
  451. Public Domain
  452. Public Port
  453. Private Sub Class_Initialize()
  454.   IP=""
  455.   Domain=""
  456.   Port="80"
  457. End Sub
  458. End Class
  459. '应用程序池的数据类型
  460. Class AppPoolTypes
  461. Public Name
  462. '由于池比较少,不再加大程序的复杂性,只记录一下池的名称就成了,其它信息由默认池中获取
  463. Private Sub Class_Initialze()
  464.   Name=""
  465. End Sub
  466. End Class
  467. '站点的数据类型
  468. Class IIsTypes
  469. Public Name
  470. Public Path
  471. Public Domains()
  472. Public User
  473. Public Password
  474. Public AppPool
  475. Public DefaultDoc
  476. Public LogDir,LogType
  477. Public AdsPath,AdsNum
  478. Public Stat
  479. Private DomainN
  480. Private Sub Class_Initialze()
  481.   Name=""
  482.   Path=""
  483.   User=""
  484.   Password=""
  485.   AppPool=""
  486.   DomainN=0
  487.   AdsPath=""
  488.   AdsNum=0
  489.   Stat=2
  490. End Sub
  491. Public Sub AddDomain(ByRef Str)
  492.   Dim Arr
  493.   Arr=Split(Str,":")
  494.   ReDim Preserve Domains(DomainN)
  495.   Set Domains(DomainN)=New BindsTypes
  496.   With Domains(DomainN)
  497.    .IP=Arr(0)
  498.    .Port=Arr(1)
  499.    .Domain=Arr(2)
  500.   End With
  501.   DomainN=DomainN+1
  502. End Sub
  503. End Class
复制代码


http://simeon.blog.51cto.com/18680/99759

返回列表