Text from clipboard

Machine-specific discussion
Unix, Linux, OS X, OS/2, Windows, ..?
Locked
William James
Posts: 58
Joined: Sat Jun 10, 2006 5:34 am

Text from clipboard

Post by William James »

Code: Select all

(context 'Clipboard)

(constant 'CF_TEXT 1)

(import "user32.DLL" "GetClipboardData")
(import "user32.DLL" "OpenClipboard")
(import "user32.DLL" "CloseClipboard")
# (import "user32.DLL" "SetClipboardData")

(import "kernel32.DLL" "GlobalLock")
(import "kernel32.DLL" "GlobalUnlock")


(define (get-text , result global_handle ptr)
  (set 'result "")
  (if (= 0 (OpenClipboard 0))
    (thow-error "Can't open clipboard."))
  (set 'global_handle (GetClipboardData CF_TEXT))
  (if (!= global_handle 0)
    (begin
      (set 'ptr (GlobalLock global_handle))
      (set 'result (get-string ptr))
      (GlobalUnlock global_handle)
    ))
  (CloseClipboard)
  result )

(context MAIN)

CaveGuy
Posts: 112
Joined: Sun Oct 13, 2002 3:00 pm
Location: Columbus Ohio
Contact:

(get-text example using SetClipboardData wanted.

Post by CaveGuy »

#(import "user32.DLL" "SetClipboardData") was conveniently commented out in the (get-text example and I am beginning to understand why.

I need to be able to put modified text back to the clipboard and I am not sure how to setup the result string to make the SetClipboardData function happy.

# If result is not nil than it is copied to the Clipboard otherwise operates the same as the (get-text example.
;
(define (get-put-text result)
.........

Any help will be appreciated.
Last edited by CaveGuy on Fri Jun 19, 2009 4:39 pm, edited 1 time in total.
Bob the Caveguy aka Lord High Fixer.

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

just a guess:

(set 'global_handle (GetClipboardData CF_TEXT))
(set 'myString "hello world")
(set 'ptr (GlobalLock global_handle))
(cpymem myString ptr (length myString))
(SetClipboardData CF_TEXT global_handle)

CaveGuy
Posts: 112
Joined: Sun Oct 13, 2002 3:00 pm
Location: Columbus Ohio
Contact:

(get-put-text [new_text]) New ClipBoard example

Post by CaveGuy »

Got it ! - It works even on a 2003 application server ...
; If new_text is present and not nil, it replaces the current contents of the Clipboard.

(constant 'CF_TEXT 1)
;
(import "user32.DLL" "GetClipboardData")
(import "user32.DLL" "EmptyClipboard")
(import "user32.DLL" "OpenClipboard")
(import "user32.DLL" "CloseClipboard")
(import "user32.DLL" "SetClipboardData")
;
(import "kernel32.DLL" "GlobalAlloc")
(import "kernel32.DLL" "GlobalLock")
(import "kernel32.DLL" "GlobalUnlock")
(import "kernel32.DLL" "GlobalFree")

;
;
(define (get-put-text new_text , result global_handle global_new_handle ptr)
(if (not new_text) (set 'new_text ""))
(if (= 0 (OpenClipboard 0))
(thow-error "Can't open clipboard."))
(set 'global_handle (GetClipboardData CF_TEXT))
(if (!= global_handle 0)
(if (= "" new_text)
(begin
(set 'ptr (GlobalLock global_handle))
(set 'result (get-string ptr))
(GlobalUnlock global_handle)
(CloseClipboard))
(begin
(EmptyClipboard)
(set 'global_new_handle (GlobalAlloc 0 (+ (length new_text) 1)))
(set 'wptr (GlobalLock global_new_handle))
(cpymem new_text wptr (length new_text))
(GlobalUnlock global_new_handle)
(set 'result (SetClipboardData CF_TEXT global_new_handle))
(CloseClipboard)
(GlobalFree global_new_handle)
)))
result )
;
Bob the Caveguy aka Lord High Fixer.

northern_witch
Posts: 2
Joined: Fri Mar 05, 2010 10:16 pm

Re: Text from clipboard

Post by northern_witch »

Fine func, but sometimes works, sometimes crashes any app (Windows 7 says module w/ error is StackHash…) where i'm trying to paste after putting to clipboard using this code. Any ideas?
P.S. Locale switching, may be useful for somebody:

Code: Select all

…
(constant 'CF_LOCALE 16)
(constant 'LocaleID (pack "u" 0x419))
…
(EmptyClipboard)
(set 'global_new_handle (GlobalAlloc 0 (+ (length new_text) 1)))
(set 'global_new_handle_locale (GlobalAlloc 0 4))
(set 'wptr (GlobalLock global_new_handle))
(set 'wptr_locale (GlobalLock global_new_handle_locale))
(cpymem new_text wptr (length new_text))
(cpymem LocaleID wptr_locale 4)
(GlobalUnlock global_new_handle)
(GlobalUnlock global_new_handle_locale)
(set 'result (SetClipboardData CF_TEXT global_new_handle))
(SetClipboardData CF_LOCALE global_new_handle_locale)
(CloseClipboard)
(GlobalFree global_new_handle)
(GlobalFree global_new_handle_locale)
…

Locked