Filen som uploader, referer til en .inc fil:
Upload.asp:
<%
\'*************************************
\'**** Test af FileUpload funktion ****
\'**** ****
\'**** Upload .gif eller .jpg ****
\'**** billede til mappen /upload ****
\'*************************************
\'Skal formen vises?
If Request.ServerVariables(\"REQUEST_METHOD\") <> \"POST\" Then
%>
<FORM ENCTYPE=\"multipart/form-data\" ACTION=\"communityold.asp\" METHOD=\"POST\">
<font face=verdana size=2><center>Tryk på \"Browse...\" og vælg et billede du vil smide ind på siden:<br> <INPUT NAME=\"fileupload\" TYPE=\"file\" style=\"border: 1px normal #000000; ; color:#00000; font-weight:normal; background-color:#EAEAEA\">
<font face=verdana size=2><INPUT NAME=\"Action\" TYPE=\"submit\" VALUE=\"Upload\" style=\"border: 1px normal #000000; ; color:#00000\">
<BR>
</FORM>
<%
Else
Dim intFileUpload, strContentType, strFilename, intFileTotalBytes
intFileUpload = FileUpload(\"images/\", 2000000, Array(\"image/gif\", \"image/jpeg\", \"image/pjpeg\"), Array(\"gif\", \"jpg\"), strContentType, strFilename, intFileTotalBytes)
If intFileUpload = 0 Then
Response.Write \"<center><br><font face=\'verdana\' size=\'2\'><b><p align=center>Uploader \" & strFilename & \"</p></b><BR></center>\"
Response.Write \"<META HTTP-EQUIV=\'Refresh\' CONTENT=\'1; URL=tilfoj_prod.asp?ImageURL=images/\" & strFilename & \"\'>\"
Else
Response.Write \"<font face=\'verdana\' size=\'2\'><b>Der opstod en fejl under upload!</b><BR>Du må kun uploade billeder med extension .jpeg eller .gif<br>\"
Response.Write \"Fejl nr: \" & intFileUpload & \"<BR>\"
Response.Write \"Filnavn: \" & strFilename & \"<BR>\"
Response.Write \"Filtype: \" & strContentType & \"<BR>\"
Response.Write \"Filstørrelse: \" & intFileTotalBytes & \"<BR>\"
End If
End If
%>
Fileupload.inc:
<%
\'-------------------- Start: fileupload.inc --------------------
\'*** 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
\'Find filnavnet
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
\'Dan det fulde outputfilnavn via MapPath
strFileSpec = Server.MapPath(LCase(strPath & strFilename)) \'LCase kan evt fjernes herfra
\'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.inc --------------------
%>
Ny bruger
Nybegynder
Opret
Preview
