关于文件对象的使用
时间：2006-08-19 来源：ccut
<%@ Language=VBScript %>
<%Response.buffer=true
Level=1%>
<HTML>
<HEAD>
<meta http-equiv="content-type" content="text/html;charset=gb2312">
<title>aspEdit</title>
<link rel=stylesheet type="text/css" href="styles/style.css">
</HEAD>
<BODY>
<!--#include File ="includes/banner.inc"-->
<!--#include File ="includes/upload.inc"-->
<div align="center">
<%
'创建FileSystemObject对象
Set fso = Server.CreateObject("Scripting.FileSystemObject")
'获得路径
Path=request.querystring("Path")
If Right(Path,1)="/" AND Path<>"/" Then Path=Left(Path,Len(Path)-1)
response.write("<font color='white'><b>" & Path & "</font></b><br>")
Var =InstrRev(Path,"/")
dirup=left(Path,Var)
'显示上一级目录链接
response.write ("[<a href='browser.asp?path=" & dirup & "'>上一级</a>]")
%>
[<a href="browser.asp?path=/">根目录</a>]<br>
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td>
<form name="FormName" <%="action='browser.asp?path=" & path & "&aktion=createfolder'"%>method="post">
<div align="center">
<input type="text" name="newSubF" size="24"><br>
<input type="submit" name="submitButtonName" value="创建子目录"></div>
</form>
</td>
<td>
<form name="FormName" <%="action='browser.asp?path=" & path & "&aktion=createfile'"%>method="post">
<div align="center">
<input type="text" name="newFile" size="24"><br>
<input type="submit" name="submitButtonName" value="创建文件"></div>
</form>
</td>
</tr>
</table>
<hr>
<%
'获取用户选择的功能选项
aktion=request.querystring("aktion")
Set ts=fso.GetFolder(Server.MapPath(Path))
Select Case aktion
Case "upload" '文件上载
If Len(Request.TotalBytes) > 0 Then
Response.Write("文件将被上载到当前目录 " & Path)
Init '初始化
For x=1 to int(request.querystring("NumOfUploads"))
fName="fName" & x
Server.ScriptTimeout = 250 '由于文件上传速度比较慢，因此要设置页面处理时间要延长
If getFileName(fName)<>"" then
If saveAs(fName,"") = true then
response.write ("<br>文件" & getFileName(fName) & " (Content-Type: " & getContentType(fName) & ") 上载成功.")
else
response.write("<br>文件 " & getFileName(fName) & "上载错误!")
end if
End if
Next
Response.Write("<hr>")
End If
Case "deletefile" '删除文件
fso.DeleteFile(Server.MapPath(request.querystring("file")))
response.write("文件被删除.<hr>")
Case "deletefolder" '删除目录
fso.DeleteFolder(Server.MapPath(request.querystring("folder")))
response.write("目录被删除.<hr>")
Case "createfile"
If right(Path,1)<>"/" then Path= Path & "/"
fso.CreateTextFile(Server.MapPath(Path & request.form("newFile")))
response.write("文件被创建成功!.<hr>")
Case "createfolder" '创建目录
If right(Path,1)<>"/" then Path= Path & "/"
fso.CreateFolder(Server.MapPath(Path & request.form("newSubF")))
response.write("目录创建成功!.<hr>")
End select %>
<table border="0" cellpadding="0" cellspacing="1" width="100%" bgcolor="#FFFFFF">
<tr>
<td colspan="7" bgcolor="#C0C0C0" height="14">
<div align="center">
<font color="#FFFFFF">
<b><span style="background-color: #000000">子目录</span></b></font></div>
</td>
</tr>
<%
For each SubF in ts.Subfolders '获取所有子目录
If right(Path,1)="/" then
WholeSubF=Path & SubF.Name
else
WholeSubF=Path & "/" & SubF.Name
end if%>
<tr>
<td colspan="3"><%="<a href='browser.asp?path=" & WholeSubF & "'>" & SubF.Name & "</a>"%></td>
<td width="15%">
<div align="right">
<%Response.Write SubF.DateLastModified%></div>
</td>
<td width="5%"></td>
<td width="5%">
<div align="center">
</div>
</td>
<td width="5%">
<div align="center">
<font size="-2">
<a <%="href='browser.asp?path=" & path & "&aktion=deletefolder&folder=" & WholeSubF & "'"%>>
删除</a></font></div>
</td>
<%next%>
</tr>
<tr>
<td colspan="7" bgcolor="#C0C0C0">
<div align="center">
<b>文件</b></div>
</td>
</tr>
<%
For each File in ts.files '显示所有文件
If right(Path,1)="/" then
WholeFile=Path & File.Name
else
WholeFile=Path & "/" & File.Name
end if %>
<tr>
<td><%=File.Name%></td>
<td width="25%">
<div align="center">
<%=File.Type%></div>
</td>
<td width="5%">
<div align="right">
<%
if File.Size <1024 Then '如果文件小于1K，则直接显示字节数量
Response.Write File.Size & " B"
ElseIf File.Size < 1048576 Then '小于1M的显示KB
Response.Write Round(File.Size / 1024.1) & " KB"
Else
Response.Write Round((File.Size/1024)/1024.1) & " MB" '其余显示MB
End if
Var=InstrRev(File.Name,".")
FileType=Right(File.Name,Len(File.Name)-Var)
%></div>
</td>
<td width="15%">
<div align="right">
<%Response.Write File.DateLastModified%></div>
</td>
<td width="5%">
<div align="center">
<%
If FileType="mdb" then '如果是ACCESS数据库，添加编辑链接
response.write ("<font size='-2'><a href='dbeditor.asp?path=" & WholeFile & "' target='_blank'>编辑数据库</a></font>")
else
response.write ("<font size='-2'><a href='editor.asp?path=" & path & "&file=" & WholeFile & "' target=_blank'>编辑</a></font>")
end if
%></div>
</td>
<td width="5%">
<div align="center">
<%
response.write (" <font size='-2'><a href='" & WholeFile & "' target=_blank'>打开/下载</a></font>")
%></div>
</td>
<td width="5%">
<div align="center">
<font size="-2">
<a <%="href='browser.asp?path=" & path & "&aktion=deletefile&file=" & WholeFile & "'"%>>
删除</a></font></div>
</td>
</tr>
<%next%> </table>
<hr>
<p><b>Upload:<br>
<%
If request.querystring("NumOfUploads")="" Or int(request.querystring("NumOfUploads"))<1 then NumOfUploads=1 Else NumOfUploads=int(request.querystring("NumOfUploads"))
%> </b>[<a <%="href='browser.asp?path=" & path & "&numofuploads=" & numofuploads+5 & "'"%>>多文件上载</a>][<a <%="href='browser.asp?path=" & path & "&numofuploads=" & numofuploads-5 & "'"%>>单个文件上载</a>]<br>
注意：文件被上载到当前目录，如果有同名的，则会覆盖！！！</p>
<FORM name=frmTest <%="action='browser.asp?path=" & path & "&aktion=upload&NumOfUploads=" & NumOfUploads & "'"%> method=post enctype="multipart/form-data">
<%For x=1 to NumOfUploads
response.write("<INPUT type='file' name='fName" & x & "'><BR>")
Next
%>
<INPUT TYPE=submit NAME=cmdSubmit VALUE="开始上载">
</FORM>
</div>
</BODY>
</HTML>
<%
Set fso = Nothing
Set ts = Nothing
%> upload.inc: <% '********************************************************************************
'变量声明
'********************************************************************************
const ForReading = 1 '读文件
const ForWriting = 2 '写文件
const ForAppending = 3 '添加文件 dim FileCount '上载的文件数量
dim FieldCount '表单的数量
dim Path '保存文件的路径
dim Dict '保存数据的字典对象 Path = Server.mappath(".") & "\" '设定路径，为当前服务器跟目录
FileCount = 0
FieldCount = 0
Dict = Null
'**********************************************************************************************
'Methods
'**********************************************************************************************
'----------------------------------------------------------------------------------------------
'Init - 根据上载的二进制数据创建dictionary对象
' 参数
' pServer [in] - 指向asp的server对象
' pRequest [in] - 指向asp的request对象
'
' init函数返回一个包含数据的dictionary对象
'----------------------------------------------------------------------------------------------
Function Init() Dim tBytes
Dim binData
Dim scrDict tBytes = Request.TotalBytes '获得总字节
RequestBin = Request.BinaryRead(tBytes) '读入数据 Set scrDict = Server.CreateObject("Scripting.Dictionary") '创建字典对象 PosBeg = 1
'查找回车符号
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13))) If PosEnd < 2 Then '如果没有数据，则返回空字典对象
Set Dict = Server.CreateObject("Scripting.Dictionary")
Exit Function
End If boundary = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
BoundaryPos = InStrB(1, RequestBin, boundary)
'根据文件上载的原理分离各个文件的数据以及各个字段的数据
'文件上载的原理参照文件上载那一章的详细介绍
Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--")))
Dim UploadControl
Set UploadControl = Server.CreateObject("Scripting.Dictionary")
Pos = InStrB(BoundaryPos, RequestBin, getByteString("Content-Disposition"))
Pos = InStrB(Pos, RequestBin, getByteString("name="))
PosBeg = Pos + 6
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
Name = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
PosFile = InStrB(BoundaryPos, RequestBin, getByteString("filename="))
PosBound = InStrB(PosEnd, RequestBin, boundary) If PosFile <> 0 And (PosFile < PosBound) Then
FileCount = FileCount + 1
PosBeg = PosFile + 10
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
FileName = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
UploadControl.Add "FileName", FileName
Pos = InStrB(PosEnd, RequestBin, getByteString("Content-Type:"))
PosBeg = Pos + 14
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))
ContentType = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
UploadControl.Add "ContentType", ContentType
PosBeg = PosEnd + 4
PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2
Value = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
Else
FieldCount = FieldCount + 1
Pos = InStrB(Pos, RequestBin, getByteString(Chr(13)))
PosBeg = Pos + 4
PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2
Value = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
End If UploadControl.Add "Value", Value
scrDict.Add Name, UploadControl '添加到字典对象中
BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary)
Loop Set Dict = scrDict
Set scrDict = Nothing End Function
'----------------------------------------------------------------------------------------------
'saveAs - 将上载的文件保存成用户指定的文件名
' 参数
' sHTMLFormField [in] - 保存新文件的路径和名称
' 如果为空，则使用当前路径以及原始的文件名
' 如果文件保存成功，saveAs 返回true
'----------------------------------------------------------------------------------------------
Function saveAs( sHTMLFormField, sNewFile) If Dict.Exists(sHTMLFormField) And Len(getFileName(sHTMLFormField)) > 0 Then binData = Dict.Item( sHTMLFormField).Item("Value")
binData = getString( binData) Dim sFilePath
sFilePath = Path & "/" & getFileName(sHTMLFormField)
If Len( sNewFile) <> 0 Then sFilePath = sNewFile Set oFSO = Server.CreateObject( "Scripting.FileSystemObject") '- 创建文件处理对象 ... Set oTextStream = oFSO.CreateTextFile(Server.MapPath(sFilePath), True) ' 创建一个二进制读写文件
oTextStream.Write( binData) '- 将二进制数据写入文件
oTextStream.Close '- 关闭文件 saveAs = True Else Response.Write( "File associated with HTML <FORM> field name <INPUT NAME=" & sHTMLFormField & "> not found!")
saveAs = False End If End Function
'----------------------------------------------------------------------------------------------
'getData -从Scripting.Dictionary对象中获取数据
' 参数
' sHTMLFormField [in] -表单名称
'
' 返回保存在字典对象中的html表单数据
'----------------------------------------------------------------------------------------------
Function getData(sHTMLFormField) If Dict.Exists(sHTMLFormField) Then
getData = Dict.Item( sHTMLFormField).Item("Value")
Else
getData = ""
End If
End Function
'----------------------------------------------------------------------------------------------
'getFileName - 获取文件名称
' 参数
' sHTMLFormField [in] - name of the item to retreive data for
'
' 返回文件名称
'----------------------------------------------------------------------------------------------
Function getFileName(sHTMLFormField) Dim strHTMLFormField
If Dict.Exists(sHTMLFormField) Then
strHTMLFormField = Dict.Item( sHTMLFormField).Item("FileName")
Else
strHTMLFormField = ""
End If Dim tPos
Dim strRtn
strRtn = ""
tPos = InStrRev(strHTMLFormField, "\")
If tPos = 0 Or IsNull(tPos) Then
strRtn = strHTMLFormField
Else
strRtn = Right(strHTMLFormField, Len(strHTMLFormField) - tPos)
End If getFileName = strRtn End Function
'----------------------------------------------------------------------------------------------
'getContentType - 获得上传文件的类型
' 参数
' sHTMLFormField [in] - 表单控件名称
'
' 返回文件类型
'----------------------------------------------------------------------------------------------
Function getContentType(sHTMLFormField)
If Dict.Exists(sHTMLFormField) Then
getContentType = Dict.Item( sHTMLFormField).Item("ContentType")
Else
getContentType = ""
End If
End Function '**********************************************************************************************
'Private Functions
'**********************************************************************************************
'----------------------------------------------------------------------------------------------
'getString -从数据中分离出字符串
' 参数
' StringBin [in] - 保存分离出来的字符串.
' 返回字符串数组.
'----------------------------------------------------------------------------------------------
Function getString(StringBin)
Dim strRtn
strRtn = ""
For intCount = 1 To LenB(StringBin)
strRtn = strRtn & Chr(AscB(MidB(StringBin, intCount, 1)))
Next
getString = strRtn
End Function
'----------------------------------------------------------------------------------------------
'getByteString - 将字符串转化成二进制数据
' 参数
' StringStr [in] - 保存转化成二进制的字符串.
' Returns byte data from a string.
'----------------------------------------------------------------------------------------------
Function getByteString(StringStr)
Dim strRtn
strRtn = ""
For i = 1 To Len(StringStr)
Char = Mid(StringStr, i, 1)
strRtn = strRtn & ChrB(AscB(Char))
Next
getByteString = strRtn
End Function %>
<%Response.buffer=true
Level=1%>
<HTML>
<HEAD>
<meta http-equiv="content-type" content="text/html;charset=gb2312">
<title>aspEdit</title>
<link rel=stylesheet type="text/css" href="styles/style.css">
</HEAD>
<BODY>
<!--#include File ="includes/banner.inc"-->
<!--#include File ="includes/upload.inc"-->
<div align="center">
<%
'创建FileSystemObject对象
Set fso = Server.CreateObject("Scripting.FileSystemObject")
'获得路径
Path=request.querystring("Path")
If Right(Path,1)="/" AND Path<>"/" Then Path=Left(Path,Len(Path)-1)
response.write("<font color='white'><b>" & Path & "</font></b><br>")
Var =InstrRev(Path,"/")
dirup=left(Path,Var)
'显示上一级目录链接
response.write ("[<a href='browser.asp?path=" & dirup & "'>上一级</a>]")
%>
[<a href="browser.asp?path=/">根目录</a>]<br>
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tr>
<td>
<form name="FormName" <%="action='browser.asp?path=" & path & "&aktion=createfolder'"%>method="post">
<div align="center">
<input type="text" name="newSubF" size="24"><br>
<input type="submit" name="submitButtonName" value="创建子目录"></div>
</form>
</td>
<td>
<form name="FormName" <%="action='browser.asp?path=" & path & "&aktion=createfile'"%>method="post">
<div align="center">
<input type="text" name="newFile" size="24"><br>
<input type="submit" name="submitButtonName" value="创建文件"></div>
</form>
</td>
</tr>
</table>
<hr>
<%
'获取用户选择的功能选项
aktion=request.querystring("aktion")
Set ts=fso.GetFolder(Server.MapPath(Path))
Select Case aktion
Case "upload" '文件上载
If Len(Request.TotalBytes) > 0 Then
Response.Write("文件将被上载到当前目录 " & Path)
Init '初始化
For x=1 to int(request.querystring("NumOfUploads"))
fName="fName" & x
Server.ScriptTimeout = 250 '由于文件上传速度比较慢，因此要设置页面处理时间要延长
If getFileName(fName)<>"" then
If saveAs(fName,"") = true then
response.write ("<br>文件" & getFileName(fName) & " (Content-Type: " & getContentType(fName) & ") 上载成功.")
else
response.write("<br>文件 " & getFileName(fName) & "上载错误!")
end if
End if
Next
Response.Write("<hr>")
End If
Case "deletefile" '删除文件
fso.DeleteFile(Server.MapPath(request.querystring("file")))
response.write("文件被删除.<hr>")
Case "deletefolder" '删除目录
fso.DeleteFolder(Server.MapPath(request.querystring("folder")))
response.write("目录被删除.<hr>")
Case "createfile"
If right(Path,1)<>"/" then Path= Path & "/"
fso.CreateTextFile(Server.MapPath(Path & request.form("newFile")))
response.write("文件被创建成功!.<hr>")
Case "createfolder" '创建目录
If right(Path,1)<>"/" then Path= Path & "/"
fso.CreateFolder(Server.MapPath(Path & request.form("newSubF")))
response.write("目录创建成功!.<hr>")
End select %>
<table border="0" cellpadding="0" cellspacing="1" width="100%" bgcolor="#FFFFFF">
<tr>
<td colspan="7" bgcolor="#C0C0C0" height="14">
<div align="center">
<font color="#FFFFFF">
<b><span style="background-color: #000000">子目录</span></b></font></div>
</td>
</tr>
<%
For each SubF in ts.Subfolders '获取所有子目录
If right(Path,1)="/" then
WholeSubF=Path & SubF.Name
else
WholeSubF=Path & "/" & SubF.Name
end if%>
<tr>
<td colspan="3"><%="<a href='browser.asp?path=" & WholeSubF & "'>" & SubF.Name & "</a>"%></td>
<td width="15%">
<div align="right">
<%Response.Write SubF.DateLastModified%></div>
</td>
<td width="5%"></td>
<td width="5%">
<div align="center">
</div>
</td>
<td width="5%">
<div align="center">
<font size="-2">
<a <%="href='browser.asp?path=" & path & "&aktion=deletefolder&folder=" & WholeSubF & "'"%>>
删除</a></font></div>
</td>
<%next%>
</tr>
<tr>
<td colspan="7" bgcolor="#C0C0C0">
<div align="center">
<b>文件</b></div>
</td>
</tr>
<%
For each File in ts.files '显示所有文件
If right(Path,1)="/" then
WholeFile=Path & File.Name
else
WholeFile=Path & "/" & File.Name
end if %>
<tr>
<td><%=File.Name%></td>
<td width="25%">
<div align="center">
<%=File.Type%></div>
</td>
<td width="5%">
<div align="right">
<%
if File.Size <1024 Then '如果文件小于1K，则直接显示字节数量
Response.Write File.Size & " B"
ElseIf File.Size < 1048576 Then '小于1M的显示KB
Response.Write Round(File.Size / 1024.1) & " KB"
Else
Response.Write Round((File.Size/1024)/1024.1) & " MB" '其余显示MB
End if
Var=InstrRev(File.Name,".")
FileType=Right(File.Name,Len(File.Name)-Var)
%></div>
</td>
<td width="15%">
<div align="right">
<%Response.Write File.DateLastModified%></div>
</td>
<td width="5%">
<div align="center">
<%
If FileType="mdb" then '如果是ACCESS数据库，添加编辑链接
response.write ("<font size='-2'><a href='dbeditor.asp?path=" & WholeFile & "' target='_blank'>编辑数据库</a></font>")
else
response.write ("<font size='-2'><a href='editor.asp?path=" & path & "&file=" & WholeFile & "' target=_blank'>编辑</a></font>")
end if
%></div>
</td>
<td width="5%">
<div align="center">
<%
response.write (" <font size='-2'><a href='" & WholeFile & "' target=_blank'>打开/下载</a></font>")
%></div>
</td>
<td width="5%">
<div align="center">
<font size="-2">
<a <%="href='browser.asp?path=" & path & "&aktion=deletefile&file=" & WholeFile & "'"%>>
删除</a></font></div>
</td>
</tr>
<%next%> </table>
<hr>
<p><b>Upload:<br>
<%
If request.querystring("NumOfUploads")="" Or int(request.querystring("NumOfUploads"))<1 then NumOfUploads=1 Else NumOfUploads=int(request.querystring("NumOfUploads"))
%> </b>[<a <%="href='browser.asp?path=" & path & "&numofuploads=" & numofuploads+5 & "'"%>>多文件上载</a>][<a <%="href='browser.asp?path=" & path & "&numofuploads=" & numofuploads-5 & "'"%>>单个文件上载</a>]<br>
注意：文件被上载到当前目录，如果有同名的，则会覆盖！！！</p>
<FORM name=frmTest <%="action='browser.asp?path=" & path & "&aktion=upload&NumOfUploads=" & NumOfUploads & "'"%> method=post enctype="multipart/form-data">
<%For x=1 to NumOfUploads
response.write("<INPUT type='file' name='fName" & x & "'><BR>")
Next
%>
<INPUT TYPE=submit NAME=cmdSubmit VALUE="开始上载">
</FORM>
</div>
</BODY>
</HTML>
<%
Set fso = Nothing
Set ts = Nothing
%> upload.inc: <% '********************************************************************************
'变量声明
'********************************************************************************
const ForReading = 1 '读文件
const ForWriting = 2 '写文件
const ForAppending = 3 '添加文件 dim FileCount '上载的文件数量
dim FieldCount '表单的数量
dim Path '保存文件的路径
dim Dict '保存数据的字典对象 Path = Server.mappath(".") & "\" '设定路径，为当前服务器跟目录
FileCount = 0
FieldCount = 0
Dict = Null
'**********************************************************************************************
'Methods
'**********************************************************************************************
'----------------------------------------------------------------------------------------------
'Init - 根据上载的二进制数据创建dictionary对象
' 参数
' pServer [in] - 指向asp的server对象
' pRequest [in] - 指向asp的request对象
'
' init函数返回一个包含数据的dictionary对象
'----------------------------------------------------------------------------------------------
Function Init() Dim tBytes
Dim binData
Dim scrDict tBytes = Request.TotalBytes '获得总字节
RequestBin = Request.BinaryRead(tBytes) '读入数据 Set scrDict = Server.CreateObject("Scripting.Dictionary") '创建字典对象 PosBeg = 1
'查找回车符号
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13))) If PosEnd < 2 Then '如果没有数据，则返回空字典对象
Set Dict = Server.CreateObject("Scripting.Dictionary")
Exit Function
End If boundary = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
BoundaryPos = InStrB(1, RequestBin, boundary)
'根据文件上载的原理分离各个文件的数据以及各个字段的数据
'文件上载的原理参照文件上载那一章的详细介绍
Do Until (BoundaryPos = InStrB(RequestBin, boundary & getByteString("--")))
Dim UploadControl
Set UploadControl = Server.CreateObject("Scripting.Dictionary")
Pos = InStrB(BoundaryPos, RequestBin, getByteString("Content-Disposition"))
Pos = InStrB(Pos, RequestBin, getByteString("name="))
PosBeg = Pos + 6
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
Name = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
PosFile = InStrB(BoundaryPos, RequestBin, getByteString("filename="))
PosBound = InStrB(PosEnd, RequestBin, boundary) If PosFile <> 0 And (PosFile < PosBound) Then
FileCount = FileCount + 1
PosBeg = PosFile + 10
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(34)))
FileName = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
UploadControl.Add "FileName", FileName
Pos = InStrB(PosEnd, RequestBin, getByteString("Content-Type:"))
PosBeg = Pos + 14
PosEnd = InStrB(PosBeg, RequestBin, getByteString(Chr(13)))
ContentType = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
UploadControl.Add "ContentType", ContentType
PosBeg = PosEnd + 4
PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2
Value = MidB(RequestBin, PosBeg, PosEnd - PosBeg)
Else
FieldCount = FieldCount + 1
Pos = InStrB(Pos, RequestBin, getByteString(Chr(13)))
PosBeg = Pos + 4
PosEnd = InStrB(PosBeg, RequestBin, boundary) - 2
Value = getString(MidB(RequestBin, PosBeg, PosEnd - PosBeg))
End If UploadControl.Add "Value", Value
scrDict.Add Name, UploadControl '添加到字典对象中
BoundaryPos = InStrB(BoundaryPos + LenB(boundary), RequestBin, boundary)
Loop Set Dict = scrDict
Set scrDict = Nothing End Function
'----------------------------------------------------------------------------------------------
'saveAs - 将上载的文件保存成用户指定的文件名
' 参数
' sHTMLFormField [in] - 保存新文件的路径和名称
' 如果为空，则使用当前路径以及原始的文件名
' 如果文件保存成功，saveAs 返回true
'----------------------------------------------------------------------------------------------
Function saveAs( sHTMLFormField, sNewFile) If Dict.Exists(sHTMLFormField) And Len(getFileName(sHTMLFormField)) > 0 Then binData = Dict.Item( sHTMLFormField).Item("Value")
binData = getString( binData) Dim sFilePath
sFilePath = Path & "/" & getFileName(sHTMLFormField)
If Len( sNewFile) <> 0 Then sFilePath = sNewFile Set oFSO = Server.CreateObject( "Scripting.FileSystemObject") '- 创建文件处理对象 ... Set oTextStream = oFSO.CreateTextFile(Server.MapPath(sFilePath), True) ' 创建一个二进制读写文件
oTextStream.Write( binData) '- 将二进制数据写入文件
oTextStream.Close '- 关闭文件 saveAs = True Else Response.Write( "File associated with HTML <FORM> field name <INPUT NAME=" & sHTMLFormField & "> not found!")
saveAs = False End If End Function
'----------------------------------------------------------------------------------------------
'getData -从Scripting.Dictionary对象中获取数据
' 参数
' sHTMLFormField [in] -表单名称
'
' 返回保存在字典对象中的html表单数据
'----------------------------------------------------------------------------------------------
Function getData(sHTMLFormField) If Dict.Exists(sHTMLFormField) Then
getData = Dict.Item( sHTMLFormField).Item("Value")
Else
getData = ""
End If
End Function
'----------------------------------------------------------------------------------------------
'getFileName - 获取文件名称
' 参数
' sHTMLFormField [in] - name of the item to retreive data for
'
' 返回文件名称
'----------------------------------------------------------------------------------------------
Function getFileName(sHTMLFormField) Dim strHTMLFormField
If Dict.Exists(sHTMLFormField) Then
strHTMLFormField = Dict.Item( sHTMLFormField).Item("FileName")
Else
strHTMLFormField = ""
End If Dim tPos
Dim strRtn
strRtn = ""
tPos = InStrRev(strHTMLFormField, "\")
If tPos = 0 Or IsNull(tPos) Then
strRtn = strHTMLFormField
Else
strRtn = Right(strHTMLFormField, Len(strHTMLFormField) - tPos)
End If getFileName = strRtn End Function
'----------------------------------------------------------------------------------------------
'getContentType - 获得上传文件的类型
' 参数
' sHTMLFormField [in] - 表单控件名称
'
' 返回文件类型
'----------------------------------------------------------------------------------------------
Function getContentType(sHTMLFormField)
If Dict.Exists(sHTMLFormField) Then
getContentType = Dict.Item( sHTMLFormField).Item("ContentType")
Else
getContentType = ""
End If
End Function '**********************************************************************************************
'Private Functions
'**********************************************************************************************
'----------------------------------------------------------------------------------------------
'getString -从数据中分离出字符串
' 参数
' StringBin [in] - 保存分离出来的字符串.
' 返回字符串数组.
'----------------------------------------------------------------------------------------------
Function getString(StringBin)
Dim strRtn
strRtn = ""
For intCount = 1 To LenB(StringBin)
strRtn = strRtn & Chr(AscB(MidB(StringBin, intCount, 1)))
Next
getString = strRtn
End Function
'----------------------------------------------------------------------------------------------
'getByteString - 将字符串转化成二进制数据
' 参数
' StringStr [in] - 保存转化成二进制的字符串.
' Returns byte data from a string.
'----------------------------------------------------------------------------------------------
Function getByteString(StringStr)
Dim strRtn
strRtn = ""
For i = 1 To Len(StringStr)
Char = Mid(StringStr, i, 1)
strRtn = strRtn & ChrB(AscB(Char))
Next
getByteString = strRtn
End Function %>
相关阅读 更多 +
