收录日期:2018/09/20 11:42:28 时间:2016/05/21 14:12:20 标签:数据库(包含打印,安装,报表)
库里已有的二进制数据,怎么把它读出来并播放呢?而且,不知道以前是以什么格式存进去的,怎么解决呢?
Option Explicit

Private Enum MediaTypes '枚举各媒体文件类型
    MTGraphic
    MTWave
    MTAVI
    MTMP3
End Enum

Dim rs As Recordset '记录集,用于存放打开的纪录
Dim DataFile As Integer, Fl As Long, Chunks As Integer
Dim Fragment As Integer, Chunk() As Byte, I As Integer
Const ChunkSize As Integer = 16384
Dim filename As String

Dim NameWanted As String
Dim db As Database
Dim Description As String

Dim lMaxHeight As Long
Dim lMaxWidth As Long
Dim CurMediaType As MediaTypes

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1


Private Sub FixFinalSize()
'设置各控件大小与位置
Dim lTempWidth As Long
Dim lTempHeight As Long
Dim X As Single
Dim Y As Single


lMaxHeight = Shape1.Height - 20
lMaxWidth = Shape1.Width

X = lMaxHeight / Picture1.Height
With picFinal
    .Width = Picture1.Width - 10
    .Height = Picture1.Height - 10
    .Width = .Width * X
    .Height = .Height * X
    .Top = Shape1.Top

    If .Width > lMaxWidth Then
        Y = lMaxWidth / .Width
        .Width = .Width * Y
        .Height = .Height * Y
    End If
End With
Me.Refresh
End Sub

Private Sub ReadFromDB()
'从数据库中读出文件
Dim MediaTemp As String
Dim lngOffset As Long
Dim lngTotalSize As Long
Dim strChunk As String
Dim mediaid As Long
On Error Resume Next

If fa.MouseRow = 0 Then Exit Sub
mediaid = Val(fa.TextMatrix(fa.MouseRow, 1))

  
Set rs = db.OpenRecordset("SELECT tblMedia.MediaBLOB, tblMedia.MediaType FROM tblMedia WHERE tblMedia.MediaID = " & mediaid, dbOpenSnapshot)
'打开选中的纪录的记录集

If rs.RecordCount = 0 Then
'若为空纪录,退出
   MsgBox "error retrieving object"
   rs.Close
   Set rs = Nothing
   Exit Sub
End If

CurMediaType = rs!MediaType
Select Case CurMediaType
'针对各种媒体文件类型以下将数据库中文件存为对应的媒体文件名
    Case MTGraphic
        MediaTemp = App.path & "\mdiatemp.tmp"
    Case MTWave
        MediaTemp = App.path & "\mdiatemp.wav"
    Case MTAVI
        MediaTemp = App.path & "\mdaitemp.avi"
    Case MTMP3
        MediaTemp = App.path & "\mdaitemp.mp3"
    Case Else
        rs.Close
        Set rs = Nothing
        MsgBox "Error retrieving object"
        Exit Sub
End Select
Kill (MediaTemp)
'若已经存在对应的媒体文件,则删除
DataFile = 1
Open MediaTemp For Binary Access Write As DataFile
'打开对应的媒体文件(MediaTemp)往里写

If Err.Number = 70 Then
    '如果格式不支持,则报错并退出
    MsgBox Err.Number & vbCr & vbCr & Err.Description & vbCr & vbCr & "this error may be due to " & _
        "the media player holding a lock on a wav or avi file." & vbCr & "Close the mediaplayer and try again.", vbInformation, "SMITH MEDIA DEMO"
    Err.Clear
    rs.Close
    Set rs = Nothing
    Exit Sub
