Программирование на Visual Basic

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