04. Этот пример показывает как с использованием API интерфейса управлять буфером Windows. Используется класс и api интерфейс. Это более надежный способ, чем другие без api интерфейса.
' Функции управления буфером
Private Declare Function IsClipboardFormatAvailable Lib "user32" _
(ByVal uFormat As Integer) As Integer
Private Declare Function apiOpenClipboard Lib "user32" Alias "OpenClipboard" _
(ByVal hWnd As Long) As Integer
Private Declare Function apiSetClipboardData Lib "user32" Alias "SetClipboardData" _
(ByVal uFormat As Integer, _
ByVal hData As Long) As Long
Private Declare Function apiGetClipboardData Lib "user32" Alias "GetClipboardData" _
(ByVal uFormat As Integer) As Long
Private Declare Function apiCloseClipboard Lib "user32" Alias "CloseClipboard" _
() As Integer
Private Declare Function apiEmptyClipboard Lib "user32" Alias "EmptyClipboard" _
() As Integer
' Функции управления памятью
Private Declare Function apiGlobalAlloc Lib "kernel32" Alias "GlobalAlloc" _
(ByVal uFlags As Integer, _
ByVal dwBytes As Long) As Long
Private Declare Function apiGlobalSize Lib "kernel32" Alias "GlobalSize" _
(ByVal hMem As Long) As Integer
Private Declare Function apiGlobalLock Lib "kernel32" Alias "GlobalLock" _
(ByVal hMem As Long) As Long
Private Declare Sub apiMoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal strDest As Any, _
ByVal lpSource As Any, _
ByVal Length As Long)
Private Declare Function apiGlobalUnlock Lib "kernel32" Alias "GlobalUnlock" _
(ByVal hMem As Long) As Integer
Private Declare Function apiGlobalFree Lib "kernel32" Alias "GlobalFree" _
(ByVal hMem As Long) As Long
' api-Константы памяти
Private Const GMEM_FIXED = H0
Private Const GMEM_MOVEABLE = H2
Private Const GMEM_NOCOMPACT = H10
Private Const GMEM_NODISCARD = H20
Private Const GMEM_ZEROINIT = H40
Private Const GMEM_MODIFY = H80
Private Const GMEM_DISCARDABLE = H100
Private Const GMEM_NOT_BANKED = H1000
Private Const GMEM_SHARE = H2000
Private Const GMEM_DDESHARE = H2000
Private Const GMEM_NOTIFY = H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKED
Private Const GMEM_VALID_FLAGS = H7F72
Private Const GMEM_INVALID_HANDLE = H8000
Private Const GMEM_TEXT = (GMEM_MOVEABLE Or GMEM_DDESHARE)
' api-Форматы буфера
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPICT = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
'==============================================================
' Копируем текст в буфер
'
Function CopyText(strText As String) As Variant
Dim hMem As Long
Dim lpMem As Long
Dim l As Long
' Выделение памяти
l = Len(strText) + 1 ' Длина строки с учетом символа \0 (c++)
hMem = apiGlobalAlloc(GMEM_TEXT, l) ' Память для буфера
' Управление памятью
lpMem = apiGlobalLock(hMem) ' Блокируем часть памяти
Call apiMoveMemory(lpMem, strText, l) ' Копируем строку в память
Call apiGlobalUnlock(hMem) ' Разблокируем память
' Управление буфером
Call apiOpenClipboard(0) ' Открываем буфер
Call apiEmptyClipboard ' Очищаем буфер
Call apiSetClipboardData(CF_TEXT, hMem) ' Загружаем текст
Call apiCloseClipboard ' Закрываем буфер
' Освобождаем память
Call apiGlobalFree(hMem)
End Function
'==============================================================
' Получаем текст из буфера
'
Public Function GetText() As Variant
Dim hMem As Long
Dim lpMem As Long
Dim s As String
Dim l As Long
' Проверяем формат буфера
If Not CBool(IsClipboardFormatAvailable(CF_TEXT)) Then
Exit Function
End If
' Работаем с буфером и памятью
Call apiOpenClipboard(0) ' Открываем буфер
hMem = apiGetClipboardData(CF_TEXT) ' Получаем заголовок данных в буфере
l = apiGlobalSize(hMem) ' Определяем размер строки
s = Space$(l) ' Выделение памяти для строки
lpMem = apiGlobalLock(hMem) ' Блокируем память
Call apiMoveMemory(s, lpMem, l) ' Копируем информацию из буфера в строку
Call apiGlobalUnlock(hMem) ' Разблокирование памяти
Call apiCloseClipboard ' Закрываем буфер
' Возвращаем результат
GetText = Left$(s, InStr(1, s, Chr$(0)) - 1)
End Function