End If
lngTotalSize = rs!MediaBLOB.FieldSize
'得到文件大小
Chunks = lngTotalSize \ ChunkSize
'得到每个数据块大小
Fragment = lngTotalSize Mod ChunkSize
ReDim Chunk(ChunkSize)
'从新申请所需的空间
Chunk() = rs!MediaBLOB.GetChunk(lngOffset, ChunkSize)
Put DataFile, , Chunk()
'写入第一块
lngOffset = lngOffset + ChunkSize
Do While lngOffset < lngTotalSize
'连续写入,直至完成
   Chunk() = rs!MediaBLOB.GetChunk(lngOffset, ChunkSize)
   Put DataFile, , Chunk()
   lngOffset = lngOffset + ChunkSize
Loop
Close DataFile
'关闭
filename = MediaTemp
  ShellPlay MediaTemp
'打开媒体文件
End Sub

Private Sub RefillGrid()
'刷新网格显示纪录
Dim sSQL As String
Dim rs As Recordset
Dim lCurRow As Long
sSQL = "SELECT tblMedia.MediaID, tblMedia.MediaName, " & _
    "tblMedia.MediaType, tblMedia.MediaDescription FROM " & _
    "tblMedia ORDER BY tblMedia.MediaName"
Set rs = db.OpenRecordset(sSQL, dbOpenForwardOnly)
'得到新的纪录集
With fa
    'setup grid
    .Cols = 5
    .FixedCols = 1
    .ColWidth(1) = 0
    .ColWidth(0) = 300
    .AllowUserResizing = flexResizeBoth
    .Rows = 1
    .TextMatrix(0, 2) = "MediaName"
    .TextMatrix(0, 3) = "Type"
    .TextMatrix(0, 4) = "Description"
    '设置列头
    'fill grid
    Do While Not rs.EOF
    '一行一行的添加纪录
        lCurRow = .Rows
        .Rows = .Rows + 1
        .TextMatrix(lCurRow, 1) = CStr(rs!mediaid)
        .TextMatrix(lCurRow, 2) = rs!MediaName
        .TextMatrix(lCurRow, 3) = rs!MediaType
        .TextMatrix(lCurRow, 4) = rs!MediaDescription
        
    rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End With

End Sub


Private Sub ResetForm()
'清空各提示
txtName = ""
txtDescription = ""
Label3.Caption = ""
End Sub


Private Sub ShellPlay(ByVal sPath As String)
'调用API函数ShellExecute打开对应的文件
    Dim lret As Long
    Dim sText As String
    sText = Trim$(sPath)
    lret = ShellExecute(hwnd, "open", sText, vbNull, vbNull, SW_SHOWNORMAL)
    If lret >= 0 And lret <= 32 Then
        MsgBox "error opening viewer program"
    End If
End Sub

Private Sub Command1_Click()
'删除纪录
Dim sSQL As String
sSQL = "DELETE * FROM tblMedia" '你这没加条件where...,应该是删除所有的纪录
db.Execute sSQL, dbFailOnError
RefillGrid
End Sub

Private Sub fa_Click()
'得到选中纪录的ID值,用于标志选中的纪录
Dim mediaid As Long

If fa.MouseRow = 1 Then Exit Sub
mediaid = Val(fa.TextMatrix(fa.MouseRow, 1))
did = mediaid
End Sub

Private Sub fa_DblClick()
'双击时先清空个提示信息,然后打开选中的文件

If fa.MouseRow = 0 Then Exit Sub

'quick demo style
ResetForm
ReadFromDB

End Sub
Private Sub FileName_Change()
SaveToDB.Enabled = filename <> ""
If filename = "" Then Exit Sub
If CurMediaType = MTGraphic Then
'如果打开的纪录存的是图像,那么在Picture控件中显示对应图像
    Picture1.Picture = LoadPicture(filename)
    If Picture1.Picture = 0 Then Exit Sub
    
    picFinal.Visible = False
    FixFinalSize
    CenterPic
    
    
    Dim SourceX As Long, SourceY As Long
    SourceX = 0
    SourceY = 0
    Dim DestX As Long, DestY As Long
    DestX = 0
    DestY = 0
    Dim SourceWidth As Long, SourceHeight As Long
    SourceWidth = Picture1.ScaleWidth
    SourceHeight = Picture1.ScaleHeight
    Dim DestWidth As Long
    Dim DestHeight As Long
    DestWidth = picFinal.ScaleWidth
    DestHeight = picFinal.ScaleHeight
    Dim RasterOp As Long
    RasterOp = &HCC0020
    
    
    
    picFinal.PaintPicture Picture1.Picture, DestX, DestY, DestWidth, DestHeight, 0, 0, SourceWidth, SourceHeight, RasterOp&
    picFinal.Visible = True

