Downloade blobs/images fra MySQL med ASP's Response.BinaryWrite
Hej jeg har stykket tre små side sammen til at uploade og downloade filer fra min database. Det fungerer fint med eks. pdf filer, men når det kommer til billeder kan scriptet kun hente 4 bytes hvilket resultere et en bronken-link billeder. Nogen der kender en løsning?FILE_EKS.ASP
<!-- #include file="upload.asp" -->
<%
CONN_STRING = "Driver={mysql odbc 3.51 Driver};SERVER=localhost;DATABASE=db;UID=id;PASSWORD=pw;option=16387;"
SCRIPT_NAME = Request.ServerVariables("SCRIPT_NAME")
' Choose what to do by looking at the action parameter
Select Case LCase(Trim(Request.QueryString("action")))
Case "addfile"
'NOTE - YOU MUST HAVE VBSCRIPT v5.0 INSTALLED ON YOUR WEB SERVER
' FOR THIS LIBRARY TO FUNCTION CORRECTLY. YOU CAN OBTAIN IT
' FREE FROM MICROSOFT WHEN YOU INSTALL INTERNET EXPLORER 5.0
' OR LATER.
' Create the FileUploader
Dim Uploader, File
Set Uploader = New FileUploader
Dim RS
' This starts the upload process
Uploader.Upload()
'******************************************
' Use [FileUploader object].Form to access
' additional form variables submitted with
' the file upload(s). (used below)
'******************************************
' Loop through the uploaded files
For Each File In Uploader.Files.Items
' Open the table you are saving the file to
strSQL = "SELECT * FROM files WHERE ID=0;"
Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open strSQL, CONN_STRING, 2, 2
RS.AddNew ' create a new record
RS("filename") = File.FileName
RS("filesize") = File.FileSize
RS("contenttype") = File.ContentType
' Save the file to the database
File.SaveToDatabase RS("filedata")
' Commit the changes and close
RS.Update
RS.Close
Next
Response.Redirect(SCRIPT_NAME)
Case "deletefile"
' Get the id to delete
iRecordId = Request.QueryString("id")
If IsNumeric(iRecordId) Then
iRecordId = CLng(iRecordId)
Else
iRecordId = 0
End If
strSQL = "DELETE FROM files WHERE id=" & iRecordId & ";"
Set cnnDBEdit = Server.CreateObject("ADODB.Connection")
cnnDBEdit.Open CONN_STRING
cnnDBEdit.Execute strSQL, adAffectAll, adExecuteNoRecords
cnnDBEdit.Close
Set cnnDBEdit = Nothing
Response.Redirect(SCRIPT_NAME)
Case Else
antal = 0
colorflip = 0
' Our default action... just lists the records in the DB
strSQL = "SELECT id, FileName, FileSize, ContentType FROM files;"
Set rstDBEdit = Server.CreateObject("ADODB.Recordset")
rstDBEdit.Open strSQL, CONN_STRING, 0, 1, 1
%>
<table width="100%" border="1" cellpadding="3" cellspacing="0">
<tr>
<td>FileName</td>
<td width="100">FileSize</td>
<td width="150">ContentType</td>
<td width="30"> </td>
</tr>
<% Do While Not rstDBEdit.EOF %>
<tr>
<td><a href="download_eks.asp?id=<%= rstDBEdit.Fields("id").Value %>" ><%= rstDBEdit.Fields("FileName").Value %></a></td>
<td><%= rstDBEdit.Fields("FileSize").Value %></td>
<td><%= rstDBEdit.Fields("ContentType").Value %></td>
<td><a onclick="return confirmSubmit()" href="<%= SCRIPT_NAME %>?action=deletefile&id=<%= rstDBEdit.Fields("id").Value %>"><img src="wrong.gif" alt="slet fil" width="16" height="13" border="0" style="border: 0;"></a></td>
</tr>
<%
rstDBEdit.MoveNext
Loop
%>
<tr>
<td colspan="4" align="center"><br>
<FORM METHOD="POST" ENCTYPE="multipart/form-data" ACTION="<%= SCRIPT_NAME %>?action=addfile">
<TABLE BORDER=0 cellpadding="0" cellspacing="0">
<tr>
<td><b>Hent filer:</b><br><INPUT TYPE="FILE" SIZE="40" NAME="FILE1"></td>
</tr>
<tr>
<td align="center"><INPUT TYPE="SUBMIT" VALUE="Gem"></td>
</tr>
</TABLE>
</FORM>
</td>
</tr>
</table>
<%
rstDBEdit.Close
Set rstDBEdit = Nothing
End Select
%>
DOWNLOAD_EKS.ASP
<%
response.Expires = 0
response.Buffer = True
response.Clear
iRecordId = Request.QueryString("id")
If IsNumeric(iRecordId) Then
iRecordId = CLng(iRecordId)
Else
iRecordId = 0
End If
CONN_STRING = "Driver={mysql odbc 3.51 Driver};SERVER=localhost;DATABASE=db;UID=id;PASSWORD=pw;option=16387;"
strSQL = "SELECT * FROM files WHERE ID="& iRecordId &";"
Set RS = Server.CreateObject("ADODB.Recordset")
RS.Open strSQL, CONN_STRING, 2, 3
Response.ContentType = "image/jpeg" 'RS("contenttype")
Response.AddHeader "Content-Disposition", "attachment; filename="& RS("FileName") &""
Response.BinaryWrite RS("filedata")
RS.Close
Set RS = Nothing
response.End
%>
UPLOAD.ASP
<%
'***************************************
' File: Upload.asp
' Author: Jacob "Beezle" Gilley
' Email: avis7@airmail.net
' Date: 12/07/2000
' Comments: The code for the Upload, CByteString,
' CWideString subroutines was originally
' written by Philippe Collignon...or so
' he claims. Also, I am not responsible
' for any ill effects this script may
' cause and provide this script "AS IS".
' Enjoy!
'****************************************
Class FileUploader
Public Files
Private mcolFormElem
Private Sub Class_Initialize()
Set Files = Server.CreateObject("Scripting.Dictionary")
Set mcolFormElem = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
If IsObject(Files) Then
Files.RemoveAll()
Set Files = Nothing
End If
If IsObject(mcolFormElem) Then
mcolFormElem.RemoveAll()
Set mcolFormElem = Nothing
End If
End Sub
Public Property Get Form(sIndex)
Form = ""
If mcolFormElem.Exists(LCase(sIndex)) Then Form = mcolFormElem.Item(LCase(sIndex))
End Property
Public Default Sub Upload()
Dim biData, sInputName
Dim nPosBegin, nPosEnd, nPos, vDataBounds, nDataBoundPos
Dim nPosFile, nPosBound
biData = Request.BinaryRead(Request.TotalBytes)
nPosBegin = 1
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
If (nPosEnd-nPosBegin) <= 0 Then Exit Sub
vDataBounds = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
nDataBoundPos = InstrB(1, biData, vDataBounds)
Do Until nDataBoundPos = InstrB(biData, vDataBounds & CByteString("--"))
nPos = InstrB(nDataBoundPos, biData, CByteString("Content-Disposition"))
nPos = InstrB(nPos, biData, CByteString("name="))
nPosBegin = nPos + 6
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sInputName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosFile = InstrB(nDataBoundPos, biData, CByteString("filename="))
nPosBound = InstrB(nPosEnd, biData, vDataBounds)
If nPosFile <> 0 And nPosFile < nPosBound Then
Dim oUploadFile, sFileName
Set oUploadFile = New UploadedFile
nPosBegin = nPosFile + 10
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(34)))
sFileName = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
oUploadFile.FileName = Right(sFileName, Len(sFileName)-InStrRev(sFileName, "\"))
nPos = InstrB(nPosEnd, biData, CByteString("Content-Type:"))
nPosBegin = nPos + 14
nPosEnd = InstrB(nPosBegin, biData, CByteString(Chr(13)))
oUploadFile.ContentType = CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
nPosBegin = nPosEnd+4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
oUploadFile.FileData = MidB(biData, nPosBegin, nPosEnd-nPosBegin)
If oUploadFile.FileSize > 0 Then Files.Add LCase(sInputName), oUploadFile
Else
nPos = InstrB(nPos, biData, CByteString(Chr(13)))
nPosBegin = nPos + 4
nPosEnd = InstrB(nPosBegin, biData, vDataBounds) - 2
If Not mcolFormElem.Exists(LCase(sInputName)) Then mcolFormElem.Add LCase(sInputName), CWideString(MidB(biData, nPosBegin, nPosEnd-nPosBegin))
End If
nDataBoundPos = InstrB(nDataBoundPos + LenB(vDataBounds), biData, vDataBounds)
Loop
End Sub
'String to byte string conversion
Private Function CByteString(sString)
Dim nIndex
For nIndex = 1 to Len(sString)
CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
Next
End Function
'Byte string to string conversion
Private Function CWideString(bsString)
Dim nIndex
CWideString =""
For nIndex = 1 to LenB(bsString)
CWideString = CWideString & Chr(AscB(MidB(bsString,nIndex,1)))
Next
End Function
End Class
Class UploadedFile
Public ContentType
Public FileName
Public FileData
Public Property Get FileSize()
FileSize = LenB(FileData)
End Property
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
Public Sub SaveToDatabase(ByRef oField)
If LenB(FileData) = 0 Then Exit Sub
If IsObject(oField) Then
oField.AppendChunk FileData
End If
End Sub
End Class
%>
