UploadScript der ikke virker på denne server

skal den kun uploade og ikke lave automatiske tumbs osv, behøver du ikke at bruge et uploadscript der er komponent afhængig.

//cdc

det eneste den skal er at ligge et billede i den rigtige mappe, - mappe = session("mappe") hvor stien til mappen er her..
Har du et eksempel læggede jeg måske kan se??

2 sec

http://activedeveloper.dk/search/default.asp?area=1&size=50&page=1&SearchType=0&keyword=upload+uden+komponent

http://activedeveloper.dk/search/default.asp?area=3&size=50&page=1&SearchType=0&keyword=upload+uden+komponent

jeg kan ikke lige finde dem jeg har brugt.... men keysersoze linker til nogle her :o)

mange tak for svaret.. den uploader godt nok.. men den opretter bare en mappe der hedder fileupload og putter billederne der i. hvordan ændre man stien så billederne bliver uploadet til den rigtige mappe? mappen navn ligger i denne mappe = session("mappe")

det er nok et sted i denne fil "filupload" skal buttes ud med min session..

unction FileUpload(strProjectPath, intAcceptMaxSize, arrAcceptContentType, arrAcceptExt, arrAcceptDir, bolAutoCreateDir, bolAutoReplaceFile)

    '** Variable deklaration **
    Dim arrFileUploadStatusTxt      'Tekster der beskriver hvordan evt. upload gik
    Dim arrSplit                    'Array med data der er splitet på basis af en streng
    Dim bolContentTypeOK            'Accept af ContentType
    Dim bolDirOK                    'Accept af Dir
    Dim bolExtOK                    'Accept af Ext
    Dim bolFileUploadDone          'Een fil er uploaded
    Dim bolMaxSizeOK                'Accept af filstørrelse
    Dim bstrDivider                'delelinien inkl. vbCrLfB
    Dim bstrPostData                'POST som binær streng
    Dim i                          'Tæller
    Dim intEndPos                  'Slutningen af denne Content del
    Dim intFileTotalBytes          'Det faktiske antal bytes i filen
    Dim intFileUploadStatus        'Tal der beskriver hvordan evt. upload gik
    Dim intInStrPos                'Position der returneres fra InStr
    Dim intPostTotalBytes          'Antallet af bytes i POST
    Dim intStartPos                'Starten af denne Content del
    Dim objFile                    'FileObject
    Dim objFSO                      'FileSystemObject
    Dim objOutputDict              'Dictionary der bruges til at returnere output
    Dim objTS                      'TextStreamObject
    Dim strAcceptContentType        'Een af de ContentTyper der accepteres
    Dim strAcceptDir                'Een af de Dir der accepteres
    Dim strAcceptExt                'Een af de Ext der accepteres
    Dim strContentDisposition      'Aktuelle Content-Disposition (uden vbCrLf)
    Dim strContentType              'Aktuelle Content-Type (uden vbCrLf)
    Dim strDestinationDir          'Den directory filen skal ende i (hentes fra form'en)
    Dim strDestinationFileSpec      'FileSpec til destinationsfilen
    Dim strDictItem                'Item tekst til Dictionary objekt
    Dim strDictKey                  'Nøgletekst til Dictionary objekt
    Dim strExt                      'Den fundne Ext
    Dim strFilename                'Filnavn
    Dim strFileSpec                'Absolut sti til filen i fileupload mappen
    Dim strSourceFileSpec          'FileSpec itl sourcefilen
    Dim vbCrLfB                    'Som vbCrLf men som binær streng

    '** Konstant deklaration **
    Const FILEUPLOAD_DIR = "fileupload/"

    '** Check input **
    'strProjectPath
    If IsNull(strProjectPath) Or strProjectPath = "" Then
        'Brug aktuelle scriptmappe som projektets rodmappe
        strProjectPath = Request.ServerVariables("SCRIPT_NAME")
        If InStrRev(strProjectPath, "/") > 0 Then
            strProjectPath = Left(strProjectPath, InStrRev(strProjectPath, "/"))
        End If
    End If
    If Right(strProjectPath, 1) <> "/" Then strProjectPath = strProjectPath & "/"

    'intAcceptMaxSize
    If IsNull(intAcceptMaxSize) Then intAcceptMaxSize = 0
    If Not IsNumeric(intAcceptMaxSize) Then intAcceptMaxSize = 0

    'arrAcceptContentType
    If IsNull(arrAcceptContentType) Then arrAcceptContentType = Array("")
    If Not IsArray(arrAcceptContentType) Then arrAcceptContentType = Array(arrAcceptContentType)

    'arrAcceptExt
    If IsNull(arrAcceptExt) Then arrAcceptExt = Array("")
    If Not IsArray(arrAcceptExt) Then arrAcceptExt = Array(arrAcceptExt)

    'arrAcceptDir
    If IsNull(arrAcceptDir) Then arrAcceptDir = Array("")
    If Not IsArray(arrAcceptDir) Then arrAcceptDir = Array(arrAcceptDir)

    'bolAutoCreateDir
    If IsNull(bolAutoCreateDir) Then bolAutoCreateDir = False
    If bolAutoCreateDir <> True Then bolAutoCreateDir = False

    'bolAutoReplaceFile
    If IsNull(bolAutoReplaceFile) Then bolAutoReplaceFile = False
    If bolAutoReplaceFile <> True Then bolAutoReplaceFile = False

    '** Forbered diverse variabler **
    intFileUploadStatus = 3 'Default svar er 3 Meddelelse: Der var ikke noget FILE felt med navnet FILEUPLOAD.
    arrFileUploadStatusTxt = Array( "OK", _
                                    "Fejl: Der var ingen data at hente.", _
                                    "Fejl: Den samlede datamængde er ikke hentet korrekt.", _
                                    "Info: Der var ikke noget FILE felt med navnet FILEUPLOAD.", _
                                    "Fejl: Filen havde ikke noget filnavn.", _
                                    "Fejl: Filen er for stor.", _
                                    "Fejl: Content-Typen accepteres ikke.", _
                                    "Fejl: Filens extension accepteres ikke.", _
                                    "Fejl: Filen blev ikke gemt korrekt på serveren.", _
                                    "Fejl: Filens destinationsmappe accepteres ikke.", _
                                    "Fejl: Destinationsmappen findes ikke (og må ikke oprettes automatisk).", _
                                    "Fejl: Destinationsfilen findes allerede (og må ikke slettes).", _
                                    "Fejl: Filen kunne ikke flyttes til destinationsmappen.")  'Mulige svar
    vbCrLfB = ChrB(13) & ChrB(10) 'Dan vbCrLf som binær streng
    bolFileUploadDone = False
    strDestinationDir = ""

    '** Forbered output **
    Set objOutputDict = CreateObject("Scripting.Dictionary")

    '** Hent input fra strøm, dan output **
    'Check: Er det faktisk POST upload?
    If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
        '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

        'Check: Er antallet af bytes i POST lig med længden af den binære streng?
        If LenB(bstrPostData) = intPostTotalBytes Then
            'Hent delelinien inkl. vbCrLfB (altid hele første linie)
            bstrDivider = LeftB(bstrPostData, InStrB(bstrPostData, vbCrLfB) + 1)

            'Løkke der finder og behandler alle Content-Disposition, Content-Type og Content-Data
            intStartPos = 1
            Do
                'Find starten af denne Content del (umiddelbart efter delelinien)
                intStartPos = InStrB(intStartPos, bstrPostData, bstrDivider) + LenB(bstrDivider)
                If intStartPos = 0 Then
                    'Ikke flere Content delelinier
                    Exit Do
                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 delelinier
                    Exit Do
                End If

                'Hent aktuelle Content-Disposition som LCase (uden vbCrLf)
                strContentDisposition = LCase(bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos)))

                'Flyt intStartPos til efter Content-Disposition linien (altså til starten af Content-Type linien)
                intStartPos = intStartPos + Len(strContentDisposition) + 2

                'Hent aktuelle Content-Type som LCase (uden vbCrLf)
                strContentType = LCase(bin2str(MidB(bstrPostData, intStartPos, InStrB(intStartPos, bstrPostData, vbCrLfB) - intStartPos)))

                'Flyt intStartPos til starten af Content-Data
                If strContentType = "" Then
                    'Flyt intStartPos til efter den ekstra blanke linie
                    intStartPos = intStartPos + 2
                Else
                    'Flyt intStartPos til efter Content-Type linien og den ekstra blanke linie
                    intStartPos = intStartPos + Len(strContentType) + 4
                End If

                'Flyt intEndPos til slutningen af Content-Data (før den efterstillede vbCrLfB)
                intEndPos = intEndPos - 2

                'Undersøg om det er et fileupload felt eller et almindeligt form felt?
                If InStr(strContentDisposition, "name=""fileupload") > 0 Then
                    'Er det et _dir felt?
                    If InStr(strContentDisposition, "name=""fileupload_dir""") > 0 Then
                        '**********************************
                        '***** Husk dir'en til senere *****
                        '**********************************

                        'Hent Content-Data som streng
                        strDestinationDir = LCase(bin2str(MidB(bstrPostData, intStartPos, intEndPos - intStartPos)))

                    'Er det et _file felt?
                    ElseIf InStr(strContentDisposition, "name=""fileupload_file""") > 0 Then

                        '*********************************
                        '***** Gem filen på serveren *****
                        '*********************************

                        'Der må ikke allerede være uploaded een fil
                        If Not bolFileUploadDone Then                       
                            '** Ekstrakt POST filnavnet fra Content-Disposition ***
                            'Opdel strContentDisposition ved ;: Content-Disposition: form-data; name="fileupload"; filename="filen.ext"
                            arrSplit = Split(strContentDisposition, ";")

                            'Find filnavnet fra filename= array
                            strFilename = "" '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= ?
                                    strFilename = Trim(arrSplit(i))
                                    Exit For
                                End If
                            Next

                            'Blev der fundet et filnavn?
                            If strFilename <> "" And strFilename <> "filename=""""" Then
                                'Find filnavnet
                                arrSplit = Split(strFilename, """")        'Opdel streng ved "
                                strFilename = arrSplit(UBound(arrSplit) - 1) 'Næstsidste indholder filnavn
                                arrSplit = Split(strFilename, "\") 'Del ved alle \  Så indeholder den sidste filnavn.ext"
                                strFilename = arrSplit(UBound(arrSplit)) 'Hent den sidste array, der må være filnavnet

                                'Autoopret evt. strProjectPath & FILEUPLOAD_DIR
                                AutoCreateDir LCase(strProjectPath & FILEUPLOAD_DIR)

                                'Dan det fulde outputfilnavn via MapPath
                                strFileSpec = Server.MapPath(LCase(strProjectPath & FILEUPLOAD_DIR & strFilename))

                                'Find det samlede antal bytes for filen
                                intFileTotalBytes = intEndPos - intStartPos

                                'Ekstrakt oplysninger om Content-Type: image/gif
                                arrSplit = Split(strContentType, " ")
                                strContentType = arrSplit(UBound(arrSplit))

                                'Skal MaxSize checkes?
                                bolMaxSizeOK = False
                                If intAcceptMaxSize > 0 Then
                                    If intFileTotalBytes <= intAcceptMaxSize Then
                                        bolMaxSizeOK = True
                                    End If
                                Else
                                    bolMaxSizeOK = True
                                End If

                                'Skal Content-Type checkes?
                                bolContentTypeOK = False
                                If arrAcceptContentType(LBound(arrAcceptContentType)) <> "" Then
                                    For Each strAcceptContentType In arrAcceptContentType
                                        If strContentType = strAcceptContentType Then
                                            bolContentTypeOK = True
                                        End If
                                    Next
                                Else
                                    bolContentTypeOK = True
                                End If

                                'Skal Ext checkes?
                                bolExtOK = False
                                If arrAcceptExt(LBound(arrAcceptExt)) <> "" Then
                                    For Each strAcceptExt In arrAcceptExt
                                        If LCase(Right(strFilename, Len(strAcceptExt))) = strAcceptExt Then
                                            strExt = strAcceptExt
                                            bolExtOK = True
                                        End If
                                    Next
                                Else
                                    bolExtOK = True
                                End If

                                'Gå videre hvis de tre checks gik godt
                                If bolMaxSizeOK And bolContentTypeOK And bolExtOK Then
                                    'Åbn, skriv og luk outputfilen
                                    Set objFSO = CreateObject("Scripting.FileSystemObject") 'Filsystem objekt
                                    Set objTS = objFSO.CreateTextFile(strFileSpec, True) 'Åbn outputfil, overskriv evt. eksisterende
                                    For i = intStartPos To intEndPos - 1
                                        objTS.Write(Chr(AscB(MidB(bstrPostData, i, 1)))) 'Skriv data eet tegn af gangen
                                    Next
                                    objTS.Close 'Luk outputfil

                                    'Check: Blev filen oprettet og har den samme størrelse?
                                    Set objFile = objFSO.GetFile(strFileSpec)
                                    If objFile.Size = intFileTotalBytes Then
                                        'Gem oplysninger om filen i Dictionary
                                        objOutputDict("FILEUPLOAD_DIR") = FILEUPLOAD_DIR
                                        objOutputDict("FILEUPLOAD_FILENAME") = strFilename
                                        objOutputDict("FILEUPLOAD_URL") = LCase(strProjectPath & FILEUPLOAD_DIR & strFilename)
                                        objOutputDict("FILEUPLOAD_SIZE") = intFileTotalBytes
                                        objOutputDict("FILEUPLOAD_CONTENTTYPE") = strContentType
                                        objOutputDict("FILEUPLOAD_EXT") = strExt

                                        '* Status 0: OK
                                        intFileUploadStatus = 0

                                        'Begræns til een og kun een fil
                                        bolFileUploadDone = True
                                    Else
                                        'Fejl 8: Filen blev ikke gemt korrekt på serveren
                                        intFileUploadStatus = 8
                                    End If

                                    'Slip objekter
                                    Set objFile = Nothing
                                    Set objTS = Nothing
                                    Set objFSO = Nothing
                                Else
                                    'MaxSize, ContentType eller Ext var ikke ok
                                    If Not bolMaxSizeOK Then
                                        '* Fejl 5: Filen er for stor
                                        intFileUploadStatus = 5
                                    ElseIf Not bolContentTypeOK Then
                                        '* Fejl 6: Content-Typen accepteres ikke
                                        intFileUploadStatus = 6
                                    ElseIf Not bolExtOK Then
                                        '* Fejl 7: Filens extension accepteres ikke
                                        intFileUploadStatus = 7
                                    End If
                                End If
                            Else
                                'Fejl 4: Filen havde ikke noget filnavn.
                                intFileUploadStatus = 4
                            End If
                        End If
                    End If
                Else
                    '**************************************************
                    '***** Gem oplysningerne om Content i objDict *****
                    '**************************************************

                    'Ekstrakt NAME fra Content-Type til strDictKey

                    'Find NAME eller returner hele Content-Typen
                    intInStrPos = InStr(strContentDisposition, "name=")
                    If intInStrPos > 0 Then
                        strDictKey = Mid(strContentDisposition, intInStrPos + 6)
                        strDictKey = Left(strDictKey, Len(strDictKey) - 1)
                    Else
                        strDictKey = strContentDisposition
                    End If

                    'Returner altid feltnavne som uppercase!
                    strDictKey = UCase(strDictKey)

                    'Hent Content-Data som streng
                    strDictItem = bin2str(MidB(bstrPostData, intStartPos, intEndPos - intStartPos))

                    'Tilføj til dictionary objekt ( = notationen retter/opretter automatisk)
                    objOutputDict(strDictKey) = strDictItem
                End If

                'Start igen umiddelbart efter denne Content, men før næste divider
                intStartPos = intEndPos
            Loop

            '** Flyt evt. filen til en anden mappe **
            If intFileUploadStatus = 0 Then
                'Er der fundet en destinations mappe
                If strDestinationDir <> "" Then
                    'DestinationDir skal slutte på /
                    If Right(strDestinationDir, 1) <> "/" Then
                        strDestinationDir = strDestinationDir & "/"
                    End If

                    'Skal Dir checkes?
                    bolDirOK = False
                    If arrAcceptDir(LBound(arrAcceptDir)) <> "" Then
                        For Each strAcceptDir In arrAcceptDir
                            'AcceptDir skal slutte på /
                            If Right(strAcceptDir, 1) <> "/" Then
                                strAcceptDir = strAcceptDir & "/"
                            End If

                            If LCase(strAcceptDir) = strDestinationDir Then
                                bolDirOK = True
                            End If
                        Next
                    Else
                        bolDirOK = True
                    End If

                    'Gik Dir checket godt?
                    If bolDirOK Then                       
                        'Findes mappen ikke?
                        If Not CheckDir(strProjectPath & strDestinationDir) Then
                            'Skal mappen oprettes?
                            If bolAutoCreateDir Then
                                'Opret mappen
                                AutoCreateDir strProjectPath & strDestinationDir
                            End If
                        End If

                        'Findes mappen nu?
                        If CheckDir(strProjectPath & strDestinationDir) Then
                            'Forbered et FSO
                            Set objFSO = CreateObject("Scripting.FileSystemObject")

                            'Find filespecs
                            strSourceFileSpec = Server.MapPath(strProjectPath & FILEUPLOAD_DIR & strFilename)
                            strDestinationFileSpec = Server.MapPath(strProjectPath & strDestinationDir & strFilename)

                            'Er filespecs forskellige?
                            If strSourceFileSpec <> strDestinationFileSpec Then
                                'Findes destinationsfilen i forvejen?
                                If objFSO.FileExists(strDestinationFileSpec) Then
                                    'Må filen slettes?
                                    If bolAutoReplaceFile Then
                                        'Slet filen
                                        objFSO.DeleteFile strDestinationFileSpec
                                    Else
                                        '* Fejl 11: Destinationsfilen findes allerede (og må ikke slettes)
                                        intFileUploadStatus = 11
                                    End If
                                End If

                                'Er destinationsfilen væk?
                                If Not objFSO.FileExists(strDestinationFileSpec) Then
                                    'Flyt filen fra kilde (fileupload) mappen til destinations mappen
                                    objFSO.MoveFile strSourceFileSpec, strDestinationFileSpec

                                    'Fejlmeld hvis det ikke gik godt
                                    If Not objFSO.FileExists(strDestinationFileSpec) Then                           
                                        '* Fejl 12: Filen kunne ikke flyttes til destinationsmappen
                                        intFileUploadStatus = 12
                                    End If
                                Else
                                    '* Fejl 11: Destinationsfilen findes allerede (og må ikke slettes)
                                    intFileUploadStatus = 11
                                End If
                            Else
                                'Kilde og Destination er een og samme fil (strDestinationDir = FILEUPLOAD_DIR
                                Rem
                            End If
                        Else
                            'Fejl 10: Destinationsmappen findes ikke (og må ikke oprettes automatisk)
                            intFileUploadStatus = 10
                        End If
                    Else
                        '* Fejl 9: Filens destinationsmappe accepteres ikke
                        intFileUploadStatus = 9

                        'Returner standardmappen
                        strDestinationDir = FILEUPLOAD_DIR
                    End If
                Else
                    'Hvis strDestinationDir = "" returneres standardmappen
                    strDestinationDir = FILEUPLOAD_DIR
                End If

                'Opdater FILEUPLOAD_DIR og FILEUPLOAD_URL
                objOutputDict("FILEUPLOAD_DIR") = strDestinationDir
                objOutputDict("FILEUPLOAD_URL") = LCase(strProjectPath & strDestinationDir & strFilename)
            End If
        Else
            'Fejl 2: Den samlede datamængde er ikke hentet korrekt.
            intFileUploadStatus = 2
        End If   
    Else
        'Fejl 1: Der var ingen data at hente.
        intFileUploadStatus = 1
    End If

    'Sæt status i dictionary objektet
    objOutputDict("FILEUPLOAD_STATUS") = intFileUploadStatus
    objOutputDict("FILEUPLOAD_STATUSTXT") = arrFileUploadStatusTxt(intFileUploadStatus)

    'Returner dictionary output objekt
    Set FileUpload = objOutputDict
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

'* Procedure der automatisk opretter manglende mapper på en sti
'* Input: strPath = Fuld sti der skal oprettes, f.eks. "/projekt/abc/def/"
Public Sub AutoCreateDir(ByVal strPath)
    Dim arrDirs
    Dim objFSO
    Dim strCurrentPath
    Dim strCurrentSpec
    Dim strDir

    'Initialiser variabler
    strCurrentPath = ""
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Check og ret input
    If Left(strPath, 1) = "/" Then strPath = Right(strPath, Len(strPath) - 1)
    If Right(strPath, 1) = "/" Then strPath = Left(strPath, Len(strPath) - 1)

    'Findes ikke mappen allerede?
    If Not objFSO.FolderExists(Server.MapPath("/" & strPath)) Then

        'Fordel de enkelte mapper ud i en array
        arrDirs = Split(strPath, "/")

        'Gennemløb alle mapper i arrDirs fra roden og op
        For Each strDir In arrDirs
            'Tilføj denne mappe til den fulde sti
            strCurrentPath = strCurrentPath & "/" & strDir

            'Find spec for denne mappe
            strCurrentSpec = Server.MapPath(strCurrentPath)

            'Findes mappen ikke allerede?
            If Not objFSO.FolderExists(strCurrentSpec) Then
                'Opret da mappen
                objFSO.CreateFolder(strCurrentSpec)
            End If
        Next

        'Frigiv objekter
        Set objFSO = Nothing
    End If
End Sub

'* Funktion der checker om en path til en mappe (uden host) findes
'* Input: strPath = Sti der skal checkes, f.eks. "/projekt/abc/def/"
Public Function CheckDir(ByVal strPath)
    Dim bolOutput
    Dim objFSO
    Dim strFolderSpec

    'Check og ret input
    If Right(strPath, 1) <> "/" Then strPath = strPath & "/"

    'Find mappens spec
    strFolderSpec = Server.MapPath(strPath)

    'Check om mappen findes
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    bolOutput = objFSO.FolderExists(strFolderSpec)
    Set objFSO = Nothing
   
    'Returner sand/falsk
    CheckDir = bolOutput
End Function

'---------------------- Slut: fileupload4inc.asp ----------------------
%>

kan ikke lige finde ud af den du har gang i her, men jeg brugte denne, og oversadte den til dansk fra svensk i sin tid, og da den har flere funtioner var den optimal til mig. Her kan du uploade og se hvad der ligger i mappen, samt slette dem der ikke skal bruges mere: http://www.gruvsjo.com/main.asp?cat=script&ucat=asp&viewID=75

//cdc

Mange tak :) det andet er temmelig svært at tygge sig i gennem.

i filen pic.asp er der øverst denne:

'###################################################
'-------------MAPPEN DU LISTAR UPP FILERNA FRÅN----------------------
'###################################################

MappNamn = "mapp" &Request.Querystring("dir")


døb mapp om til mappe så smider den alle dine billeder der ned i

Det Virker!!! Alt for fedt så læg et svar /cdc og mange mange tak for hjælpen

svarer :o)

Tak for points :o)

Hej /cdc

Dit link virker ikke længer.. kan du gøre det live igen? det virkede til du havde den rigtige (let forståelige) løsning og sådan en kunne jeg også godt bruge!