CFFI и win32 доступ к буферу обмена

Question

Я новичок в Common Lisp и провел несколько экспериментов на нем. Я изо всех сил пытался получить доступ к буферу обмена Windows, а затем я нашел эту ссылку:

https://groups.google.com/forum/

Это было прекрасно, за исключением того, что оно было адаптировано для CLISP FFI, и я хотел, чтобы он работал с CFFI. Затем я попытался преобразовать код и частично преуспел, но есть проблема с подпрограммой (get-clip-string), тестирующей с Clozure CL 1.10 на WinXP(!):

Тестовый текст: имейте скафандр-будет путешествовать

? (Получить-клип-строка)

Ошибка: значение "Have Space-Suit-Will Travel" не соответствует ожидаемому типу (UNSIGNED-BYTE 32). Во время выполнения: GLOBAL-LOCK-STRING, в обработчике процесса (1). Введите:POP для отмены,:R для получения списка доступных перезапусков. Тип:? для других вариантов.

Я думаю, что я не получил ничего типового на CFFI (хотя я прочитал руководство), или оригинальное предписание на CLISP. у кого-нибудь есть подсказка? следующая последовательность команд работает, но я боюсь, что это не безопасно:

(open-clip 0)
(get-clip 1)
(close-clip 0)

(open-clip 0) (get-clip 1) (close-clip 0)

вот код:

(ql:quickload :cffi)


(cffi:load-foreign-library "user32.dll")

(cffi:load-foreign-library "kernel32.dll")

(cffi:load-foreign-library "msvcrt.dll")


(cffi:defcfun ("GetClipboardData" get-clip) :string

(uformat  :unsigned-int))


(cffi:defcfun ("OpenClipboard" open-clip) :int

  (hOwner  :unsigned-int))


(cffi:defcfun ("CloseClipboard" close-clip) :int


      (hOwner  :unsigned-int))


(cffi:defcfun ("EmptyClipboard" empty-clip) :int)


(cffi:defcfun ("SetClipboardData" set-clip) :int

  (data  :unsigned-int)

  (format :unsigned-int))


(cffi:defcfun ("GlobalAlloc" global-alloc) :int

  (flags  :unsigned-int)

  (numbytes :unsigned-int))


(cffi:defcfun ("GlobalLock" global-lock) :unsigned-int

  (typ  :unsigned-int))


(cffi:defcfun ("GlobalLock" global-lock-string) :string 

  (typ  :unsigned-int))


(cffi:defcfun ("GlobalUnlock" global-unlock) :int

  (typ  :unsigned-int))


(cffi:defcfun ("memcpy" memcpy) :int

  (dest  :unsigned-int)

  (src :string) 

  (coun :unsigned-int))



(defun get-clip-string ()

          (open-clip 0)

          (let* ((h (get-clip 1)) (s (global-lock-string h)))

                 (global-unlock h) (close-clip 0) s))


(defun set-clip-string (s)

          (let* ((slen (+ 1 (length s)))(newh (global-alloc 8194 slen))

(newp (global-lock newh)))

          (memcpy newp s (+ 1 slen)) (global-unlock newh) (open-clip 0)

(set-clip 1 newh) (close-clip 0)))

Answer 1

Ошибка в типе возврата, который вы использовали для GetClipboardData и тип аргумента, который вы использовали для GlobalLock а также GlobalUnlock, Вы определяете GetClipboardData вернуть строку, но в C, GetClipboardData возвращает HANDLE, который определяется как указатель на voidи аргумент, принятый GlobalLock а также GlobalUnlock также HANDLE, Измените ваши определения функции C на это:

(cffi:defcfun ("GetClipboardData" get-clip) :pointer
    (uformat  :unsigned-int))

(cffi:defcfun ("GlobalLock" global-lock-string) :string 
    (type  :pointer))

(cffi:defcfun ("GlobalUnlock" global-unlock) :int
    (type  :pointer))

... и проблема уходит.

Вы также должны исправить другой global-lock-* функции, а также memcpy если вы хотите использовать set-clip-string,

Однако есть еще одна ошибка: когда вы вводите всю программу, set-clip-string Функция также может быть вызвана, то set-clip-string только кажется, что можно поместить строку в буфер обмена, который является локальным для процесса Lisp (я использую консольную сборку SBCL через SLIME на Win7). Предположим, вы скопировали Have Space Suit-Will Travel в буфер обмена с помощью блокнота. Тогда попробуйте это:

CL-USER> (set-clip-string "MY CLIPBOARD")
1
CL-USER> (get-clip-string)
"MY CLIPBOARD"

Так что, похоже, сработало. Но затем, если вы попытаетесь вставить в EMACS из буфера обмена с помощью ShiftIns, вы получите:

CL-USER> Have Space Suit-Will Travel

Таким образом, в реальном буфере все еще есть то, что положил туда Блокнот, а в вашей программе на Лисп есть только личный буфер обмена, который нельзя использовать для копирования данных в другие программы, даже в сеанс EMACS, на котором он размещен.

Это происходит потому, что set-clip-string нужно позвонить empty-clip после звонка open-clip,

Кроме того, каждый из этих вызовов Windows может потерпеть неудачу, но ваш код не проверяет ошибки и не обрабатывает ошибки.