Private Const ERR_BASE = 1100
Public Const CLIPBOARD_ERR = ERR_BASE + 1

Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096

Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (Byval lpString1 As String, Byval lpString2 As Long) As Long
Declare Function lstrcpy1 Lib "kernel32" Alias "lstrcpy" (Byval lpString1 As Long, Byval lpString2 As String) As Long
Declare Function SetClipboardData Lib "User32" (Byval wFormat As Long, Byval hMem As Long) As Long
Declare Function OpenClipboard Lib "User32" (Byval hwnd As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function GetClipboardData Lib "User32" (Byval wFormat As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (Byval wFlags&, Byval dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (Byval hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (Byval hMem As Long) As Long
Declare Function GlobalSize Lib "kernel32" (Byval hMem As Long) As Long

'
' ClipBoard represents the Win32 clipboard. It allows you to copy data
' between the clip board and your application.
'
' Example:
'
'  Dim test_string As String
'  test_string = "test"
'
'  Dim clip_board As New ClipBoard
'  clip_board.Contents = test_string
'
'  If test_string <> clip_board.Contents Then
'    Messagebox "Failure!"
'  End If
'
Public Class ClipBoard
  
  ' The data contents of the clipboard.
  ' Raises CLIPBOARD_ERR if the data can't be copied to the clipboard.
  Public Property Set Contents As String
    Dim hGlobalMemory As Long
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    hGlobalMemory = GlobalAlloc(GHND, Len(Contents) + 1) 
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lpGlobalMemory = lstrcpy1(lpGlobalMemory, Contents)
    If GlobalUnlock(hGlobalMemory) <> 0 Then 
      Error CLIPBOARD_ERR, "Could not unlock memory location."
    End If 
    
    If OpenClipboard(0&) = 0 Then
      Error CLIPBOARD_ERR, "Could not open the Clipboard."
    End If 
    
    If EmptyClipboard() = 0 Then
      CloseClipboard
      Error CLIPBOARD_ERR, "Could not empty the Clipboard."
    End If
    
    hClipMemory = SetClipboardData(CF_TEXT,  hGlobalMemory) 
    
    If CloseClipboard() = 0 Then
      Error CLIPBOARD_ERR, "Could not close Clipboard."
    End If
  End Property
  
  ' The data contents of the clipboard.
  ' Raises CLIPBOARD_ERR if the data can't be retrieved from the clipboard.
  Public Property Get Contents As String
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim result As String
    If OpenClipboard(0&) = 0 Then
      Error CLIPBOARD_ERR, "Could not open the Clipboard."
    End If
    
    hClipMemory = GetClipboardData(CF_TEXT) 
    If Isnull(hClipMemory) Then
      Error CLIPBOARD_ERR, "Could not allocate memory."
    End If 
    
    lpClipMemory = GlobalLock(hClipMemory) 
    If Not Isnull(lpClipMemory) Then
      result = Space$(MAXSIZE)
      If Isnull(lstrcpy(result, lpClipMemory)) Then
        CloseClipboard
        Error CLIPBOARD_ERR, "Could not copy string."
      End If 
      If Isnull(GlobalUnlock(hClipMemory)) Then
        CloseClipboard
        Error CLIPBOARD_ERR, "Could not unlock reference to clipboard contents."
      End If 
      result = ToLSString(result)
    Else
      Error CLIPBOARD_ERR, "Could not lock memory to copy string from."
    End If 
    
    If CloseClipboard() = 0 Then
      Error CLIPBOARD_ERR, "Could not close the clipboard."
    End If
    
    Contents = result 
  End Property
  
  ' Removes the terminating null character from C strings.
  Private Function ToLSString(s As String) As String
    ToLSString = Mid(s, 1, Instr(1, s, Chr$(0), 0) - 1) 
  End Function
End Class