Else
    '否则,调用相关程序打开文件
    ShellPlay filename
End If
End Sub

Private Sub Form_Load()
'打开文件grx.mdb,并初始化网格与提示信息
Set db = Workspaces(0).OpenDatabase(App.path & "\grx.mdb")
ResetForm
RefillGrid
End Sub






Private Sub SaveToDB_Click()
'添加新的纪录或修改纪录
Dim MediaName As String
MediaName = Trim$(txtName)
If Len(MediaName) = 0 Then
    MsgBox "请输入媒体文件的名称!"
    Exit Sub
End If

Set rs = db.OpenRecordset("SELECT * FROM tblMedia WHERE tblMedia.MediaName = " & Chr(34) & MediaName & Chr(34), dbOpenDynaset)
'打开记录集
If rs Is Nothing Or rs.Updatable = False Then
    '若打不开,提示报错退出
   MsgBox "不能打开或写入记录集!"
   Exit Sub
End If
If rs.EOF Then
    '如果是最后,则添加新纪录
   rs.AddNew
Else
    '否则,修改纪录
    rs.Edit
End If
    '赋值
    rs!MediaName = MediaName
    Description = Trim$(txtDescription)
    rs!MediaDescription = Description
    rs!MediaType = CurMediaType
DataFile = 1
Open filename For Binary Access Read As DataFile
    '读取文件到对应字段rs!MediaBLOB
    Fl = LOF(DataFile)    ' 文件中数据长度
    If Fl = 0 Then
        Close DataFile
        Exit Sub
    End If
    Chunks = Fl \ ChunkSize
    Fragment = Fl Mod ChunkSize
    ReDim Chunk(Fragment)
    Get DataFile, , Chunk()
    rs!MediaBLOB.AppendChunk Chunk()
    ReDim Chunk(ChunkSize)
    For I = 1 To Chunks
        Get DataFile, , Chunk()
        rs!MediaBLOB.AppendChunk Chunk()
    Next I
Close DataFile
rs.Update
rs.Close
Set rs = Nothing

ResetForm
RefillGrid
End Sub



Private Sub LoadFromFile_Click() '
'选择文件,得到要打开的文件名
On Error Resume Next
With CommonDialog1
    .CancelError = True
    .Filter = "Pictures(*.bmp;*.ico;*.gif;*.jpg)|*.bmp;*.ico;*.gif;*.jpg|Wave Files(*.wav)|*.wav|MS Video(*.avi)|*.avi|all files(*.*)|*.*"
     .Flags = cdlOFNHideReadOnly
    .ShowOpen
    If Err.Number = cdlCancel Then
        Err.Clear
        Exit Sub
    End If
    CurMediaType = .FilterIndex - 1
    Label3.Caption = .filename
    filename = .filename
    txtName.Text = .FileTitle
End With
End Sub
具体参见http://expert.csdn.net/Expert/topic/2290/2290220.xml?temp=9.823024E-03

你可以先从数据库中读出存为一个临时文件,然后用API函数ShellExecute 打开此文件,他回自己调用相关联的程序打开文件的
读数据库就不用说了吧,播放就用API把读取得字节数组播放出来就可以了,哪有那么麻烦
API函数
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As any, ByVal hModule As Long, ByVal dwFlags As Long) As Long
用得着如此麻烦么?使用ADODB中的Stream对象进行读出到硬盘,然后使用PlaySound播放
发出来的声音是滋滋的,好像格式不对,还有别的办法吗?