Пример кольцевого буфера

RingBuffer.bas

#include once "windows.bi"

Private Function FindFreeAddress( _
		ByVal dwSize As UInteger _
	)As LPVOID
	
	Dim lpBaseAddress As LPVOID = VirtualAlloc( _
		NULL, _
		dwSize, _
		MEM_RESERVE, _
		PAGE_READWRITE _
	)
	
	If lpBaseAddress Then
		VirtualFree(lpBaseAddress, 0, MEM_RELEASE)
	End If
	
	Return lpBaseAddress
	
End Function

Private Function GetAllocationGranularity() As DWORD
	
	' узнаём размер гранулы
	Dim info As SYSTEM_INFO = Any
	GetSystemInfo(@info)
	
	Return info.dwAllocationGranularity
	
End Function

Private Function RingBufferInitialize( _
		ByVal DesiredCapacity As UInteger, _
		ByVal ppFirstPage As UByte Ptr Ptr, _
		ByVal ppSecondPage As UByte Ptr Ptr _
	)As HRESULT
	
	' VirtualAlloc создаёт память с округлением до гранулы
	
	Dim dwGranularity As DWORD = GetAllocationGranularity()
	
	Dim Capacity As UInteger = ((DesiredCapacity \ Cast(size_t, dwGranularity)) + 1) * dwGranularity
	
	Dim hMapFile As HANDLE = Any
	Scope
		Dim ulBufferSize As ULARGE_INTEGER = Any
		ulBufferSize.QuadPart = Capacity * 2
		
		hMapFile = CreateFileMapping( _
			INVALID_HANDLE_VALUE, _
			NULL, _
			PAGE_READWRITE, _
			ulBufferSize.HighPart, ulBufferSize.LowPart, _
			NULL _
		)
		If hMapFile = NULL Then
			Dim dwError As DWORD = GetLastError()
			*ppFirstPage = NULL
			*ppSecondPage = NULL
			
			Return HRESULT_FROM_WIN32(dwError)
		End If
	End Scope
	
	' Ищем свободный адрес (несколько попыток)
	Const StepsCount = 10
	
	For i As Integer = 0 To StepsCount - 1
		Dim lpBaseAddress1 As LPVOID = FindFreeAddress( _
			Capacity * 2 _
		)
		
		If lpBaseAddress1 Then
			
			Dim pFirstRegion As UByte Ptr = MapViewOfFileEx( _
				hMapFile, _
				FILE_MAP_READ Or FILE_MAP_WRITE, _
				0, 0, _
				Cast(DWORD, Capacity), _
				lpBaseAddress1 _
			)
			
			If pFirstRegion Then
				
				Dim lpBaseAddress2 As LPVOID = Cast(LPVOID, (CPtr(UByte Ptr, lpBaseAddress1) + Capacity))
				
				Dim pSecondRegion As UByte Ptr = MapViewOfFileEx( _
					hMapFile, _
					FILE_MAP_READ Or FILE_MAP_WRITE, _
					0, 0, _
					Cast(DWORD, Capacity), _
					lpBaseAddress2 _
				)
				
				If pSecondRegion Then
					
					*ppFirstPage = pFirstRegion
					*ppSecondPage = pSecondRegion
					
					Return S_OK
				End If
				
				UnmapViewOfFile(pFirstRegion)
			End If
			
		End If
		
	Next
	
	*ppFirstPage = NULL
	*ppSecondPage = NULL
	
	CloseHandle(hMapFile)
	
	Return E_OUTOFMEMORY
	
End Function

Const HelloWorld = __TEXT("Hello World")

Dim pFirstPage As Any Ptr = Any
Dim pSecondPage As Any Ptr = Any
Dim hr As HRESULT = RingBufferInitialize( _
	100, _
	@pFirstPage, _
	@pSecondPage _
)
If FAILED(hr) Then
	End(1)
End If

' Записываем данные во вторую страницу
memcpy(pSecondPage, @HelloWorld, (Len(HelloWorld) + 1) * SizeOf(TCHAR))

' и читаем данные из первой страницы
' проверяем: данные совпадают
Print *(Cast(LPTSTR, pFirstPage))
Print *(Cast(LPTSTR, pSecondPage))

' однако указатели разные
Print Hex(pFirstPage), Hex(pSecondPage)