件絕對路徑的獲取（支援非８０埠） 

作者：airzen　　轉自：http://blog.csdn.net/airzen/

得到當前asp執行檔所在的絕對路徑（支援帶埠的絕對路徑）以'/'結束　
在解決一些XML文檔調用時有用．或應用到小偷程式中

程式如下
//powered By Airzen
//qq:39192170
//e_mail:airzen@sohu.com
//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  :airzen@sohu.com
'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
%>

 

文章來自: Tank部落格
引用通告: 查看所有引用 | 我要引用此文章
Tags: 絕對路徑
相關日誌: