|
Option Compare Database 'Use database order for string comparisons
Option Explicit : DefInt A-Z
Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
Declare Function GlobalCompact Lib "Kernel" (ByVal dwMinFree As Long) As Long
Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
Declare Function GlobalHandle Lib "Kernel" (ByVal wMem As Integer) As Long
Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
Declare Function GlobalReAlloc Lib "Kernel" (ByVal hMem As Integer, ByVal dwBytes As Long, ByVal wFlags As Integer) As Integer
Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
' Global Memory Flags
Global Const GMEM_FIXED = &H0
Global Const GMEM_MOVEABLE = &H2
Global Const GMEM_NOCOMPACT = &H10
Global Const GMEM_NODISCARD = &H20
Global Const GMEM_ZEROINIT = &H40
Global Const GMEM_MODIFY = &H80
Global Const GMEM_DISCARDABLE = &H100
Global Const GMEM_NOT_BANKED = &H1000
Global Const GMEM_SHARE = &H2000
Global Const GMEM_DDESHARE = &H2000
Global Const GMEM_NOTIFY = &H4000
Global Const GMEM_LOWER = GMEM_NOT_BANKED
Global Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Global Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
'NOTE: instead of declaring the function GlobalDiscard and calling
' GlobalDiscard(hMem), call GlobalReAlloc(hMem, 0, GMEM_MOVEABLE)
Declare Function MemoryRead Lib "Toolhelp.dll" (ByVal wSel As Integer, ByVal dwOffset As Long, ByVal lpvBuf As String, ByVal dwcb As Long) As Integer
Declare Function MemoryWrite Lib "Toolhelp.dll" (ByVal wSel As Integer, ByVal dwOffset As Long, ByVal lpvBuf As String, ByVal dwcb As Long) As Integer
Declare Function sndPlaySound Lib "MMSYSTEM" (ByVal lpszSoundName As Any, ByVal uFlags As Integer) As Integer
' flag values for wFlags parameter
Global Const SND_SYNC = &H0 ' play synchronously (default)
Global Const SND_ASYNC = &H1 ' play asynchronously
Global Const SND_NODEFAULT = &H2 ' don't use default sound
Global Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file
Global Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
Global Const SND_NOSTOP = &H10 ' don't stop any currently playing sound
'Play a sound
Sub ExecAssoc (ByVal key As String)
Dim DB As Database: Set DB = CurrentDB()
Dim T As Table: Set T = DB.OpenTable("associations")
T.index = "primarykey"
T.Seek "=", key
If (T.nomatch) Then Error 32767
Dim DL As Long: DL = T.[data].FieldSize()
Dim handle As Integer: handle = GlobalAlloc(GMEM_FIXED, DL)
Debug.Print "DL = " & DL & ", handle = " & Hex$(handle)
If (handle < 1) Then Error 32767
Dim pointer As Long: pointer = GlobalLock(handle)
Debug.Print "pointer = " & Hex$(pointer)
Dim i As Long: i = 0
While (i < DL)
Dim chunk As String: chunk = T.[data].GetChunk(i, IIf(DL - i > 16384, 16384, DL - i))
Dim r As Integer: r = MemoryWrite(handle, i, chunk, Len(chunk))
i = i + Len(chunk)
Wend
r = sndPlaySound(pointer, SND_SYNC + SND_MEMORY + SND_NOSTOP)
r = GlobalUnlock(handle)
r = GlobalFree(handle)
'This next seems to prevent the above from becoming the Windows default
r = sndPlaySound(Space$(128), SND_SYNC + SND_MEMORY + SND_NOSTOP + SND_NODEFAULT)
End Sub
'Load a new sound into the table
Sub LoadAssoc (ByVal key As String, ByVal path As String)
Dim DB As Database: Set DB = CurrentDB()
Dim T As Table: Set T = DB.OpenTable("associations")
Dim fd As Integer: fd = FreeFile
Open path For Binary Access Read Lock Write As #fd
Dim FL As Long: FL = LOF(fd)
T.AddNew
T.[key] = key
T.[data] = Null
While (FL > 0)
Dim buffer As String: buffer = Space$(IIf(FL > 4096, 4096, FL))
Get #fd, , buffer: FL = FL - Len(buffer)
Debug.Print Len(buffer) & " bytes read"
T.[data].AppendChunk (buffer)
Wend
Close #fd
T.Update
T.Close
DB.Close
End Sub
|
