Problem med upload af billed
Hejjeg har fået fat i et script til upload af billeder uden brug af komponenter herinde på eksperten, men problemet er at billederne bliver gemt med billednavn "test".gif/jpg/bmp osv.
script1:
<!-- #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
Response.Write "SavePostedFile"
res = SavePostedFile(0, "./", "test" , "")
Response.Write "...Done!<br />"
Response.Write FieldCount & "<br />"
Dim tekst
tekst = requestForm("tekst")
Response.Write "CleanUp"
CleanUp
Response.Write "...Done!<br />"
%>
include filen:
<%
' 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
%>
håber i kan hjælpe.
