<%@ LANGUAGE="VBScript" CODEPAGE="65001" %>
<%
'============================================================
' 版权:aabc
' 更新: 2006-04-15
' 主页:funxa.com funxa.net happydna.com happydna.net 100fun.com.cn
' 电邮: admin@funxa.com aa19972002@yahoo.com.cn
' Q Q :32781884
'============================================================
Response.Buffer = True
Response.Charset = "UTF-8"
EditPageSize=400
'=========================注:以下间隔部分是化境上传类======================
dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function
Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function
Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version="化境HTTP上传程序 Version 2.0"
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_5xsoft = Server.CreateObject("adodb.stream")
Data_5xsoft.Type = 1
Data_5xsoft.Mode =3
Data_5xsoft.Open
Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)
Data_5xsoft.Position=0
RequestData =Data_5xsoft.Read
iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iInfoEnd
Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
End Sub
Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = Server.Mappath("/")
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_5xsoft.position=FileStart
Data_5xsoft.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
'==================================================================================================================
%>
<%
Select Case Request.Querystring("act")
Case "readfile"
Call ReadFile()
Case "newfile"
Call NewFile()
Case "uploadfile"
Call UPLoadFile()
Case "copyfile"
Call CopyFile()
Case "cutfile"
Call CutFile()
Case "pastefile"
Call PaseFile()
Case "renamefilewrite"
Call ReNameFileWrite()
Case "renamefile"
Call ReNameFile()
Case "downfile"
Call DownloadFile(Request.Querystring("fileurl"))
Case "getfield"
Call GetField()
Case "compactdb"
Call CompactDB()
Case "delfile"
Call DelFile()
Case "savenewfile"
Call SaveNewFile()
Case "deletefile"
Call DeleteFile()
Case "newfolder"
Call NewFolder()
Case "copyfolder"
Call CopyFolder()
Case "pastefolder"
Call PasteFolder()
Case "delfolder"
Call DelFolder()
Case "deletefolder"
Call DeleteFolder()
Case "createnewfolder"
Call CreateNewFolder()
Case "renamefolderwrite"
Call ReNameFolderWrite()
Case "renamefolder"
Call ReNameFolder()
Case "cutfolder"
Call CutFolder()
Case Else
Call Main()
End Select
Sub Main()
Call Head("WAP在线管理","","")
PathUrl=Request.Querystring("pathurl")'接收虚拟地址信息
If PathUrl="" Then PathUrl="\" '首判断赋值
set FsObj=Server.CreateObject("scripting.filesystemobject") '创建对象
set MyFolder=FsObj.GetFolder(Server.Mappath(PathUrl)) '创建实例
Response.Write (""&PathUrl&" ------------------- ") '显示当前目录
For Each j in MyFolder.SubFolders '循环目录
Response.Write (""&UTF8(FsObj.GetBaseName(j))&" ")
Next
For Each i in MyFolder.Files '循环文件
Response.Write ("") '转化为虚拟路径
Response.Write UTF8(FsObj.GetFileName(i))&" "
Next
Response.Write " ---------------------- "
Response.Write UTF8("大小:")&Formatnumber((MyFolder.Size/1024/1024),2,-1) & "M " '显示大小
Call SetFolder(PathUrl) '调出文件夹操作选项菜单
If PathUrl<>"\" Then
Response.Write "回上级"&FsObj.GetBaseName(FsObj.GetParentFolderName(PathUrl))&"目录 "
Response.Write ""&UTF8("返回根目录")&" "
End If
MyFolder=Close
Set MyFolder=Nothing
Set FsObj=Nothing
Last()
End Sub
Sub ReadFile()
FileUrl=Request.Querystring("fileurl")'接收虚拟地址信息
FilePage=Cint(Request.Querystring("filepage"))'接收文件分页信息
CharType=Request.Querystring("chartype")
If CharType="" Then CharType="GB2312"
Set FsObj=CreateObject("scripting.filesystemobject")
HeadFileName=FsObj.GetFileName(FileUrl) '这里的变量按理可以直接使用,用OP测试也是可以的
BackFolderURL=FsObj.GetParentFolderName(FileUrl) '但放到空间上,用手机测试却变成了空量,使用FSO转一下,手机上测试又通过了.怪.
DownURL=Server.Mappath(FileUrl)
FileExtensionName=FsObj.GetExtensionName(FileUrl)
Set FsObj=Nothing
Call Head(HeadFileName,"","")
If ReTextFile(FileExtensionName)="text" Then '如果该文件格式可以阅读
Set SrmObj = Server.CreateObject("adodb.stream")
SrmObj.Type=1
SrmObj.Mode=3
SrmObj.Open
SrmObj.Position=0
SrmObj.LoadFromFile Server.MapPath(FileUrl)
SrmObj.Position = 0
SrmObj.Type=2
SrmObj.Charset=CharType
FileStr=SrmObj.ReadText
Set SrmObj=Nothing
FilePageCount=Int((Len(FileStr)/EditPageSize))+1
Response.Write UTF8(Mid(FileStr,EditPageSize*FilePage+1,EditPageSize))&"
"
If FilePage < FilePageCount-1 Then Response.Write ""&UTF8("下一页")&""
If FilePage >0 Then Response.Write ""&UTF8("上一页")&" "
Response.Write "("&(FilePage+1)&"/"&FilePageCount&") "
ElseIf ReTextFile(FileExtensionName) = "pic" Then
Response.Write " "
ElseIf FileExtensionName = "mdb" Then Response.Write GetTable(FileUrl) '如果是数据库文档
Else
Response.Write "不支持" & FileExtensionName & "格式文件在线查看,但可直接下载.
"
End If
Response.Write " "
Response.Write "返回上级目录 "
Call Last()
End Sub
Sub NewFile()
Call Head("新建文件","","")
PathUrl=Request.Querystring("pathurl")
Response.Write ""&PathUrl&" -------------------------- "
Response.Write "文档名称(含后缀):
"
Response.Write "文档内容:
"
Response.Write " 保存|"
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write "取消 "
Call Last()
End Sub
Sub NewFolder()
Call Head("新建文件夹","","")
PathUrl=Request.Querystring("pathurl")
Response.Write ""&PathUrl&" -------------------------- "
Response.Write "文件夹名称(英文/数字)
"
Response.Write " 创建|"
Response.Write ""
Response.Write ""
Response.Write "取消 "
Call Last()
End Sub
Sub DelFolder()
Call Head("删除文件夹","","")
PathUrl=Request.Querystring("pathurl")
Response.Write "你真的要删除"&PathUrl&"这个文件夹吗?"
Response.Write "
"
Call Last()
End Sub
Sub DeleteFolder()
PathUrl=Request.Querystring("pathurl")
Set FsObj=Server.CreateObject("scripting.filesystemobject")
Fsobj.DeleteFolder Server.Mappath(PathUrl)
Call Head("删除ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&FsObj.GetParentFolderName(PathUrl))
Response.Write "已经删除,正在返回..
"
Response.Write "手动返回 "
Set FsObj=Nothing
Call Last()
End Sub
Sub SaveNewFile()
PathUrl=Request.Querystring("pathurl")
FileName=Request.Form("filename")
FileContent=Request.Form("filecontent")
Call Head("保存"&FileName,50,Request.ServerVariables("PATH_INFO")&"?pathurl="&PathUrl)
Set FsObj=Server.CreateObject("Scripting.filesystemobject")
Set NewTextFile=FsObj.CreateTextFile(Server.Mappath(PathUrl)&"\"&FileName)
NewTextFile.WriteLine(FileContent)
Response.Write "已经将文件写入路径:"&PathUrl&"中,正在返回..
"
Response.Write "手动返回 "
NewTextFile=Close
Set NewTextFile=Nothing
Set FsObj=Nothing
Call Last()
End Sub
Sub DelFile()
FileUrl=Request.Querystring("fileurl")
Call Head("删除文件","","")
Response.Write "真的要删除"&FileUrl&"吗?"
Response.Write "
删除|"
Response.Write "取消 "
Call Last()
End Sub
Sub DeleteFile()
FileUrl=Request.Querystring("fileurl")
Set FsObj=Server.CreateObject("scripting.filesystemobject")
Call Head("删除"&FsObj.GetFileName(FileUrl),50,Request.ServerVariables("PATH_INFO")&"?pathurl="&FsObj.GetParentFolderName(FileUrl))
FsObj.DeleteFile Server.Mappath(FileUrl)
Response.Write "已经删除,正在返回..
"
Response.Write "手动返回 "
Set FsObj=Nothing
Call Last()
End Sub
Sub CreateNewFolder()
PathUrl=Request.Querystring("pathurl")
FolderName=Request.Form("foldername")
Call Head("保存ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&PathUrl)
Set FsObj=Server.CreateObject("Scripting.filesystemobject")
FsObj.CreateFolder(Server.Mappath(PathUrl)&"\"&FolderName)
Set FsObj=Nothing
Response.Write "已经将文件夹"&FolderName&"创建在路径:"&PathUrl&"中,正在返回...
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub CopyFolder()
PathUrl=Request.Querystring("pathurl")
Call Head("复制ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&PathUrl)
If PathUrl="" Or PathUrl="\" Then Call ErrorStr("不能复制根目录")
Session("FolderPath")=PathUrl
Session("FolderCopyORCut")="Copy"
Response.Write "复制完成,请选择其它目录进行粘贴操作,正在返回..
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub CopyFile()
FileUrl=Request.Querystring("fileurl")
Call Head("复制ing..",50,Request.ServerVariables("PATH_INFO")&"?act=readfile&fileurl="&FileUrl)
Session("FilePath")=FileUrl
Session("FileCopyORCut")="Copy"
Response.Write "复制完成,请选择其它目录进行粘贴操作,正在返回..
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub CutFolder()
PathUrl=Request.Querystring("pathurl")
Call Head("剪切ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&PathUrl)
If PathUrl="" Or PathUrl="\" Then Call ErrorStr("不能剪切根目录")
Session("FolderPath")=PathUrl
Session("FolderCopyORCut")="Cut"
Response.Write "剪切完成,请选择其它目录进行粘贴操作,正在返回..
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub CutFile()
FileUrl=Request.Querystring("fileurl")
Call Head("剪切ing..",50,Request.ServerVariables("PATH_INFO")&"?act=readfile&fileurl="&FileUrl)
Session("FilePath")=FileUrl
Session("FileCopyORCut")="Cut"
Response.Write "剪切完成,请选择其它目录进行粘贴操作,正在返回..
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub PasteFolder()
PathUrl=Request.Querystring("pathurl")
Call Head("粘贴ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&PathUrl)
If Session("FolderPath")="" Then Call ErrorStr("没有可粘贴内容!")
If Session("FolderPath")=PathUrl Then Call ErrorStr("源文件夹与目标文件夹不能相同")
Set FsObj=CreateObject("scripting.filesystemobject")
FolderName=FsObj.GetBaseName(Session("FolderPath"))
FsObj.CreateFolder(Server.Mappath(PathUrl)&"\"&FolderName)
FsObj.CopyFolder Server.Mappath(Session("FolderPath")),Server.Mappath(PathUrl)&"\"&FolderName
If Session("FolderCopyORCut")="Cut" Then FsObj.DeleteFolder Server.Mappath(Session("FolderPath"))
Set FsObj=Nothing
Session("FolderPath")=""
Session("FolderCopyORCut")=""
Response.Write "粘贴处理完毕,正在返回...
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub PaseFile()
PathUrl=Request.Querystring("pathurl")
Call Head("粘贴ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&PathUrl)
If Session("FilePath")="" Then Call ErrorStr("没有可粘贴内容")
Set FsObj=CreateObject("scripting.filesystemobject") '创建FSO对象
FsObj.CopyFile Server.Mappath(Session("FilePath")),Server.Mappath(PathUrl)&"\"&FsObj.GetFileName(Session("FilePath"))
If Session("FileCopyORCut")="Cut" Then FsObj.DeleteFile Server.Mappath(Session("FilePath"))
Set FsObj=Nothing
Session("FilePath")=""
Session("FileCopyORCut")=""
Response.Write "粘贴完成,正在返回..
"
Response.Write "手动返回 "
Call Last()
End Sub
Sub ReNameFolderWrite()
PathUrl=Request.Querystring("pathurl")
Call Head("重命名文件夹","","")
Response.Write ""&PathUrl&" -------------------------- "
Response.Write "重命名(英文/数字)
"
Response.Write " 确定|"
Response.Write ""
Response.Write ""
Response.Write "取消 "
Call Last()
End Sub
Sub ReNameFileWrite()
FileUrl=Request.Querystring("FileUrl")
Call Head("重命名文档","","")
Response.Write ""&Left(FileUrl,Instrrev(FileUrl,"\"))&" -------------------------- "
Response.Write "重命名(英文/数字)
"
Response.Write "注:必须有文件后缀 "
Response.Write " 确定|"
Response.Write ""
Response.Write ""
Response.Write "取消 "
Call Last()
End Sub
Sub ReNameFolder()
PathUrl=Request.Querystring("pathurl")
FolderName=Request.Form("foldername")
Set FsObj=CreateObject("scripting.filesystemobject")
Fsobj.MoveFolder Server.Mappath(PathUrl),Server.Mappath(FsObj.GetParentFolderName(PathUrl)&"\"&FolderName)
Call Head("重命名ing..",50,Request.ServerVariables("PATH_INFO")&"?pathurl="&FsObj.GetParentFolderName(PathUrl)&"\"&FolderName)
Response.Write "已经将路径"&PathUrl&"文件夹重命名为"&FolderName&"正在返回..
"
Response.Write "手动返回 "
Set FsObj=Nothing
Call Last()
End Sub
Sub ReNameFile()
FileUrl=Request.Querystring("fileurl")
FileName=Request.Form("filename")
Set FsObj=CreateObject("scripting.filesystemobject")
FsObj.MoveFile Server.Mappath(FileUrl),Server.Mappath(FsObj.GetParentFolderName(FileUrl)&"\"&FileName)
Call Head("重命名ing..",50,Request.ServerVariables("PATH_INFO")&"?act=readfile&fileurl="&FsObj.GetParentFolderName(FileUrl)&"\"&FileName)
Response.Write FsObj.GetParentFolderName(FileUrl)&"\"&FileName &" "
Response.Write "已经将路径"&FileUrl&"文档重命名为"&FileName&"正在返回..
"
Response.Write "手动返回 "
Set FsObj=Nothing
Call Last()
End Sub
Sub GetField()
DBName=Request.Querystring("fileurl")
FieldName=Request.Querystring("fieldName")
Call Head(FieldName,"","")
Response.Write ""&DBName&" ------------------- "&FieldName&"
"
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "DBQ=" & Server.Mappath(DBName) & ";DRIVER={Microsoft Access Driver (*.mdb)};"
Set Rs=Server.CreateObject("ADODB.Recordset")
Sql="select * from ["&FieldName&"] where 1<>1"
Rs.Open Sql,Conn,1,1
For i=0 to (Rs.Fields.Count-1)
Response.Write "" & Rs.Fields(i).Name & " "
Response.Write "类型:" & GetType(Rs.Fields(i).type) & " "
Response.Write "长度:" & Rs.Fields(i).DefinedSize & "
"
Next
Response.Write "------------------- " & FieldName & "表共有" & Rs.Fields.Count & "个字段 -------------------- "
Set Rs=Nothing
Set Conn=Nothing
Response.Write "返回数据库 "
Response.Write "返回界面 "
Call Last()
End Sub
Function GetTable(DBName)
GetTable = ""&DBName&" ------------------- "
Set Conn = Server.CreateObject("ADODB.Connection")
Conn.Open "DBQ=" & Server.Mappath(DBName) & ";DRIVER={Microsoft Access Driver (*.mdb)};"
Set Rs = Conn.OpenSchema(20)
Rs.MoveFirst
While not rs.EOF
If Rs(3)="TABLE" Then
GetTable=GetTable & ""&Rs(2)&"
"
End If
Rs.MoveNext
Wend
GetTable=GetTable & "压缩数据库 "
Set Rs=Nothing
Set Conn=Nothing
End Function
Function GetType(TypeNum)
Select Case Cint(TypeNum)
Case 2
GetType = "数字整型"
Case 3
GetType = "数字长整"
Case 4
GetType = "数字单精"
Case 5
GetType = "数字双精"
Case 6
GetType = "货币"
Case 11
GetType = "布尔"
Case 17
GetType = "数字字节"
Case 72
GetType = "数字同步ID"
Case 131
GetType = "数字小数"
Case 135
GetType = "日期/时间"
Case 202
GetType = "文本"
Case 203
GetType = "备注/链接"
Case 205
GetType = "OLE对象类型"
End Select
End Function
Sub UploadFile()
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write "WAPFTP"
Response.Write ""
Response.Write ""
Response.Write "
"
UPFolderPath=Request.Querystring("folderpath")
If Request.Querystring("amd")<>"ok" Then
Response.Write "上传到"&UPFolderPath&" -------------------- "
Response.Write "注:手机需支持2.0上传 "
Response.Write "
"
Response.Write "返回目录 "
Response.Write "返回界面"
Else
Set upload=new upload_5xsoft
Set file=upload.file("file1")
if file.fileSize>0 then
file.saveAs Server.mappath(UPFolderPath&"\"&file.FileName)
response.write " 文件:"&file.FileName&"上传成功!"
response.write " size:"&file.FileSize
response.Write "
继续上传"
response.Write " 返回目录"
response.Write " 返回界面"
End If
Set file=nothing
Set upload=nothing
End If
Response.Write ""
Response.Write ""
Response.Write ""
End Sub
Sub CompactDB()
FileUrl=Request.Querystring("fileurl")
Call Head("数据库压缩ing..",50,Request.ServerVariables("PATH_INFO")&"?act=readfile&fileurl="&FileUrl)
Set FsObj = CreateObject("Scripting.FileSystemObject")
InfoDB = Server.MapPath(FileUrl)
NewDB = Server.MapPath(FileUrl)& ".bak"
Set Eng = Server.CreateObject("JRO.JetEngine")
Pvd = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Eng.CompactDatabase Pvd & InfoDB , Pvd & NewDB
Set Eng = Nothing
FsObj.DeleteFile InfoDB
FsObj.MoveFile NewDB, InfoDB
Response.write "数据库"&FsObj.GetFileName(FileUrl)&"压缩完成,正在返回.. "
Set FsObj= Nothing
Response.Write "手动返回 "
Call Last()
End Sub
Sub SetFolder(PathUrl)
Response.Write " "
End Sub
Sub Head(hdstr,timemun,urlstr)
Response.ContentType = "text/vnd.wap.wml"
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write ""
Response.Write "
"
End Sub
Sub Last
Response.Write " Funxa-版权所有"
Response.Write "
"
Response.Write ""
Response.Write ""
Response.End
End Sub
Function UTF8(Str)
Dim i,OneStr,AllStr
For i = 1 To Len(Str)
OneStr = Mid(Str,i,1)
AllStr = AllStr & chr(38) & chr(35) & chr(120) & Hex(Ascw(OneStr)) & chr(59)
Next
UTF8 = AllStr
End Function
Sub ErrorStr(str)
Response.Write UTF8("错误信息:"&str)&" "
Call Last
End Sub
Function ReTextFile(Str)
ReStr=Split("asp|aspx|php|jsp|html|htm|xml|shtm|shtml|wml|asa|asc|inc|txt|ini|css|js|vb|","|")
For i=0 to Ubound(ReStr)
If Lcase(Str)=Cstr(ReStr(i)) Then
ReTextFile="text"
Exit For
End If
Next
ReStr=Split("jpg|jpeg|bmp|wbmp|gif|png|","|")
For i=0 to Ubound(ReStr)
If Lcase(Str)=Cstr(ReStr(i)) Then
ReTextFile="pic"
Exit For
End If
Next
End Function
Function DownLoadFile(StrFile)
StrFilename = Server.MapPath(StrFile) '得到绝对路径
'StrFilename=StrFile
Response.Buffer = True
Response.Clear
Set SrmObj = Server.CreateObject("ADODB.Stream") '创建Stream流对象
SrmObj.Open
SrmObj.Type = 1
On Error Resume Next '忽略所有错误
Set FsObj = Server.CreateObject("Scripting.FileSystemObject") '创建FSO实例
Set MyFile = FsObj.GetFile(StrFilename) '创建一个File实例
SrmObj.LoadFromFile(StrFilename)
Response.AddHeader "Content-Disposition","attachment; filename="&MyFile.name '文件
Response.AddHeader "Content-Length",MyFile.Size '大小
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream" '类型
Response.BinaryWrite SrmObj.Read
Response.Flush
SrmObj.Close
Set SrmObj = Nothing
End Function
%>