得到当前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 %>

|