05. februar 2005 - 12:32Der er
8 kommentarer og 1 løsning
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?
' 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
<% '*************************************** ' 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
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
Kom nu... Er der ikke nogen som tør prøve kræfter med denne her lille udfordring? Jeg tror det er et ret nyttigt script hvis småfejlene bliver eliminieret...
Jeg har stjålet lidt hist og pist, men det kan ses i scriptet. Eller har jeg skrevet en del af det selv.
Der bliver kun gemt 4 bytes, når jeg downloader. Upload fungere fint. Alt hvad der uploades gemmes korrekt i databasen og kan enten ses direkte i databasen eller gemmes til disk. Jeg kan ikke finde ud af om MySQL tilføjer en oleheader i stil med access eller hvad der er galt.
Jeg fået scriptet til at virke hvis det i stedet gemmer filerne på disken, men det er jo ikke helt det samme.
Her en er filemanager, som lægger hver fil ned i en unik mappe på drevet, så der ikke opstår navnekonflikt. Er nødvendigt, hvis flere brugere skal kunne uploade uden at de kan se hinandens filer.
>>>>>>>>>> FILEMANAGER.SQL
#---------------------------- # Table structure for files #---------------------------- create table filemanager ( id int(11) not null auto_increment, FileName varchar(50) not null, FileSize varchar(50) not null, ContentType varchar(50) not null, primary key (id)) type=MyISAM;
>>>>>>>>FILEMANAGER.ASP
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <title>Filemanager</title> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
<script LANGUAGE="JavaScript"> <!--
function confirmSubmit() { var agree=confirm("Er du sikker på du vil fortsætte?"); if (agree) return true ; else return false ; } // --> </script>
<% '*************************************** ' 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
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
' Choose what to do by looking at the action parameter
Select Case LCase(Trim(Request.QueryString("action"))) Case "addfile"
' Get the id iRecordId = Request.QueryString("id") If IsNumeric(iRecordId) Then iRecordId = CLng(iRecordId) Else iRecordId = 0 End If
'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 filemanager WHERE ID=0;" Set RS = Server.CreateObject("ADODB.Recordset") RS.CursorLocation = 3 RS.Open strSQL, CONN_STRING, 1, 2, 1
RS.AddNew ' create a new record RS.Fields("filename").Value = File.FileName RS.Fields("filesize").Value = File.FileSize RS.Fields("contenttype").Value = File.ContentType RS.Update
' henter nyoprettede id strFolderId = RS.Fields("id").Value
'8***********************************************8 ' Jason Withrow - For ASP101 July 2001 ' This page forces the save as dialogue to prevent ' files from being opened in the browser. ' ' jwithrow@mediaone.net '8***********************************************8
Response.Buffer = True Dim strFilePath, strFileSize, strFileName
Const adTypeBinary = 1
' Get the id to fetch iRecordId = Request.QueryString("id") If IsNumeric(iRecordId) Then iRecordId = CLng(iRecordId) Else iRecordId = 0 End If
strSQL = "SELECT * FROM filemanager WHERE id="& iRecordId &";" Set rstDBEdit = Server.CreateObject("ADODB.Recordset") rstDBEdit.Open strSQL, CONN_STRING, 0, 1, 1
'8*******************************8 ' Requires MDAC 2.5 to be stable ' I recommend MDAC 2.6 or 2.7 '8*******************************8 Set objStream = Server.CreateObject("ADODB.Stream") objStream.Open objStream.Type = adTypeBinary objStream.LoadFromFile strFilePath
strFileType = lcase(Right(strFileName, 4))
' Feel Free to Add Your Own Content-Types Here Select Case strFileType Case ".asf" ContentType = "video/x-ms-asf" Case ".avi" ContentType = "video/avi" Case ".doc" ContentType = "application/msword" Case ".zip" ContentType = "application/zip" Case ".xls" ContentType = "application/vnd.ms-excel" Case ".gif" ContentType = "image/gif" Case ".jpg", "jpeg" ContentType = "image/jpeg" Case ".wav" ContentType = "audio/wav" Case ".mp3" ContentType = "audio/mpeg3" Case ".mpg", "mpeg" ContentType = "video/mpeg" Case ".rtf" ContentType = "application/rtf" Case ".htm", "html" ContentType = "text/html" Case ".asp" ContentType = "text/asp" Case Else 'Handle All Other Files ContentType = "application/octet-stream" End Select
Response.AddHeader "Content-Disposition", "attachment; filename=" & strFileName Response.AddHeader "Content-Length", strFileSize ' In a Perfect World, Your Client would also have UTF-8 as the default ' In Their Browser Response.Charset = "UTF-8" Response.ContentType = ContentType
Jamen downloadkoden står der allerede... Men kan da godt lige fremhæve den her...
Tror at problemet ligger i den måde, som mysql gemmer blobs - det siger min fornemmelse mig... Har læst mig til at f.eks. access tilføjer en oleheader til informationen, som skal fjernes før det igen kan hentes ud.
Ja det undrer mig at jeg kun har 2 parametrer der, når jeg normalt har 3. Og ja det virkede næsten... billederne kommer nu halvt igennem ... Men det har jeg læst om et eller andet sted... Så langt så godt...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.