12-08-2025, 06:48 PM (This post was last modified: 12-15-2025, 08:43 AM by Petr.)
Hello everyone.
The following dynamic libraries are written in collaboration with AI.
I solved some things, but unfortunately only for Windows users. Yes, I was doing research on the laboriousness of Linux... I ran away. Fast. Very fast.
First, one thing that started to crash for some unknown reason - InputBox. The ZIP file contains the source code in C, the BAS program, compiled DLLs for IDE 32bit and IDE64bit.
So for users who want a different inputbox than the one available in QB64PE, there is this option.
32-bit version compiled by QB64PE compiler 4.0.0, 64-bit version compiled by QB64PE compiler 4.1.0
Code: (Select All)
// qb_inputbox_ex.c (PURE C, build as DLL x86/x64 to match QB64PE)
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <commdlg.h>
#include <wchar.h>
#include <wctype.h>
#include <stdlib.h>
#include <strsafe.h>
static int ValidateOnOk(HWND hDlg, INPUTBOX_CTX* ctx) {
wchar_t tmp[4096];
GetDlgItemTextW(hDlg, IDC_EDIT, tmp, (int)(sizeof(tmp)/sizeof(tmp[0])));
int len = (int)wcslen(tmp);
if (!(ctx->flags & IB_ALLOWEMPTY)) {
if (len == 0) {
MessageBoxW(hDlg, L"Please enter a value (cannot be empty).", CAPTION_BOX, MB_ICONWARNING);
SetFocus(GetDlgItem(hDlg, IDC_EDIT));
return 0;
}
}
if (ctx->minLen > 0 && len < ctx->minLen) {
wchar_t msg[256];
wsprintfW(msg, L"Text is too short. Minimum: %d characters.", ctx->minLen);
MessageBoxW(hDlg, msg, CAPTION_BOX, MB_ICONWARNING);
SetFocus(GetDlgItem(hDlg, IDC_EDIT));
return 0;
}
if (ctx->maxLen > 0 && len > ctx->maxLen) {
wchar_t msg[256];
wsprintfW(msg, L"Text is too long. Maximum: %d characters.", ctx->maxLen);
MessageBoxW(hDlg, msg, CAPTION_BOX, MB_ICONWARNING);
SetFocus(GetDlgItem(hDlg, IDC_EDIT));
return 0;
}
// numeric validation only for single-line
if ((ctx->flags & IB_NUMBERS) && !(ctx->flags & IB_MULTILINE)) {
wchar_t numBuf[4096];
wcsncpy(numBuf, tmp, (int)(sizeof(numBuf)/sizeof(numBuf[0])) - 1);
numBuf[(sizeof(numBuf)/sizeof(numBuf[0])) - 1] = 0;
ReplaceCommaWithDot(numBuf);
wchar_t* p = numBuf;
while (*p && iswspace(*p)) p++;
wchar_t* end = NULL;
double v = wcstod(p, &end);
if (end == p) {
MessageBoxW(hDlg, L"Invalid number.", CAPTION_BOX, MB_ICONWARNING);
SetFocus(GetDlgItem(hDlg, IDC_EDIT));
return 0;
}
while (*end && iswspace(*end)) end++;
if (*end != 0) {
MessageBoxW(hDlg, L"Invalid number (contains unsupported characters).", CAPTION_BOX, MB_ICONWARNING);
SetFocus(GetDlgItem(hDlg, IDC_EDIT));
return 0;
}
if (ctx->maxVal > ctx->minVal) {
if (v < ctx->minVal || v > ctx->maxVal) {
wchar_t msg[256];
// wsprintfW(msg, L"Number must be in the range %.12g to %.12g.", ctx->minVal, ctx->maxVal);
StringCchPrintfW(msg, 256, L"Number must be in the range %.12g to %.12g.", ctx->minVal, ctx->maxVal);
MessageBoxW(hDlg, msg, CAPTION_BOX, MB_ICONWARNING);
SetFocus(GetDlgItem(hDlg, IDC_EDIT));
return 0;
}
}
}
return 1;
}
static int DoBrowseFile(HWND hDlg) {
wchar_t fileBuf[4096] = {0};
if (ctx->title) SetWindowTextW(hDlg, ctx->title);
if (ctx->prompt) SetDlgItemTextW(hDlg, IDC_PROMPT, ctx->prompt);
if (ctx->defText) SetDlgItemTextW(hDlg, IDC_EDIT, ctx->defText);
if ((ctx->flags & IB_CHECKBOX) && ctx->checkDefault)
CheckDlgButton(hDlg, IDC_CHECK, BST_CHECKED);
Declare Dynamic Library "qb_inputbox_2en"
FUNCTION QB_InputBoxExA% (BYVAL title AS _OFFSET, BYVAL prompt AS _OFFSET, BYVAL defText AS _OFFSET, _
BYVAL outBuf AS _OFFSET, BYVAL outBufBytes AS LONG, _
BYVAL flags AS LONG, BYVAL minLen AS LONG, BYVAL maxLen AS LONG, _
BYVAL minVal AS DOUBLE, BYVAL maxVal AS DOUBLE, _
BYVAL cbText AS _OFFSET, BYVAL cbDefault AS LONG, _
BYVAL cbValueOut AS _OFFSET)
End Declare
' ===== demo =====
Dim ok As Long, chk As Long
Dim flags As Long
Function WinInputBoxEx$ (title$, prompt$, def$, flags&, minLen&, maxLen&, minVal#, maxVal#, cbText$, cbDefault&, cbValue&, ok&)
Dim t As String * 256
Dim p As String * 1024
Dim d As String * 2048
Dim c As String * 256
Dim outs As String * 4096
t = Left$(title$, Len(t) - 1) + Chr$(0)
p = Left$(prompt$, Len(p) - 1) + Chr$(0)
d = Left$(def$, Len(d) - 1) + Chr$(0)
c = Left$(cbText$, Len(c) - 1) + Chr$(0)
Extended _ScreenImage (declared with existing dynamic libraries in BAS source)
The built-in _ScreenImage returns the image of the primary monitor only.
This version returns the image of the primary monitor, or the secondary monitor, or both.
Code: (Select All)
Option _Explicit
' API types
Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Type POINTAPI
x As Long
y As Long
End Type
Type MONITORINFOEX
cbSize As _Unsigned Long
rcMonitor As RECT
rcWork As RECT
dwFlags As _Unsigned Long
szDevice As String * 32
End Type
Type BITMAPINFOHEADER
biSize As _Unsigned Long
biWidth As Long
biHeight As Long
biPlanes As _Unsigned Integer
biBitCount As _Unsigned Integer
biCompression As _Unsigned Long
biSizeImage As _Unsigned Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As _Unsigned Long
biClrImportant As _Unsigned Long
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors0 As _Unsigned Long
End Type
' API declaring
Declare Dynamic Library "user32"
Function GetDC%& (ByVal hwnd As _Offset)
Function ReleaseDC& (ByVal hwnd As _Offset, ByVal hdc As _Offset)
Function GetSystemMetrics& (ByVal nIndex As Long)
Function GetCursorPos (lpPoint As POINTAPI)
Function MonitorFromRect%& (lprc As RECT, ByVal dwFlags As _Unsigned Long)
Function GetMonitorInfoA& (ByVal hMon As _Offset, lpmi As MONITORINFOEX)
End Declare
Declare Dynamic Library "gdi32"
Function CreateCompatibleDC%& (ByVal hdc As _Offset)
Function DeleteDC& (ByVal hdc As _Offset)
Function CreateCompatibleBitmap%& (ByVal hdc As _Offset, ByVal nWidth As Long, ByVal nHeight As Long)
Function SelectObject%& (ByVal hdc As _Offset, ByVal hObject As _Offset)
Function DeleteObject& (ByVal hObject As _Offset)
Function BitBlt& (ByVal hDestDC As _Offset, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As _Offset, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As _Unsigned Long)
Function GetDIBits& (ByVal hdc As _Offset, ByVal hbmp As _Offset, ByVal uStartScan As _Unsigned Long, ByVal cScanLines As _Unsigned Long, ByVal lpvBits As _Offset, bmi As BITMAPINFO, ByVal uUsage As _Unsigned Long)
End Declare
Screen _NewImage(1280, 720, 32)
_Title "Extended _ScreenImage! Press 1 for primary monitor, 2 for secondary monitor, 3 for both!"
Dim shot&: shot& = 0
Do
_Limit 60
Dim k$: k$ = InKey$
If k$ <> "" Then
Select Case k$
Case Chr$(27)
Exit Do
Case "1"
If shot& Then _FreeImage shot&
shot& = CapturePrimary32&
Case "2"
If shot& Then _FreeImage shot&
shot& = CaptureMonitorIndex32&(2)
Case "3"
If shot& Then _FreeImage shot&
shot& = CaptureAll32&
End Select
Cls
If shot& Then
_PutImage (0, 0)-(_Width(0) - 1, _Height(0) - 1), shot&
Else
_PrintString (10, 10), "Capture selhalo (shot&=0)."
End If
_Display
End If
Loop
Dim x As Long, y As Long, w As Long, h As Long
x = GetSystemMetrics(SM_XVIRTUALSCREEN)
y = GetSystemMetrics(SM_YVIRTUALSCREEN)
w = GetSystemMetrics(SM_CXVIRTUALSCREEN)
h = GetSystemMetrics(SM_CYVIRTUALSCREEN)
CaptureAll32& = CaptureRect32&(x, y, w, h)
End Function
Dim w As Long, h As Long
w = GetSystemMetrics(SM_CXSCREEN)
h = GetSystemMetrics(SM_CYSCREEN)
CapturePrimary32& = CaptureRect32&(0, 0, w, h)
End Function
' Monitor according to index: (1 = first,, 2 = second, 3 = third...)
Function CaptureMonitorIndex32& (idx As Long)
Dim r As RECT
If GetMonitorRectByIndex%(idx, r) = 0 Then Exit Function
CaptureMonitorIndex32& = CaptureRect32&(r.left, r.top, r.right - r.left, r.bottom - r.top)
End Function
' Internal capture any rectangle of the virtual surface
Function CaptureRect32& (sx As Long, sy As Long, w As Long, h As Long)
Const BI_RGB = 0
Const DIB_RGB_COLORS = 0
Const SRCCOPY = &H00CC0020~&
Const CAPTUREBLT = &H40000000~&
If w <= 0 Or h <= 0 Then Exit Function
Dim img&: img& = 0
Dim hScreenDC As _Offset, hMemDC As _Offset, hBmp As _Offset, hOld As _Offset
Dim bmi As BITMAPINFO
Dim m As _MEM
Dim ok As Long
hScreenDC = GetDC(0)
If hScreenDC = 0 Then GoTo cleanup
hMemDC = CreateCompatibleDC(hScreenDC)
If hMemDC = 0 Then GoTo cleanup
hBmp = CreateCompatibleBitmap(hScreenDC, w, h)
If hBmp = 0 Then GoTo cleanup
hOld = SelectObject(hMemDC, hBmp)
ok = BitBlt(hMemDC, 0, 0, w, h, hScreenDC, sx, sy, (SRCCOPY Or CAPTUREBLT))
If ok = 0 Then GoTo cleanup
img& = _NewImage(w, h, 32)
If img& = 0 Then GoTo cleanup
m = _MemImage(img&)
bmi.bmiHeader.biSize = Len(bmi.bmiHeader)
bmi.bmiHeader.biWidth = w
bmi.bmiHeader.biHeight = -h
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = BI_RGB
bmi.bmiHeader.biSizeImage = w * h * 4
ok = GetDIBits(hMemDC, hBmp, 0, h, m.OFFSET, bmi, DIB_RGB_COLORS)
If ok = 0 Then
_MemFree m
_FreeImage img&
img& = 0
GoTo cleanup
End If
' B,G,R,X -> set alpha to 255
Dim o As _Offset, oLast As _Offset
o = m.OFFSET + 3
oLast = m.OFFSET + (w * h * 4)
$Checking:Off
Do While o < oLast
_MemPut m, o, 255 As _UNSIGNED _BYTE
o = o + 4
Loop
$Checking:On
_MemFree m
cleanup:
If hMemDC <> 0 And hOld <> 0 Then hOld = SelectObject(hMemDC, hOld)
If hBmp <> 0 Then hBmp = DeleteObject(hBmp)
If hMemDC <> 0 Then hMemDC = DeleteDC(hMemDC)
If hScreenDC <> 0 Then hScreenDC = ReleaseDC(0, hScreenDC)
CaptureRect32& = img&
End Function
' Internal: find monitor rectangle by index
' idx=1 primary; others left to right, top to bottom
Function GetMonitorRectByIndex% (idx As Long, rOut As RECT)
Const SM_XVIRTUALSCREEN = 76
Const SM_YVIRTUALSCREEN = 77
Const SM_CXVIRTUALSCREEN = 78
Const SM_CYVIRTUALSCREEN = 79
Const SM_CMONITORS = 80
Dim need As Long: need = GetSystemMetrics(SM_CMONITORS)
If need <= 0 Then need = 1
'scan a unique HMONITOR without a callback: via MonitorFromRect on a grid of points
Dim vx As Long, vy As Long, vw As Long, vh As Long
vx = GetSystemMetrics(SM_XVIRTUALSCREEN)
vy = GetSystemMetrics(SM_YVIRTUALSCREEN)
vw = GetSystemMetrics(SM_CXVIRTUALSCREEN)
vh = GetSystemMetrics(SM_CYVIRTUALSCREEN)
If vw <= 0 Or vh <= 0 Then Exit Function
Dim hMon As _Offset
Dim monCount As Long: monCount = 0
ReDim hMon(1 To 1) As _Offset
Dim stepPx As Long: stepPx = 256
If stepPx < 32 Then stepPx = 32
Dim xx As Long, yy As Long, i As Long, found As Long
Dim rr As RECT
Dim hm As _Offset
For yy = vy To vy + vh - 1 Step stepPx
For xx = vx To vx + vw - 1 Step stepPx
rr.left = xx: rr.top = yy: rr.right = xx + 1: rr.bottom = yy + 1
hm = MonitorFromRect(rr, MONITOR_DEFAULTTONULL)
If hm <> 0 Then
found = 0
For i = 1 To monCount
If hMon(i) = hm Then found = 1: Exit For
Next
If found = 0 Then
monCount = monCount + 1
If monCount = 1 Then
hMon(1) = hm
Else
ReDim _Preserve hMon(1 To monCount) As _Offset
hMon(monCount) = hm
End If
If monCount >= need Then Exit For
End If
End If
Next
If monCount >= need Then Exit For
Next
If monCount = 0 Then Exit Function
' načíst recty + flagy
Dim leftA As Long, topA As Long, primA As Long
ReDim leftA(1 To monCount) As Long
ReDim topA(1 To monCount) As Long
ReDim primA(1 To monCount) As Long
Dim mi As MONITORINFOEX, ok As Long
For i = 1 To monCount
mi.cbSize = Len(mi)
ok = GetMonitorInfoA(hMon(i), mi)
If ok Then
leftA(i) = mi.rcMonitor.left
topA(i) = mi.rcMonitor.top
primA(i) = ((mi.dwFlags And MONITORINFOF_PRIMARY) <> 0)
Else
leftA(i) = 0: topA(i) = 0: primA(i) = 0
End If
Next
' sort: primary first, rest left/top
Dim As Long j, swp, tmpL, tmpT, tmpP
Dim tmpO As _Offset
For i = 1 To monCount - 1
For j = i + 1 To monCount
swp = 0
' primary always before non-primary
If primA(i) = 0 And primA(j) = 1 Then swp = 1
' both of the same "primary" type -> left/top
If swp = 0 And primA(i) = primA(j) Then
If leftA(j) < leftA(i) Then swp = 1
If leftA(j) = leftA(i) And topA(j) < topA(i) Then swp = 1
End If
If swp Then
tmpO = hMon(i): hMon(i) = hMon(j): hMon(j) = tmpO
tmpL = leftA(i): leftA(i) = leftA(j): leftA(j) = tmpL
tmpT = topA(i): topA(i) = topA(j): topA(j) = tmpT
tmpP = primA(i): primA(i) = primA(j): primA(j) = tmpP
End If
Next
Next
If idx < 1 Or idx > monCount Then Exit Function
mi.cbSize = Len(mi)
ok = GetMonitorInfoA(hMon(idx), mi)
If ok = 0 Then Exit Function
rOut = mi.rcMonitor
GetMonitorRectByIndex% = 1
End Function
12-08-2025, 07:52 PM (This post was last modified: 12-08-2025, 07:53 PM by Petr.)
And here we finally have something that men have been wanting for a long time.
Microphone? Line - In? Live sound?
Do you want to visualize it? Do you want to save it?
Well, you can. You can do all of this. We wrote a dynamic library in C for it. The ZIP file includes DLLs for 32bit IDE and 64bit IDE, the source code of the dynamic library in C, and the main BAS program.
hr = IAudioCaptureClient_GetNextPacketSize(pCap, &pkt);
if (FAILED(hr)) break;
}
Sleep(5);
}
if (pClient) IAudioClient_Stop(pClient);
if (hFile != INVALID_HANDLE_VALUE) patch_wav_sizes(hFile, totalData);
if (hTask) AvRevertMmThreadCharacteristics(hTask);
done:
free(stereo);
if (hFile != INVALID_HANDLE_VALUE) CloseHandle(hFile);
if (pwfx) CoTaskMemFree(pwfx);
if (pCap) IAudioCaptureClient_Release(pCap);
if (pClient) IAudioClient_Release(pClient);
if (pDev) IMMDevice_Release(pDev);
if (pEnum) IMMDeviceEnumerator_Release(pEnum);
__declspec(dllexport) int WL_StartEx2(const char* pathNullTerminated,
LONG flags, LONG ringMs,
LONG endpointType, LONG role)
{
if (InterlockedCompareExchange(&gRunning, 1, 1)) return 0;
if (!InterlockedCompareExchange(&gCsInit, 1, 1)) {
InitializeCriticalSection(&gCs);
InterlockedExchange(&gCsInit, 1);
}
__declspec(dllexport) LONG WL_AvailableFrames(void) {
if (!gCsInit || !gRing || gRingBytes == 0) return 0;
LONG frames = 0;
EnterCriticalSection(&gCs);
frames = (LONG)(ring_used_nolock() / 4);
LeaveCriticalSection(&gCs);
return frames;
}
// dest = pointer na int16_t buffer (interleaved L,R), maxFrames = kolik stereo frames
__declspec(dllexport) LONG WL_ReadFrames(void* dest, LONG maxFrames) {
if (!gCsInit || !dest || maxFrames <= 0) return 0;
uint32_t want = (uint32_t)maxFrames * 4;
uint32_t got = ring_read_bytes((uint8_t*)dest, want);
return (LONG)(got / 4);
}
My program:
Code: (Select All)
' WASAPI LOOPBACK / CAPTURE demo (QB64PE)
' - saves WAV (PCM16 stereo) and simultaneously reads live samples for visualization
'
' Requires: wasapi_loopback.dll in the same folder as EXE / BAS
'
' Controls:
' 1 = Loopback (what you hear in speakers) -> write to WAV + stream
' 2 = Capture (default mic/line-in) -> write to WAV + stream
' V = on/off visualization (saves CPU)
' ESC = stop and end
'
' Notes:
' - DLL always streams to QB64PE stereo PCM16: L,R (interleaved), 1 frame = 4 bytes
' - WL_ReadFrames() "consumes" data from the ring-buffer (shifts the reading index)
' - Ring buffer holds the last ringMs milliseconds. If you can't read, older data is discarded.
Option _Explicit
'----- Import DLL
Declare Dynamic Library "wasapi_loopback3_64"
Function WL_StartEx2% (pathZ As String, ByVal flags As Long, ByVal ringMs As Long, ByVal endpointType As Long, ByVal role As Long)
Sub WL_Stop
Function WL_Running% ()
Sub WL_GetFormat (sampleRate As Long, channels As Long)
Function WL_AvailableFrames& ()
Function WL_ReadFrames& (ByVal dest As _Offset, ByVal maxFrames As Long)
End Declare
' this constants must be the same as used in DLL
Const WL_FLAG_WRITE_WAV = 1
Const WL_FLAG_STREAM = 2
Dim vizOn As Long: vizOn = -1
Dim sr As Long, ch As Long
Dim As Long running, gotFrames, i, peakL, peakR, aL, aR, barL, barR, w
Dim As String k
' Start default loopback
StartCapture WL_ENDPOINT_LOOPBACK 'visualize only
'StartCapture WL_ENDPOINT_CAPTURE 'visualize + record sound to WAV 16 bit stereo file
'sound from microphone and Line-In is saved to file "mic_or_linein.wav"
'livestream (that what is in speakers) is saved to file "what_you_hear.wav"
'try play video on youtube + this program at once, or just this program and play something from qb64 (Play, Sound, Beep, _SndPlay...)
Do
_Limit 60
k$ = InKey$
If k$ <> "" Then
Select Case UCase$(k$)
Case "1": StartCapture WL_ENDPOINT_LOOPBACK
Case "2": StartCapture WL_ENDPOINT_CAPTURE
Case "V": vizOn = Not vizOn
Case Chr$(27): Exit Do
End Select
End If
running = WL_Running%
If running = 0 Then
'if error just wait
_Limit 30
'LOOP
End If
' Visualize
If vizOn Then
' get new chunk, if is nothing, draw nothing
gotFrames& = WL_ReadFrames(memS.OFFSET, BUF_FRAMES)
If gotFrames& > 0 Then
' simple peak (VU)
peakL& = 0: peakR& = 0
For i& = 0 To gotFrames& * 2 - 1 Step 2
aL& = Abs(samples(i&))
aR& = Abs(samples(i& + 1))
If aL& > peakL& Then peakL& = aL&
If aR& > peakR& Then peakR& = aR&
Next
_PrintString (10, 170), "1=loopback 2=mic/line-in V=viz ESC=stop"
_Display
End If
End If
Loop
' clear ram BUT ALSO (!) WRITE WAV Header if recorded!!!
If WL_Running% Then WL_Stop
_MemFree memS
End
Sub StartCapture (endpointType As Long)
Dim flags As Long, ok As Integer
Dim fname$, mode$
flags = WL_FLAG_WRITE_WAV Or WL_FLAG_STREAM
If endpointType = WL_ENDPOINT_LOOPBACK Then
fname$ = "what_you_hear.wav"
mode$ = "LOOPBACK (what you hear)"
Else
fname$ = "mic_or_linein.wav"
mode$ = "CAPTURE (default input)"
End If
If WL_Running% Then WL_Stop
'ringMs: how many ms of history to keep for visualization (2000 = 2 s)
ok = WL_StartEx2(fname$ + Chr$(0), flags, 2000, endpointType, WL_ROLE_CONSOLE)
If ok = 0 Then
Cls
_PrintString (10, 10), "WL_StartEx2 selhalo."
_Display
Sleep 2
Exit Sub
End If
' wait until DLL find format
Dim As Single sr, ch
sr = 0: ch = 0
Dim t0 As Double: t0 = Timer
Do
_Limit 120
WL_GetFormat sr, ch
If sr <> 0 Then Exit Do
Loop While (Timer - t0) < 1.0
12-09-2025, 07:21 PM (This post was last modified: 12-09-2025, 07:31 PM by Petr.)
This is really bad cooperation. Why didn't someone write to me that the 32-bit version simply doesn't work? I understand. You wanted to give me a moment of joy. You are very kind and I thank you for that
I came to the computer, started the 32-bit version and boom. The program crashed. What's going on? Why? Did it work yesterday? Or did I only try it in the 64-bit version and I didn't run the 32-bit version? I had about 6 windows with the IDE here, so it was a mess...
Result. New C code for the 32-bit version. Reason why it crashed:
The essence of the problem was in the calling convention (the way to call functions) between QB64PE and the DLL.
What exactly was wrong:
In 32-bit Windows there are different calling conventions: mainly cdecl and stdcall (WINAPI).
The original DLL exported functions without WINAPI, so on x86 they were called as cdecl (or at least not as stdcall).
But QB64PE called them as stdcall/WinAPI (typically on Windows).
Result: function return threw the stack --> process "closed" (classic crash without mercy).
Why it worked in 64bit
On 64bit Windows, function calls are unified (practically "one" ABI). The difference between cdecl vs stdcall is not relevant there in this way, so even though it was written "badly for x86", x64 tolerated it.
What I fixed and why it works now:
I switched exports to WINAPI/stdcall.
And at the same time I ensured that the DLL also exported undecorated names (WL_StartEx2) because of QB64PE.
I used the report output for this:
llvm-readobj --coff-exports wasapi_loopback3_32.dll
So now two files are needed to compile into a DLL. C file and DEF file.
hr = IAudioCaptureClient_GetNextPacketSize(pCap, &pkt);
if (FAILED(hr)) break;
}
Sleep(5);
}
if (pClient) IAudioClient_Stop(pClient);
if (hFile != INVALID_HANDLE_VALUE) patch_wav_sizes(hFile, totalData);
if (hTask) AvRevertMmThreadCharacteristics(hTask);
done:
free(stereo);
if (hFile != INVALID_HANDLE_VALUE) CloseHandle(hFile);
if (pwfx) CoTaskMemFree(pwfx);
if (pCap) IAudioCaptureClient_Release(pCap);
if (pClient) IAudioClient_Release(pClient);
if (pDev) IMMDevice_Release(pDev);
if (pEnum) IMMDeviceEnumerator_Release(pEnum);
WL_EXPORT int WL_CALL WL_StartEx2(const char* pathNullTerminated,
LONG flags, LONG ringMs,
LONG endpointType, LONG role)
{
if (InterlockedCompareExchange(&gRunning, 1, 1)) return 0;
// init critical section exactly once
if (InterlockedCompareExchange(&gCsInit, 1, 0) == 0) {
InitializeCriticalSection(&gCs);
}
and only then compile it all into a DLL like this:
i686-w64-mingw32-gcc -shared -O2 -static-libgcc ^ -o wasapi_loopback3_32.dll wasapi_loopback3.c wasapi_loopback3_32.def ^ -lole32 -lavrt
So here is the new 32bit DLL file, replace the original one (in the 32bit IDE). Tested in the latest IDE 4.2.0 x86 and also in IDE 4.0.0 32bit, it works correctly in both cases. BAS source code remains the same.
12-11-2025, 04:19 PM (This post was last modified: 12-11-2025, 04:19 PM by Petr.)
We had a conversation with @madscijr about MP3 as audio in the ADPCM compression thread. I promised to look into it after I was notified by @ahenry3068 that MP3 is no longer covered by licenses. At first I thought I would start writing an encoder in QB64PE.... after researching the complexity I gave up.
Here we have a ready-made solution for saving audio to MP3. I used a program from LAME (in C) and compiled two dynamic libraries for QB64PE from it. I chose the easier way, an incomplete API, only the basics, but it is enough to create MP3. If there is interest, I can also try the full LAME API (but that is the libmp3lame library and it has more difficult declarations).
GoTo row 78, 79 and rewrite source sound file (all which QB64PE support are supported) and output MP3 file name.
ZIP file contains lame_enc32.dll, lame_enc64.dll, BAS source code and s3m music file.
' Preset -1 = LQP_NOPRESET, i.e. no predefined preset, we use plain CBR
Const LQP_NOPRESET = -1
' Structure size BE_CONFIG according to BladeMP3EncDLL.h (CURRENT_STRUCT_SIZE)
Const BE_CONFIG_SIZE = 331
' This buffer is used to copy MP3 data in chunks as a string
Const MP3_CHUNKBUF = 65535
Dim Shared mp3Chunk As String * MP3_CHUNKBUF
'====================== FUNCTION DECLARATIONS FROM lame_enc.dll ===================
Declare Dynamic Library "lame_enc32"
' BE_ERR beInitStream(PBE_CONFIG pbeConfig, PDWORD dwSamples, PDWORD dwBufferSize, PHBE_STREAM phbeStream)
Function beInitStream& (ByVal pCfg As _Offset, ByVal pSamples As _Offset, ByVal pBufSize As _Offset, ByVal pStream As _Offset)
' BE_ERR beEncodeChunk(HBE_STREAM hbeStream, DWORD nSamples, PSHORT pSamples, PBYTE pOutput, PDWORD pdwOutput)
Function beEncodeChunk& (ByVal hStream As _Offset, ByVal nSamples As _Unsigned Long, ByVal pPCM As _Offset, ByVal pOut As _Offset, ByVal pOutBytes As _Offset)
' BE_ERR beDeinitStream(HBE_STREAM hbeStream, PBYTE pOutput, PDWORD pdwOutput)
Function beDeinitStream& (ByVal hStream As _Offset, ByVal pOut As _Offset, ByVal pOutBytes As _Offset)
' BE_ERR beCloseStream(HBE_STREAM hbeStream)
Function beCloseStream& (ByVal hStream As _Offset)
' BE_ERR beWriteVBRHeader(LPCSTR lpszFileName)
Function beWriteVBRHeader& (ByVal pszFile As _Offset)
End Declare
'========================= FORWARD DECLARATIONS OF SUBS ========================
Declare Sub PutU32 (m As _MEM, ofs As _Unsigned Long, v As _Unsigned Long)
Declare Sub PutS32 (m As _MEM, ofs As _Unsigned Long, v As Long)
Declare Function BytesPerSample% (t As Long)
Declare Function MemChannels% (m As _MEM)
Declare Function Clamp16% (v As Long)
Declare Function Long32To16% (x As Long)
Declare Sub WriteBytesToFile (hFile As Long, ou() As _Unsigned _Byte, outLen As _Unsigned Long)
Dim inFile As String, outFile As String
Dim As Long snd, ch, errCode
Dim As _MEM src, cfgM
Dim As _Unsigned Long sampleRate, dwSamples, dwMP3Buf
Dim cfg(0 To BE_CONFIG_SIZE - 1) As _Unsigned _Byte ' 331 bytes
Dim hStream As _Offset
' SET INPUT AND OUTPUT HERE
inFile = "awesome.s3m" ' source audio (WAV/MP3/XM/... anything _SndOpen can load)
outFile = "out.mp3" ' destination MP3 file
'-------------------------------------------------------------
' 1) Load sound via _SndOpen and _MemSound
'-------------------------------------------------------------
snd = _SndOpen(inFile)
If snd = 0 Then
Print "Unable to open audio file: "; inFile
End
End If
src = _MemSound(snd, 0)
If src.SIZE = 0 Then
Print "_MemSound returned SIZE = 0 – no PCM data."
_SndClose snd
End
End If
' Determine number of channels from the _MEM block (1 = mono, 2 = stereo)
ch = MemChannels(src)
If ch <> 1 And ch <> 2 Then
Print "Unknown channel count ("; ch; ") – only mono or stereo is supported."
_MemFree src
_SndClose snd
End
End If
ReDim pcm(0 To dwSamples - 1) As Integer ' number of 16bit samples as reported by LAME
ReDim outBuf(0 To dwMP3Buf - 1) As _Unsigned _Byte
Dim outBytes As _Unsigned Long
'-------------------------------------------------------------
' 5) Open output MP3 file
'-------------------------------------------------------------
If _FileExists(outFile) Then Kill outFile
Open outFile For Binary As #1
'-------------------------------------------------------------
' 6) Loop over the entire _MEM block with audio
' - src.SIZE = number of bytes in the memory block
' - src.ELEMENTSIZE = size of one "frame" (all channels at one time)
' e.g. 16bit stereo: ELEMENTSIZE = 4 bytes (L 16bit + R 16bit)
' SINGLE stereo: ELEMENTSIZE = 8 bytes (L float + R float)
'
' - framesTotal = number of frames = number of samples per channel
' - in each iteration:
' * compute how many 16bit samples (wordsThis) we can send
' * unpack frames into pcm() as 16bit PCM
' * call beEncodeChunk
'-------------------------------------------------------------
Dim framesTotal As _Integer64
framesTotal = src.SIZE \ src.ELEMENTSIZE ' number of "frames" (1 frame = 1 sample of all channels)
Dim totalWords As _Integer64
totalWords = framesTotal * ch ' number of 16bit words = frames * channels
Dim framePos As _Integer64
framePos = 0
Do While framePos < framesTotal
Dim wordsLeft As _Integer64
wordsLeft = (framesTotal - framePos) * ch ' how many 16bit samples remain
Dim wordsThis As _Unsigned Long
If wordsLeft > dwSamples Then
wordsThis = dwSamples ' LAME-recommended chunk
Else
wordsThis = wordsLeft ' last, shorter chunk
End If
' From wordsThis compute how many frames (1 frame = 1 sample of all channels)
Dim framesThis As _Unsigned Long
framesThis = wordsThis \ ch ' wordsThis is always multiple of number of channels
' Clear PCM buffer (entire buffer, for safety)
Dim i As Long
For i = 0 To dwSamples - 1
pcm(i) = 0
Next
' Convert framesThis frames to 16bit PCM stored in pcm()
Dim f As _Unsigned Long
Dim ofs As _Offset
Select Case src.TYPE
Case 260 ' 32bit SINGLE in range -1.0..+1.0
Dim sLeft As Single, sRight As Single
For f = 0 To framesThis - 1
' Frame address = base + (frame index) * frame size
ofs = src.OFFSET + (framePos + f) * src.ELEMENTSIZE
If ch = 2 Then
' right channel is 4 bytes further
sRight = _MemGet(src, ofs + 4, Single)
pcm(f * ch + 1) = Clamp16(CLng(sRight * 32767!))
End If
Next
Case 132 ' 32bit LONG integer (signed)
Dim lLeft As Long, lRight As Long
For f = 0 To framesThis - 1
ofs = src.OFFSET + (framePos + f) * src.ELEMENTSIZE
If ch = 2 Then
lRight = _MemGet(src, ofs + 4, Long)
pcm(f * ch + 1) = Long32To16(lRight)
End If
Next
Case 130 ' 16bit INTEGER PCM (already in the desired format)
Dim iLeft As Integer, iRight As Integer
For f = 0 To framesThis - 1
ofs = src.OFFSET + (framePos + f) * src.ELEMENTSIZE
If ch = 2 Then
iRight = _MemGet(src, ofs + 2, Integer)
pcm(f * ch + 1) = iRight
End If
Next
Case 1153 ' 8bit UNSIGNED PCM (0..255), convert to signed 16bit
Dim bLeft As _Unsigned _Byte, bRight As _Unsigned _Byte
For f = 0 To framesThis - 1
ofs = src.OFFSET + (framePos + f) * src.ELEMENTSIZE
bLeft = _MemGet(src, ofs, _Unsigned _Byte)
pcm(f * ch) = (CLng(bLeft) - 128) * 256 ' shift to -128..+127 and scale to 16bit
If ch = 2 Then
bRight = _MemGet(src, ofs + 1, _Unsigned _Byte)
pcm(f * ch + 1) = (CLng(bRight) - 128) * 256
End If
Next
Case Else
Print "Unsupported _MemSound.TYPE: "; src.TYPE
Exit Do
End Select
' Encode this chunk pcm() into MP3
outBytes = 0
errCode = beEncodeChunk(hStream, wordsThis, _Offset(pcm(0)), _Offset(outBuf(0)), _Offset(outBytes))
If errCode <> BE_ERR_SUCCESSFUL Then
Print "beEncodeChunk failed, error: "; errCode
Exit Do
End If
' If any MP3 bytes were produced, write them to the file
If outBytes > 0 Then
WriteBytesToFile 1, outBuf(), outBytes
End If
' Advance frame position
framePos = framePos + framesThis
Loop
'-------------------------------------------------------------
' 7) Flush – finish internal LAME buffers and write remaining MP3 data
'-------------------------------------------------------------
outBytes = 0
errCode = beDeinitStream(hStream, _Offset(outBuf(0)), _Offset(outBytes))
If errCode <> BE_ERR_SUCCESSFUL Then
Print "beDeinitStream failed, error: "; errCode
End If
If outBytes > 0 Then
WriteBytesToFile 1, outBuf(), outBytes
End If
' Close the LAME stream
Dim closeRes As Long
closeRes = beCloseStream(hStream)
Dim zPath As String
zPath = outFile + Chr$(0) ' C-style null-terminated string
closeRes = beWriteVBRHeader(_Offset(zPath))
'-------------------------------------------------------------
' 9) Clean up and exit
'-------------------------------------------------------------
_MemFree cfgM
_MemFree src
_SndClose snd
Print
Print "Done, saved as: "; outFile
End
' PutU32:
' Write 32bit UNSIGNED value to a _MEM block
'---------------------------------------------
Sub PutU32 (m As _MEM, ofs As _Unsigned Long, v As _Unsigned Long)
_MemPut m, m.OFFSET + ofs, v
End Sub
Sub PutS32 (m As _MEM, ofs As _Unsigned Long, v As Long)
_MemPut m, m.OFFSET + ofs, v
End Sub
' BytesPerSample:
' How many bytes one sample per channel takes, based on _MemSound.TYPE
' 260 = SINGLE (32bit float)
' 132 = LONG (32bit signed)
' 130 = INTEGER(16bit signed)
' 1153 = _Unsigned _Byte (8bit unsigned)
Function BytesPerSample% (t As Long)
Select Case t
Case 260, 132
BytesPerSample = 4
Case 130
BytesPerSample = 2
Case 1153
BytesPerSample = 1
Case Else
BytesPerSample = 0
End Select
End Function
Function MemChannels% (m As _MEM)
Dim bps As Integer
bps = BytesPerSample(m.TYPE)
If bps = 0 Then
MemChannels = 0
Else
MemChannels = m.ELEMENTSIZE \ bps
End If
End Function
' Clamp16:
' Clamp value to 16bit signed PCM range
Function Clamp16% (v As Long)
If v > 32767 Then
Clamp16 = 32767
ElseIf v < -32768 Then
Clamp16 = -32768
Else
Clamp16 = v
End If
End Function
' Long32To16:
' Convert 32bit signed PCM (LONG) to 16bit
' by shifting 16 bits (divide by 65536) and preserving sign
Function Long32To16% (x As Long)
If x < 0 Then
Long32To16 = -((-x) \ 65536)
Else
Long32To16 = x \ 65536
End If
End Function
' WriteBytesToFile:
' From byte array ou() (filled by LAME) create string chunks
' and write them to file hFile.
'
' - outLen is the number of valid bytes in ou()
' - mp3Chunk$ is fixed-length string * 65535, used as copy buffer via _MEMCOPY
Sub WriteBytesToFile (hFile As Long, ou() As _Unsigned _Byte, outLen As _Unsigned Long)
If outLen = 0 Then Exit Sub
Dim mAry As _MEM, mStr As _MEM
mAry = _Mem(ou(0))
mStr = _Mem(mp3Chunk)
Dim i As _Unsigned Long, n As _Unsigned Long
Dim chunk As String
i = 0
Do While i < outLen
n = outLen - i
If n > Len(mp3Chunk) Then n = Len(mp3Chunk)
' Copy n bytes from ou() starting at offset i into mp3Chunk$
_MemCopy mAry, mAry.OFFSET + i, n To mStr, mStr.OFFSET
' Create string of exact length n and write it to file
chunk = Left$(mp3Chunk, n)
Put #hFile, , chunk
12-12-2025, 10:00 PM (This post was last modified: 12-12-2025, 10:00 PM by Petr.)
Here’s something for the audiophiles out there. I personally use this format because it offers the absolute best sound quality. FLAC is a lossless compression format widely used in professional studios. Since QB64PE can now play it, you also have the option to save audio in this format. It’s open source and license-free.
In terms of storage, FLAC is about 60% the size of a WAV file, yet it offers significantly better sound quality than ADPCM.
Zip file contains libFLAC32.DLL file, libFLAC64.DLL file, bas file, MOD music file and txt info file.
Code: (Select All)
Option _Explicit
Const FLAC__STREAM_ENCODER_INIT_STATUS_OK = 0
Const FLAC_COMPRESSION_LEVEL = 6 ' 0 = fastest, 8/12 = highest compression (depending on libFLAC version)
Const FLAC_CHUNK_FRAMES = 4096 ' number of sample frames per encode call
$If 64BIT Then
Declare Dynamic Library "libFLAC64"
' FLAC__StreamEncoder* FLAC__stream_encoder_new(void);
Function FLAC_New%& Alias "FLAC__stream_encoder_new" ()
' void FLAC__stream_encoder_delete(FLAC__StreamEncoder *encoder);
Sub FLAC_Del Alias "FLAC__stream_encoder_delete" (ByVal enc As _Offset)
' FLAC__bool FLAC__stream_encoder_set_channels(FLAC__StreamEncoder *encoder, unsigned channels);
Function FLAC_SetChannels& Alias "FLAC__stream_encoder_set_channels" (ByVal enc As _Offset, ByVal channels As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_set_sample_rate(FLAC__StreamEncoder *encoder, unsigned sample_rate);
Function FLAC_SetSampleRate& Alias "FLAC__stream_encoder_set_sample_rate" (ByVal enc As _Offset, ByVal sample_rate As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_set_bits_per_sample(FLAC__StreamEncoder *encoder, unsigned bits_per_sample);
Function FLAC_SetBitsPerSample& Alias "FLAC__stream_encoder_set_bits_per_sample" (ByVal enc As _Offset, ByVal bits As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_set_compression_level(FLAC__StreamEncoder *encoder, unsigned level);
Function FLAC_SetCompressionLevel& Alias "FLAC__stream_encoder_set_compression_level" (ByVal enc As _Offset, ByVal level As _Unsigned Long)
' FLAC__StreamEncoderInitStatus FLAC__stream_encoder_init_file(...);
Function FLAC_InitFile& Alias "FLAC__stream_encoder_init_file" (ByVal enc As _Offset, ByVal filename As _Offset, ByVal progress_cb As _Offset, ByVal client_data As _Offset)
' FLAC__bool FLAC__stream_encoder_process_interleaved(..., const FLAC__int32 buffer[], unsigned samples);
Function FLAC_ProcessInterleaved& Alias "FLAC__stream_encoder_process_interleaved" (ByVal enc As _Offset, ByVal buffer As _Offset, ByVal samples As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_finish(FLAC__StreamEncoder *encoder);
Function FLAC_Finish& Alias "FLAC__stream_encoder_finish" (ByVal enc As _Offset)
End Declare
$Else
Declare Dynamic Library "libFLAC32"
' FLAC__StreamEncoder* FLAC__stream_encoder_new(void);
Function FLAC_New%& Alias "FLAC__stream_encoder_new" ()
' void FLAC__stream_encoder_delete(FLAC__StreamEncoder *encoder);
Sub FLAC_Del Alias "FLAC__stream_encoder_delete" (ByVal enc As _Offset)
' FLAC__bool FLAC__stream_encoder_set_channels(FLAC__StreamEncoder *encoder, unsigned channels);
Function FLAC_SetChannels& Alias "FLAC__stream_encoder_set_channels" (ByVal enc As _Offset, ByVal channels As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_set_sample_rate(FLAC__StreamEncoder *encoder, unsigned sample_rate);
Function FLAC_SetSampleRate& Alias "FLAC__stream_encoder_set_sample_rate" (ByVal enc As _Offset, ByVal sample_rate As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_set_bits_per_sample(FLAC__StreamEncoder *encoder, unsigned bits_per_sample);
Function FLAC_SetBitsPerSample& Alias "FLAC__stream_encoder_set_bits_per_sample" (ByVal enc As _Offset, ByVal bits As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_set_compression_level(FLAC__StreamEncoder *encoder, unsigned level);
Function FLAC_SetCompressionLevel& Alias "FLAC__stream_encoder_set_compression_level" (ByVal enc As _Offset, ByVal level As _Unsigned Long)
' FLAC__StreamEncoderInitStatus FLAC__stream_encoder_init_file(...);
Function FLAC_InitFile& Alias "FLAC__stream_encoder_init_file" (ByVal enc As _Offset, ByVal filename As _Offset, ByVal progress_cb As _Offset, ByVal client_data As _Offset)
' FLAC__bool FLAC__stream_encoder_process_interleaved(..., const FLAC__int32 buffer[], unsigned samples);
Function FLAC_ProcessInterleaved& Alias "FLAC__stream_encoder_process_interleaved" (ByVal enc As _Offset, ByVal buffer As _Offset, ByVal samples As _Unsigned Long)
' FLAC__bool FLAC__stream_encoder_finish(FLAC__StreamEncoder *encoder);
Function FLAC_Finish& Alias "FLAC__stream_encoder_finish" (ByVal enc As _Offset)
End Declare
$End If
Dim inFile$, outFile$
inFile$ = "g7.mod" ' input audio file (any format _SndOpen can load)
outFile$ = "out.flac" ' output FLAC filename
Dim snd As Long
snd = _SndOpen(inFile$)
If snd = 0 Then
Print "Cannot open input sound file: "; inFile$
End
End If
' Get raw sample data from QB64PE mixer
Dim src As _MEM
src = _MemSound(snd, 0)
If src.SIZE = 0 Then
Print "_MemSound returned SIZE = 0 (no audio data)."
_SndClose snd
End
End If
Dim ch%: ch% = MemChannels(src)
If ch% < 1 Then
Print "Unable to detect channel count from _MEM (TYPE="; src.TYPE; ", ELEMENTSIZE="; src.ELEMENTSIZE; ")."
_MemFree src
_SndClose snd
End
End If
Dim sr As _Unsigned Long
sr = _SndRate ' QB64PE global mixer rate; _MemSound data are at this rate
Dim enc As _Offset
Dim encInited%: encInited% = 0
Dim ok%: ok% = -1 ' assume success until some step fails
enc = FLAC_New
If enc = 0 Then
Print "FLAC__stream_encoder_new returned NULL."
ok% = 0
GoTo EncodeCleanup
End If
' Required basic parameters: channels, bits per sample, sample rate
If FLAC_SetChannels(enc, ch%) = 0 Then
Print "FLAC__stream_encoder_set_channels failed."
ok% = 0
GoTo EncodeCleanup
End If
' We always encode as 16-bit FLAC, regardless of source format
If FLAC_SetBitsPerSample(enc, 16) = 0 Then
Print "FLAC__stream_encoder_set_bits_per_sample(16) failed."
ok% = 0
GoTo EncodeCleanup
End If
If FLAC_SetSampleRate(enc, sr) = 0 Then
Print "FLAC__stream_encoder_set_sample_rate("; sr; ") failed."
ok% = 0
GoTo EncodeCleanup
End If
' Optional: compression level (0 = fastest, higher = better compression, slower)
If FLAC_SetCompressionLevel(enc, FLAC_COMPRESSION_LEVEL) = 0 Then
Print "FLAC__stream_encoder_set_compression_level("; FLAC_COMPRESSION_LEVEL; ") failed."
ok% = 0
GoTo EncodeCleanup
End If
' Initialize encoder with output filename
Dim outNameZ As String
outNameZ = outFile$ + Chr$(0) ' C-style zero-terminated filename string
Dim initStatus&: initStatus& = FLAC_InitFile(enc, _Offset(outNameZ), 0, 0)
If initStatus& <> FLAC__STREAM_ENCODER_INIT_STATUS_OK Then
Print "FLAC__stream_encoder_init_file failed, status="; initStatus&
ok% = 0
GoTo EncodeCleanup
End If
encInited% = -1
Dim framesTotal&&
framesTotal&& = src.SIZE \ src.ELEMENTSIZE ' number of sample frames (all channels together)
Dim framesLeft&&: framesLeft&& = framesTotal&&
Dim posFrame&&: posFrame&& = 0
' Buffer for interleaved FLAC__int32 samples (16-bit data stored in 32-bit container)
Dim flacBuf As Long
ReDim flacBuf(0 To FLAC_CHUNK_FRAMES * ch% - 1) As Long
Print "Total frames: "; framesTotal&&
Dim As Long framesThis, frameIdx
Dim BaseOfs As _Offset
Do While framesLeft&& > 0
framesThis& = FLAC_CHUNK_FRAMES
If framesThis& > framesLeft&& Then framesThis& = framesLeft&&
' Convert QB64PE internal format to signed 16-bit samples in 32-bit container (FLAC__int32)
For frameIdx& = 0 To framesThis& - 1
BaseOfs = src.OFFSET + (posFrame&& + frameIdx&) * src.ELEMENTSIZE
Select Case src.TYPE
Case 260
' 32-bit float samples, range roughly [-1.0, +1.0]
Dim s As Single
Dim chan%
For chan% = 0 To ch% - 1
s = _MemGet(src, BaseOfs + chan% * 4, Single)
flacBuf(frameIdx& * ch% + chan%) = ClampTo16(CLng(s * 32767!))
Next
Case 132
' 32-bit signed PCM
Dim l As Long
Dim chan2%
For chan2% = 0 To ch% - 1
l = _MemGet(src, BaseOfs + chan2% * 4, Long)
flacBuf(frameIdx& * ch% + chan2%) = Long32To16(l)
Next
Case 130
' 16-bit signed PCM
Dim iSS As Integer
Dim chan3%
For chan3% = 0 To ch% - 1
iSS = _MemGet(src, BaseOfs + chan3% * 2, Integer)
flacBuf(frameIdx& * ch% + chan3%) = iSS
Next
Case 1153
' 8-bit unsigned PCM (0..255) -> convert to signed 16-bit
Dim b As _Unsigned _Byte
Dim chan4%
For chan4% = 0 To ch% - 1
b = _MemGet(src, BaseOfs + chan4%, _Unsigned _Byte)
flacBuf(frameIdx& * ch% + chan4%) = (CLng(b) - 128) * 256
Next
Case Else
Print "Unsupported _MemSound TYPE: "; src.TYPE
ok% = 0
GoTo EncodeCleanup
End Select
Next
' Send converted samples to FLAC encoder
If FLAC_ProcessInterleaved(enc, _Offset(flacBuf(0)), framesThis&) = 0 Then
Print "FLAC__stream_encoder_process_interleaved failed."
ok% = 0
GoTo EncodeCleanup
End If
If encInited% Then
' Finish encoder; this also finalizes and closes the output file internally
Dim finRes&: finRes& = FLAC_Finish(enc)
If finRes& = 0 Then
Print "Warning: FLAC__stream_encoder_finish reported failure."
ok% = 0
End If
End If
If enc <> 0 Then FLAC_Del enc
_MemFree src
_SndClose snd
If ok% Then
Print "FLAC encoding completed successfully: "; outFile$
Else
Print "FLAC encoding ended with an error."
End If
End
Function BytesPerSample% (t As Long)
' Returns number of bytes for a single channel sample
Select Case t
Case 260, 132: BytesPerSample = 4 ' SINGLE, LONG
Case 130: BytesPerSample = 2 ' 16-bit INTEGER
Case 1153: BytesPerSample = 1 ' 8-bit unsigned
Case Else: BytesPerSample = 0
End Select
End Function
Function MemChannels% (m As _MEM)
' Derive channel count from TYPE and ELEMENTSIZE
Dim bps%: bps% = BytesPerSample(m.TYPE)
If bps% = 0 Then MemChannels = 0: Exit Function
MemChannels = m.ELEMENTSIZE \ bps%
End Function
Function ClampTo16& (v As Long)
' Clamp a value into 16-bit signed range and keep it as 32-bit container (FLAC__int32)
If v > 32767 Then
ClampTo16 = 32767
ElseIf v < -32768 Then
ClampTo16 = -32768
Else
ClampTo16 = v
End If
End Function
Function Long32To16& (x As Long)
' Convert 32-bit signed PCM to 16-bit range, with truncating toward zero
If x < 0 Then
Long32To16 = -((-x) \ 65536)
Else
Long32To16 = x \ 65536
End If
End Function
Here is a new update: I have added support for saving to OGG format. This was a challenging project, but the results are interesting.
Important Notes:
32-bit Version: This includes 5 DLL files. One is compiled but unused (related to playback, seeking and metadata), so you don't need it because QB64PE handles that natively.
The qboggvorbis.dll file acts as a wrapper. This is necessary because the 32-bit DLL calling conventions differ from those used by QB64PE.
This wrapper resolves that compatibility issue (similar to the live visualization tool discussed earlier).
Note: vorbisfile.dll is included but not used here (it is strictly for playback, seeking, and metadata).
64-bit Version: This includes 4 DLL files. No wrapper is needed here; it works out of the box. Again, vorbisfile.dll is not used.
WARNING: Do NOT rename any of the DLL files. The internal dependencies are hardcoded in the source code. Renaming even a single DLL will break the linkage and cause "dynamic library not found" errors.
Folder Structure: I attempted to organize the 32-bit and 64-bit versions into separate subfolders within the program, but I couldn't get the path referencing to work properly. If anyone knows how to achieve this, I’d appreciate the tip. For now, the 32-bit and 64-bit versions are in separate folders. Since the filenames cannot be changed, please be careful not to mix them up.
Future Plans & Feedback: Finally, I have a question: What else would you be interested in seeing? I'm open to suggestions.
Thanks to this thread, I plan to rework my SaveSound library to consolidate everything nicely. There are a few more formats QB64PE can write directly (like AIFF, AIFC). Some others might require a full tracker implementation to be useful, or I need to research them further.
Zip file contains:
32bit version: qboggvorbis.dll warapper, wrapper source code in C, wrapper DEF file, mod music file, BAS file, ogg.dll, vorbis.dll, vorbisenc.dll, vorbisfile.dll.
64bit version: the same BAS source code, ogg.dll, vorbis.dll, vorbisenc.dll, vorbisfile.dll, s3m music file.
Code: (Select All)
Option _Explicit
' ============================================================
' QB64PE OGG/Vorbis encoder (DLL): _MemSound() -> .OGG
'
' 64-bit: calls original DLLs directly:
' ogg.dll, vorbis.dll, vorbisenc.dll (DO NOT RENAME)
'
' 32-bit: use stdcall bridge wrapper:
' qboggvorbis.dll (exports same symbol names)
' + original ogg.dll, vorbis.dll, vorbisenc.dll next to EXE
' ============================================================
' ---------------- USER SETTINGS ----------------
Const INPUT_FILE$ = "07.mp3" ' Any format _SndOpen can load
Const OUTPUT_OGG$ = "out.ogg"
Const VORBIS_QUALITY! = 0.30! ' VBR quality ~0.3..0.6 typical
Const CHUNK_FRAMES& = 1024
Const MAX_CHANNELS& = 16
' ---------------- DLL DECLARES ----------------
$If 32BIT Then
' x86: stdcall bridge (wrapper)
Declare Dynamic Library "qboggvorbis"
Function ogg_stream_init& Alias "ogg_stream_init" (ByVal os As _Offset, ByVal serialno As Long)
Function ogg_stream_packetin& Alias "ogg_stream_packetin" (ByVal os As _Offset, ByVal op As _Offset)
Function ogg_stream_pageout& Alias "ogg_stream_pageout" (ByVal os As _Offset, ByVal og As _Offset)
Function ogg_stream_flush& Alias "ogg_stream_flush" (ByVal os As _Offset, ByVal og As _Offset)
Function ogg_stream_clear& Alias "ogg_stream_clear" (ByVal os As _Offset)
Sub vorbis_info_init Alias "vorbis_info_init" (ByVal vi As _Offset)
Sub vorbis_info_clear Alias "vorbis_info_clear" (ByVal vi As _Offset)
Sub vorbis_comment_init Alias "vorbis_comment_init" (ByVal vc As _Offset)
Sub vorbis_comment_add_tag Alias "vorbis_comment_add_tag" (ByVal vc As _Offset, ByVal tag As _Offset, ByVal contents As _Offset)
Sub vorbis_comment_clear Alias "vorbis_comment_clear" (ByVal vc As _Offset)
Function vorbis_analysis_init& Alias "vorbis_analysis_init" (ByVal vd As _Offset, ByVal vi As _Offset)
Function vorbis_block_init& Alias "vorbis_block_init" (ByVal vd As _Offset, ByVal vb As _Offset)
Function vorbis_analysis_headerout& Alias "vorbis_analysis_headerout" (ByVal vd As _Offset, ByVal vc As _Offset, ByVal op As _Offset, ByVal op_comm As _Offset, ByVal op_code As _Offset)
Function vorbis_analysis_buffer%& Alias "vorbis_analysis_buffer" (ByVal vd As _Offset, ByVal vals As Long) ' returns float** as pointer
Function vorbis_analysis_wrote& Alias "vorbis_analysis_wrote" (ByVal vd As _Offset, ByVal vals As Long)
Function vorbis_analysis_blockout& Alias "vorbis_analysis_blockout" (ByVal vd As _Offset, ByVal vb As _Offset)
Function vorbis_analysis& Alias "vorbis_analysis" (ByVal vb As _Offset, ByVal op As _Offset) ' op may be NULL
Function vorbis_bitrate_addblock& Alias "vorbis_bitrate_addblock" (ByVal vb As _Offset)
Function vorbis_bitrate_flushpacket& Alias "vorbis_bitrate_flushpacket" (ByVal vd As _Offset, ByVal op As _Offset)
Function vorbis_block_clear& Alias "vorbis_block_clear" (ByVal vb As _Offset)
Sub vorbis_dsp_clear Alias "vorbis_dsp_clear" (ByVal vd As _Offset)
Function vorbis_encode_init_vbr& Alias "vorbis_encode_init_vbr" (ByVal vi As _Offset, ByVal channels As Long, ByVal rate As Long, ByVal base_quality As Single)
End Declare
$Else
' x64: direct calls to original DLLs
Declare Dynamic Library "ogg"
Function ogg_stream_init& Alias "ogg_stream_init" (ByVal os As _Offset, ByVal serialno As Long)
Function ogg_stream_packetin& Alias "ogg_stream_packetin" (ByVal os As _Offset, ByVal op As _Offset)
Function ogg_stream_pageout& Alias "ogg_stream_pageout" (ByVal os As _Offset, ByVal og As _Offset)
Function ogg_stream_flush& Alias "ogg_stream_flush" (ByVal os As _Offset, ByVal og As _Offset)
Function ogg_stream_clear& Alias "ogg_stream_clear" (ByVal os As _Offset)
End Declare
Declare Dynamic Library "vorbis"
Sub vorbis_info_init Alias "vorbis_info_init" (ByVal vi As _Offset)
Sub vorbis_info_clear Alias "vorbis_info_clear" (ByVal vi As _Offset)
Sub vorbis_comment_init Alias "vorbis_comment_init" (ByVal vc As _Offset)
Sub vorbis_comment_add_tag Alias "vorbis_comment_add_tag" (ByVal vc As _Offset, ByVal tag As _Offset, ByVal contents As _Offset)
Sub vorbis_comment_clear Alias "vorbis_comment_clear" (ByVal vc As _Offset)
Function vorbis_analysis_init& Alias "vorbis_analysis_init" (ByVal vd As _Offset, ByVal vi As _Offset)
Function vorbis_block_init& Alias "vorbis_block_init" (ByVal vd As _Offset, ByVal vb As _Offset)
Function vorbis_analysis_headerout& Alias "vorbis_analysis_headerout" (ByVal vd As _Offset, ByVal vc As _Offset, ByVal op As _Offset, ByVal op_comm As _Offset, ByVal op_code As _Offset)
Function vorbis_analysis_buffer%& Alias "vorbis_analysis_buffer" (ByVal vd As _Offset, ByVal vals As Long)
Function vorbis_analysis_wrote& Alias "vorbis_analysis_wrote" (ByVal vd As _Offset, ByVal vals As Long)
Function vorbis_analysis_blockout& Alias "vorbis_analysis_blockout" (ByVal vd As _Offset, ByVal vb As _Offset)
Function vorbis_analysis& Alias "vorbis_analysis" (ByVal vb As _Offset, ByVal op As _Offset)
Function vorbis_bitrate_addblock& Alias "vorbis_bitrate_addblock" (ByVal vb As _Offset)
Function vorbis_bitrate_flushpacket& Alias "vorbis_bitrate_flushpacket" (ByVal vd As _Offset, ByVal op As _Offset)
Function vorbis_block_clear& Alias "vorbis_block_clear" (ByVal vb As _Offset)
Sub vorbis_dsp_clear Alias "vorbis_dsp_clear" (ByVal vd As _Offset)
End Declare
Declare Dynamic Library "vorbisenc"
Function vorbis_encode_init_vbr& Alias "vorbis_encode_init_vbr" (ByVal vi As _Offset, ByVal channels As Long, ByVal rate As Long, ByVal base_quality As Single)
End Declare
$End If
' ============================================================
' MAIN
' ============================================================
Dim snd As Long
snd = _SndOpen(INPUT_FILE$)
If snd = 0 Then
Print "Cannot open input: "; INPUT_FILE$
End
End If
Dim src As _MEM
src = _MemSound(snd, 0)
If src.SIZE = 0 Then
Print "_MemSound returned SIZE=0."
_SndClose snd
End
End If
Dim ch As Long: ch = MemChannels(src)
If ch < 1 Or ch > MAX_CHANNELS& Then
Print "Bad channel count: "; ch; " (TYPE="; src.TYPE; " ELEMENTSIZE="; src.ELEMENTSIZE; ")"
_MemFree src
_SndClose snd
End
End If
If SaveMemSoundAsOggVorbis(src, ch, sr, OUTPUT_OGG$, VORBIS_QUALITY!) Then
Print "OK."
Else
Print "FAILED."
End If
_MemFree src
_SndClose snd
End
' ============================================================
' Core encoder: uses opaque memory blocks for lib structs
' ============================================================
Function SaveMemSoundAsOggVorbis% (src As _MEM, ch As Long, sr As Long, outFile$, quality As Single)
SaveMemSoundAsOggVorbis = 0
' Oversized opaque blocks (must be >= real struct sizes)
Dim vi As _MEM: vi = _MemNew(256)
Dim vc As _MEM: vc = _MemNew(2048)
Dim vd As _MEM: vd = _MemNew(16384)
Dim vb As _MEM: vb = _MemNew(8192)
Dim os As _MEM: os = _MemNew(8192)
Dim op As _MEM: op = _MemNew(512)
Dim op_comm As _MEM: op_comm = _MemNew(512)
Dim op_code As _MEM: op_code = _MemNew(512)
Dim og As _MEM: og = _MemNew(OGG_PAGE_BYTES&)
' Zero-fill blocks (safe)
_MemFill vi, vi.OFFSET, vi.SIZE, 0 As _Unsigned _Byte
_MemFill vc, vc.OFFSET, vc.SIZE, 0 As _Unsigned _Byte
_MemFill vd, vd.OFFSET, vd.SIZE, 0 As _Unsigned _Byte
_MemFill vb, vb.OFFSET, vb.SIZE, 0 As _Unsigned _Byte
_MemFill os, os.OFFSET, os.SIZE, 0 As _Unsigned _Byte
_MemFill op, op.OFFSET, op.SIZE, 0 As _Unsigned _Byte
_MemFill op_comm, op_comm.OFFSET, op_comm.SIZE, 0 As _Unsigned _Byte
_MemFill op_code, op_code.OFFSET, op_code.SIZE, 0 As _Unsigned _Byte
_MemFill og, og.OFFSET, og.SIZE, 0 As _Unsigned _Byte
Dim fh As Integer
fh = FreeFile
Open outFile$ For Binary As #fh
Dim ok As Integer: ok = -1
Dim serial As Long
Randomize Timer
serial = Int(Rnd * 2147483647)
' --- Vorbis init ---
vorbis_info_init vi.OFFSET
If vorbis_encode_init_vbr(vi.OFFSET, ch, sr, quality) <> 0 Then
Print "vorbis_encode_init_vbr failed (this is where x86 calling-convention mismatch usually kills the process)."
ok = 0
GoTo Cleanup
End If
If vorbis_analysis_init(vd.OFFSET, vi.OFFSET) <> 0 Then
Print "vorbis_analysis_init failed."
ok = 0
GoTo Cleanup
End If
If vorbis_block_init(vd.OFFSET, vb.OFFSET) <> 0 Then
Print "vorbis_block_init failed."
ok = 0
GoTo Cleanup
End If
' --- Ogg stream init ---
If ogg_stream_init(os.OFFSET, serial) <> 0 Then
Print "ogg_stream_init failed."
ok = 0
GoTo Cleanup
End If
' --- Header packets ---
If vorbis_analysis_headerout(vd.OFFSET, vc.OFFSET, op.OFFSET, op_comm.OFFSET, op_code.OFFSET) <> 0 Then
Print "vorbis_analysis_headerout failed."
ok = 0
GoTo Cleanup
End If
If ogg_stream_packetin(os.OFFSET, op.OFFSET) <> 0 Then ok = 0: GoTo Cleanup
If ogg_stream_packetin(os.OFFSET, op_comm.OFFSET) <> 0 Then ok = 0: GoTo Cleanup
If ogg_stream_packetin(os.OFFSET, op_code.OFFSET) <> 0 Then ok = 0: GoTo Cleanup
Do While ogg_stream_flush(os.OFFSET, og.OFFSET) <> 0
WriteOggPageFromMem fh, og
Loop
' --- Audio frames ---
Dim framesTotal As _Integer64
framesTotal = src.SIZE \ src.ELEMENTSIZE
Dim poss As _Integer64: poss = 0
Dim framesThis As Long
Dim bufPP As _Offset
Dim mp As _MEM
Dim c As Long, f As Long
Dim N As Long
Dim chanPtr As _Offset
ReDim chanPtr(0 To ch - 1) As _Offset
Dim mchan As _MEM
Dim baseOfs As _Offset
Dim s As Single
Do While poss < framesTotal
framesThis = CHUNK_FRAMES&
If poss + framesThis > framesTotal Then framesThis = framesTotal - poss
bufPP = vorbis_analysis_buffer(vd.OFFSET, framesThis)
If bufPP = 0 Then
Print "vorbis_analysis_buffer returned NULL."
ok = 0
GoTo Cleanup
End If
mp = _Mem(bufPP, ch * PTR_BYTES&)
For c = 0 To ch - 1
chanPtr(c) = _MemGet(mp, mp.OFFSET + c * PTR_BYTES&, _Offset)
Next
_MemFree mp
For c = 0 To ch - 1
mchan = _Mem(chanPtr(c), framesThis * 4)
For f = 0 To framesThis - 1
baseOfs = src.OFFSET + (poss + f) * src.ELEMENTSIZE
s = SampleToFloat!(src, baseOfs, c)
If s > 1! Then s = 1!
If s < -1! Then s = -1!
_MemPut mchan, mchan.OFFSET + f * 4, s
Next
_MemFree mchan
Next
If vorbis_analysis_wrote(vd.OFFSET, framesThis) <> 0 Then
Print "vorbis_analysis_wrote failed."
ok = 0
GoTo Cleanup
End If
Do While vorbis_analysis_blockout(vd.OFFSET, vb.OFFSET) = 1
N = vorbis_analysis(vb.OFFSET, 0)
N = vorbis_bitrate_addblock(vb.OFFSET)
Do While vorbis_bitrate_flushpacket(vd.OFFSET, op.OFFSET) = 1
N = ogg_stream_packetin(os.OFFSET, op.OFFSET)
Do While ogg_stream_pageout(os.OFFSET, og.OFFSET) <> 0
WriteOggPageFromMem fh, og
Loop
Loop
Loop
poss = poss + framesThis
Loop
' End-of-stream
N = vorbis_analysis_wrote(vd.OFFSET, 0)
Do While vorbis_analysis_blockout(vd.OFFSET, vb.OFFSET) = 1
N = vorbis_analysis(vb.OFFSET, 0)
N = vorbis_bitrate_addblock(vb.OFFSET)
Do While vorbis_bitrate_flushpacket(vd.OFFSET, op.OFFSET) = 1
N = ogg_stream_packetin(os.OFFSET, op.OFFSET)
Do While ogg_stream_flush(os.OFFSET, og.OFFSET) <> 0
WriteOggPageFromMem fh, og
Loop
Loop
Loop
Cleanup:
Close #fh
N = ogg_stream_clear(os.OFFSET)
N = vorbis_block_clear(vb.OFFSET)
Call vorbis_dsp_clear(vd.OFFSET)
Call vorbis_comment_clear(vc.OFFSET)
Call vorbis_info_clear(vi.OFFSET)
_MemFree og
_MemFree op_code
_MemFree op_comm
_MemFree op
_MemFree os
_MemFree vb
_MemFree vd
_MemFree vc
_MemFree vi
If ok Then SaveMemSoundAsOggVorbis = -1
End Function
' Add Vorbis comment tag (ASCIIZ)
Sub AddTag (vc As _MEM, tag$, value$)
Dim tZ$, vZ$
tZ$ = tag$ + Chr$(0)
vZ$ = value$ + Chr$(0)
vorbis_comment_add_tag vc.OFFSET, _Offset(tZ$), _Offset(vZ$)
End Sub
' Convert one interleaved sample to float [-1..+1]
Function SampleToFloat! (src As _MEM, baseOfs As _Offset, c As Long)
Select Case src.TYPE
Case 260
SampleToFloat! = _MemGet(src, baseOfs + c * 4, Single)
Case 132
Dim l As Long
l = _MemGet(src, baseOfs + c * 4, Long)
SampleToFloat! = l / 2147483648!
Case 130
Dim i16 As Integer
i16 = _MemGet(src, baseOfs + c * 2, Integer)
SampleToFloat! = i16 / 32768!
Case 1153
Dim b As _Unsigned _Byte
b = _MemGet(src, baseOfs + c, _Unsigned _Byte)
SampleToFloat! = (CSng(b) - 128!) / 128!
Case Else
SampleToFloat! = 0!
End Select
End Function
' Write ogg_page (read fields from opaque ogg_page memory)
Sub WriteOggPageFromMem (fh As Integer, og As _MEM)
Dim headerPtr As _Offset, bodyPtr As _Offset
Dim headerLen As Long, bodyLen As Long
If headerLen > 0 Then
Dim s$
s$ = Space$(headerLen)
Dim mh As _MEM
mh = _Mem(headerPtr, headerLen)
_MemGet mh, mh.OFFSET, s$
_MemFree mh
Put #fh, , s$
End If
If bodyLen > 0 Then
Dim b$
b$ = Space$(bodyLen)
Dim mb As _MEM
mb = _Mem(bodyPtr, bodyLen)
_MemGet mb, mb.OFFSET, b$
_MemFree mb
Put #fh, , b$
End If
End Sub
' Detect channels from _MEMSOUND format (interleaved)
Function BytesPerSample% (t As Long)
Select Case t
Case 260, 132: BytesPerSample% = 4
Case 130: BytesPerSample% = 2
Case 1153: BytesPerSample% = 1
Case Else: BytesPerSample% = 0
End Select
End Function
Function MemChannels% (m As _MEM)
Dim bps As Long: bps = BytesPerSample%(m.TYPE)
If bps = 0 Then MemChannels% = 0: Exit Function
MemChannels% = m.ELEMENTSIZE \ bps
End Function
Very nice work Petr,
I tried to play an avi video in qb64
but I couldn't find a stable code.
I found the code below but it doesn't
show the video properly (flickering).
The only way to avoid flickering is to play
the avi in another window.
This happens in QB64, in QB64PE it doesn't
show anyhting.
I don't need avi playing, it's just for learning,
not something important. I have windows7-64
Does anyone know something?
Declare Dynamic Library "WINMM"
Function mciSendStringA% (lpstrCommand As String, lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer)
Function mciGetErrorStringA% (ByVal dwError As Integer, lpstrBuffer As String, ByVal uLength As Integer)
End Declare
'a% = mciSendStringA%("open " + Filename + " alias avifile parent " + Str$(hwnd&) + " style child", ReturnString$, Len(ReturnString$), 0) ' ==== OPENS ANOTHER WINDOW IN QB64, ==== DOES NOTHING IN QB64PE
a% = mciSendStringA%("open " + Filename + " style popup", ReturnString$, Len(ReturnString$), 0) '==== FLICKERING IN QB64, =====SHOWS NOTHING IN QB64PE
This is reapired version, it play in QB64PE 4.2.0 and also in QB64 1.4....
Code: (Select All)
Option _Explicit
Declare Dynamic Library "winmm"
Function mciSendStringA& (lpstrCommand As String, lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As _Offset)
Function mciGetErrorStringA& (ByVal dwerrsor As Long, lpstrBuffer As String, ByVal uLength As Long)
End Declare
Dim filename As String, aliasName As String
filename = "1.avi"
aliasName = "vid"
Dim cmd As String
Dim errs As Long, N As Long
Dim dummy As String: dummy = Space$(1)
' Open AVI as avivideo, place it as CHILD to QB64PE window
cmd = "open " + Chr$(34) + filename + Chr$(34) + " type avivideo alias " + aliasName + _
" parent " + LTrim$(Str$(hwnd)) + " style child"
errs = mciSendStringA&(cmd, dummy, 0, 0): MCI_Check errs, cmd
' Set window size and window postition
cmd = "put " + aliasName + " window at 0 0 800 600"
errs = mciSendStringA&(cmd, dummy, 0, 0): MCI_Check errs, cmd
' Play it
cmd = "play " + aliasName
errs = mciSendStringA&(cmd, dummy, 0, 0): MCI_Check errs, cmd
Do
_Limit 60
Loop Until InKey$ <> ""
N = mciSendStringA&("stop " + aliasName, dummy, 0, 0)
N = mciSendStringA&("close " + aliasName, dummy, 0, 0)
End
Sub MCI_Check (errsCode As Long, where As String) 'error code handler if error occur
Dim N As Long
If errsCode <> 0 Then
Dim msg As String
msg = Space$(256)
N = mciGetErrorStringA&(errsCode, msg, Len(msg))
Print "MCI errsOR ("; errsCode; "): "; where
Print RTrim$(msg)
Sleep
End
End If
End Sub
