ASP批量导出IIS标识,域名列表,描述,对应目录,是否运行,端口

iis.zip

 1.将以下代码另存为iis.asp
2.将C:\Windows\System32\inetsrv\MetaBase.xml 文件或IIS 备份文件改名为IIS.xml
3.将两文件放入IIS 里某个站点里，使用浏览器访问iis.asp页面例如 :http://localhost/iis.asp 即可查看结果，效果图如下，如需要放入Excel里 直接复制粘贴到Excel  ！

<%
'修改了基本函数，可以导出任意你想的数据
option explicit
dim FSO
Set FSO = Server.CreateObject("Scripting.FileSystemObject")
dim ts
Set ts = fso.OpenTextFile(server.MapPath("iis.xml"),1)  '修改此处的iis备份文件名即可,同目录下哦
dim content,contentdir,arraylocal
content= ts.ReadAll
contentdir=content

content=split(content,"<IIsWebServer")

'取主相关字段
'splitStr可以为你想要截取的标识如：ServerComment、AppFriendlyName、Path

function getStr(str,splitStr)
dim reg,readstr,matches,match1
set reg=new Regexp
reg.Multiline=True
reg.Global=false
reg.IgnoreCase=true
reg.Pattern=splitStr&"(.*)\s"
Set matches = reg.execute(str)
  For Each match1 in matches
   readstr=match1.Value
  Next
Set matches = Nothing
Set reg = Nothing
getStr=replace(readstr,splitStr&"=","")
getStr=replace(getStr,"""","")
end function

'取字段

function GetKey(HTML,Start,Last)
dim filearray,filearray2
filearray=split(HTML,Start)
filearray2=split(filearray(1),Last)
GetKey=filearray2(0)
End function

function Clear(content)
dim arr,i
arr=split(content,":")
for i=0 to ubound(arr)
if instr(arr(i),".")>0 then
Clear=Clear & arr(i)&"<Br/>"
end if
next
end function

function Clearport(content)
dim arr,i
arr=split(content,":")
for i=1 to ubound(arr)
if instr(arr(i),".")=0 then
Clearport=Clearport & arr(i)&"<Br/>"
end if
next
end function

response.Clear()

dim i,lc,contentdirs

response.Write("<table <tr><td <div align='center'>编号</div></td><td <div align='center'>运行</div></td><td <div align='center'>描述</div></td><td <div align='center'>域名</div></td><td <div align='center'>端口</div></td><td <div align='center'>目录</div> </td><td <div align='center'>标识</div> </td></tr>")

for i=0 to ubound(content)

lc=split(getStr(content(i),"Location"),"/")

 if ubound(lc)=3 then
 contentdir = Replace(contentdir,"/ROOT","/root")
'contentdirs 切割整个xml 创建数组   取文件存放的目录

 contentdirs = split(contentdir,"<IIsWebVirtualDir Location =""/LM/W3SVC/"&rtrimVBcrlf(lc(3))&"/root""")
 
  response.Write("<tr><td height='30'>"&i&"</td><td height='30'>"&getStr(content(i),"ServerAutoStart")&"</td><td>"&getStr(content(i),"ServerComment")&"</td><td>"&Clear(GetKey(content(i),"ServerBindings=""",""""))&"</td><td>"&Clearport(GetKey(content(i),"ServerBindings=""",""""))&"</td><td>"&replace(getStr(content(i),"Path="),"Path=","")&"</td><td>"&rtrimVBcrlf(lc(3))&"</tr>")
 end if
next

response.Write("</table>")

'去掉字符串空格
function rtrimVBcrlf(str)
dim pos,isBlankChar
pos=len(str)
isBlankChar=true
while isBlankChar and pos>=2
 if mid(str,pos,1)=" " then
  pos=pos-1
 elseif mid(str,pos-1,2)=VBcrlf then
  pos=pos-2
 else
  isBlankChar=false
 end if
wend
rtrimVBcrlf=rtrim(left(str,pos))
end function
%>