include-filen fileupload.asp:
<%
'-------------------- Start: fileupload.asp --------------------
'*** FileUpload ***
'*** af Lars Snyder (pila@mailme.dk) ***
'***
http://www.tipsogtricks-online.dk ***
'*
'* Sprog: VBScript
'*
'* Input:
'* strPath Streng med uploadpath, f.eks. "output/", "/asp/binary/upload/" eller ""
'* intMaxSize Tilladte grænse for filerne filer der uploades. Hvis < 1 er der ingen grænse.
'* arrAcceptType Array med accepterede Content-Type, f.eks. "image/gif", "image/jpeg". Hvis ("") er alle filtyper accepterede.
'* arrAcceptExt Array med sidste dele af filnavne, f.eks. "gif", "jpg" eller "kundennefil.xls". Hvis ("") er alle ext accepterede.
'*
'* Output: 0 hvis filen er uploaded korrekt.
'* 1 Request fra bruger gik galt
'* 2 Content med name="fileupload" blev ikke fundet
'* 3 Ingen filnavn
'* 4 Content-Type accepteres ikke
'* 5 Ext accepteres ikke
'* 6 Filen er for stor
'* 7 Filen blev ikke uploaded korrekt
'* strContentType Den fundne type, f.eks. "image/gif"
'* strFilename Det fundne filnavn, f.eks. "button.gif"
'* intFileTotalBytes Filens samlede størrelse, f.eks. 9853
'*
'* Eksempler på ContentTypes
'* Microsoft IE4 | Netscape NN4 | Beskrivelse
'* "image/gif" | "image/gif" | CompuServe Graphics Interchange (.gif)
'* "image/pjpeg" | "image/jpeg" | JPEG/JFIF Compliant (.jpg | .jif | .jpeg)
'* "application/octet-stream" | "application/msexcel" | Microsoft Excel-regneark (.xls)
'* "application/octet-stream" | "application/msword" | Microsoft Word-dokument (.doc)
'* "text/html" | "text/html" | HTML Document (.htm | .html)
'* "text/plain" | "application/x-unknown-content-type-asp_auto_file" | Active Server Page (.asp)
'* "text/plain" | "text/plain" | Tekstdokument (.txt)
'* "text/plain" | "application/x-unknown-content-type-Excel.CSV" | Separeret fil (.csv)
'* "application/octet-stream" | "application/octet-stream" | Binær fil (.bin)
'* "application/octet-stream" | "application/octet-stream" | Uden kendt filtype (.lol)
'* Bemærk i øvrigt, at
'* a. Der er desværre forskel på den tekst Microsoft og Netscape anvender på samme filtype.
'* b. Microsoft evaulerer ikke kun filens efternavn, men også det faktiske indhold!
Function FileUpload(strPath, intMaxSize, arrAcceptType, arrAcceptExt, ByRef strContentType, ByRef strFilename, ByRef intFileTotalBytes)
'Variable deklaration
Dim intPostTotalBytes, intStartPos, intEndPos, i
Dim bstrPostData, bstrDivider
Dim strTemp, strFileSpec
Dim arrSplit
Dim vbCrLfB
Dim bolStopLoop, bolContentTypeOK, bolExtOK
Dim fs, ts, f
'Sæt returværdier
strContentType = ""
strFilename = ""
intFileTotalBytes = 0
'Check: Er det faktisk POST upload?
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
'Dan vbCrLf som binær streng
vbCrLfB = ChrB(13) & ChrB(10)
'Hent den binære POST fra brugeren
intPostTotalBytes = Request.TotalBytes 'Find antallet af bytes i POST
bstrPostData = Request.BinaryRead(intPostTotalBytes) 'Hent POST til en binær streng
If LenB(bstrPostData) <> intPostTotalBytes Then 'Check: Er antallet af bytes i POST forskelligt fra den binære streng?
'Returner værdi og stop
FileUpload = 1
Exit Function
End If
'Hent delelinien inkl. vbCrLfB (altid hele første linje)
bstrDivider = LeftB(bstrPostData, InStrB(bstrPostData, vbCrLfB) + 1)
'Default StartPos
intStartPos = 1
'Find Content-Disposition hvor name="fileupload"
bolStopLoop = False
Do
'Find starten af denne Content del (umiddelbart efter delelinien)
intStartPos = InStrB(intStartPos, bstrPostData, bstrDivider) + LenB(bstrDivider)
If intStartPos = 0 Then
'Ikke flere Content delere - Returner værdi og stop
FileUpload = 2
Exit Function
End If
'Find slutningen af denne Content del (umiddelbart inden den næste delelinie)
intEndPos = InStrB(intStartPos, bstrPostData, bstrDivider)
If intEndPos = 0 Then
'Ikke flere Content delere - Returner værdi og stop
FileUpload = 2
Exit Function
End If
'Hent denne Content-Disposition (uden vbCrLf)
strTemp = bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos))
'Er fileupload feltet i denne Content-Disposition?
If InStr(LCase(strTemp), "name=""fileupload""") > 0 Then
'Stop løkken her
bolStopLoop = True
Else
'Start igen umiddelbart efter denne Content, men før næste divider
intStartPos = intEndPos
End If
Loop Until bolStopLoop
'Flyt intStartPos til efter Content-Disposition linjen
intStartPos = intStartPos + Len(strTemp) + 2
'Ekstrakt POST filnavnet fra strTemp
arrSplit = Split(strTemp, ";") 'Opdel strTemp ved ;: Content-Disposition: form-data; name="fileupload"; filename="filen.txt"
'Find filnavnet fra filename= array
strTemp = "" 'Værdi ved fejl
For i = 0 To UBound(arrSplit) 'Køres for alle i denne array
If LCase(Left(Trim(arrSplit(i)), 9)) = "filename=" Then 'Står der filename= ?
strTemp = Trim(arrSplit(i))
Exit For
End If
Next
'Afbryd hvis der ikke blev fundet noget filnavn
If strTemp = "" Or strTemp = "filename=""""" Then
FileUpload = 3
Exit Function
End If
'---------------------------------------filnavnet !!!!-----------------------------------------------------
'Find filnavnet
strFilename = server.UrlEncode(strFileName)
strFilename = strFileName
arrSplit = Split(strTemp, """") 'Opdel streng ved "
strTemp = arrSplit(UBound(arrSplit) - 1) 'Næstsidste indholder filnavn
arrSplit = Split(strTemp, "\") 'Del ved alle \ Så indeholder den sidste filnavn.ext"
strFilename = arrSplit(UBound(arrSplit)) 'Hent den sidste array, der må være filnavnet - både fornavn og efternavn
'If LCase(right(strFileName,3)) = "jpg" Then
'strFileName = Session("ID") & ".jpg"
'ElseIf LCase(right(strFileName,3)) = "gif" then
'strFileName = Session("ID") & ".gif"
'ElseIf LCase(right(strFileName,4)) = "jpeg" then
'strFileName = Session("ID") & ".jpeg"
'End If
'Dan det fulde outputfilnavn via MapPath
strFileSpec = Server.MapPath(LCase(strPath & strFilename)) 'LCase kan evt fjernes herfra
'strFileSpec = LCase(strFilename) 'LCase kan evt fjernes herfra
'------------------------------------------filnavn slut!!!!!----------------------------------------------
'Hent Content-Type (uden vbCrLf)
strTemp = bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos))
'Flyt intStartPos til efter Content-Type linjen
intStartPos = intStartPos + Len(strTemp) + 2
'Ekstrakt POST Content-Type
arrSplit = Split(strTemp, " ")
strContentType = arrSplit(UBound(arrSplit))
'Skal Content-Type checkes?
bolContentTypeOK = False
If arrAcceptType(LBound(arrAcceptType)) <> "" Then
For Each strTemp In arrAcceptType
If strContentType = strTemp Then
bolContentTypeOK = True
End If
Next
'Check: Er det en accepteret Content-Type?
If Not bolContentTypeOK Then
'ContentType ikke fundet - Returner værdi og stop
FileUpload = 4
Exit Function
End If
End If
'Skal ekstention checkes?
bolExtOK = False
If arrAcceptExt(LBound(arrAcceptExt)) <> "" Then
For Each strTemp In arrAcceptExt
If LCase(Right(strFilename, Len(strTemp))) = strTemp Then
bolExtOK = True
End If
Next
'Check: Er det en accepteret ekstention?
If Not bolExtOK Then
'Ekstention ikke fundet - Returner værdi og stop
FileUpload = 5
Exit Function
End If
End If
'Find faktiske start/slut på datafilen ved at fjerne foranstillede og efterstillede vbCrLfB
intStartPos = intStartPos + 2
intEndPos = intEndPos - 2
intFileTotalBytes = intEndPos - intStartPos
'Skal filstørrelsen checkes?
If intMaxSize > 0 Then
'Check: Er filen for stor?
If intFileTotalBytes > intMaxSize Then
'Filen er for stor - Returner værdi og stop
FileUpload = 6
Exit Function
End If
End If
'Åbn, skriv og luk outputfilen
Set fs = CreateObject("Scripting.FileSystemObject") 'Filsystem objekt
Set ts = fs.CreateTextFile(strFileSpec, True) 'Åbn outputfil, overskriv evt. eksisterende
For i = intStartPos To intEndPos - 1
ts.Write(Chr(AscB(MidB(bstrPostData, i, 1)))) 'Skriv data eet tegn af gangen
Next
ts.Close 'Luk outputfil
'Check: Blev filen oprettet og har den samme størrelse?
Set f = fs.GetFile(strFileSpec)
If f.Size <> intFileTotalBytes Then
FileUpload = 7
Exit Function
End If
'* Returner OK
FileUpload = 0
End If
End Function
'* Funktion der oversætter en bstr binær streng til en almindelig streng
'* Pas på med 00 værdier, da de fungerer som EOF i en almindelig streng
Function bin2str(bstrBinary)
Dim i
For i = 1 To LenB(bstrBinary)
bin2str = bin2str & Chr(AscB(MidB(bstrBinary, i, 1)))
Next
End Function
'-------------------- Slut: fileupload.asp --------------------
%>
