Как загрузить файлы с помощью asp-classic

Я хочу создать страницу с asp-classic, где пользователи могут загружать файлы или ZIP-папки.

Я искал в Google, но каждое найденное мной решение использует сторонний файл. Но я не смог заставить эти файлы работать.

долгое время с тех пор, как я это сделал, но мы использовали загрузку без сторонних компонентов, только два classа vbscript (кредит на решение Lewis Moten).
Похоже, вы все еще можете найти это «решение Льюиса Мотена» в дикой природе

Если вы включите файл clsUpload, процесс последующей загрузки будет таким же простым, как:

Dim objUpload Dim strFile, strPath ' Instantiate Upload Class ' Set objUpload = New clsUpload strFile = objUpload.Fields("file").FileName strPath = server.mappath("/data") & "/" & strFile ' Save the binary data to the file system ' objUpload("file").SaveAs strPath Set objUpload = Nothing 

Это все для серверной стороны …

На стороне клиента вам просто нужен входной файл

 
Upload file:

Надеюсь это поможет..

Редактировать 23 июня 2014 года
Как отметил Дейв Вут, моя ссылка на решение «в дикой природе» не полностью соответствовала предоставленному fragmentу кода. Таким образом, полные classы, которые я использовал исторически (комментарии обрезаны, чтобы оставаться ниже предела 30000 SO). Это была ранняя версия решения Льюиса Мотена, найденная по адресу http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8525&lngWId=4

1) Содержание clsUpload.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.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 ' ------------------------------------------------------------------------------ %> 

2) Содержание 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 Settings\lmoten\Desktop\Photo.gif Public FileDir ' Directory that file existed in on visitors computer ' C:\Documents and Settings\lmoten\Desktop 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 ' ------------------------------------------------------------------------------ %> 

Свойство FileName никогда не задано, я добавляю эту недостающую строку в clsUpload.asp (между строками 157 и 158) в Private Sub AddField (…)

  lobjField.Name = pstrName lobjField.FilePath = pstrFileName lobjField.FileName = Mid(pstrFileName, InStrRev(pstrFileName, "\") + 1) ' <= line added to set the file name lobjField.ContentType = pstrContentType 

Вы также должны объявить константу ниже: Const adSaveCreateOverWrite = 2

К сожалению, установить службу загрузки не удастся, по крайней мере, немного потрудиться при использовании сторонних скриптов и внести некоторые корректировки на ваш сервер.

Однако вы можете проверить у своего хостинг-провайдера список компонентов, которые уже установлены; большинство хостинговых услуг также поддерживают библиотеки / faq / wiki с почти готовыми примерами использования этих компонентов. Если его нет, есть еще FreeAspUpload, который является компонентом без DLL, поэтому его можно использовать на любом classическом ASP-сервере.

После определения того, какой компонент / сценарий вы будете использовать, вы также должны проверить разрешения на запись в целевых папках загрузки. Если вы не можете установить целевую папку с разрешением на запись файлов, ваши загрузки не будут работать. Проверьте, разрешает ли вам панель управления вашего хостинг-провайдера, или если вам нужно сделать запрос на эти изменения.

Interesting Posts

В чем разница между статическим методом и нестатическим методом?

Функция Matplotlib ion () не может быть интерактивной

Показать Unity Scene как Sub View в студии android

Не удается включить Windows Hello. Некоторые настройки управляются вашей организацией.

Safari: как напрямую перейти от «omnibox» (т. Е. «Поле интеллектуального поиска») к результатам поиска (как в Chrome)?

Как автоматически скрыть текст заполнителя при фокусировке с помощью css или jquery?

В clang, как вы используете атрибуты оптимизации для каждой функции?

Как заменить часть текстового файла между маркерами на другой текстовый файл?

Apache 2.4 + php 5.4.7 не может загрузить php5apache2_4.dll

Назначить xib для UIView в Swift

JavaScriptSerializer UTC DateTime вопросы

Почему этот шаблон совпадения недоступен при использовании нелитеральных шаблонов?

Нет двойной опции загрузки для Windows на моей машине

Шаги по созданию веб-службы с использованием Axis2 – Код клиента

Как избежать мягкой клавиатуры, подталкивающей мой макет?

Давайте будем гением компьютера.