Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

How can play an avi video stored in an access database using Visual Basic

Posted on 2006-05-03
5
Medium Priority
?
464 Views
Last Modified: 2013-11-25
Hi,

How can I play an avi video stored in an access database in a binary field using mciSendStringA in Visual Basic 6.0 without using a temporal file. (I think using a stream, some example?)

Thanks.
 
0
Comment
Question by:fferdinan
  • 3
4 Comments
 
LVL 28

Expert Comment

by:Ark
ID: 16680118
0
 

Author Comment

by:fferdinan
ID: 16681649
Ark, stored in a database no in a dll.....
0
 
LVL 28

Expert Comment

by:Ark
ID: 16687755
No difference - just fill array from BLOB field and set lpData = VarPtr(arrData(0)). Probably, you'll need GlobalAlloc/GlobalLock API to lock memory area and pass lpData pointer, returned by GlobalLock API.
0
 
LVL 28

Accepted Solution

by:
Ark earned 2000 total points
ID: 16688506
Here is the code:

'=====bas module========
Option Explicit
     
Public lpData As Long
Public fileSize As Long
Public hInst As Long

Public Const MMIO_INSTALLPROC = &H10000   'mmioInstallIOProc:install
                                          'MMIOProc

Public Const MMIO_GLOBALPROC = &H10000000 'mmioInstallIOProc: install
                                          'globally

Public Const MMIO_READ = &H0
Public Const MMIOM_CLOSE = 4
Public Const MMIOM_OPEN = 3
Public Const MMIOM_READ = MMIO_READ
Public Const MMIO_REMOVEPROC = &H20000
Public Const MMIOM_SEEK = 2
Public Const SEEK_CUR = 1
Public Const SEEK_END = 2
Public Const SEEK_SET = 0
Public Const MEY = &H2059454D   'This is the value of "MEY " run
                                'through FOURCC

'Create a user defined variable for the API function calls
Public Type MMIOINFO
       dwFlags As Long
       fccIOProc As Long
       pIOProc As Long
       wErrorRet As Long
       htask As Long
       cchBuffer As Long
       pchBuffer As String
       pchNext As String
       pchEndRead As String
       pchEndWrite As String
       lBufOffset As Long
       lDiskOffset As Long
       adwInfo(4) As Long
       dwReserved1 As Long
       dwReserved2 As Long
       hmmio As Long
End Type

