Seriøs Hjælp til Picture Upload i ASP!
Jeg har downloade 3 filer:pic_upload.asp
pic_uploaded.asp
fileupload.inc
De skulle kunne uploade et billed til en server... det går osse MEGET fint... men jeg vil gerne at filen bliver omdøbt til en et Nummer, alt efter hvilken varer det er man uploader til!
Men jeg synes ikke rigtig jeg kan få det til at virker!
pic_upload.asp
---------------------------------------------------------------------------
<%@ Language="VBScript" %>
<!-- #INCLUDE FILE="fileupload.inc" -->
<HTML>
<HEAD>
<TITLE>Upload uden komponent</TITLE>
<style fprolloverstyle>A:hover {color: #FF0000; font-family: Arial; font-size: 10 pt}
</style>
</HEAD>
<body bgcolor="#AC1A03">
<%
Session("BilledNummer") = request.QueryString("id")
%>
<tabel>
<FORM ENCTYPE="multipart/form-data" ACTION="pic_uploaded.asp" METHOD="POST">
<table border="1" cellpadding="5" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="100%" id="AutoNumber2" bgcolor="#006699">
<tr>
<td width="100%"><b><font face="Arial" size="2" color="#FFFFFF">Uploadning
af billeder:</font></b></td>
</tr>
</table>
<p> </p>
<div align="center">
<center>
<table border="1" cellpadding="5" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="50%" id="AutoNumber1">
<tr>
<td width="100%" bgcolor="#006699"><b>
<font face="Arial" size="2" color="#FFFFFF">Vælg billed:</font></b></td>
</tr>
<tr>
<td width="100%" bgcolor="#FFFFFF">
<tabel>
<font face="Arial"><font size="2">Vælg et billede der skal uploades til serveren.<br>
Bemærk at der ikke må være flere med samme navn<br>
derfor kontroller venligst det INDEN uploadningen!<br>
<BR>
</font>
<INPUT NAME="fileupload" TYPE="file" size="20"></font><P><font face="Arial">
<font size="2">Skulle du have en lille
kommentar til billedet,<br>
kan du evt skrive det her:<br>
<br>
</font>
<input type="text" name="comment" size="37"><font size="2"><br>
<BR>
</font>
<INPUT NAME="Action" TYPE="submit" VALUE="Upload"><font size="2"> </font></font>
</tabel>
</td>
</tr>
</table>
</center>
</div>
</FORM>
</tabel>
<p align="center"><font face="Arial" size="2">
<a target="_self" href="index.asp">tilbage</a></font></p>
</BODY>
</HTML>
pic_uploaded.asp:
-----------------------------------------------------------------
<%@ Language="VBScript" %>
<% Option Explicit %>
<!-- #INCLUDE FILE="fileupload.inc" -->
<HTML>
<HEAD>
<TITLE>Upload uden komponent</TITLE>
<style fprolloverstyle>A:hover {color: #FF0000; font-family: Arial; font-size: 10 pt}
</style>
</HEAD>
<body bgcolor="#AC1A03">
<%
Session("BilledNummer") = Session("BilledNummer")
response.write Session("BilledNummer")
'*************************************
'**** Test af FileUpload funktion ****
'**** ****
'**** Upload .gif eller .jpg ****
'**** billede til mappen /upload ****
'*************************************
'Skal formen vises?
If Request.ServerVariables("REQUEST_METHOD") <> "POST" Then
%>
<tabel>
<FORM ENCTYPE="multipart/form-data" ACTION="uploadgfx.asp" METHOD="POST">
<table border="1" cellpadding="5" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="100%" id="AutoNumber2" bgcolor="#006699">
<tr>
<td width="100%"><b><font face="Arial" size="2" color="#FFFFFF">Uploadning
af billeder:</font></b></td>
</tr>
</table>
</FORM>
</tabel>
<br>
<div align="center">
<center>
<table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="50%" id="AutoNumber3" bgcolor="#FFFFFF">
<tr>
<td width="100%"> </td>
<%
Else
Dim intFileUpload, strContentType, strFilename, intFileTotalBytes
Dim rsPic
Dim SQL
strFilename = Session("BilledNummer")
intFileUpload = FileUpload("../produkter/", 20000, Array("image/gif", "image/jpeg", "image/pjpeg"), Array("gif", "jpg"), strContentType, strFilename, intFileTotalBytes)
%>
<%
strFilename = Session("BilledNummer")
If intFileUpload = 0 Then
%><face="Arial" size="2"><%Response.Write "Filen " & strFilename & " blev uploaded.<BR>"
%><face="Arial" size="2"><%Response.Write "Det er en fil af typen " & strContentType & " og den fylder " & intFileTotalBytes & " bytes:<BR>"
%><face="Arial" size="2"><%Response.Write "<IMG SRC=""../produkter/" & strFilename & """><BR>"
Else
%><face="Arial" size="2"><%Response.Write "Der opstod en fejl under upload!<BR>"
%><face="Arial" size="2"><%Response.Write "Fejl nr: " & intFileUpload & "<BR>"
%><face="Arial" size="2"><%Response.Write "Filnavn: " & strFilename & "<BR>"
%><face="Arial" size="2"><%Response.Write "Filtype: " & strContentType & "<BR>"
%><face="Arial" size="2"><%Response.Write "Filstørrelse: " & intFileTotalBytes & "<BR>"
End If
End If
%>
</tabel>
</tr>
</table>
</center>
</div>
<blockquote>
<p align="center"><font face="Arial" size="2">
<a target="_self" href="pic_upload.asp">tilbage</a></font> </p>
</blockquote>
</BODY>
</HTML>
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 --------------------
%>
