Upload kun billeder..
Hej Alle!Jeg har understående glimrende script. Imidlertid er det muligt, at uploade andet end billeder, og det er knap så perfekt.
Hvad skal der stå for kun, at uploade billeder? Jeg har ligeledes et problem med timeout´en. Jeg har prøvet, at indsætte server.timeout flere forskillige steder, men uden held :)
Håber nogle vil hjælpe..
På forhånd tak.
### SCRIPT ###
<% @EnableSessionState = False %>
<% Response.Expires = 0 %>
<%
Response.Buffer = True
' Connection til database
Set Con = Server.CreateObject("ADODB.Connection")
DBPath = "DBQ=" & server.mappath("../../../database/database.mdb")
Con.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & DBPath
Sql = "SELECT * FROM avanceretopsaetning"
Set Record = Con.Execute(Sql)
PictureLink = Record("maildomain")
%>
<%
Dim ScriptX
Dim UPLOAD_PATH
UPLOAD_PATH = Server.MapPath("../../billeder")
Dim g_oFso, g_oFolder, g_oFile
Set g_oFso = Server.CreateObject("Scripting.FileSystemObject")
Set g_oFolder = g_oFso.getFolder(UPLOAD_PATH)
If (Request.ServerVariables("REQUEST_METHOD") = "POST") Then
Dim g_oUpload
Set g_oUpload = get_upload_files()
Dim fpos, fcontent
fcontent = g_oUpload("upload").Item("content")
Set g_oFile = g_oFso.CreateTextFile(UPLOAD_PATH & "\" & extract_filename(g_oUpload("upload").Item("filename")))
For fpos = 1 to LenB(fcontent)
g_oFile.Write chr(AscB(MidB(fcontent, fpos, 1)))
Next
g_oFile.Close: Set g_oFile = Nothing
Response.Redirect Request.ServerVariables("SCRIPT_NAME") & "?upload=on"
End If
if request.querystring("upload") = "on" then
scriptx = "alert('Upload er udført!');"
end if
Response.Write "<html><title>UPLOAD AF FILER</title><head></head><body topmargin=""0"" leftmargin=""0"" style=""background-color:transparent;""><script> " & scriptX & " </script><table border=""0"" cellspacing=""0"" cellpadding=""0"" width=""315""><tr><td><form name=""frmUpload"" method=""post"" enctype=""multipart/form-data"" action=""" & Request.ServerVariables("SCRIPT_NAME") & """> <input type=""file"" name=""upload"" style=""font-family: Verdana, Arial, Helvetica; font-size: 10 px;""> <input type=""submit"" value=""Upload"" style=""font-family: Verdana, Arial, Helvetica; font-size: 10 px;""></form></td><tr>"
Response.Write "<tr><td><img src=""../gfx/1x1.gif"" width=""5"" height=""60""></td><tr><tr><td><form name=myform><select MULTIPLE size=""5"" style=""width:315;height:275; font-family:Verdana, Arial, Helvetica; font-size:10px"" name=""site"" onchange=""if(this.selectedIndex>0)parent.passText(this.value)""><option value=""""></option>"
For Each g_oFile In g_oFolder.files
Response.Write "<option value=""http://www." & PictureLink & "/billeder/" & g_oFile.name & """>" & g_oFile.name & "</option>"
Next
Response.Write "</select><br><br></td><tr></table></body></html>"
%>
<%
Con.Close
Set Con = Nothing
%>
<%
Function get_upload_files()
Dim upload_object, request_binaries
Dim position_start, position_end
Dim boundary, boundary_pos
Set upload_object = Server.CreateObject("Scripting.Dictionary")
request_binaries = Request.BinaryRead(Request.TotalBytes)
position_start = 1
position_end = InstrB(position_start, request_binaries, get_byte_string(chr(13)))
boundary = MidB(request_binaries, position_start, (position_end - position_start))
boundary_pos = InstrB(1, request_binaries, boundary)
Do Until (boundary_pos = InstrB(request_binaries, boundary & get_byte_string("--")))
If Not(Response.IsClientConnected) Then Response.End
Dim name, pos_file
position_start = (InstrB(InstrB(boundary_pos, request_binaries, get_byte_string("Content-Disposition")), request_binaries, get_byte_string("name=")) + 6)
position_end = InstrB(position_start, request_binaries, get_byte_string(chr(34)))
name = get_string(MidB(request_binaries, position_start, (position_end - position_start)))
pos_file = InstrB(boundary_pos, request_binaries, get_byte_string("filename="))
If ((pos_file <> 0) AND (pos_file < InstrB(position_end, request_binaries, boundary))) Then
upload_object.Add name, Server.CreateObject("Scripting.Dictionary")
position_start = (pos_file + 10)
position_end = InstrB(position_start, request_binaries, get_byte_string(chr(34)))
upload_object.item(name).Add "filename", get_string(MidB(request_binaries, position_start, (position_end - position_start)))
position_start = (InstrB(position_end, request_binaries, get_byte_string("Content-Type:")) + 14)
position_end = InstrB(position_start, request_binaries, get_byte_string(chr(13)))
upload_object.item(name).Add "content-type", get_string(MidB(request_binaries, position_start, (position_end - position_start)))
position_start = (position_end + 4)
position_end = InstrB(position_start, request_binaries, boundary) - 2
upload_object.item(name).Add "size", ((position_end - position_start))
upload_object.item(name).Add "content", MidB(request_binaries, position_start, (position_end - position_start))
End If
boundary_pos = InstrB(boundary_pos + LenB(boundary), request_binaries, boundary)
Loop
Set get_upload_files = upload_object
End Function
Function get_byte_string(str)
Dim cnt
For cnt = 1 to Len(str)
get_byte_string = get_byte_string & chrB(AscB(Mid(str, cnt, 1)))
Next
End Function
Function get_string(str)
Dim cnt
For cnt = 1 to LenB(str)
get_string = get_string & chr(AscB(MidB(str, cnt, 1)))
Next
End Function
Function extract_filename(filename)
extract_filename = Right(filename, Len(filename) - InStrRev(filename, "\", -1, 1))
End Function
%>