Public Declare Function FindResource Lib "kernel32" Alias "FindResourceA" (ByVal hInstance As Long, ByVal lpName As String, ByVal lpType As String) As Long
Public Declare Function LoadResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long
Public Declare Function LockResource Lib "kernel32" (ByVal hResData As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function mmioInstallIOProc Lib "winmm" Alias "mmioInstallIOProcA" (ByVal fccIOProc As Long, ByVal pIOProc As Long, ByVal dwFlags As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Long, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function SizeofResource Lib "kernel32" (ByVal hInstance As Long, ByVal hResInfo As Long) As Long

'Accesses a unique storage system, such as a database or file
'archive. Install or remove this callback function with the
'mmioInstallIOProc function.
Public Function IOProc(ByRef lpMMIOInfo As MMIOINFO, ByVal uMessage As Long, ByVal lParam1 As Long, ByVal lParam2 As Long) As Long
   Static alreadyOpened As Boolean
   Select Case uMessage
          Case MMIOM_OPEN
               If Not alreadyOpened Then
                  alreadyOpened = True
                  lpMMIOInfo.lDiskOffset = 0
               End If
               IOProc = 0
          Case MMIOM_CLOSE
               IOProc = 0
          Case MMIOM_READ:
               Call CopyMemory(ByVal lParam1, ByVal lpData + lpMMIOInfo.lDiskOffset, lParam2)
               lpMMIOInfo.lDiskOffset = lpMMIOInfo.lDiskOffset + lParam2
               IOProc = lParam2
          Case MMIOM_SEEK
               Select Case lParam2
                      Case SEEK_SET
                           lpMMIOInfo.lDiskOffset = lParam1
                      Case SEEK_CUR
                           lpMMIOInfo.lDiskOffset = lpMMIOInfo.lDiskOffset + lParam1
                           lpMMIOInfo.lDiskOffset = fileSize - 1 - lParam1
                      Case SEEK_END
                           lpMMIOInfo.lDiskOffset = fileSize - 1 - lParam1
               End Select
               IOProc = lpMMIOInfo.lDiskOffset
         Case Else
              IOProc = -1 ' Unexpected msgs.  For instance, we do not
                         ' process MMIOM_WRITE in this sample
   End Select
End Function ' IOProc

'==============Form code========
'Add 3 command button and 1 listbox

Dim mCN As Connection
Dim rsAVI As ADODB.Recordset

Private Const GMEM_MOVEABLE = &H2
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

'Open database and fill listbox with AVI names
Private Sub Command1_Click()
   NewConnection mCN
   With mCN
     .Provider = "Microsoft.JET.OLEDB.4.0"
     .Properties("Data Source").Value = App.Path & "\AVITest.mdb" '<<< Change to your database name
     .Properties("Jet OLEDB:Engine Type") = 5
     .CursorLocation = adUseServer
     .Mode = adModeShareDenyNone
     .Open
   End With
   OpenRS rsAVI, "SELECT * FROM AVI" '<<< Change to your database table
   rsAVI.MoveFirst
   While Not rsAVI.EOF
      List1.AddItem rsAVI("AVIName") '<<< Change to your database field containing AVI Name
      rsAVI.MoveNext
   Wend
   If List1.ListCount Then List1.ListIndex = 0
End Sub

'Play AVI from database
Private Sub Command2_Click()
   Dim abAVI() As Byte
   Dim hMem As Long
   Dim strCmd As String, strReturnVal As String
   Dim nbuf As Long

   rsAVI.MoveFirst
   rsAVI.Find "AVIName='" & List1.List(List1.ListIndex) & "'" '<<< Change to your database field containing AVI Name
   If rsAVI.EOF Then Exit Sub
   abAVI = rsAVI("AVISource") '<<< Change to your database field containing AVI BLOB
   fileSize = UBound(abAVI) + 1
   hMem = GlobalAlloc(GMEM_MOVEABLE, fileSize)
   If hMem = 0 Then Exit Sub
   ' Lock the memory object and get a pointer to it.
   lpData = GlobalLock(hMem)
   If lpData = 0 Then
      Call GlobalFree(hMem)
      Exit Sub
   End If
   CopyMemory ByVal lpData, abAVI(0), fileSize
   
   Call mmioInstallIOProc(MEY, AddressOf IOProc, MMIO_INSTALLPROC + MMIO_GLOBALPROC)
   nbuf = 256

   'Play the AVI file
   strCmd = "open test.MEY+ type avivideo alias test"
   strReturnVal = mciSendString(strCmd, 0&, 0&, 0&)
   strCmd = "play test wait"
   strReturnVal = mciSendString(strCmd, 0&, 0&, 0&)
   strCmd = "close test"
   strReturnVal = mciSendString(strCmd, 0&, 0&, 0&)

   Call mmioInstallIOProc(MEY, vbNull, MMIO_REMOVEPROC)
   GlobalUnlock hMem
   GlobalFree hMem
End Sub

'Write AVI file content into database
Private Sub Command3_Click()
   Dim abAVI() As Byte
   Dim mySTM As New ADODB.Stream
   rsAVI.MoveFirst
   rsAVI.Find "AVIName='" & List1.List(List1.ListIndex) & "'" '<<< Change to your database field containing AVI Name
   With mySTM
       .Type = adTypeBinary
       .Open
       .LoadFromFile App.Path & "\file.avi" '<<< Change to your AVI File Name
       rsAVI!AVISource = mySTM.Read
       rsAVI.Update
       .Close
   End With
   Set mySTM = Nothing
End Sub

Private Sub NewConnection(oConn As ADODB.Connection)
  If Not (oConn Is Nothing) Then
     On Error Resume Next
     oConn.Close
     Set oConn = Nothing
  End If
  Set oConn = New ADODB.Connection
End Sub

Private Sub OpenRS(rs As ADODB.Recordset, strSQL As String, _
                  Optional CursorType As CursorTypeEnum = adOpenKeyset, _
                  Optional LockType As LockTypeEnum = adLockOptimistic, _
                  Optional Options As Long = adCmdTableDirect, _
                  Optional oConn As Connection)
   If rs Is Nothing Then
      Set rs = New ADODB.Recordset
   Else
      If rs.State = adStateOpen Then rs.Close
   End If
   If oConn Is Nothing Then
      rs.Open strSQL, mCN, CVar(CursorType), CVar(LockType), CLng(Options)
   Else
      rs.Open strSQL, oConn, CVar(CursorType), CVar(LockType), CLng(Options)
   End If
End Sub

Private Sub CloseRS(rs As ADODB.Recordset)
    On Error Resume Next
    If Not rs Is Nothing Then
       If rs.State = adStateOpen Then
          rs.Close
       End If
       Set rs = Nothing
    End If
End Sub

Private Sub Form_Load()
   Command1.Caption = "Open RS"
   Command2.Caption = "Play avi"
End Sub

Private Sub Form_Unload(Cancel As Integer)
   CloseRS rsAVI
   On Error Resume Next
   mCN.Close
   Set mCN = Nothing
End Sub
0

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question