copyright(c) by zcy
关于如何使用IIS创建asp服务，请读者自行研究
注：不要忘记添加入站规则
-
根目录
-
filecloudEV.html 提前验证
-
filecloudEV.aspx 判断密码是否正确
-
filecloudMAIN.aspx 主界面
-
UpLoad.asp 上传界面
-
SaveFile.asp 保存文件
-
InputFilename.aspx 让用户输入文件名
-
AddPath.aspx 将当前文件加入文件清单
-
clsField.asp 文件上传的底层支持代码
-
clsUpload.asp 文件上传的底层支持代码
-
DownLoad.aspx 下载界面
-
list.txt 用户上传的文件的清单
-
files 用户上传的文件的储存文件夹
-
用户首先是进入filecloudEV.html进行验证：
<html> <head> <title>filecloud early verification</title> <meta charset="UTF-8"></meta> </head> <body> <form action="filecloudEV.aspx" method="post"> <center> <p style="font-size:50px;">Password</p> <input type="password" name="password" style="font-size:50px;"></input> <input type="submit" value="Submit" style="font-size:50px;"></input> </center> </form> </body> </html>
一个文本框，将用户输入的密码传到filecloudEV.aspx里面去
filecloudEV.aspx
<html> <head> <title>filecloud early verification</title> <meta charset="UTF-8"></meta> </head> <body> <% dim a a=Request.Form("password") response.write("<center><p style=""font-size:30px"">") if a="XXXXXXX" then '验证密码是否正确 response.write("Password is right!")%> <form action="filecloudMAIN.aspx" method="post"><!--只有正确才显示这个跳转按钮--> <input type="submit" value="跳转" style="font-size:30px"></input> </form> <% else response.write("Password is wrong!") response.write("Please go back") end if response.write("</p></center>") %> </body> </html>
然后进入主界面：
filecloudMAIN.aspx
<html> <head> <title>FilecloudMAIN</title> <meta charset="UTF-8"></meta> </head> <body> <center> <a href="./UpLoad.asp" style="font-size:50px">UpLoad</a><br /><br /> <a href="./DownLoad.aspx" style="font-size:50px">DownLoad</a><br /><br /> </center> </body> </html>
其实就只是显示了两个超链接:
先来介绍一下上传：
UpLoad.asp
<html> <head> <title>UpLoad</title> <meta charset="UTF-8"> </head> <body> <form method="post" encType="multipart/form-data" action="SaveFile.asp"> <input type="File" name="File1"> <input type="Submit" value="Upload"> </form> </body> </html>
把文件流传到SaveFile.asp中
SaveFile.asp
<!--#INCLUDE FILE="clsUpload.asp"--> <!--引用clsUpLoad.asp--> <html> <head> <title>SaveFile</title> <meta charset="UTF-8"> </head> <body> <% Dim Upload Dim Folder Set Upload = New clsUpload Folder = Server.MapPath("Uploads") & "" '绑定储存文件的路径 Upload("File1").SaveAs Folder & Upload("File1").FileName '保存文件 Set Upload = Nothing Response.Write("<script>alert('UpLoad Success!');window.location.href='InputFilename.aspx'</script>") '跳转到InputFilename.aspx %> </body> </html>
接下来介绍一下clsUpload.asp
声明：这个文件以及下面的clsField.asp都是我从Stack Overflow中找到的
clsUpload.asp
<!--METADATA TYPE="TypeLib" NAME="Microsoft ActiveX Data Objects 2.5 Library" UUID="{00000205-0000-0010-8000-00AA006D2EA4}" VERSION="2.5" --> <!--#INCLUDE FILE="clsField.asp"--> <% ' ------------------------------------------------------------------------------ ' Author: Lewis Moten ' Date: March 19, 2002 ' ------------------------------------------------------------------------------ ' Upload class retrieves multi-part form data posted to web page ' and parses it into objects that are easy to interface with. ' Requires MDAC (ADODB) COM components found on most servers today ' Additional compenents are not necessary. ' Class clsUpload ' ------------------------------------------------------------------------------ Private mbinData ' bytes visitor sent to server Private mlngChunkIndex ' byte where next chunk starts Private mlngBytesReceived ' length of data Private mstrDelimiter ' Delimiter between multipart/form-data (43 chars) Private CR ' ANSI Carriage Return Private LF ' ANSI Line Feed Private CRLF ' ANSI Carriage Return & Line Feed Private mobjFieldAry() ' Array to hold field objects Private mlngCount ' Number of fields parsed ' ------------------------------------------------------------------------------ Private Sub RequestData Dim llngLength ' Number of bytes received ' Determine number bytes visitor sent mlngBytesReceived = Request.TotalBytes ' Store bytes recieved from visitor mbinData = Request.BinaryRead(mlngBytesReceived) End Sub ' ------------------------------------------------------------------------------ Private Sub ParseDelimiter() ' Delimiter seperates multiple pieces of form data ' "around" 43 characters in length ' next character afterwards is carriage return (except last line has two --) ' first part of delmiter is dashes followed by hex number ' hex number is possibly the browsers session id? ' Examples: ' -----------------------------7d230d1f940246 ' -----------------------------7d22ee291ae0114 mstrDelimiter = MidB(mbinData, 1, InStrB(1, mbinData, CRLF) - 1) End Sub ' ------------------------------------------------------------------------------ Private Sub ParseData() ' This procedure loops through each section (chunk) found within the ' delimiters and sends them to the parse chunk routine Dim llngStart ' start position of chunk data Dim llngLength ' Length of chunk Dim llngEnd ' Last position of chunk data Dim lbinChunk ' Binary contents of chunk ' Initialize at first character llngStart = 1 ' Find start position llngStart = InStrB(llngStart, mbinData, mstrDelimiter & CRLF) ' While the start posotion was found While Not llngStart = 0 ' Find the end position (after the start position) llngEnd = InStrB(llngStart + 1, mbinData, mstrDelimiter) - 2 ' Determine Length of chunk llngLength = llngEnd - llngStart ' Pull out the chunk lbinChunk = MidB(mbinData, llngStart, llngLength) ' Parse the chunk Call ParseChunk(lbinChunk) ' Look for next chunk after the start position llngStart = InStrB(llngStart + 1, mbinData, mstrDelimiter & CRLF) Wend End Sub ' ------------------------------------------------------------------------------ Private Sub ParseChunk(ByRef pbinChunk) ' This procedure gets a chunk passed to it and parses its contents. ' There is a general format that the chunk follows. ' First, the deliminator appears ' Next, headers are listed on each line that define properties of the chunk. ' Content-Disposition: form-data: name="File1"; filename="C:Photo.gif" ' Content-Type: image/gif ' After this, a blank line appears and is followed by the binary data. Dim lstrName ' Name of field Dim lstrFileName ' File name of binary data Dim lstrContentType ' Content type of binary data Dim lbinData ' Binary data Dim lstrDisposition ' Content Disposition Dim lstrValue ' Value of field ' Parse out the content dispostion lstrDisposition = ParseDisposition(pbinChunk) ' And Parse the Name lstrName = ParseName(lstrDisposition) ' And the file name lstrFileName = ParseFileName(lstrDisposition) ' Parse out the Content Type lstrContentType = ParseContentType(pbinChunk) ' If the content type is not defined, then assume the ' field is a normal form field If lstrContentType = "" Then ' Parse Binary Data as Unicode lstrValue = CStrU(ParseBinaryData(pbinChunk)) ' Else assume the field is binary data Else ' Parse Binary Data lbinData = ParseBinaryData(pbinChunk) End If ' Add a new field Call AddField(lstrName, lstrFileName, lstrContentType, lstrValue, lbinData) End Sub ' ------------------------------------------------------------------------------ Private Sub AddField(ByRef pstrName, ByRef pstrFileName, ByRef pstrContentType, ByRef pstrValue, ByRef pbinData) Dim lobjField ' Field object class ' Add a new index to the field array ' Make certain not to destroy current fields ReDim Preserve mobjFieldAry(mlngCount) ' Create new field object Set lobjField = New clsField ' Set field properties lobjField.Name = pstrName lobjField.FilePath = pstrFileName lobjField.FileName = Mid(pstrFileName, InStrRev(pstrFileName, "") + 1) ' <= line added to set the file name lobjField.ContentType = pstrContentType ' If field is not a binary file If LenB(pbinData) = 0 Then lobjField.BinaryData = ChrB(0) lobjField.Value = pstrValue lobjField.Length = Len(pstrValue) ' Else field is a binary file Else lobjField.BinaryData = pbinData lobjField.Length = LenB(pbinData) lobjField.Value = "" End If ' Set field array index to new field Set mobjFieldAry(mlngCount) = lobjField ' Incriment field count mlngCount = mlngCount + 1 End Sub ' ------------------------------------------------------------------------------ Private Function ParseBinaryData(ByRef pbinChunk) ' Parses binary content of the chunk Dim llngStart ' Start Position ' Find first occurence of a blank line llngStart = InStrB(1, pbinChunk, CRLF & CRLF) ' If it doesn't exist, then return nothing If llngStart = 0 Then Exit Function ' Incriment start to pass carriage returns and line feeds llngStart = llngStart + 4 ' Return the last part of the chunk after the start position ParseBinaryData = MidB(pbinChunk, llngStart) End Function ' ------------------------------------------------------------------------------ Private Function ParseContentType(ByRef pbinChunk) ' Parses the content type of a binary file. ' example: image/gif is the content type of a GIF image. Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Fid the first occurance of a line starting with Content-Type: llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Type:"), vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the end of the line llngEnd = InStrB(llngStart + 15, pbinChunk, CR) ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text "Content-Type:" llngStart = llngStart + 15 ' If the start position is the same or past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine length llngLength = llngEnd - llngStart ' Pull out content type ' Convert to unicode ' Trim out whitespace ' Return results ParseContentType = Trim(CStrU(MidB(pbinChunk, llngStart, llngLength))) End Function ' ------------------------------------------------------------------------------ Private Function ParseDisposition(ByRef pbinChunk) ' Parses the content-disposition from a chunk of data ' ' Example: ' ' Content-Disposition: form-data: name="File1"; filename="C:Photo.gif" ' ' Would Return: ' form-data: name="File1"; filename="C:Photo.gif" Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Find first occurance of a line starting with Content-Disposition: llngStart = InStrB(1, pbinChunk, CRLF & CStrB("Content-Disposition:"), vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the end of the line llngEnd = InStrB(llngStart + 22, pbinChunk, CRLF) ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text "Content-Disposition:" llngStart = llngStart + 22 ' If the start position is the same or past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine Length llngLength = llngEnd - llngStart ' Pull out content disposition ' Convert to Unicode ' Return Results ParseDisposition = CStrU(MidB(pbinChunk, llngStart, llngLength)) End Function ' ------------------------------------------------------------------------------ Private Function ParseName(ByRef pstrDisposition) ' Parses the name of the field from the content disposition ' ' Example ' ' form-data: name="File1"; filename="C:Photo.gif" ' ' Would Return: ' File1 Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Find first occurance of text name=" llngStart = InStr(1, pstrDisposition, "name=""", vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the closing quote llngEnd = InStr(llngStart + 6, pstrDisposition, """") ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text name=" llngStart = llngStart + 6 ' If the start position is the same or past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine Length llngLength = llngEnd - llngStart ' Pull out field name ' Return results ParseName = Mid(pstrDisposition, llngStart, llngLength) End Function ' ------------------------------------------------------------------------------ Private Function ParseFileName(ByRef pstrDisposition) ' Parses the name of the field from the content disposition ' ' Example ' ' form-data: name="File1"; filename="C:Photo.gif" ' ' Would Return: ' C:Photo.gif Dim llngStart ' Start Position Dim llngEnd ' End Position Dim llngLength ' Length ' Find first occurance of text filename=" llngStart = InStr(1, pstrDisposition, "filename=""", vbTextCompare) ' If not found, return nothing If llngStart = 0 Then Exit Function ' Find the closing quote llngEnd = InStr(llngStart + 10, pstrDisposition, """") ' If not found, return nothing If llngEnd = 0 Then Exit Function ' Adjust start position to start after the text filename=" llngStart = llngStart + 10 ' If the start position is the same of past the end, return nothing If llngStart >= llngEnd Then Exit Function ' Determine length llngLength = llngEnd - llngStart ' Pull out file name ' Return results ParseFileName = Mid(pstrDisposition, llngStart, llngLength) End Function ' ------------------------------------------------------------------------------ Public Property Get Count() ' Return number of fields found Count = mlngCount End Property ' ------------------------------------------------------------------------------ Public Default Property Get Fields(ByVal pstrName) Dim llngIndex ' Index of current field ' If a number was passed If IsNumeric(pstrName) Then llngIndex = CLng(pstrName) ' If programmer requested an invalid number If llngIndex > mlngCount - 1 Or llngIndex < 0 Then ' Raise an error Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.") Exit Property End If ' Return the field class for the index specified Set Fields = mobjFieldAry(pstrName) ' Else a field name was passed Else ' convert name to lowercase pstrName = LCase(pstrname) ' Loop through each field For llngIndex = 0 To mlngCount - 1 ' If name matches current fields name in lowercase If LCase(mobjFieldAry(llngIndex).Name) = pstrName Then ' Return Field Class Set Fields = mobjFieldAry(llngIndex) Exit Property End If Next End If ' If matches were not found, return an empty field Set Fields = New clsField ' ' ERROR ON NonExistant: ' ' If matches were not found, raise an error of a non-existent field ' Call Err.Raise(vbObjectError + 1, "clsUpload.asp", "Object does not exist within the ordinal reference.") ' Exit Property End Property ' ------------------------------------------------------------------------------ Private Sub Class_Terminate() ' This event is called when you destroy the class. ' ' Example: ' Set objUpload = Nothing ' ' Example: ' Response.End ' ' Example: ' Page finnishes executing ... Dim llngIndex ' Current Field Index ' Loop through fields For llngIndex = 0 To mlngCount - 1 ' Release field object Set mobjFieldAry(llngIndex) = Nothing Next ' Redimension array and remove all data within ReDim mobjFieldAry(-1) End Sub ' ------------------------------------------------------------------------------ Private Sub Class_Initialize() ' This event is called when you instantiate the class. ' ' Example: ' Set objUpload = New clsUpload ' Redimension array with nothing ReDim mobjFieldAry(-1) ' Compile ANSI equivilants of carriage returns and line feeds CR = ChrB(Asc(vbCr)) ' vbCr Carriage Return LF = ChrB(Asc(vbLf)) ' vbLf Line Feed CRLF = CR & LF ' vbCrLf Carriage Return & Line Feed ' Set field count to zero mlngCount = 0 ' Request data Call RequestData ' Parse out the delimiter Call ParseDelimiter() ' Parse the data Call ParseData End Sub ' ------------------------------------------------------------------------------ Private Function CStrU(ByRef pstrANSI) ' Converts an ANSI string to Unicode ' Best used for small strings Dim llngLength ' Length of ANSI string Dim llngIndex ' Current position ' determine length llngLength = LenB(pstrANSI) ' Loop through each character For llngIndex = 1 To llngLength ' Pull out ANSI character ' Get Ascii value of ANSI character ' Get Unicode Character from Ascii ' Append character to results CStrU = CStrU & Chr(AscB(MidB(pstrANSI, llngIndex, 1))) Next End Function ' ------------------------------------------------------------------------------ Private Function CStrB(ByRef pstrUnicode) ' Converts a Unicode string to ANSI ' Best used for small strings Dim llngLength ' Length of ANSI string Dim llngIndex ' Current position ' determine length llngLength = Len(pstrUnicode) ' Loop through each character For llngIndex = 1 To llngLength ' Pull out Unicode character ' Get Ascii value of Unicode character ' Get ANSI Character from Ascii ' Append character to results CStrB = CStrB & ChrB(Asc(Mid(pstrUnicode, llngIndex, 1))) Next End Function ' ------------------------------------------------------------------------------ End Class ' ------------------------------------------------------------------------------ %>
clsField.asp
<% ' ------------------------------------------------------------------------------ ' Author: Lewis Moten ' Date: March 19, 2002 ' ------------------------------------------------------------------------------ ' Field class represents interface to data passed within one field ' ' ------------------------------------------------------------------------------ Class clsField Public Name ' Name of the field defined in form Private mstrPath ' Full path to file on visitors computer ' C:Documents and SettingslmotenDesktopPhoto.gif Public FileDir ' Directory that file existed in on visitors computer ' C:Documents and SettingslmotenDesktop Public FileExt ' Extension of the file ' GIF Public FileName ' Name of the file ' Photo.gif Public ContentType ' Content / Mime type of file ' image/gif Public Value ' Unicode value of field (used for normail form fields - not files) Public BinaryData ' Binary data passed with field (for files) Public Length ' byte size of value or binary data Private mstrText ' Text buffer ' If text format of binary data is requested more then ' once, this value will be read to prevent extra processing ' ------------------------------------------------------------------------------ Public Property Get BLOB() BLOB = BinaryData End Property ' ------------------------------------------------------------------------------ Public Function BinaryAsText() ' Binary As Text returns the unicode equivilant of the binary data. ' this is useful if you expect a visitor to upload a text file that ' you will need to work with. ' NOTICE: ' NULL values will prematurely terminate your Unicode string. ' NULLs are usually found within binary files more often then plain-text files. ' a simple way around this may consist of replacing null values with another character ' such as a space " " Dim lbinBytes Dim lobjRs ' Don't convert binary data that does not exist If Length = 0 Then Exit Function If LenB(BinaryData) = 0 Then Exit Function ' If we previously converted binary to text, return the buffered content If Not Len(mstrText) = 0 Then BinaryAsText = mstrText Exit Function End If ' Convert Integer Subtype Array to Byte Subtype Array lbinBytes = ASCII2Bytes(BinaryData) ' Convert Byte Subtype Array to Unicode String mstrText = Bytes2Unicode(lbinBytes) ' Return Unicode Text BinaryAsText = mstrText End Function ' ------------------------------------------------------------------------------ Public Sub SaveAs(ByRef pstrFileName) Dim lobjStream Dim lobjRs Dim lbinBytes ' Don't save files that do not posess binary data If Length = 0 Then Exit Sub If LenB(BinaryData) = 0 Then Exit Sub ' Create magical objects from never never land Set lobjStream = Server.CreateObject("ADODB.Stream") ' Let stream know we are working with binary data lobjStream.Type = adTypeBinary ' Open stream Call lobjStream.Open() ' Convert Integer Subtype Array to Byte Subtype Array lbinBytes = ASCII2Bytes(BinaryData) ' Write binary data to stream Call lobjStream.Write(lbinBytes) ' Save the binary data to file system ' Overwrites file if previously exists! Call lobjStream.SaveToFile(pstrFileName, adSaveCreateOverWrite) ' Close the stream object Call lobjStream.Close() ' Release objects Set lobjStream = Nothing End Sub ' ------------------------------------------------------------------------------ Public Property Let FilePath(ByRef pstrPath) mstrPath = pstrPath ' Parse File Ext If Not InStrRev(pstrPath, ".") = 0 Then FileExt = Mid(pstrPath, InStrRev(pstrPath, ".") + 1) FileExt = UCase(FileExt) End If ' Parse File Name If Not InStrRev(pstrPath, "") = 0 Then FileName = Mid(pstrPath, InStrRev(pstrPath, "") + 1) End If ' Parse File Dir If Not InStrRev(pstrPath, "") = 0 Then FileDir = Mid(pstrPath, 1, InStrRev(pstrPath, "") - 1) End If End Property ' ------------------------------------------------------------------------------ Public Property Get FilePath() FilePath = mstrPath End Property ' ------------------------------------------------------------------------------ Private Function ASCII2Bytes(ByRef pbinBinaryData) Dim lobjRs Dim llngLength Dim lbinBuffer ' get number of bytes llngLength = LenB(pbinBinaryData) Set lobjRs = Server.CreateObject("ADODB.Recordset") ' create field in an empty recordset to hold binary data Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength) ' Open recordset Call lobjRs.Open() ' Add a new record to recordset Call lobjRs.AddNew() ' Populate field with binary data Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData & ChrB(0)) ' Update / Convert Binary Data ' Although the data we have is binary - it has still been ' formatted as 4 bytes to represent each byte. When we ' update the recordset, the Integer Subtype Array that we ' passed into the Recordset will be converted into a ' Byte Subtype Array Call lobjRs.Update() ' Request binary data and save to stream lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength) ' Close recordset Call lobjRs.Close() ' Release recordset from memory Set lobjRs = Nothing ' Return Bytes ASCII2Bytes = lbinBuffer End Function ' ------------------------------------------------------------------------------ Private Function Bytes2Unicode(ByRef pbinBytes) Dim lobjRs Dim llngLength Dim lstrBuffer llngLength = LenB(pbinBytes) Set lobjRs = Server.CreateObject("ADODB.Recordset") ' Create field in an empty recordset to hold binary data Call lobjRs.Fields.Append("BinaryData", adLongVarChar, llngLength) ' Open Recordset Call lobjRs.Open() ' Add a new record to recordset Call lobjRs.AddNew() ' Populate field with binary data Call lobjRs.Fields("BinaryData").AppendChunk(pbinBytes) ' Update / Convert. ' Ensure bytes are proper subtype Call lobjRs.Update() ' Request unicode value of binary data lstrBuffer = lobjRs.Fields("BinaryData").Value ' Close recordset Call lobjRs.Close() ' Release recordset from memory Set lobjRs = Nothing ' Return Unicode Bytes2Unicode = lstrBuffer End Function ' ------------------------------------------------------------------------------ End Class ' ------------------------------------------------------------------------------ %>
但是我们还需要把这个文件名加到文件列表中（如果说不添加，可以在服务器后端运行一个不断获取文件夹内的文件列表写入list.txt比较麻烦
于是我们就需要让用户自己输入刚才上传的文件名：
InputFilename.aspx
<html> <head> <title>Filename Inputer</title> <meta charset="UTF-8"> </head> <body> <form action="AddPath.aspx" method="post"><!--让AddPath.aspx将它加入列表--> <p>Input the file's filename you upload just then:</p> <input type="input" name="fnm"> <input type="submit" value="Submit"> </form> </body> </html>
AddPath.aspx
<%@ Page Debug="true" %> <html> <head> <title>AddPath</title> <meta charset="UTF-8"> </head> <body> <% Dim fso Dim f fso=CreateObject("Scripting.FileSystemObject") f=fso.OpenTextFile("D:cloudlist.txt",8,True) '注意这里要用绝对路径，不然会引发权限错误 Dim fnm fnm=Request.Form("fnm") f.WriteLine(fnm) f.Close Response.write("<script>alert('UpLoad Success!');window.location.href='./UpLoad.asp';</script>") '跳转回去 %> </body> </html>
上传到此结束，接下来看下载
DownLoad.aspx
<html> <head> <title>DownLoad</title> <meta charset="UTF-8"></meta> </head> <body> <% Dim Fso Dim myFile Fso = Server.CreateObject("Scripting.FileSystemObject") myFile = Fso.OpenTextFile(Server.MapPath("list.txt"),1,True) While Not myFile.AtEndOfStream '将文件列表中的全部输出 Dim V=myFile.ReadLine Response.Write("<a href='UpLoads" & V & "' download='" & V & "'style='font-size:30px'>" & V & "</a><br /><br />") '输出下载标签 End While %> </body> </html>
到此，所有文件都写完了，接下来可以http://localhost:端口/filecloudEV.html查看效果了
但是这个网址还有一个问题：