<%
'www.sql8.net
'本段代码是根据 http://www.2cto.com/os/201202/118849.html 扩展而
'修改了基本函数,可以导出任意你想的数据
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
content= ts.ReadAll
contentdir=content
content=split(content,"<IIsWebServer")
'取主相关字段
'splitStr可以为你想要截取的标识如:ServerComment、AppFriendlyName、Path
'www.sql8.net
'yxy
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
'取字段
'www.sql8.net
'yxy
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
'取文件存放的目录
contentdir=split(contentdir,"<IIsWebVirtualDir")
response.Clear()
dim i
for i=0 to ubound(content)
if instr(content(i),"ServerBindings")>0 then
response.Write (i)&" 描述:"&getStr(content(i),"ServerComment")&"<br>主机头:<br/>"&Clear(GetKey(content(i),"ServerBindings=""",""""))
response.write("文件目录:"&getStr(contentdir(i),"Path")&"<BR/><Br/>")
end if
next
%>