Beispiel zum hochladen von Dateien
In diesem Beispiel kann der Benutzer mittels eines Formulares eine Datei auf seinem Computer auswählen und auf den Webserver hochladen. Beim Absenden wird das Script "upload.asp" aufgerufen und alle Formulardaten übergeben. Das Script überprüft die eingegebenen Daten und zeigt entweder eine Webseite mit Fehlermeldungen oder eine Webseite mit einer Erfolgsmeldung an.
Mit diesem Script können nur Dateien mit einer maximalen Grösse von 2 Megabytes übertragen werden. Jede Datei die grösser ist, wird nicht hochgeladen. Das Verzeichnis in welches sie die Datei hochladen wollen muss ausserdem Schreibrechte besitzen.
Das Formular
<html>
<head>
<title>ASP Upload Beispiel</title>
</head>
<body>
<form method="POST" action="upload.asp" enctype="multipart/form-data" target="_new">
<input type="file" name="File" size="50"><br>
<input type="submit" value="Hochladen" name="Submit">
</form>
</body>
</html>
Das Script
<html>
<head>
<title>ASP Upload Beispiel</title>
</head>
<body bgcolor="white">
<%=Font%>
<%
' --- Fehlerbehandlung aktivieren
' --- On Error Resume Next
' --- Zuweisen der Fehlerquelle, die bei einem Fehler ausgegeben werden soll
Err.Source = "GetFILE HTTP-Upload"
' --- Konstante für Fehlerüberschrift
Const ErrHeader = "<b>Fehler</b><br><br>"
' --- Array deklarieren
Dim ErrArray(4)
ErrArray(0) = "10900 - Ihre gesendete Datei ist zu gross."
ErrArray(1) = "10901 - Unbekannter Fehler.<br>"
ErrArray(2) = "10902 - Es wurde keine Datei gesendet oder die Ãœbertragung ist fehlerhaft.<br>"
' -- Aufrufen der Subroutine GetFILE
Call GetFILE()
Private Sub GetFile()
' --- In dieser Subroutine wird der HTTP-Stream ausgelesen
' --- Deklarieren der Variablen
Dim FileText
FileText = Request.BinaryRead(Request.TotalBytes)
Dim FileTextByte
FileTextByte = ""
Dim FileTextNew
FileTextNew = ""
Dim FilePosFirst
FilePosFirst = 0
Dim FilePosLast
FilePosLast = 0
Dim FileType
FileType = ""
Dim strRevText
strRevText = ""
Dim strFileName
strFileName = ""
Dim strFileNameOnly
strFileName = ""
Dim search
search = 0
Dim string
string = ""
Dim posFileName
posFileName = 0
Dim rghFile
rghFileName = ""
Dim lenFileTextByte
lenFileTextByte = 0
' --- Angeben der max. Dateigrösse + ca. 500 Byte für Dateiinformationen
Dim maxLength
maxLength = 25500
' --- Abfrage der Grösse des gesendeten Streams
If Request.TotalBytes > maxLength Then
Call Error_Handler(10900)
Exit Sub
End if
' --- Suchen nach HexCode 0D 0A 0D 0A (Dateianfang innerhalb des HTTP-Streams)
FilePosFirst = InStrB(FileText, (ChrB(13) & ChrB(10) & ChrB(13) & ChrB(10)))
' --- Suchen nach HexCode 0D 0A 2D 2D (Dateiende innerhalb des HTTP-Streams)
FilePosLast = InStrB(FileText, (ChrB(13) & ChrB(10) & ChrB(45) & ChrB(45)))
' --- Suchen nach HexCode 2D 0A 0D innerhalb des umgedrehten HTTP-Streams, da unter
' --- Umständen mehrere Dateiendekennzeichen vorhanden sind.
strRevText = StrReverse(FileText)
FilePosLast = InStrB(strRevText, (ChrB(45) & ChrB(10)) & ChrB(13))
FilePosLast = LenB(FileText) - FilePosLast
' --- Abbruch bei Dateigrösse 0 Byte
If FilePosFirst = 0 Or FilePosLast = 0 Or FilePosLast - FilePosFirst < 5 Then
Call Error_Handler(10902)
Exit Sub
End If
' --- Abbruch, wenn ein Fehler aufgetrten ist
If Err <> 0 Then
Call Error_Handler(10901)
Exit Sub
End if
' --- Schreiben des Dateiinhalts in ByteArray
FileTextByte = MidB(FileText, (FilePosFirst + 4), (FilePosLast - (FilePosFirst + 4)))
' --- Ermittlung der Dateigrösse durch Auslesen der Länge des ermittelten Dateiinhalts
lenFileTextByte = LenB(FileTextByte)
' --- Konvertierung des Dateiinhalts (Binärstream) in Ascii-Zeichen
For i = 1 To lenFileTextByte
FileTextNew = FileTextNew & Chr(AscB(MidB(FileTextByte, i, 1)))
Next
' --- Ermittlung des Dateinamens inkl. Pfad innerhalb des HTTP-Streams
string = ChrB(102)&ChrB(105)&ChrB(108)&ChrB(101)&ChrB(110)&ChrB(97)&ChrB(109)&ChrB(101)&ChrB(61)&ChrB(34)
search=InStrB(FileText,string)
posFileName=search+9
rghFileText = RightB(FileText, LenB(FileText) - posFileName)
strFileName = LeftB(rghFileText, InStrB(rghFileText, ChrB(34)) - 1)
' --- Schreiben des ermittelten Dateiinhalts in eine Datei.
Set objFileSys = Server.CreateObject("Scripting.FileSystemObject")
Set File=objFileSys.CreateTextFile(Server.MapPath("./")&"\"&BinaryToString(strFileName),True,False)
File.WriteLine CStr(FileTextNew)
File.Close
Set File = Nothing
Set objFileSys = Nothing
' --- Ausgeben der Dateigrösse in Bytes
Response.Write "<strong>Dateigröße: </strong>" & lenFileTextByte & " Byte.<br><br>"
Response.Write "Datei erfolgreich hochgeladen"
End Sub
' --- Wandelt den Dateinamen in ein verträgliches Format um
Function BinaryToString(Binary)
Dim I, S
For I = 1 To LenB(Binary)
S = S & Chr(AscB(MidB(Binary, I, 1)))
Next
BinaryToString = S
End Function
Private Sub Error_Handler(intErrNumber)
' --- Ermitteln des übergebenen Fehlercodes und Ausgabe am Bildschirm
Select Case intErrNumber
Case 10900: Response.Write ErrHeader & ErrArray(0)
Case 10901: Response.Write ErrHeader & ErrArray(1)
Case 10902: Response.Write ErrHeader & ErrArray(2)
Case Else: Response.Write ErrHeader & Err.Description
End Select
Exit Sub
End Sub
%>
</body>
</html>
|
