Text from clipboard

[William James]

Code Select Expand


(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]

#(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.

[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]

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 )

;

[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 Expand


...
(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)
...