LotusScript ClipBoard Code für 32/64 Bit

[eknori]

Hier gab es schon ein paar Einträge, dass der "alte" Clipboard Code unter 64 Bit teilweise nicht mehr funktioniert. Gestern gab es in einem anderen Forum ebenfalls die gleiche Diskussion.
Ich habe mir das heute einmal näher angesehen.

Hier eine funktionierende Variante

Code

%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

[Tode]

Fantastisch, danke Ulrich! Thomas Bahn hatte das im HCL Support Forum auch gefragt, habe die Lösung von dort aber nie ausprobiert...

[eknori]

Die Lösung von Thomas unter https://support.hcltechsw.com/community?id=community_question&sys_id=6d7817641be3b59cddcd75d4cc4bcb9b&anchor=answer_0da2f4871b6b3958534c4159cc4bcb20&view_source=searchResult
funktioniert auch

[jBubbleBoy]

Im Zusammenhang mit der 64-Bit-Umstellung habe ich eine einfache Alternative für die Abfrage der Zwischenablage unter Windows gefunden:

Code

Call setClipboardString("Test-ABC")	
MsgBox getClipboardString()

Sub setClipboardString(cTxt As String)
	Dim clipboard As Variant, txt_ As Variant
	Set clipboard = CreateObject("htmlfile")
	txt_ = cTxt
	Call clipboard.ParentWindow.ClipboardData.SetData("Text", txt_)
End Sub
	
Function getClipboardString As string
	Dim clipboard As Variant
	Set clipboard = CreateObject("htmlfile")

	getClipboardString = clipboard.ParentWindow.ClipboardData.getData("Text")
End Function

[PromITheus]

Erik, habe den Code zwar in leicht abgewandelter Form im Einsatz, kann das aber bestätigen.
Der Code ist sehr schlank und läuft sowohl auf 64 bit- sowohl auch auf 32 bit Clients. Top!

[jBubbleBoy]

Ja wenn alle so einfach wäre

Diese Lösung konnte ich einer KI entlocken, für Notes-DLL's gibt es solche Möglichkeiten nicht, hier muss man mit notesSession.UseDoubleAsPointer arbeiten und die Pointer auf double ändern. Bei meinen Recherchen bin ich sogar auf eine Quelle gestoßen in der die Variante mit CreateObject("htmlfile") genannt wird:
https://support.hcl-software.com/community?id=community_question&sys_id=6d7817641be3b59cddcd75d4cc4bcb9b

Bei der 64-Bit-Umstellung waren fast alle KI's hilflos, nun arbeitet HCL anscheinend an einem domänenspezifischen Sprachmodell, mal sehen ob und wie das zum Einsatz kommt. Bis dahin muss alles manuell umgesetzt werden, hilfreich ist dabei die Domino C-API: https://github.com/HCL-TECH-SOFTWARE/domino-c-api-docs um zu prüfen was ein Pointer ist oder auch nicht.

[AlexZX]

Hallo,

eine weitere Möglichkeit ist es über Java zu lösen.

Zuerst eine Java Klasse mit der zugehörigen Methode in einer Java Scriptbibliothek erstellen

Code

public class Clipboard {
	public static void copyStringToClipboard(String text) {
		try {
			java.awt.datatransfer.StringSelection selection = new java.awt.datatransfer.StringSelection(text);
			java.awt.datatransfer.Clipboard clipboard = java.awt.Toolkit.getDefaultToolkit().getSystemClipboard();
			clipboard.setContents(selection, selection);
		} catch(Exception e) {
			e.printStackTrace();
		}
	}
}

Danach über LS2J auf diese Java Methode aus dem LotusScript zugreifen:

Code

Uselsx "*javacon"
Use "ScriptsJava"

Sub CopyTextToClipboard(text As String)
	
	On Error Goto ErrorHandler
	
	Dim js As JavaSession
	Dim clipboardClass As JavaClass
	Dim clipboardObject As JavaObject
	Dim copyStringToClipboard As JavaMethod
	
	If Fulltrim(text) <> "" Then
		Set js = New JavaSession
		Set clipboardClass = js.GetClass("Clipboard")
		Set copyStringToClipboard = clipboardClass.GetMethod("copyStringToClipboard", "(Ljava/lang/String;)V")
		Set clipboardObject = clipboardClass.CreateObject()
		
		Call copyStringToClipboard.Invoke(clipboardObject, text)
	End If
	
ExitSub:
	Exit Sub
	
ErrorHandler:
	Messagebox "Fehler: " & Err & " - " & Error$ & Chr(13) & Chr(10) & "Sub: CopyTextToClipboard" & Chr(13) & Chr(10) & "Line: " & Erl, 16, "Text in Zwischenablage kopieren"
	Resume ExitSub
End Sub

Entsprechend kann man auch Text aus der Zwischenablage auslesen:

Code

public class Clipboard {
	public static String getStringFromClipboard() {
		String text = "";

		try {
			java.awt.datatransfer.Clipboard clipboard = java.awt.Toolkit.getDefaultToolkit().getSystemClipboard();
			text = (String)clipboard.getData(java.awt.datatransfer.DataFlavor.stringFlavor);
		} catch(Exception e) {
			text = "";
			e.printStackTrace();
		}

		return text;
	}
}

Code

Uselsx "*javacon"
Use "ScriptsJava"

Function GetStringFromClipboard() As String
	
	On Error Goto ErrorHandler
	
	Dim js As JavaSession
	Dim clipboardClass As JavaClass
	Dim clipboardObject As JavaObject
	Dim getStringFromClipboard As JavaMethod
	
	Dim text As String
	
	Set js = New JavaSession
	Set clipboardClass = js.GetClass("Clipboard")
	Set getStringFromClipboard = clipboardClass.GetMethod("getStringFromClipboard", "()Ljava/lang/String;")
	Set clipboardObject = clipboardClass.CreateObject()
	
	text = getStringFromClipboard.Invoke(clipboardObject)
	
ExitFunction:
	GetStringFromClipboard = text
	Exit Sub
	
ErrorHandler:
	text = ""
	Messagebox "Fehler: " & Err & " - " & Error$ & Chr(13) & Chr(10) & "Function: GetStringFromClipboard" & Chr(13) & Chr(10) & "Line: " & Erl, 16, "Text aus der Zwischenablage lesen"
	Resume ExitFunction
End Sub

Ist bei mir in einigen Datenbanken im Einsatzt, bisher ohne Prohleme.

Gruß
Alex