CFFI 和 win32 剪贴板访问

Question

我是 Common Lisp 的新手，并对其进行了一些实验。我试图获得对 windows 剪贴板的一些访问权限，然后我找到了这个参考：

https://groups.google.com/forum/#!topic/comp.lang.lisp/hyNqn2QhUY0

那太完美了，除了它是为 CLISP FFI 量身定制的，我希望它能与 CFFI 一起使用。然后我尝试转换代码，部分成功但是例程有问题（get-clip-string），在 WinXP 上使用 Clozure CL 1.10 进行测试（！）：

测试文本：有Space适合旅行

？（获取剪辑字符串）

Error: The value "Have Space Suit-Will Travel" is not of the expected type (UNSIGNED-BYTE 32). While executing: GLOBAL-LOCK-STRING, in process listener(1). Type :POP to abort, :R for a list of available restarts. Type :? for other options.

我想我没有在 CFFI 上得到类型的东西（虽然我已经阅读了手册），或者在 CLISP 上的原始处方。有人有什么提示吗？以下命令序列有效，但恐怕不安全：

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

(打开剪辑 0) （获取剪辑 1） (关闭剪辑 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 的 return 类型以及您用于 GlobalLock 和 GlobalUnlock 的参数类型中。你定义GetClipboardData到return一个字符串，但是在C中，GetClipboardDatareturn是一个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-* 函数，如果您想使用 set-clip-string，还需要修复 memcpy。

但是还有另一个错误：当您对整个程序进行类型更正以便 set-clip-string 函数也可以被调用时，set-clip-string 似乎只能将字符串放到Lisp 进程本地的剪贴板（我在 Win7 上通过 SLIME 使用控制台构建的 SBCL）。假设您使用记事本将 Have Space Suit-Will Travel 复制到剪贴板。然后试试这个：

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

所以它似乎奏效了。但是，如果您尝试使用 ShiftIns 从剪贴板粘贴到 EMACS，您会得到：

CL-USER> Have Space Suit-Will Travel

所以真正的剪贴板仍然有记事本放在那里的东西，而你的Lisp程序只有一个私人剪贴板，不能用来复制数据到其他程序，甚至托管它的 EMACS 会话。

发生这种情况是因为 set-clip-string 需要在调用 open-clip 之后调用 empty-clip。

此外，这些 Windows 调用中的每一个都可能失败，但您的代码不会检查失败或处理错误。

CFFI 和 win32 剪贴板访问

CFFI and win32 clipboard access

winapi

common-lisp

cffi