得到当前asp执行文件所在的绝对路径（支持带端口的绝对路径）以'/'结束
在解决一些XML文档调用时有用．或应用到小偷程序中
程序如下
//powered By Airzen
//qq:39192170
//e_mail:[email protected]
//date:2004-12-03
//转贴请保留作者信息
FUNCTION GetFullPath()
dim path,host_name,host_port,url_path
path=request.ServerVariables("PATH_INFO")
path=left(path,instrrev(path,"/"))
host_name=request.ServerVariables("SERVER_NAME")
host_port=request.ServerVariables("SERVER_PORT")
if host_port<>"80" then host_name=host_name&":"&host_port
GetFullPath="http://"&host_name&path
End Function
Function GetPage(url)
IF url="" then exit function
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
GetPage = BytesToBstr(.ResponseBody)
End With
Set Retrieval = Nothing
End Function
Function BytesToBstr(body)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = "GB2312"
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
Function WriteToFile(fil,wstr)
Dim fso, f
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateTextFile(Server.MapPath(fil),True)
f.Write wstr
Set f = nothing
Set fso = nothing
End function
Function ReadAllTextFile(filespec)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(server.MapPath(filespec), 1)
ReadAllTextFile = f.ReadAll
Set f=nothing
Set fso=nothing
End Function
Function IsExists(filespec)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(server.MapPath(filespec))) Then
IsExists = True
Else
IsExists = False
End If
End Function
MakeXML.ASP
----------------------------------------------------------------------------------------------------------
<p><a href="?MakeFile=address.xml&SeedFile=listAddress.asp" >点击生成客户XML文件</a>（address.xml）</p>
<p><a href="?MakeFile=brand.xml&SeedFile=listBrand.asp">点击生成产品XML文件</a>（brand.xml）</p>
<!-- #include file="Module/func.asp"-->
<%
'///////////////////////////////////////
' MakeXML.asp
'coder :airzen
'date :Nov 15,2004
'descript :MAKE THE XML FILE "Address.xml" "Brand.xml"
'email :[email protected]
'qq :39192170
'Create Date:2004 11.5
'Modified History:2004 11.15
'///////////////////////////////////////
'on error resume next
SUB MakeXML(byVal make_fileName,byVal seed_ASPfile)
IF IsExists(seed_ASPfile) THEN
url_path=GetFullPath()&seed_ASPfile
'response.write url_path
make_content=GetPage(url_path)
call WriteToFile(make_fileName,make_content)
if err.number>0 then
response.write "<BR>File Generate Failed!"
else
'response.write make_content
response.write "<BR>OK!! the File [ <font color=red>"&make_fileName&"</font> ] has Generated!"
end if
ELSE
RESPONSE.WRITE("参数错误")
END IF
END SUB
make_fileName=request.QueryString("MakeFile")
seed_ASPfile=request.QueryString("SeedFile")
IF request.ServerVariables("QUERY_STRING")>"" then
CALL MakeXML(make_fileName,seed_ASPfile)
END IF
%>
本文地址：http://com.8s8s.com/it/it7866.htm