upload af images !

Har du adgang til en upload komponent?

hey... nej det har jeg ikke....

ok så bliver det uden komponent.
Jeg har dette som du kan prøve det består af 3 filer.


Først filen:  FilePost.asp


<%
' INCLUDE-FIL... FilePost.asp
' Efter at have kørt SaveFile ligger request-form-variable
' i requestForm, som er et dictionary
' Kan slåes op som fx. requestForm("titel")
' Filnavnet som filen blev gemt under ligger i savedFilename
' Kan højst klare 10 filer. FileCount starter med 0 og går op til 9
' Der er ikke specielle regler om navngivning af fil-felterne. De bliver læst ind i den rækkefølge de kommer.

' --- DELTE VARIABLE
Dim requestForm
Dim FieldCount
Dim savedFilename
Dim FileCount
Dim myRequestFiles(9, 3)    ' ,0 = field name, ,1 = value, ,2 = filename, ,3 = file type

' Jo større filer, der forventes - jo højere skal script-timeout sættes
Server.ScriptTimeout = 5400

' --- PRIVATE VARIABLE
Dim myRequest
Dim SaveFile
Dim CrLf

Const ForWriting = 2
Const TristateTrue = -1


CrLf = Chr(13) & Chr(10)

' This function retreives a field´s name
Function GetFieldName(infoStr)
    Dim sPos
    Dim EndPos
   
    sPos = InStr(infoStr, "name=")
    EndPos = InStr(sPos + 6, infoStr, Chr(34) & ";")
    If EndPos = 0 Then
        EndPos = inStr(sPos + 6, infoStr, Chr(34))
    End If
    GetFieldName = Mid(infoStr, sPos + 6, endPos - (sPos + 6))
End Function

' This function retreives a file field´s filename
Function GetFileName(infoStr)
    Dim sPos
    Dim EndPos
   
    sPos = InStr(infoStr, "filename=")
    EndPos = InStr(infoStr, Chr(34) & CrLf)
    GetFileName = Mid(infoStr, sPos + 10, EndPos - (sPos + 10))
End Function

' This function retreives a file field´s MIME type
Function GetFileType(infoStr)
    Dim sPos
   
    sPos = InStr(infoStr, "Content-Type: ")
    GetFileType = Mid(infoStr, sPos + 14)
End Function


Function ReadFormData()
    ' Yank the file (and anything else) that was posted
    Dim ErrMsg
    Dim nIndex
    Dim PostData
    Dim ContentType
    Dim ctArray
    Dim Boundary
    Dim FormData
    Dim bArray
    Dim varInfo
    Dim varValue
    Dim x
    Dim InfoEnd
   
    PostData = ""
    ErrMsg = "Ukendt fejl"
    Dim biData
    biData = Request.BinaryRead(Request.TotalBytes)
   
    ' Careful! It´s binary! So, let´s change it into
    ' something a bit more manageable.
    For nIndex = 1 to LenB(biData)
        PostData = PostData & Chr(AscB(MidB(biData,nIndex,1)))
    Next
   
    ' Having used BinaryRead, the Request.Form collection is
    ' no longer available to us. So, we have to parse the
    ' request variables ourselves!
    ' First, let´s find that encoding type!
   
    ContentType = Request.ServerVariables("CONTENT_TYPE")
    ctArray = Split(ContentType, ";")
   
    ' File posts only work well when the encoding is
    ' "multipart/form-data", so let´s check for that!
    If Trim(ctArray(0)) = "multipart/form-data" Then
        ErrMsg = ""
       
        ' grab the form boundary...
        bArray = Split(Trim(ctArray(1)), "=")
        Boundary = Trim(bArray(1))
       
        ' Now use that to split up all the variables!
        FormData = Split(PostData, Boundary)
       
        ' Extract the information for each variable and its data
       
        Set myRequest = CreateObject("Scripting.Dictionary")
        FileCount = 0
        For x = 0 to UBound(FormData)
           
            ' Two CrLfs mark the end of the information about
            ' this field; everything after that is the value
            InfoEnd = InStr(FormData(x), CrLf & CrLf)
            If InfoEnd > 0 Then
               
                ' Get info for this field, minus stuff at the end
                varInfo = Mid(FormData(x), 3, InfoEnd - 3)
               
                ' Get value for this field, being sure to skip
                ' CrLf pairs at the start and the CrLf at the end
                varValue = Mid(FormData(x), InfoEnd + 4, _
                    Len(FormData(x)) - InfoEnd - 7)
               
                ' Is this a file?
                If (InStr(varInfo, "filename=") > 0) Then
                    ' Place it into our files array
                    ' (While this supports more than one file
                    ' uploaded at a time we only consider the
                    ' single file case in this example)
                    myRequestFiles(FileCount, 0) = GetFieldName(varInfo)
                    myRequestFiles(FileCount, 1) = varValue
                    myRequestFiles(FileCount, 2) = GetFileName(varInfo)
                    myRequestFiles(FileCount, 3) = GetFileType(varInfo)
                    FileCount = FileCount + 1
                Else
                    ' It´s a regular field
                    myRequest.add GetFieldName(varInfo), varValue
                End If
            End If
        Next
        Set FormData = Nothing
    Else
        ErrMsg = "Formen skal postes som 'multipart/form-data'!"
    End If
   
    ReadFormData = ErrMsg
    Set biData = Nothing
    Set PostData = Nothing
    Set requestForm = myRequest
