FFI: 外部ライブラリ関数の呼び出し

Scheme

MzScheme では (MzScheme に限りませんが)、外部ライブラリの API 関数を呼び出す FFI (Foreign Function Interface) という仕組みが提供されています。

今回は、zip ファイルを解凍するプログラムと、Winamp を REPL で制御する例をご紹介します。

UNZIP dll の呼び出し

統合アーカイバプロジェクトの UNZIP32.dll を使います。

まず、

(require (lib "foreign.ss"))
(unsafe!)

のように最初に必ず unsafe! 宣言をしておきます。

次に、ライブラリをロードします。

(define libunzip (ffi-lib "UNZIP32"))

拡張子は自動で補われます。絶対パスでも指定できますが、この場合 UNZIP32.dll がライブラリの検索パスに入っている必要があります。環境変数 $PATH 内のディレクトリであれば大丈夫です。

そして、API 関数を get-ffi-obj 関数と _fun マクロによって

(define UnZipGetVersion
  (get-ffi-obj "UnZipGetVersion" libunzip
               (_fun -> _int)))

のようにして定義していきます。

取得したい関数名を文字列 (またはバイト列かシンボル) で、関数の型を "type1 type2 ... -> result-type" という書式で指定します。

この例では引数無しで戻り値は整数型、という指定になっています。

ただ、一つひとつこのように定義していくのが面倒なので、マクロを書いてみました。

