使用vbs腳本檢查網站是否使用asp.net

Const AspNetExt="aspx"

Dim Obj,Fso,F,Val,i

Set Obj=New IISClass

Set Fso=CreateObject("Scripting.FileSystemObject")

Set F = Fso.CreateTextFile("是否有Net程式.txt", True)

Obj.GetIIS

i=0

For Each Val In Obj.Site

 i=i+1

 WScript.Echo Fill(i,4) & "正在檢測站點 " & Val.Name & " 是否有" & AspNetExt & "檔案："

 Path=Val.Path

 If CheckAspNet(Path) Then

  WScript.Echo vbTab & "有"

  F.WriteLine Fill(Val.Name,25) & Path

 Else

  WScript.Echo vbTab & "沒有"

 End If

Next

F.Close()

Set Fso=Nothing

Set Obj=Nothing

Function CheckAspNet(ByRef Path)

 Dim F,Folder,Files,fName,ExtName,dPath

 Dim Fso

 Set Fso=CreateObject("Scripting.FileSystemObject")

 Set F=Fso.GetFolder(Path)

 CheckAspNet=False

 For Each Files In F.Files

  fName=Files.Name

  ExtName=Fso.GetExtensionName(Path & "\" & fName)

  If LCase(ExtName)=LCase(AspNetExt) Then

   CheckAspNet=True

   Exit Function

  End If

 Next

 For Each Folder In F.SubFolders

  dPath=Path & "\" & Folder.Name

  If CheckAspNet(dPath) Then

 Set F=Nothing

 Set Fso=Nothing

End Function

Function Fill(byRef Str,byRef L)

 Dim Tmp

 If CLng(L)<=Len(Str) Then

  Fill=Str

  Exit Function

 Tmp=Str & Space(L)

 Fill=Left(Tmp,L)

'IIS操作類，包含建立應用程式池、站點和使用者的功能

Class IISClass

 Public Site()

 Public AppPool()

 Private SiteN,PoolN

 Private AnonyMouseName,ComputerName

 Private AppPoolAndIIsSplitStr,SplitStr

 Private CreateSiteTmpNum

 Private Sub Class_Initialize()

  SiteN=0

  PoolN=0

  ComputerName=GetComputerName

  AnonyMouseName="IUSR_" & ComputerName

  AppPoolAndIIsSplitStr=vbCrlf & "|AppPoolEndIIsStart|" & vbCrLf  '生成備份檔案時，應用程式池和IIS站點資訊的分隔線

  SplitStr="<|>"

  CreateSiteTmpNum=0

 End Sub

 '擷取目前計算機的名稱

 Private Function GetComputerName()

  Dim ObjNetWork,NetworkStr

  NetworkStr="Wscript.Network"

  Set objNetwork = CreateObject(NetworkStr)

  GetComputerName = objNetwork.ComputerName

  Set ObjNetWork=Nothing

 End Function

 '把域名綁定的對象轉換成數組的原始資料

 Private Function DomainObjToArr(ByRef Obj)

  Dim Tmp(),Val,i,s

  i=0

  s=""

  For Each Val In Obj

   ReDim Preserve Tmp(i)

   s=Val.IP & ":" & Val.Port & ":" & Val.Domain

   Tmp(i)=s

   i=i+1

  Next

  DomainObjToArr=Tmp

 '把使用者添加到指定的組中

 Public Function AddUserToGroup(byRef UserName,byRef GroupName,ByRef ErrMsg)

  Dim Obj,GroupObj

  AddUserToGroup=False

  On Error Resume Next

  Err.Clear

  Set Obj=GetObject("WinNT://" & ComputerName)

  If Err.number<>0 Then

   ErrMsg="無法使用ADSI功能"

  Set GroupObj=Obj.GetObject("Group",GroupName)

   ErrMsg="控制使用者組失敗，請檢查組的名稱是否正确"

  GroupObj.add("WinNT://" & ComputerName & "/" & UserName)

   ErrMsg="在把使用者添加到組中時出現錯誤，可能是該組中已存在此使用者"

  AddUserToGroup=True

  Set Obj=Nothing

  Set GroupObj=Nothing

 '建立一個使用者

 Function CreateUser(byRef UserName,byRef UserPass,byRef FullName,byRef ExtInfo,ByRef ErrMsg)

  Dim ComputerObj,NewUser

  CreateUser=False

  Set ComputerObj = GetObject("WinNT://"& ComputerName)

  Err.Clear    

  Set NewUser = ComputerObj.Create("User" , UserName)  

  NewUser.SetInfo

   ErrMsg="建立使用者出錯" & Err.Description

  '進行帳号設定

  NewUser.SetPassword UserPass '帳号密碼

  NewUser.FullName=FullName  '帳号全名

  NewUser.Description=ExtInfo  '帳号說明

  NewUser.UserFlags=&H10040  '&H20000(使用者下次登入時須變更密碼) &H0040(使用者不得變更密碼) &H10000(密碼永久正确) &H0002(帳戶暫時停用)

   ErrMsg="設定使用者資訊時出錯" & Err.Description

  Set ComputerObj=nothing

  CreateUser=True

 '建立一個應用程式池

 Public Function CreateAppPool(ByRef AppPoolObj,ByRef ErrMsg)

  Dim ServerObj, AppObj

  CreateAppPool=False

  Set ServerObj = GetObject("IIS://Localhost/W3SVC/AppPools")

  Set AppObj = ServerObj.Create("IIsApplicationPool", AppPoolObj.Name)

  AppObj.SetInfo

  If Err.Number <> 0 Then

   ErrMsg="建立應用程式池出錯" & Err.Description

  Set AppObj=Nothing

  Set ServerObj=Nothing

  CreateAppPool=True

 '設定站點的應用程式池

 Public Function SetSiteAppPool(ByRef SiteObj,ByRef ErrMsg)

  Dim WWWServer,Obj

  SetSiteAppPool=False

  Set WWWServer = GetObject(SiteObj.AdsPath & "/ROOT")

  WWWServer.AppPoolId=SiteObj.AppPool

  WWWServer.SetInfo

  If Err.Number<>0 Then

   ErrMsg="設定站點的應用程式池時出錯"

  Set WWWServer=Nothing

  SetSiteAppPool=True

 '設定站點的使用者名和密碼

 Public Function SetSiteUser(ByRef SiteObj,ByRef ErrMsg)

  SetSiteUser=False

  If SiteObj.User<>"" And SiteObj.Password<>"" Then

   On Error Resume Next

   Err.Clear

   Set WWWServer = GetObject(SiteObj.AdsPath & "/ROOT")

   WWWServer.AnonymousUserName=SiteObj.User

   WWWServer.AnonymousUserPass=SiteObj.Password

   WWWServer.SetInfo

   If Err.Number<>0 Then

    ErrMsg="設定站點的使用者名和密碼時出錯"

    Exit Function

   End If

   Set WWWServer=Nothing

  Else

   ErrMsg="沒有設定使用者名和密碼"

  SetSiteUser=True

 '建立一個站點，由于便與分析出錯資訊，此處建立站點隻建立最基本的屬性（站點名稱，綁定域名，站點目錄）

 Public Function CreateSite(ByRef SiteObj,ByRef ErrMsg)

  '預設從配置檔案中擷取的資訊不會出錯，不再寫容錯處理程式

  Dim WWWServer,IIsAdsNum,TmpObj,VDirObj,ServerObj

  CreateSite=False

  Set WWWServer = GetObject("IIS://Localhost/W3SVC")

  IIsAdsNum=SiteObj.AdsNum

  Set TmpObj = WWWServer.GetObject("IIsWebServer", IIsAdsNum)

  If Err.Number = 0 Then

   '程式執行沒有出錯說明該站點已存在

   ErrMsg = "該伺服器已經存在和此站點AdsPath相同的站點"

  '開始建立站點

        Set ServerObj = WWWServer.Create("IIsWebServer", IIsAdsNum)

   ErrMsg = "建立站點失敗"

  '配置站點

  ServerObj.ServerComment = SiteObj.Name

  ServerObj.LogType=SiteObj.LogType

  If SiteObj.LogType Then

   ServerObj.LogFileDirectory=SiteObj.LogDir

  ServerObj.ServerBindings = DomainObjToArr(SiteObj.Domains)

  ServerObj.SetInfo

   ErrMsg = "配置站點時出錯"

  '建立ROOT虛拟目錄

  Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")

   ErrMsg = "建立ROOT虛拟目錄失敗"

  '預設ROOT資訊

  VDirObj.Path=SiteObj.Path

  VDirObj.DefaultDoc=SiteObj.DefaultDoc

  VDirObj.SetInfo

  VDirObj.AppFriendlyName = "預設應用程式"

  VDirObj.AppCreate2 2

  VDirObj.AccessScript = True

  VDirObj.AccessFlags = 513

   ErrMsg = "配置ROOT虛拟目錄時出錯"

  If CInt(SiteObj.Stat)=2 Then

   ServerObj.Start

   ServerObj.Stop

  Set VDirObj = Nothing

  Set TmpObj = Nothing

  Set ServerObj = Nothing

  Set WWWServer = Nothing

  CreateSite = True

 '建立一個FTP

 Public Function CreateFTP(ByRef SiteObj,ByRef ErrMsg)

  Dim FtpObj,RootObj,VirObj

  CreateFTP=False

   Set FtpObj= GetObject("IIS://Localhost/MSFTPSVC/1")

   Set RootObj=FtpObj.GetObject("IIsFtpVirtualDir", "ROOT")

   Set VirObj=RootObj.Create("IIsFtpVirtualDir",SiteObj.User)

   VirObj.AccessFlags=3

   VirObj.DontLog=0

   VirObj.Path=SiteObj.Path

   VirObj.SetInfo

    ErrMsg="建立站點失敗" & Err.Description

   Set VirObj=Nothing

   Set RootObj=Nothing

   Set FtpObj=Nothing

  CreateFTP=True

 '把IIS資訊整合成文本内容

 Public Function BackUP()

  Dim Str,s,v

  Str=""

  For Each v In AppPool

   If s="" Then

    s=v.Name

   Else

    s=s & "," & v.Name

  Str=s & AppPoolAndIIsSplitStr

  '以上為應用程式池的儲存

  '下面儲存IIS的資訊

  Dim Tmp,D,DStr

  Tmp=""

  For Each v In Site

   If CLng(v.AdsNum)<>1 Then

    DStr=""

    For Each D In v.Domains

     If DStr="" Then

      DStr=D.IP & ":" & D.Port & ":" & D.Domain

     Else

      DStr=DStr & "," & D.IP & ":" & D.Port & ":" & D.Domain

     End If

    Next

    Tmp=v.Name & SplitStr & _

     v.Path & SplitStr & _

     v.User & SplitStr & _

     v.Password & SplitStr & _

     v.AppPool & SplitStr & _

     v.DefaultDoc & SplitStr & _

     v.LogType & SplitStr & _

     v.LogDir & SplitStr & _

     v.AdsPath & SplitStr & _

     v.AdsNum & SplitStr & _

     v.Stat & SplitStr & _

     DStr

    If s="" Then

     s=Tmp

    Else

     s=s & vbCrLf & Tmp

    End If

  Str=Str & s

  Backup=Str

 '從以前備份的IIS内容中讀出資訊

 Public Sub ReadFromFile(ByRef Content)

  Dim Arr,PoolStr,IIsStr,Pool,S,TmpArr,Val

  Arr=Split(Content,AppPoolAndIIsSplitStr)

  PoolStr=Arr(0)

  IIsStr=Arr(1)

  For Each Pool In Split(PoolStr,",")

   ReDim Preserve AppPool(PoolN)

   Set AppPool(PoolN)=New AppPoolTypes

   AppPool(PoolN).Name=Pool

   PoolN=PoolN+1

  For Each S In Split(IIsStr,vbCrLf)

   ReDim Preserve Site(SiteN)

   Set Site(SiteN)=New IIsTypes

   TmpArr=Split(S,SplitStr)

   With Site(SiteN)

    .Name=TmpArr(0)

    .Path=TmpArr(1)

    .User=TmpArr(2)

    .Password=TmpArr(3)

    .AppPool=TmpArr(4)

    .DefaultDoc=TmpArr(5)

    .LogType=TmpArr(6)

    .LogDir=TmpArr(7)

    .AdsPath=TmpArr(8)

    .AdsNum=TmpArr(9)

    .Stat=TmpArr(10)

    For Each Val In Split(TmpArr(11),",")

     .AddDomain Val

   End With

   SiteN=SiteN+1

 '從目前伺服器上IIS中讀取應用程式池的清單

 Public Sub GetPool()

  Dim WWWObj,AppObj

  Set WWWObj=GetObject("IIS://Localhost/W3SVC/AppPools")

  For Each AppObj In WWWObj

   AppPool(PoolN).Name=AppObj.name

  Set WWWObj=Nothing

 '從目前伺服器上IIS中讀取站點的清單

 Public Sub GetIIS()

  Dim WWWObj,SiteObj,Obj,UserName,UserPass,SiteName

  Dim Binds,AppPool,VirObj

  '從IIS站點中擷取所有IIS資訊

  Set WWWObj=GetObject("IIS://Localhost/w3svc")

  For Each SiteObj In WWWObj

   If SiteObj.Class="IIsWebServer" Then

    Binds=SiteObj.ServerBindings

    SiteName=SiteObj.ServerComment

    Set Obj=SiteObj.GetObject("IIsWebVirtualDir","ROOT")

    UserName=Obj.AnonymousUserName

    UserPass=Obj.AnonymousUserPass

    AppPool=Obj.AppPoolId

    '處理一下使用者名的資訊

    UserName=Replace(UserName,ComputerName & "\","")

    UserName=Replace(UserName,AnonyMouseName,"")

    If UserName="" Then

     UserName=""

     UserPass=""

    ReDim Preserve Site(SiteN)

    Set Site(SiteN)=New IIsTypes

    With Site(SiteN)

     .Name=SiteName

     .Path=Obj.Path

     .DefaultDoc=Obj.DefaultDoc

     .LogType=SiteObj.LogType

     .LogDir=SiteObj.LogFileDirectory

     For Each Val In Binds

      .AddDomain Val

     Next

     .User=UserName

     .Password=UserPass

     .AppPool=AppPool

     .AdsPath=SiteObj.AdsPath

     .AdsNum=SiteObj.Name

     .Stat=SiteObj.Status

    End With

    SiteN=SiteN+1

End Class

'站點綁定資訊資料類型

Class BindsTypes

 Public IP

 Public Domain

 Public Port

  IP=""

  Domain=""

  Port="80"

'應用程式池的資料類型

Class AppPoolTypes

 Public Name

 '由于池比較少，不再加大程式的複雜性，隻記錄一下池的名稱就成了，其它資訊由預設池中擷取

 Private Sub Class_Initialze()

  Name=""

'站點的資料類型

Class IIsTypes

 Public Path

 Public Domains()

 Public User

 Public Password

 Public AppPool

 Public DefaultDoc

 Public LogDir,LogType

 Public AdsPath,AdsNum

 Public Stat

 Private DomainN

  Path=""

  User=""

  Password=""

  AppPool=""

  DomainN=0

  AdsPath=""

  AdsNum=0

  Stat=2

 Public Sub AddDomain(ByRef Str)

  Dim Arr

  Arr=Split(Str,":")

  ReDim Preserve Domains(DomainN)

  Set Domains(DomainN)=New BindsTypes

  With Domains(DomainN)

   .IP=Arr(0)

   .Port=Arr(1)

   .Domain=Arr(2)

  End With

  DomainN=DomainN+1

 本文轉自 simeon2005 51CTO部落格，原文連結:http://blog.51cto.com/simeon/99759