filecreate.asp

本软件可以把网站中的ASP文件转成HTML文件便于网站优化!

<% option explicit %>
<%
Response.Buffer = true
Response.ExpiresAbsolute = now()-1
Response.Expires = 0
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "No-Cache"
Response.Clear()

'文件操作定义开始----------------------------------------------------------------------------------------------------
dim FileObject
function CreateDIR(byval LocalPath) '建立目录，如果有多级目录，则一级一级的创建
	dim patharr
	dim path_level
	dim i
	dim pathtmp
	dim cpath
	LocalPath = replace(LocalPath,"\","/")
	set FileObject = server.createobject("Scrip" & "ting.File" & "SystemObject")
	patharr = split(LocalPath,"/")
	path_level = ubound(patharr)
	for i = 0 to path_level
		if i=0 then pathtmp=patharr(0) & "/" else pathtmp = pathtmp & patharr(i) & "/"
		cpath = left(pathtmp,len(pathtmp)-1)
		if not FileObject.FolderExists(cpath) then FileObject.CreateFolder cpath
	next
	set FileObject = nothing
	if err.number<>0 then
		CreateDIR = false
		err.Clear
	else
		CreateDIR = true
	end if
end function
Function ReportFileStatus(FileName) 
	Dim msg
	msg = -1
	If (FileObject.FileExists(FileName)) Then
		msg = 1
	Else
	msg = -1
	End If
	ReportFileStatus = msg
End Function
'写文本文件
Function WriteTxtFile(FileName,TextStr,WriteORAppendType)
	Const ForReading = 1, ForWriting = 2 , ForAppending = 8
	Dim f, m
	set FileObject = server.createobject("Scrip" & "ting.File" & "SystemObject")
	select Case WriteORAppendType
		Case 1: '文件进行写操作
			Set f = FileObject.OpenTextFile(FileName, ForWriting, True)
			f.Write TextStr
			f.Close
			If ReportFileStatus(FileName) = 1 then
				WriteTxtFile = 1
			Else
				WriteTxtFile = -1
			End if
		Case 2: '文件末尾进行写操作
			If ReportFileStatus(FileName) = 1 then
				Set f = FileObject.OpenTextFile(FileName, ForAppending)
				f.Write TextStr
				f.Close
				WriteTxtFile = 1
			Else
				WriteTxtFile = -1
			End if
	End select
End Function
'文件操作定义结束-------------------------------------------------------------------------------------------------------------

'获取内容
dim content
content=request("content")
if len(content)<6 then response.write "无内容，创建失败...":response.end 
CONST REP_FOLDER="asp_to_html"
dim sDir
dim sBaseFolder
dim sBasePath
dim sFolderName	'文件夹
dim sFileName	'文件名
dim sFilePath
sBaseFolder=trim(Request("basefolder"))
sFolderName=trim(Request("foldername"))
sFileName=trim(Request("filename"))
if len(sFileName)<1 then response.write "无文件名,创建失败...":response.end 

'获取虚拟目录
'sFileName=Year(DateStr)&"-"&Month(DateStr)&"-"&Day(DateStr)
sBasePath=Replace(server.MapPath("./"),REP_FOLDER,"")
'response.write "sBasePath:"&sBasePath
'response.end 
if len(sBaseFolder)>1 then
	sBasePath=sBasePath & sBaseFolder & "\"
end if

if len(sFolderName)>1 then
	sDir=CreateDIR(sBasePath & sFolderName)
	if sDir=false then
		response.write "找不到目录,创建失败...":response.end 
	end if
	sFilePath=sBasePath & sFolderName &"\"& sFileName &".html"
else
	sFilePath=sBasePath & sFileName &".html"
end if
if request("ispost")="yes" then
	if WriteTxtFile(sFilePath,content,1)=1 then
		response.write sFileName & "&nbsp;&nbsp;创建成功..."
		response.write "<script>window.close();</script>"
	else
		response.write sFileName & "&nbsp;&nbsp;创建失败..."
	end if
end if
%>