(define-syntax define-api
  (syntax-rules ()
    ((_ lib (func type) ...)
     (define-values (func ...)
       (let ((the-lib lib))
         (values (get-ffi-obj 'func the-lib (_fun . type))
                 ...))))))

これにより、一括して API 関数を定義できるようになります:

(define-api (ffi-lib "UNZIP32")
  (UnZip ((_long = 0) _string _bytes _int -> _int))
  (UnZipGetRunning (-> _int))
  (UnZipGetVersion (-> _int))
  (UnZipGetSubVersion (-> _int))
  (UnZipGetFileCount (_string -> _int))
  ...)

ここで、(type = expr) のような書式は、予め引数を束縛しておくことを意味します。したがって、関数呼び出し時は引数の数が一つ減ることになります。この例はウィンドウ・ハンドルとして NULL を渡しているところです。

さらに他の書式の例として、UnZip (解凍を行う関数) のちょっと豪華版を作ってみました:

(UnZip ((_long = 0)
        _string
        (buf : _bytes = (make-bytes 4096))
        (_int = (bytes-length buf))
        -> (res : _int)
        -> (values res
                   (let ((in (open-input-bytes buf)))
                     (lambda ()
                       (define (read) (read-bytes-line in 'any))
                       (let lp ((l (read)))
                         (unless (or (eof-object? l)
                                     (= (bytes-ref l 0) 0))
                           (display l)
                           (newline)
                           (lp (read)))))))))

(name : type) で値に名前を付けて、後から Scheme の変数として参照できるという例です。buf が解凍状況を示すメッセージが入るバッファ (LPSTR 型)、res は戻り値です。

また、戻り値の型指定 "-> (res : _int)" の後にさらに戻り値を指定できることに注目してください。ここでは本来の戻り値と、バッファの内容表示を行う thunk を返しています。

この定義に基づいた zip 解凍関数は次のようになります:

(define extract-zip
  (opt-lambda (file (where #f))
    (define-values (res mes)
      (UnZip (format "-xv -n --i -qq -s \"~a\"~a"
                     file
                     (if where
                         (format " \"~a\"" where)
                         ""))))
    (mes)
    res))

UnZip が 1 引数関数になっているのがお分かりでしょう。

extract-zip の利用例です。

(extract-zip "c:/path/to/archive.zip" "d:/")

第 2 引数はオプションで、解凍先ディレクトリを指定します。無ければカレント・ディレクトリに解凍されます。

Windows API による Winamp 制御

Windows の SendMessageA という API 関数を用いて Windows アプリにメッセージを送る例をお見せします。

今度は user32.dll というライブラリを呼び出します:

(define-api (ffi-lib "user32")
  (FindWindowA ((className : _string)
                (windowName : _string)
                -> _long))
  (SendMessageA ((hwnd : _long)
                 (wMsg : _long)
                 (wParam : _long)
                 (lParam : _long)
                 -> _long)))

FindWindowA によってアプリケーションのウィンドウ・ハンドルを取得し、それに対してメッセージを送る、という流れになります。

Winamp のハンドルを取得する関数はこのように定義できます:

(define (winamp-handle)
  (let ((handle (FindWindowA "Winamp v1.x" #f)))
    (and (> handle 0) handle)))

"Winamp v1.x" というのは Winamp のバージョンに関わらず固定されているものです。

現在演奏中かどうかを調べるには SendMessageA を使って次のようにメッセージを送ります:

(define (playing?)
  (cond ((winamp-handle)
         => (lambda (handle)
              (= (SendMessageA handle 1024 2 104) 1)))
        (else #f)))

1 が返って来れば演奏中です (0 は停止中、3 はポーズ中を表します)。

演奏、停止その他のコマンドを表すメッセージは次のような形式になっています:

(SendMessageA handle #x111 command-code 0)

次のようにクロージャを使ってコマンド・メーカーを作るのが楽そうです:

(define (winamp-controller code)
  (lambda ()
    (cond ((winamp-handle)
           => (cut SendMessageA <> #x111 code 0)))))

(define play (winamp-controller 40045))
...

これも、一つひとつ定義するのは面倒なので、マクロを使いましょう。

(define-syntax define-controller
  (syntax-rules ()
    ((_ (cmd code) ...)
     (define-values (cmd ...)
       (values (winamp-controller code) ...)))))

ざっとこんな感じで、基本的なコマンドは揃います:

(define-controller
  (prev     40044)
  (play     40045)
  (pause    40046)
  (stop     40047)
  (next     40048)
  (vol-up   40058)
  (vol-down 40059)
  (forward  40060)
  (rewind   40061))

もうこの時点で、Scheme の REPL 上で (play) とか (stop) とかを打ち込んで Winamp を操作できるようになっています。

さらに一工夫して、Winamp が起動していなければ起動し、自動的に演奏を開始する関数も作ってみましょう。

(define winamp-path "c:/Program Files/Winamp/winamp.exe")

(define (start-winamp)
  (or (winamp-handle)
      (letrec ((poll (lambda ()
                       (or (winamp-handle)
                           (begin (sleep 1) (poll))))))
        (system* (find-executable-path "start.exe" #f)
                 winamp-path)
        (poll))))

"process.ss" という標準ライブラリにある system* 関数を使っています。普通に system (これも同ライブラリにあり、1 引数関数です) で起動すると、winamp を終了するまで Scheme 側に制御が戻らないんですね。このため、start というコマンドを使って起動する必要があるのです。

つづき:

(define (play-winamp)
  (or (playing?)
      (and (start-winamp) (play))))

(play-winamp)

すでに演奏中であれば何もせず、そうでなければ起動・演奏を行う関数が出来上がりました。


以上、比較的簡単な例をご紹介しましたが、他にも C の構造体を作れたり等々、高度な C API プログラミングを純粋に Scheme だけで行うことができます。夢が広がりますね！


参考文献:
http://www.geekpedia.com/tutorial27_Winamp-basic-controls.html
http://www.perlmonks.org/?node_id=176838


追記:

Winamp の実行についてですが、ShellExecute 関数を利用する方法もありました。

(define-api (ffi-lib "shell32")
  (ShellExecuteA ((hwnd : _uint)
                  (lpOperation : _string)
                  (lpFile : _string)
                  (lpParameters : _string)
                  (lpDirectory : _string)
                  (nShowCmd : _int)
                  -> _int)))

(defnie SW_SHOWMINNOACTIVE 7)

(define (execute-winamp)
  (ShellExecuteA 0 "open" winamp-path #f #f SW_SHOWMINNOACTIVE))

こっちの方が、フォアグランドに表示しない、等の細かい制御が利くので便利ですね。


さらに追記:

うっかり忘れていたんですが、Windows 版 MzScheme には組み込みで shell-execute という関数が用意されていました。引数は ShellExecuteA とほぼ同じです:

(shell-execute "open" winamp-path "" "c:" 'SW_SHOWMINNOACTIVE)

大変失礼しました…