03-24-2025, 09:35 PM
I'm glad for your responses. Believe me, I'm trying to embellish it somehow. I have a version where the output works in VLC player and MPC-HC, but unfortunately Windows Media Player just stands up and rejects the output file. I've been looking for an error in the structure for several hours - but if FFMPEG is happy with it, I really don't know what Windows Media Player doesn't like. Well, however, here you have such an intermediate version (let's say a hot program directly from the keyboard). Recording an AVI file is limited by the length of the song this time, or it can be stopped at any time by pressing any key.
However, it is necessary to underline a few fundamental things. Since we are dealing with huge numbers here, the LOF function that the program refers to has a limit of 9 GigaBytes. Take this into account when using this program. Another limit is the file system of your operating system. If you use FAT32, you will reach the limit at a size of 4 Gigabyte, while with NTFS and EXT4, LOF will fail later (limit 16 TB). So I recommend, if you really want crazy sizes, to split your files according to these operating system limits. I will try some light compression, but first I will try to make this compatible with WMP as well.
You NEED MP3 file
However, it is necessary to underline a few fundamental things. Since we are dealing with huge numbers here, the LOF function that the program refers to has a limit of 9 GigaBytes. Take this into account when using this program. Another limit is the file system of your operating system. If you use FAT32, you will reach the limit at a size of 4 Gigabyte, while with NTFS and EXT4, LOF will fail later (limit 16 TB). So I recommend, if you really want crazy sizes, to split your files according to these operating system limits. I will try some light compression, but first I will try to make this compatible with WMP as well.
You NEED MP3 file
Code: (Select All)
Dim ms As _MEM
Dim snd As Long
snd = _SndOpen("b.mp3") '<--- place here MP3 (must be MP3!) file
' ======================================================
' Dynamic creation of AVI file with structures and correct offsets
' + updating the total frame count upon finishing recording
' ======================================================
' -------------------------
' Structure Definitions
' -------------------------
Type AVIMainHeader
microSecPerFrame As Long ' Microseconds per frame
maxBytesPerSec As Long ' Maximum data rate (bytes per second)
paddingGranularity As Long ' Padding granularity (for alignment)
flags As Long ' AVI flags (e.g., HASINDEX)
totalFrames As Long ' Total number of frames in the video
initialFrames As Long ' Initial frames (typically 0)
streams As Long ' Number of streams (video, audio, etc.)
suggestedBufferSize As Long ' Suggested buffer size for playback
width As Long ' Video width in pixels
height As Long ' Video height in pixels
reserved As String * 16 ' Reserved bytes (set to 0)
End Type
Type AVIStreamHeader
fccType As String * 4 ' Stream type (e.g., "vids" for video, "auds" for audio)
fccHandler As String * 4 ' Codec handler (e.g., "DIB " for uncompressed video)
flags As Long ' Stream flags
priority As Integer ' Priority (unused)
language As Integer ' Language code (unused)
initialFrames As Long ' Initial frames (unused)
scale As Long ' Time scale for the stream
rate As Long ' Data rate (scale/rate = frames per second for video)
start As Long ' Start time (usually 0)
length As Long ' Length of the stream (in time units)
suggestedBufferSize As Long ' Suggested buffer size for the stream
quality As Long ' Quality indicator (-1 for default)
sampleSize As Long ' Sample size (0 for video, nonzero for audio)
frameLeft As Long ' For video: left coordinate of the source rectangle
frameTop As Long ' For video: top coordinate of the source rectangle
frameRight As Long ' For video: right coordinate of the source rectangle
frameBottom As Long ' For video: bottom coordinate of the source rectangle
End Type
Type BITMAPINFOHEADER
size As Long ' Size of this header (40 bytes)
width As Long ' Image width in pixels
height As Long ' Image height (negative for top–down)
planes As Integer ' Number of color planes (must be 1)
bitCount As Integer ' Bits per pixel (24 for 24-bit, 32 for 32-bit)
compression As Long ' Compression method (0 = BI_RGB for uncompressed)
sizeImage As Long ' Size of the image data in bytes
xPelsPerMeter As Long ' Horizontal resolution (pixels per meter)
yPelsPerMeter As Long ' Vertical resolution (pixels per meter)
clrUsed As Long ' Number of colors used (0 = all)
clrImportant As Long ' Number of important colors (0 = all)
End Type
Type WAVEFORMATEX
wFormatTag As Integer ' Audio format code (1 = PCM)
nChannels As Integer ' Number of audio channels (2 for stereo)
nSamplesPerSec As Long ' Sample rate in Hz
nAvgBytesPerSec As Long ' Average bytes per second
nBlockAlign As Integer ' Block alignment in bytes
wBitsPerSample As Integer ' Bits per sample (16 for 16-bit PCM)
cbSize As Integer ' Extra size (0 for PCM)
End Type
Type ChunkIndex
chunkID As String * 4 ' Chunk identifier (e.g., "00db" for video, "01wb" for audio)
flags As Long ' Flags (e.g., keyframe flag)
offset As _Unsigned Long ' Offset of chunk data from start of 'movi' section
size As Long ' Size of chunk data in bytes (could also be _Unsigned Long if needed)
End Type
' -------------------------
' SHARED Variables
' -------------------------
Dim Shared aviFileNum As Integer
' Positions for updating headers and stream information - now declared as _unsigned long
Dim Shared riffSizePos As _Unsigned Long, hdrlSizePos As _Unsigned Long
Dim Shared moviSizePos As _Unsigned Long, moviDataStart As _Unsigned Long
' Save the file position where the MainHeader is written
Dim Shared mainHdrPos As _Unsigned Long
' Save the file position for the video stream header
Dim Shared vidStrhPos As _Unsigned Long
' For the audio stream – position and copy of the stream header
Dim Shared audStrhPos As _Unsigned Long
Dim Shared audStrh As AVIStreamHeader
' Shared copies of structures that will be updated upon finish
Dim Shared shMainHdr As AVIMainHeader
Dim Shared shVidStrh As AVIStreamHeader
' Counters for video frames and audio samples
Dim Shared totalFrames As Long, totalAudioSamples As Long
' Array of chunk indices
Dim Shared idxArr(1 To 10000) As ChunkIndex
Dim Shared idxCount As Long
' -------------------------
' Parameters
' -------------------------
Const vidFPS = 20 ' Frames per second
Const bytesPerPixel = 4 ' Each pixel in a 32-bit image (BGRA) takes 4 bytes
Dim Shared frameWidth As Long: frameWidth = 640
Dim Shared frameHeight As Long: frameHeight = 480
Const sampleRate = 44100 ' Audio sample rate
' -------------------------
' Main Program
' -------------------------
Cls
idxCount = 0
totalFrames = 0
totalAudioSamples = 0
' 1) Initialize AVI file
StartAvi "VideoTest5.avi"
Screen _NewImage(frameWidth, frameHeight, 32)
' 2) Recording loop
Dim Shared As Long x, img
Dim Shared frameData As String
Dim Shared memData As _MEM
Dim Shared audioSamplesPerFrame As Long
audioSamplesPerFrame = sampleRate \ vidFPS
Dim Shared audioData As String
Dim Shared iSample As Long
Dim Shared As Integer sampleL, sampleR
Dim StartTimer As Single
StartTimer = Timer
' Variable for file size from LOF (now _unsigned long)
Dim afs As _Unsigned Long
' --- Your video and audio loop starts here ---
ms = _MemSound(snd, 0)
Dim audL(frameWidth) As Single
Dim audR(frameWidth) As Single
Dim au As Long, xx As Long
Dim As Single SampleL1, SampleR1
Do While InKey$ = "" Or au > ms.SIZE - 8
totalFrames = totalFrames + 1
' --- Generate video frame ---
img = _NewImage(frameWidth, frameHeight, 32)
Dim preDest As Long
preDest = _Dest
_Dest img
Cls
deltaX = (frameWidth - xx) \ 2
For x = 0 To xx
Line (deltaX + x, frameHeight / 2)-(deltaX + x, frameHeight / 2 - 150 * audL(x)), _RGB32(Sin(j) * 255, Sin(j + .45) * 255, Sin(j + .9) * 255), BF
Line (deltaX + x, frameHeight / 2)-(deltaX + x, frameHeight / 2 + 150 * audR(x)), _RGB32(Cos(j) * 255, Cos(j + .45) * 255, Cos(j + .9) * 255), BF
j = j + .015
Next x
frameData = Space$(frameWidth * frameHeight * bytesPerPixel)
memData = _MemImage(img)
_MemGet memData, memData.OFFSET, frameData
_MemFree memData
_Dest preDest
' --- Generate audio block ---
audioData = ""
xx = 0
VisStep = _Ceil(audioSamplesPerFrame / frameWidth)
For iSample = 1 To audioSamplesPerFrame
SampleL1 = _MemGet(ms, ms.OFFSET + au, Single)
SampleR1 = _MemGet(ms, ms.OFFSET + au + 4, Single)
_SndRaw SampleL1, SampleR1
sampleL = SampleL1 * 32767
sampleR = SampleR1 * 32767
If iSample Mod VisStep = 0 Then
audL(xx) = SampleL1
audR(xx) = SampleR1
xx = xx + 1
End If
au = au + 8
If au > ms.SIZE - 8 Then Exit Do ' if music ends, finish loop
Dim uVal As Long
uVal = sampleL And &HFFFF
audioData = audioData + Chr$(uVal And &HFF) + Chr$((uVal \ 256) And &HFF)
uVal = sampleR And &HFFFF
audioData = audioData + Chr$(uVal And &HFF) + Chr$((uVal \ 256) And &HFF)
Next
totalAudioSamples = totalAudioSamples + audioSamplesPerFrame * 2
' --- Write chunk ---
CreateAviData frameData, audioData
_PutImage , img, 0
Locate 1
afs = LOF(aviFileNum)
Print "Press any key to stop generating AVI. File size: "; afs; " Duration: "; Int(Timer - StartTimer)
_FreeImage img
_Display
Do Until _SndRawLen < .1
Loop
_Limit 20
Loop
_Dest preDest
_AutoDisplay
Print "Closing AVI, please wait!"
' --- End of video and audio loop ---
_MemFree ms
_SndClose snd
' 3) Finalize AVI (update frame counts etc.)
EndAvi
Print "Done: 'VideoTest5.avi'"
Sleep
End
' -----------------------------------------------------------------
' Sub StartAvi – Opens file, writes headers and prepares LIST movi
' -----------------------------------------------------------------
Sub StartAvi (AviName As String)
' dummyLong is a placeholder for 32-bit chunk size; Long is sufficient
Dim dummyLong As Long
dummyLong = 0
aviFileNum = FreeFile
If _FileExists(AviName) Then Kill AviName
Open AviName For Binary As #aviFileNum
' 1) RIFF chunk
Dim strRIFF As String
strRIFF = "RIFF"
Put #aviFileNum, , strRIFF
riffSizePos = LOF(aviFileNum) + 1 ' _unsigned long
Put #aviFileNum, , dummyLong
Dim strAVI As String
strAVI = "AVI "
Put #aviFileNum, , strAVI
' 2) LIST hdrl chunk
Dim strLIST As String
strLIST = "LIST"
Put #aviFileNum, , strLIST
hdrlSizePos = LOF(aviFileNum) + 1 ' _unsigned long
Put #aviFileNum, , dummyLong
Dim strHdrl As String
strHdrl = "hdrl"
Put #aviFileNum, , strHdrl
' 3) avih chunk (Main AVI header)
Dim strAvih As String
strAvih = "avih"
Put #aviFileNum, , strAvih
Dim avihChunkSize As Long
avihChunkSize = 56
Put #aviFileNum, , avihChunkSize
' Fill shMainHdr with main header information
shMainHdr.microSecPerFrame = 1000000 \ vidFPS
shMainHdr.maxBytesPerSec = frameWidth * frameHeight * bytesPerPixel * vidFPS
shMainHdr.paddingGranularity = 0
shMainHdr.flags = &H110 ' AVIF_HASINDEX + AVIF_ISINTERLEAVED
shMainHdr.totalFrames = 0
shMainHdr.initialFrames = 0
shMainHdr.streams = 2
shMainHdr.suggestedBufferSize = frameWidth * frameHeight * bytesPerPixel
shMainHdr.width = frameWidth
shMainHdr.height = frameHeight
shMainHdr.reserved = String$(16, Chr$(0))
mainHdrPos = LOF(aviFileNum) + 1 ' _unsigned long
Put #aviFileNum, , shMainHdr
' --- Video stream (LIST strl) ---
strLIST = "LIST"
Put #aviFileNum, , strLIST
Dim listVidSizePos As _Unsigned Long
listVidSizePos = LOF(aviFileNum) + 1
Put #aviFileNum, , dummyLong
Dim strlVid As String
strlVid = "strl"
Put #aviFileNum, , strlVid
' Video stream header (strh)
Dim strhVid As String
strhVid = "strh"
Put #aviFileNum, , strhVid
Dim strhVidSize As Long
strhVidSize = 64
Put #aviFileNum, , strhVidSize
shVidStrh.fccType = "vids"
shVidStrh.fccHandler = "DIB "
shVidStrh.flags = 0
shVidStrh.priority = 0
shVidStrh.language = 0
shVidStrh.initialFrames = 0
shVidStrh.scale = 1
shVidStrh.rate = vidFPS
shVidStrh.start = 0
shVidStrh.length = 0
shVidStrh.suggestedBufferSize = frameWidth * frameHeight * bytesPerPixel
shVidStrh.quality = -1
shVidStrh.sampleSize = 0
shVidStrh.frameLeft = 0
shVidStrh.frameTop = 0
shVidStrh.frameRight = frameWidth
shVidStrh.frameBottom = frameHeight
vidStrhPos = LOF(aviFileNum) + 1 ' _unsigned long
Put #aviFileNum, , shVidStrh
' Video format chunk (strf) using BITMAPINFOHEADER
Dim strfVid As String
strfVid = "strf"
Put #aviFileNum, , strfVid
Dim strfVidSize As Long
strfVidSize = 40
Put #aviFileNum, , strfVidSize
Dim bmpInfo As BITMAPINFOHEADER
bmpInfo.size = 40
bmpInfo.width = frameWidth
bmpInfo.height = -frameHeight ' Negative height indicates top–down image
bmpInfo.planes = 1
bmpInfo.bitCount = 32
bmpInfo.compression = 0
bmpInfo.sizeImage = frameWidth * frameHeight * bytesPerPixel
bmpInfo.xPelsPerMeter = 0
bmpInfo.yPelsPerMeter = 0
bmpInfo.clrUsed = 0
bmpInfo.clrImportant = 0
Put #aviFileNum, , bmpInfo
Dim currPos As _Unsigned Long
currPos = LOF(aviFileNum) + 1
Dim calcListVidSize As _Unsigned Long
calcListVidSize = currPos - listVidSizePos - 4
Seek #aviFileNum, listVidSizePos
Put #aviFileNum, , calcListVidSize
Seek #aviFileNum, currPos
' --- Audio stream (LIST strl) ---
Put #aviFileNum, , strLIST
Dim listAudSizePos As _Unsigned Long
listAudSizePos = LOF(aviFileNum) + 1
Put #aviFileNum, , dummyLong
Dim strlAud As String
strlAud = "strl"
Put #aviFileNum, , strlAud
' Audio stream header (strh)
Dim strhAud As String
strhAud = "strh"
Put #aviFileNum, , strhAud
Dim strhAudSize As Long
strhAudSize = 64
Put #aviFileNum, , strhAudSize
audStrh.fccType = "auds"
audStrh.fccHandler = String$(4, 0)
audStrh.flags = 0
audStrh.priority = 0
audStrh.language = 0
audStrh.initialFrames = 0
audStrh.scale = 1
audStrh.rate = sampleRate
audStrh.start = 0
audStrh.length = 0
audStrh.suggestedBufferSize = sampleRate * 4
audStrh.quality = -1
audStrh.sampleSize = 4
audStrh.frameLeft = 0
audStrh.frameTop = 0
audStrh.frameRight = 0
audStrh.frameBottom = 0
audStrhPos = LOF(aviFileNum) + 1 ' _unsigned long
Put #aviFileNum, , audStrh
Dim strfAud As String
strfAud = "strf"
Put #aviFileNum, , strfAud
' Corrected WAVEFORMATEX chunk size to 18 (2 extra bytes -> cbSize)
Dim wfSize As Long
wfSize = 18
Put #aviFileNum, , wfSize
Dim wf As WAVEFORMATEX
wf.wFormatTag = 1
wf.nChannels = 2
wf.nSamplesPerSec = sampleRate
wf.nBlockAlign = wf.nChannels * (16 \ 8)
wf.nAvgBytesPerSec = wf.nSamplesPerSec * wf.nBlockAlign
wf.wBitsPerSample = 16
wf.cbSize = 0
Put #aviFileNum, , wf
currPos = LOF(aviFileNum) + 1
Dim calcListAudSize As _Unsigned Long
calcListAudSize = currPos - listAudSizePos - 4
Seek #aviFileNum, listAudSizePos
Put #aviFileNum, , calcListAudSize
Seek #aviFileNum, currPos
' --- LIST movi chunk ---
Put #aviFileNum, , strLIST
moviSizePos = LOF(aviFileNum) + 1 ' _unsigned long
Put #aviFileNum, , dummyLong
Dim strMovi As String
strMovi = "movi"
Put #aviFileNum, , strMovi
moviDataStart = LOF(aviFileNum) + 1
End Sub
' ---------------------------------------------------------------------
' Sub CreateAviData – Writes video chunk (00db) and audio chunk (01wb)
' ---------------------------------------------------------------------
Sub CreateAviData (frameData As String, audioData As String)
Dim padA As String
padA = Chr$(0)
' --- Video chunk ---
Dim chunkOffset As _Unsigned Long
chunkOffset = LOF(aviFileNum) - moviDataStart + 1
Dim vidChunkID As String
vidChunkID = "00db"
Put #aviFileNum, , vidChunkID
Dim frameLen As Long
frameLen = Len(frameData)
Put #aviFileNum, , frameLen
Put #aviFileNum, , frameData
If (frameLen Mod 2) <> 0 Then
Dim padV As String
padV = Chr$(0)
Put #aviFileNum, , padV
End If
idxCount = idxCount + 1
idxArr(idxCount).chunkID = vidChunkID
idxArr(idxCount).flags = &H10 ' key frame flag
idxArr(idxCount).offset = chunkOffset
idxArr(idxCount).size = frameLen
If UBound(idxArr) <= idxCount Then ReDim _Preserve idxArr(idxCount + 1000) As ChunkIndex
' --- Audio chunk ---
Dim chunkOffsetA As _Unsigned Long
chunkOffsetA = LOF(aviFileNum) - moviDataStart + 1
Dim audChunkID As String
audChunkID = "01wb"
Put #aviFileNum, , audChunkID
Dim audioLen As Long
audioLen = Len(audioData)
Put #aviFileNum, , audioLen
Put #aviFileNum, , audioData
If (audioLen Mod 2) <> 0 Then
Put #aviFileNum, , padA
End If
idxCount = idxCount + 1
idxArr(idxCount).chunkID = audChunkID
idxArr(idxCount).flags = 0
idxArr(idxCount).offset = chunkOffsetA
idxArr(idxCount).size = audioLen
End Sub
' ----------------------------------------------------------------------------------------
' Sub EndAvi – Finalizes AVI: updates totalFrames, movi size, RIFF size, and writes index
' ----------------------------------------------------------------------------------------
Sub EndAvi
' 1) Update shMainHdr with the actual totalFrames
shMainHdr.totalFrames = totalFrames
' 2) Update video stream header length with totalFrames
shVidStrh.length = totalFrames
' 2a) Update audio stream header – length is number of samples per channel
' (totalAudioSamples contains samples for both channels)
audStrh.length = totalAudioSamples \ 2
' --- Rewrite AVIMainHeader (avih) ---
Seek #aviFileNum, mainHdrPos
Put #aviFileNum, , shMainHdr
' --- Rewrite AVIStreamHeader (video) ---
Seek #aviFileNum, vidStrhPos
Put #aviFileNum, , shVidStrh
' --- Rewrite AVIStreamHeader (audio) ---
Seek #aviFileNum, audStrhPos
Put #aviFileNum, , audStrh
' 3) Adjust LIST movi size
Dim currPos As _Unsigned Long
currPos = LOF(aviFileNum) + 1
Dim moviSize As _Unsigned Long
moviSize = currPos - moviSizePos - 4
Seek #aviFileNum, moviSizePos
Put #aviFileNum, , moviSize
Seek #aviFileNum, currPos
' 4) RIFF size (total file size minus 8)
Dim riffSize As _Unsigned Long
riffSize = currPos - 8 ' This should be correct; adjust if necessary for 0-index differences
Seek #aviFileNum, riffSizePos
Put #aviFileNum, , riffSize
Seek #aviFileNum, currPos
' 5) Write index (idx1)
Dim strIdx As String
strIdx = "idx1"
Put #aviFileNum, , strIdx
Dim idxSize As Long
idxSize = idxCount * 16
Put #aviFileNum, , idxSize
Dim Nsize As _Unsigned Long
Nsize = LOF(aviFileNum) + 1
Dim hdrlSize As _Unsigned Long
hdrlSize = currPos - hdrlSizePos - 4
Seek #aviFileNum, hdrlSizePos
Put #aviFileNum, , hdrlSize
Seek #aviFileNum, Nsize
Dim i As Long
For i = 1 To idxCount
Put #aviFileNum, , idxArr(i).chunkID
Put #aviFileNum, , idxArr(i).flags
Put #aviFileNum, , idxArr(i).offset
Put #aviFileNum, , idxArr(i).size
Next i
Close #aviFileNum
End Sub