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