LS/API ClipBoard Code for 32/64Bit
When HCL introduced the 64 Bit Notes Client, the code to set and get data from the clipboard stopped working.
Here is some updated code. It works on HCL Notes 14 64 Bit. I have not tested on V12 64 bit, but it should work on this version too.
%REM
Library lib_clipboard32-64
Created Mar 4, 2024 by francesco@marzolo.com
Modified Mar 5, 2024 by Ulrich Krause
Description: Allows 64-32 bitness clipboard managing
%END REM
Option Public
Option Declare
Const CF_UNICODETEXT = 13
Const CF_TEXT = 1
Const OS_TRANSLATE_UNICODE_TO_LMBCS = 23
Const LSI_THREAD_PROC=1
Const LSI_THREAD_CALLPROC=10
Public Const GHND = &H42
'** 32-bit API calls
Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32.dll" () As Long
Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat 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
Declare Function OSTranslateFromPtr Lib "nnotes.dll" Alias "OSTranslate" ( _
ByVal mode As Integer, _
ByVal strIn As Long, _
ByVal lenIn As Integer, _
ByVal strOut As LMBCS String, _
ByVal lenOut As Integer ) As Integer
'** 64-bit API calls
Declare Function OpenClipboard_64 Lib "user32.dll" Alias "OpenClipboard" (ByVal hwnd As double) As Long '** hwnd is a window handle
Declare Function GetClipboardData_64 Lib "user32.dll" Alias "GetClipboardData" (ByVal wFormat As Long) As Double '** returns a memory handle
Declare Function CloseClipboard_64 Lib "user32.dll" Alias "CloseClipboard" () As Long
Declare Function GlobalLock_64 Lib "kernel32.dll" Alias "GlobalLock" (ByVal hMem As Double) As Double '** hMem is a memory handle, returns a pointer
Declare Function GlobalUnlock_64 Lib "kernel32.dll" Alias "GlobalUnlock" (ByVal hMem As Double) As Long '** hMem is a memory handle, returns a BOOL
Declare Function GlobalSize_64 Lib "kernel32.dll" Alias "GlobalSize" (ByVal hMem As Double) As Long '** hMem is a memory handle, returns a size
Declare Function OSTranslateFromPtr_64 Lib "nnotes.dll" Alias "OSTranslate" ( _
ByVal mode As Integer, _
ByVal strIn As Double, _ '** strIn is a string pointer
ByVal lenIn As Integer, _
ByVal strOut As LMBCS String, _
ByVal lenOut As Integer ) As Integer
'to set clipboard
Private Const GMEM_MOVEABLE = &H40
Private Const GMEM_ZEROINIT = &H2
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long '** returns a memory handle
Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As String) As Long
Declare Function GlobalAlloc_64 Lib "kernel32" Alias "GlobalAlloc" (ByVal wFlags As Long, ByVal dwBytes As Long) As Double '** returns a memory handle
Declare Function NEMGetCurrentSubprogramWindow Lib "nnotesws.dll" () As Long
Declare Function SetClipboardData_64 Lib "user32" Alias "SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Double) As Long
Sub Initialize
End Sub
Sub Terminate
End Sub
Public Function GetClipboard() As String
Dim session As New NotesSession
If (session.Platform = "Windows/64") Then
GetClipboard = GetClipboard64()
Exit Function
End If
Dim glbHandle As Long
Dim cbPointer As Long
Dim cbPointerLen As Long
Dim cbString As String
If OpenClipboard(0) Then
glbHandle = GetClipboardData(CF_UNICODETEXT)
cbPointer = GlobalLock(glbHandle)
cbPointerLen = GlobalSize(glbHandle)
cbString = Space(cbPointerLen)
Call OSTranslateFromPtr( OS_TRANSLATE_UNICODE_TO_LMBCS, _
cbPointer, cbPointerLen, cbString, cbPointerLen )
cbString = StrLeft(cbString, Chr(0))
Call GlobalUnlock(glbHandle)
Call CloseClipboard()
End If
GetClipboard = cbString
End Function
Public Sub SetClipboard(txt As String)
Dim session As New NotesSession
If (session.Platform = "Windows/64") Then
SetClipboard64(txt)
Exit Sub
End If
Dim hwnd As Long
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim ret As Long
On Error GoTo error_handler
' Get a handle to current window
hwnd = NEMGetCurrentSubProgramWindow()
If hwnd Then
' Allocate memory
hGlobalMemory = GlobalAlloc(CLng(GMEM_MOVEABLE Or GMEM_ZEROINIT),CLng(Len(txt)+1))
If hGlobalMemory Then
lpGlobalMemory = GlobalLock(hGlobalMemory)
If lpGlobalMemory Then
ret = lstrcpy(lpGlobalMemory, txt)
Call GlobalUnlock(hGlobalMemory)
If OpenClipboard(hwnd) Then
ret = EmptyClipboard()
ret = SetClipboardData(CF_TEXT, hGlobalMemory)
ret = CloseClipboard()
End If
Else
MsgBox "Can't allocated global memory pointer.", 32, "Error"
End If
Else
MsgBox "Can't allocated global memory handle.", 32, "Error"
End If
Else
MsgBox "Can't get window handle.", 32, "Error"
End If
Exit Sub
error_handler:
Print "Error: " + Error$(Err)
Resume Next
End Sub
Function describeError() As String
describeError=Error & " (at row " & Erl & " of " & GetThreadInfo(LSI_THREAD_CALLPROC) & ")"
End Function
Function GetClipboard64() As String
On Error GoTo sbreng
Dim session As New NotesSession
session.UseDoubleAsPointer = True
Dim glbHandle_64 As Double
Dim cbPointer_64 As Double
Dim cbPointerLen As Long
Dim cbString As String
If OpenClipboard_64(0) Then
glbHandle_64 = GetClipboardData_64(CF_UNICODETEXT)
cbPointer_64 = GlobalLock_64(glbHandle_64)
cbPointerLen = GlobalSize_64(glbHandle_64)
cbString = Space(cbPointerLen)
Call OSTranslateFromPtr_64( OS_TRANSLATE_UNICODE_TO_LMBCS, cbPointer_64, cbPointerLen, cbString, cbPointerLen )
cbString = StrLeft(cbString, Chr(0))
Call GlobalUnlock_64(glbHandle_64)
Call CloseClipboard_64()
End If
GetClipboard64=cbString
endop:
session.UseDoubleAsPointer = False
Exit Function
sbreng:
Dim errmsg$
errmsg$="Error: " & Err & ", call stack: " & describeerror()
Print errmsg
'ensure you execute anyway useDoubleAsPointer=False
Resume endop
End Function
Function SetClipboard64(txt As String)
Dim session As New NotesSession
session.UseDoubleAsPointer = True
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long
Dim X As Long
hGlobalMemory = GlobalAlloc(GHND, Len(txt) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, txt)
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
X = EmptyClipboard()
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
session.UseDoubleAsPointer = False
End Function