End Function

Function SavePostedFile(FileNo, RelPath, FixedName, FixedExt)
   
    ' Save the actual posted file
    ' If supporting more than one file, turn this into a loop!
    Dim lf   
   
    Set lf = server.createObject("Scripting.FileSystemObject")
   
    Dim fName
    Dim oName ' original name
    Dim BrowserType
    Dim sPos
    Dim FilePath
    Dim SavePath
   
   
    'Use the filename that came with the file
    'At this point, you need to determine what sort of
    'client sent the file. Macintoshes only send the file
    'name, with no path information, while Windows clients
    'send the entire path of the file that was selected
    BrowserType = UCase(Request.ServerVariables("HTTP_USER_AGENT"))
    If (InStr(BrowserType, "WIN") > 0) Then
        ' It´s Windows; yank the filename off the end!
        sPos = InStrRev(myRequestFiles(FileNo, 2), Chr(92))  ' \
        oName = Mid(myRequestFiles(FileNo, 2), sPos + 1)
    End If
    If (InStr(BrowserType, "MAC") > 0) Then
        ' It´s a Mac. Simple.
        ' (Mac filenames can contain characters that are
        ' illegal under Windows, so look out for that!)
        oName = myRequestFiles(FileNo, 2)
    End If
   
   
    if ((FixedName = "") Or IsNull(FixedName)) And ((FixedExt = "") Or IsNull(FixedExt)) Then
        fName = oName
    Else
        fName = ""
        If (Len(FixedName) > 0) Then
            fName = FixedName
        Else
            sPos = InStrRev(oName, ".")
            If (sPos > 0) Then
                fName = Left(oName, sPos-1)
            Else
                fName = oName
            End If
        End If
        fName = fName & "."
        If (Len(FixedExt) > 0) Then
            fName = fName & FixedExt
        Else   
            sPos = InStrRev(oName, ".")
            If (sPos > 0) Then
                fName = fName & Mid(oName, sPos+1)
            End If
        End If
    End If
   
    If Len(RelPath) <= 0 Then
        RelPath = "./"
    End If
    If (Right(RelPath, 1) <> "/") Then
        RelPath = RelPath & "/"
    End If
   
    FilePath = RelPath & fName
    savedFileName = fName
   
    SavePath = Server.MapPath(FilePath)
    Set SaveFile = lf.CreateTextFile(SavePath, True)
    dim i
    For i = 1 To Len(myRequestFiles(FileNo, 1))
        SaveFile.Write Mid(myRequestFiles(FileNo, 1), i, 1)
    Next
    'SaveFile.Write myRequestFiles(FileNo, 1)
    SaveFile.Close
   
    SavePostedFile = savedFileName
   
    Set lf = Nothing
End Function

Sub CleanUp()
    Set SaveFile = Nothing
    Set myRequest = Nothing
    Set requestForm = Nothing
    Dim x
    For x = 0 To 9
        Set myRequestFiles(x, 0) = Nothing
        Set myRequestFiles(x, 1) = Nothing
        Set myRequestFiles(x, 2) = Nothing
        Set myRequestFiles(x, 3) = Nothing
    Next

End Sub

%>

I denne fil skal du rette baseFolder variablen sådan den passer med hvor du image folderen ligger, eksemppelvis her i wwwroot folderen:

baseFolder = "/images"


Så filen:  postit.asp

