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
Post Views: 13

4 thoughts on “LS/API ClipBoard Code for 32/64Bit”

  1. Hi,

    SetClipboard64() fails on 14 .0 FP1

    here…

    If GlobalUnlock(hGlobalMemory) 0 Then
    MsgBox “Could not unlock memory location. Copy aborted.”

    I tried switching GlobalUnlock for GlobalUnlock_64 but still failed.

    Any suggestions would be gratefully received.

  2. I have tested in my environment (Notes 12.0.2FP3 & 14.0.0FP1), and everything works as expected.
    You do not have to make a call into SetClipBoard64() explicitly.
    All you have to do is to call into setClipBoard and getClipBoard on 32 and 64 Bit. The code ‘knows’ where to go from there.

  3. Thanks for trying Ulrich. I am calling SetClipBoard and it then calls SetClipBoard64() when using R14.

    I’ve managed to get passed the “Could not unlock memory location” error by updating SetClipboard64 to use the _64 calls (see below).
    Now I don’t get an error at all, but nothing is added to the Windows clipboard either!

    Function SetClipboard64(txt As String)

    Dim session As New NotesSession
    session.UseDoubleAsPointer = True

    Dim hGlobalMemory As Double
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    Dim X As Long

    hGlobalMemory = GlobalAlloc_64(GHND, Len(txt) + 1)
    lpGlobalMemory = GlobalLock_64(hGlobalMemory)
    lpGlobalMemory = lstrcpy(lpGlobalMemory, txt)

    If GlobalUnlock_64(hGlobalMemory) 0 Then
    MsgBox “Could not unlock memory location. Copy aborted.”
    GoTo OutOfHere2
    End If

    If OpenClipboard_64(0&) = 0 Then
    MsgBox “Could not open the Clipboard. Copy aborted.”
    Exit Function
    End If

    X = EmptyClipboard()
    hClipMemory = SetClipboardData_64(CF_TEXT, hGlobalMemory)

    OutOfHere2:
    If CloseClipboard_64() = 0 Then
    MsgBox “Could not close Clipboard.”
    End If
    session.UseDoubleAsPointer = False
    End Function

  4. Sorted now. Couldn’t get the above to work so I’m using the code below which I’ve tested in 32 bit R9 and R12 and 64 bit R14.

    Sub SetClipboardText(ByVal Text As Variant)
    Dim obj As Variant
    Set obj = CreateObject(“htmlfile”)
    Call obj.ParentWindow.ClipboardData.SetData(“Text”, Text)
    End sub

    Function GetClipBoardText() As String
    On Error Resume Next
    Dim obj As Variant
    Set obj = CreateObject(“htmlfile”)
    GetClipBoardText = obj.ParentWindow.ClipboardData.getData(“Text”)
    End Function

    Sub ClearClipBoardText()
    Dim obj As Variant
    Set obj = CreateObject(“htmlfile”)
    Call obj.ParentWindow.ClipboardData.clearData(“Text”)
    End sub

Comments are closed.