Code: Accessing Windows Clipboard
Several years ago, I found some code to access the Win32 functions for the Windows Clipboard. I don't remember where I found it, who wrote it or if it was VB code that I modified or already written for Lotusscript. I rewrote the the code as a class and put it in a script library called "Class.Win32.ClipBoard". The complete code is listed below. In my next blog entry I will describe how I am using this class for some very convenient functions. Option Public Option Declare Declare Private Function GetClipboardData Lib "User32" (Byval wFormat As Long) As Long Declare Private Function SetClipboardData Lib "user32" (Byval wFormat As Long, Byval hData As Long) As Long Declare Private Function OpenClipboard Lib "User32" Alias "OpenClipboard" (Byval hwnd As Long) As Long Declare Private Function CloseClipboard Lib "User32" Alias "CloseClipboard" () As Long Declare Private Function GlobalLock Lib "kernel32" Alias "GlobalLock" (Byval hMem As Long) As Long Declare Private Function GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (Byval hMem As Long) As Long Declare Private Function GlobalAlloc Lib "kernel32" (Byval wFlags As Long, Byval dwBytes As Long) As Long Declare Private Function GlobalFree Lib "kernel32" (Byval hMem As Long) As Long Declare Private Function EmptyClipboard Lib "user32" () As Long Declare Private Function lstrcpyLP2Str Lib "kernel32" Alias "lstrcpyA" (Byval lpString1 As String, _ Byval lpString2 As Long) As Long Declare Private Function lstrlenLP Lib "kernel32" Alias "lstrlenA" (Byval lpString As Long) As Long Declare Private Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Byval strDest As Any, _ Byval lpSource As Any, Byval Length As Any) Declare Private Function GetFocus Lib "User32" Alias "GetFocus" () As Long Private Const CF_TEXT = 1 Private Const GMEM_MOVABLE = &H2& Private Const GMEM_DDESHARE = &H2000& Class WindowsClipboard Public Property Get Contents As String Dim hClipboard As Long Dim LpStrl As Long Dim Resultl As Long Dim Clipboardstr As String If (OpenClipboard(0&) <> 0) Then hClipboard = GetClipboardData(CF_TEXT) If (hClipboard <> 0) Then LpStrl = GlobalLock(hClipboard) Clipboardstr = Space$(lstrlenLP(LpStrl)) Resultl = lstrcpyLP2Str(Clipboardstr, LpStrl) GlobalUnlock(hClipboard) Else Clipboardstr = "NULL" End If Call CloseClipboard() &nbs p; Else Clipboardstr = "" End If Contents = Clipboardstr End Property ' Ends the "Get" method for the "Contents" property Public Property Set Contents As String Dim lSize As Long Dim hMem As Long Dim pMemory As Long Dim temp As Variant lSize = Len(Contents)+1 hMem = GlobalAlloc(GMEM_MOVABLE Or GMEM_DDESHARE, lSize) If hMem = 0 Or Isnull(hMem) Then Exit Property pMemory = GlobalLock(hMem) If pMemory = 0 Or Isnull(pMemory) Then GlobalFree(hMem) Exit Property End If Call MoveMemory(pMemory, Contents, lSize) Call GlobalUnlock(hMem) If (OpenClipboard(0&) <> 0) Then If (EmptyClipboard() <> 0) Then temp = SetClipboardData(CF_TEXT, hMem) End If temp = CloseClipboard() End If GlobalFree(hMem) End Property ' Ends the "Set" method for the "Contents" property End Class
