Jeg har gennem længere tid haft glæde af "fileupload" scriptet, lavet af
Lars Snyder, og modificeret af Thomas Petersen, hvilket gør det muligt at
uploade en enkelt fil uden komponent.
Nu er jeg dog løbet ind i et problem, da jeg vil bruge det til flere filer.
Lad mig prøve at ridse problematikken op...
Jeg har en form-side, hvor man kan indtaste hvor mange filer man ønsker
oploaded (1-50)
Derefter vælger man alle filnavnene via en form og disse bliver så gemt i en
txt-fil.
Nu kommer problemet...
I det nuværende script, skal man vælge én fil og så poste formen...
men jeg vil gerne lave en løkke som gennemløber min txt-fil og uploader hver
enkelt fil, sådan her
for 1 to 50
læs txtfil-linie
upload fil
næste
Når jeg gør det på den måde, så får jeg en fejl fra scriptet, som lyder
sådan her:
"Der opstod en Microsoft VBScript-kørselsfejl fejl '800a01c2'
Antallet af argumenter er forkert eller egenskabstildelingen er ugyldig:
'FileUpload'
/natur/upload/upload2.asp, linje 51"
Problemet kommer sikkert fordi jeg ikke bruger Form Post metoden, men bare
prøver at overføre filnavnet direkte.
Har du en løsning på det problem... eller en anden smart måde at gøre det på
??
Det skal lige siges, at jeg ikke har mulighed for at lægge nogen komponent
op på serveren, så det skal helst kunne klares ved asp-kode.
Jeg har kopieret både min side og scriptet ind, herunder.
Jeg håber at du kan/vil hjælpe mig, da jeg nu er gået helt død, og jeg
skulle helst have det til at virke.
Til info, så har jeg prøvet at kontakte begge de herrer som har
lavet/modificeret scriptet, men en kan ikke nåes og den anden arbejder ikke
mere med asp ;-((
Hilsen
Jon Klose Larsen
Webmaster
www.landsbyen-nibe.dk
********* Min side ***********
<%@ Language="VBScript" %>
<!-- #INCLUDE FILE="fileupload.inc" -->
<%
'* åben txt-fil
filename = server.mappath("../../../databaser/natur/") & "\" &
"tempup.txt"
set txtfso = CreateObject("Scripting.FileSystemObject")
set txtfil = txtfso.getfile(filename)
set txtstream = txtfil.openastextstream(1)
'* læs upload-sti fra txt-fil (altid første linie i txt-fil)
sti = txtstream.readline
'* læs filnavn(e) fra txtfil og upload dem, indtil txtfil er tom
DO WHILE NOT txtstream.atendofstream
strtxt = txtstream.readline
'*************
'Det er her det går galt for mig !!!
'Hvordan får jeg overført værdien i strtxt til fileupload-funktionen ?
'*************
intFileUpload = FileUpload(sti, 100000, Array("image/gif"),
Array("gif"), strContentType, strFilename, intFileTotalBytes, "")
If intFileUpload = 0 Then
Response.Write "Filen " & strFilename & " blev
uploaded.<BR><BR>"
Else
Response.Write "Der opstod en fejl under upload!<BR>"
Response.Write "Fejl nr: " & intFileUpload & "<BR>"
Response.Write "Filnavn: " & strFilename & "<BR><BR>"
End If
LOOP
%>
********* Upload scriptet ********
<%
'-------------------- Start: fileupload.inc --------------------
'##########################################################
' Modificeret af Thomas Petersen, tp@doller.dk, 2001-08-30
'##########################################################
'*** 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
'* intNewFilename Angiver et evt. andet filnavn til filen, BEMÆRK:
Angives uden extension!!!
'*
'* 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!
'###########################################################
' Denne function bruges til at gemme filen i større pakker.
'
' Thomas Petersen, tp@doller.dk, 2001-08-30
'###########################################################
function encodePakke(encInd)
encUd = ""
for c = 1 to lenb(encInd)
encUd = encUd & Chr(AscB(MidB(encInd, c, 1)))
next
encodePakke = encUd
end function
'###########################################################
Function FileUpload(strPath, intMaxSize, arrAcceptType, arrAcceptExt, ByRef
strContentType, ByRef strFilename, ByRef intFileTotalBytes, ByRef
strNewFilename)
'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
'*************************************************
' indsæt dags dato som første del af fil-navnet
' i formatet ååååmmdd-filnavn
'strdato = date
'strdato = "20" & mid(strdato,7,2) & mid(strdato,4,2) & left(strdato,2) &
"-"
'strFilename = strdato & strFilename
'*************************************************
'#################################################
' Her undersøges om filen skal have et andet navn
'
' Thomas Petersen, tp@doller.dk, 2001-08-30
'#################################################
if strNewFilename <> "" and instr(strFilename, ".") then
strExt = mid(strFilename, instr(strFilename, "."), len(strFilename) -
instr(strFilename, ".") + 1)
strNewFilename = strNewFileName & strExt
strFilename = strNewFilename
end if
'#################################################
'Dan det fulde outputfilnavn via MapPath
'strFileSpec = Server.MapPath(LCase(strPath & strFilename)) 'LCase
kan evt fjernes herfra
strFileSpec = 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
'###########################################################################
#########################
' Her begynder ny upload funktion. Denne deler filen op i 1Kb stykker,
hvis filen er over 1Kb i alt.
' Derved opnåes en højere uploadhastighed.
'
' Thomas Petersen, tp@doller.dk, 2001-08-30
'###########################################################################
#########################
dim intPakkeStr, intStep, ialt
intPakkeStr = 1024
if intFileTotalBytes > intPakkeStr then
intStep = intPakkeStr
else
intStep = intFileTotalBytes
end if
intPakkeStr = intStep
ialt = 0
i = intStartPos
Do Until i > intEndPos - 1
if i + intStep > intEndPos - 1 then
intPakkeStr = intEndPos - i
end if
ialt = ialt + intPakkeStr
ts.Write encodePakke(MidB(bstrPostData, i, intPakkeStr))
i = i + intStep
Loop
'###########################################################################
#########################
ts.Close 'Luk outputfil
'Check: Blev filen oprettet og har den samme størrelse?
Set f = fs.GetFile(strFileSpec)
If f.Size <> intFileTotalBytes Then
response.write f.size
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 --------------------
%>