CFFI和win32剪贴板访问

Question

我是Common Lisp的新手，在上面做了一些实验。我正在努力访问windows剪贴板，然后我发现了这个参考:

https://groups.google.com/forum/!主题/comp.lang.lisp hyNqn2QhUY0

这是完美的，除了它是为clip FFI量身定制的，我希望它与CFFI一起工作。然后我试图转换代码，部分成功，但有一个问题与例程(get-clip-string)，在WinXP上测试Clozure CL 1.10 (!):

测试文本:Have Space Suit-Will Travel

?(get-clip-string)

错误:值"Have Space Suit-Will Travel"不是预期的类型(UNSIGNED-BYTE 32)。在进程监听器(1)中执行GLOBAL-LOCK-STRING时。键入: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))

…然后问题就解决了。

如果你想使用set-clip-string，你还需要修复其他global-lock-*函数和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调用都可能失败，但是你的代码不会检查失败或处理错误。