<% Option Explicit %>
<html>
<body>
<!-- #INCLUDE FILE="FilePost.asp" -->
<%

    Dim res
   
    'Response.Write "ReadFormData"
    res = ReadFormData
    'Response.Write "...Done!<br />"
   
    If res <> "" Then
        Response.Write res
        Response.End
    End If
   
    If FileCount < 1 Then
        Response.Write "Ingen filer " & FileCount
        Response.End
    End If
   

    dim rootFolder,fso,addSti,baseFolder,nyFolderArr,sti,saveFolder,i

    baseFolder = "images" 

    set fso = Server.CreateObject("Scripting.FilesystemObject")
    addSti=replace(requestForm("sti"),"\","/")
    if left(addSti,1)="/" then addSti = Mid(addSti,2)
    if right(addSti,1)="/" then addSti = left(addSti,len(addSti)-1)
    if right(baseFolder,1)="/" then baseFolder = left(baseFolder,len(baseFolder)-1)
   
    saveFolder = baseFolder
    if addSti<>"" then saveFolder = saveFolder & "/" & addSti
    nyfolderArr = Split(saveFolder, "/")

    for i = 0 to ubound(nyfolderArr)
      sti = sti & nyfolderArr(i) & "/"
      if sti <> "/" then
        if fso.FolderExists(Server.Mappath(sti)) = false then
          Set rootFolder = fso.CreateFolder(Server.Mappath(sti)) 
          CreateServerFolder = rootFolder.Path
        end if
      end if
    next   
    set fso=Nothing


    'Response.Write "SavePostedFile"
    res = SavePostedFile(0, saveFolder, "", "")
    'Response.Write "...Done!<br />"
   
    Response.Write FieldCount & "<br />"
   
    'Response.Write "CleanUp"
    CleanUp
    'Response.Write "...Done!<br />"
   
   
%>
Filen <% =savefolder&res %> blev gemt.<br />
</body>
</html>

til sidst form filen som ineholder form hvor du kan vælge en fil samt skrive en sti

Stien kan skrive som:  bla/bla
så vil den oprette bla/bal i images så det bliver:
images/bla/bla


Navnet på den fil betyder ikke så meget så det må du selv bestemme :)

<html>
<body>
<form method="post" action="postit.asp" enctype="multipart/form-data">
Vælg billede<input type="file" name="fil1" /><br />
Skrive en sti<input type="text" name="sti" /><br />
<input type="submit" />
</form>
</body>
</html>

Jeg smutter i seng for i aften så du må prøve at rode lidt med det :)

tak! over and out

hey...

det virker fint, men der er et lille problem...
når jeg uploader ét images + jeg opretter en ny mapper
vil den ikke gemme billede... Hvorfor nu... det ??

Hvordan skriver du stien?
Umidelbart skulle det ikke være noget problem.

Jeg skriver at (fx) /billedemappe så bliver mappen oprettet, men ikke billede...
men hvis jeg så opretter den igen er der ikke noget problem... ??

Ok, der vra en lille smutter :)
Prøv rette koden i  postit.asp  i dette:



<% Option Explicit %>
<html>
<body>
<!-- #INCLUDE FILE="FilePost.asp" -->
<%

    Dim res
   
    'Response.Write "ReadFormData"
    res = ReadFormData
    'Response.Write "...Done!<br />"
   
    If res <> "" Then
        Response.Write res
        Response.End
    End If
   
    If FileCount < 1 Then
        Response.Write "Ingen filer " & FileCount
        Response.End
    End If
   

    dim rootFolder,fso,addSti,baseFolder,nyFolderArr,sti,saveFolder,i

    baseFolder = "images" 

    set fso = Server.CreateObject("Scripting.FilesystemObject")
    addSti=replace(requestForm("sti"),"\","/")
    if left(addSti,1)="/" then addSti = Mid(addSti,2)
    if right(addSti,1)="/" then addSti = left(addSti,len(addSti)-1)
    if right(baseFolder,1)="/" then baseFolder = left(baseFolder,len(baseFolder)-1)
   
    saveFolder = baseFolder
    if addSti<>"" then saveFolder = saveFolder & "/" & addSti
    nyfolderArr = Split(saveFolder, "/")

    for i = 0 to ubound(nyfolderArr)
      sti = sti & nyfolderArr(i) & "/"
      if sti <> "/" then
        if fso.FolderExists(Server.Mappath(sti)) = false then
          Set rootFolder = fso.CreateFolder(Server.Mappath(sti)) 
        end if
      end if
    next   
    set fso=Nothing


    'Response.Write "SavePostedFile"
    res = SavePostedFile(0, saveFolder, "", "")
    'Response.Write "...Done!<br />"
   
    'Response.Write FieldCount & "<br />"
   
    'Response.Write "CleanUp"
    CleanUp
    'Response.Write "...Done!<br />"
   
   
%>
Filen <% =savefolder&res %> blev gemt.<br />
</body>
</html>

takker...

Så er der et svar her :)