--- title: "Kan behöva lite hjälp med upload" type: "forum-thread" url: "https://www.webforum.nu/amne/asp/7612-kan-behöva-lite-hjälp-med-upload" topic: "ASP" topic_url: "https://www.webforum.nu/amne/asp" author: "Inferis" published: "2001-01-06T18:16:00.000Z" updated: "2001-01-06T18:16:00.000Z" replies: 0 views: 230 page: 1 pages: 1 language: "sv-SE" site: "webForum — webforum.nu" rights: "Upphovsrätten till varje inlägg tillhör dess författare." attribution: "Citera som: webForum, https://www.webforum.nu/amne/asp/7612-kan-behöva-lite-hjälp-med-upload" --- # Kan behöva lite hjälp med upload ## #1 — Inferis, 2001-01-06T18:16Z Jag har hittat ett danskt script som gör att man kan ladda upp filer till servern via webläsaren. Allt funkar som det ska, problemet är bara att jag kan inte klura ut hur man tvingar en besökare att använda ett visst namn på sin bild. Tex sitt inloggningsnamn. Vill någon vara snäll och visa hur det ska se ut? Koden: \<% '-------------------- Start: fileupload.inc -------------------- '\*\*\* FileUpload \*\*\* '\*\*\* af Lars Snyder (pila@mailme.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 = "admin" 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="eyetest" '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 \> 10000 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 -------------------- %\> Permalänk: https://www.webforum.nu/p/7612 --- Tråden på webben: https://www.webforum.nu/amne/asp/7612-kan-behöva-lite-hjälp-med-upload