%|||%
&|What       |'''ffidl'''|&
&|Where      |http://elf.org/ffidl/|&
&|Where      |http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/doc (dead)|&
&|version    |0.6|&
&|Updated    |??/2006|&
&|Contact    |mailto:rec@elf.org ([Roger E Critchlow%|%Roger E. Critchlow Jr.])|&



** See Also **

   [Ffix - Ffidl eXtented]:   an experimental wrapper to make foreign function calling easier



** Description **

'''ffidl''', "Foreign Function Interface with Dynamic Loading",  by [Roger E
Critchlow], is an [extension] which allows pure Tcl extensions to invoke
functions in shared libraries without having to create any glue code.  Ffidl
supports calls in both directions between C/C++ and Tcl, and operates on a
variety of platforms.

The Tcl command specifies a function name, a library, a list of
argument types, and a return type, and ffidl takes care of the details of
setting up the arguments and invoking the C function.  Using  ffidl, a pure Tcl
wrapper to a shared library can be created. 

Avaliable for [Linux], [Windows], and [Mac OS X].

modifications resulting in version 0.6 were contributed by [DAS].



** Development **

   [https://github.com/prs-de/ffidl%|%git repository]:   Released 0.7 version with Tcl 8.6 support (incorporates [PYK] changes below, compatibility with recent libffi and some cleanups).  Check out the renewed [https://prs-de.github.io/ffidl/%|%documentation]. [APN] Nice to see a new release. From the docs though it is not clear if the new version has support for 64-bit Windows (the original version did not). This is due to the fact, that size of data type ''long ''is 4 bytes even on 64-bit Windows and therefore unsuitable to store and retrieve function pointers.
   [https://chiselapp.com/user/pooryorick/repository/ffidl%|%unofficial fossil repository]:   no releases yet, but some minor fixes have been made.  Unlike 0.6, below, it builds with Tcl-8.6.

Changes to file ffidl.c version 0.7 however let build a properly working binary package for 32-bit Windows as well as for 64-bit Windows, which passes test suite. Verified using
   * Tcl/Tk version 8.6.4.1 installation's header and library files
   * ftp://sourceware.org/pub/libffi%|%libffi%|% library version 3.1.<<br>>Note: Binary built using library version 3.2.1 did not pass test suite.
   * https://sourceforge.net/projects/mingw-w64%|%MinGW-w64 for 32 and 64 bit Windows%|% compilers version 7.2.0.<<br>>Note: Use ''-mlong-double-64'' compiler option as Microsoft's data type ''long double'' is 8 bytes and equal to data type ''double''.

The diff applied to file ffidl.c against version 0.7: 
======none
@@ -540,0 +541 @@ EXTERN int        Ffidl_Init _ANSI_ARGS_((Tcl_I
+#endif
@@ -553 +553,0 @@ EXTERN int        Ffidl_Init _ANSI_ARGS_((Tcl_I
-#endif
@@ -1228 +1228 @@ static int cif_protocol(Tcl_Interp *inte
-#ifdef __WIN32__
+#if defined(__WIN32__) && ! defined(__WIN64__)
@@ -1546 +1546 @@ static void callback_callback(ffi_cif *f
-  long ltmp;
+  Tcl_WideIntOrLong ltmp;
@@ -1616 +1616 @@ static void callback_callback(ffi_cif *f
-      Tcl_ListObjAppendElement(interp, list, Tcl_NewLongObj((long)(*(void **)argp)));
+      Tcl_ListObjAppendElement(interp, list, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)(*(void **)argp)));
@@ -1652 +1652 @@ static void callback_callback(ffi_cif *f
-      ltmp = (long)dtmp;
+      ltmp = (Tcl_WideIntOrLong)dtmp;
@@ -1654 +1654 @@ static void callback_callback(ffi_cif *f
-        if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
+        if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
@@ -1658 +1658 @@ static void callback_callback(ffi_cif *f
-    } else if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
+    } else if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
@@ -1682 +1682 @@ static void callback_callback(ffi_cif *f
-      if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
+      if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
@@ -2257 +2257 @@ static int tcl_ffidl_info(ClientData cli
-    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)interp));
+    Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)interp));
@@ -2400 +2400 @@ static int tcl_ffidl_call(ClientData cli
-  long ltmp;
+  Tcl_WideIntOrLong ltmp;
@@ -2421 +2421 @@ static int tcl_ffidl_call(ClientData cli
-        ltmp = (long)dtmp;
+        ltmp = (Tcl_WideIntOrLong)dtmp;
@@ -2423 +2423 @@ static int tcl_ffidl_call(ClientData cli
-          if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
+            if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
@@ -2425 +2425 @@ static int tcl_ffidl_call(ClientData cli
-      } else if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
+      } else if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
@@ -2441 +2441 @@ static int tcl_ffidl_call(ClientData cli
-        if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
+        if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
@@ -2624 +2624 @@ static int tcl_ffidl_call(ClientData cli
-  case FFIDL_PTR:        Tcl_SetObjResult(interp, Tcl_NewLongObj((long)cif->rvalue.v_pointer)); break;
+  case FFIDL_PTR:        Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)cif->rvalue.v_pointer)); break;
@@ -2647 +2647 @@ static int tcl_ffidl_callout(ClientData
-  long tmp;
+  Tcl_WideIntOrLong tmp;
@@ -2675 +2675 @@ static int tcl_ffidl_callout(ClientData
-  if (Tcl_GetLongFromObj(interp, objv[4], &tmp) == TCL_ERROR) return TCL_ERROR;
+  if (Tcl_GetWideIntOrLongFromObj(interp, objv[4], (Tcl_WideIntOrLong*)&tmp) == TCL_ERROR) return TCL_ERROR;
@@ -2867 +2867 @@ static int tcl_ffidl_symbol(ClientData c
-  Tcl_SetObjResult(interp, Tcl_NewLongObj((long)address));
+  Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)address));
@@ -2938 +2938 @@ static int tcl_ffidl_stubsymbol(ClientDa
-  Tcl_SetObjResult(interp, Tcl_NewLongObj((long)address));
+  Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)address));
======






** Obtaining **

[DAS] - I have updated [Ffidl] to support Darwin/[Mac OS X], as well as modernized it in other ways:
   * updates for 2005 versions of libffi & ffcall
   * TEA 3.2 buildsystem, testsuite
   * support for Tcl 8.4, TclpDlopen, Tcl_WideInt
   * fixes for 64bit LP64
   * callouts & callbacks are created/used relative to current namespace (for unqualified names)
   * addition of [[ffidl::stubsymbol]] for Tcl/Tk symbol resolution via stubs tables
   * callbacks can be called anytime, not just from inside call-outs (using Tcl_BackgroundError to report errors)
the testsuite is just the existing tests wrapped into .test files.

   [http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/doc/%|%updated docs%|%]:   
   [http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/ffidl.tar.gz%|%source tarball%|%]:   
   [http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/ffidl-full.tar.gz%|%full source tarball%|%]:   includes libffi and ffcall sources


For MacOS users, an unofficial update version 0.6.1 can be found at
   * [http://www.categorifiedcoder.info/tcltk/ffidl/ffidl-0.6.1-darwin-9-univ.tar.gz%|%source code%|%]
   * [http://www.tcl.tk/starkits/ffidl0.6.1_ub.tgz%|%MacOS Universal Binary%|%]  (tested on Leopard)

Note that the binary package listed at http://elf.org/ffidl/ does not work on
Tiger/Leopard (? only for PowerPC ?)

A binary package for Win/Linux/Mac, unoficially versioned 0.6.1.1, is available
at the
[http://irrational-numbers.googlecode.com/files/ffidl-0.6.1.1.zip%|%irrational-numbers project%|%]

Note that a little BUG has been fixed ("Ffidlrt.tcl does not work if installed in a path name with whitespaces").

Ffidl either uses unmodified
[http://www.haible.de/bruno/gnu/ffcall-1.10.tar.gz%|%ffcall 1.10%|%] or the
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/libffi.tar.bz2%|%HEAD of
libffi from the gcc CVS%|%] with a
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/libffi.diff%|%small
patch%|%] to the buildsystem to make it build standalone (i.e. without relying
on the gcc sourcetree structure)

Note that libffi is under BSD license but ffcall is GPLd.

[APN]:  In response to a question on c.l.t [DAS] replied: no, ffidl uses either
libffi or ffcall, but never both. If you use my 0.6 update to ffidl, the choice
of libffi vs ffcall is a compile time option (with libffi being the default for
GPL avoidance reasons). A ffidl binary built with the default configure options
(or with -enable-libffi) will contain only BSD licensed code, whereas a ffidl
built with --enable-ffcall will indeed become GPLd as a whole by virtue of
static linking with ffcall. 

[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/ffidl.c.diff%|%The
diff%|%] of ffidl.c against the 0.5 version

[Mac OS X] ffidl binaries (with libffi) are available as tarball
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/binaries/darwin/%|%installer package or tarball%|%].

A [Windows] ffidl binary (with libffi) built with [MinGW] on WIndowsXP in
VirtualPC is now also
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/binaries/windows/Ffidl0.6.zip%|%available%|%].

I have tested & exercised this quite extensively on [Mac OS X] 10.3 (with both
libffi and ffcall), and have verified that it builds and passes the testsuite
on Windows XP with [MinGW] (in Virtual PC on my Mac...).

I have also built ffidl and run the testsuite on all the machines in the
[http://sourceforge.net/docman/display_doc.php?group_id=1&docid=762#hosts%|%sourceforge compilefarm%|%]:

hosts passing the test suite with both libffi and ffcall:
   * amd64-linux1
   * alpha-linux1
   * x86-linux1
   * x86-linux2
   * x86-solaris1
   * x86-freebsd1
   * x86-netbsd1
host core dumping when running the test suite (with both libffi and ffcall):
   * sparc-solaris1
hosts passing the test suite with ffcall, but where building the libffi library fails:
   * x86-openbsd1
   * ppc-osx1
   * ppc-osx2
the last two may be fixable by reverting to an earlier version of libffi


** Code Using Ffidl **

   [always on top]:   

   [http://wiki.tcl.tk/4016%|%wrapper code%|%] for [AutoIt]:   

   [web2desktop]:   [ZLM]: includes an example of using ffidl to set the Windows desktop background.

   [Custom Toplevel Frame]:   [SeS] (26-10-2010): uses Ffidl to access DLL's and create customized toplevel frames in the Windows OS 

   [Collation]:    [bll] 2016-5-20: Uses Ffidl to call setlocale() and wcscoll() to provide a collated sort.

** Example: The Tcl Library **

[PYK] 2014-09-19: In the following example, [Tcl C API] functions are called.
One thing to note is how space for a pointer is passed into `Tcl_GetCwd`.

======
#! /bin/env tclsh

package require Ffidl
namespace eval ::ffidl {
        namespace export *
        namespace ensemble create
}

if {[namespace current] ne {::}} {
        namespace import ::ffidl
}
set tclso libtcl8.6.so
#set tclso libtcl8.5.so
#set tclso [ffidl::find-lib tcl8.6]

set Tcl_CreateInterp_sym [ffidl symbol $tclso Tcl_CreateInterp]
set Tcl_GetCwd_sym [ffidl symbol $tclso Tcl_GetCwd]
set Tcl_InterpDeleted_sym [ffidl symbol $tclso Tcl_InterpDeleted]
set Tcl_GetString_sym [ffidl symbol $tclso Tcl_GetString]
set Tcl_EvalObjEx_sym [ffidl symbol $tclso Tcl_EvalObjEx]

ffidl callout Tcl_CreateInterp {} pointer $Tcl_CreateInterp_sym
ffidl callout Tcl_GetCwd {pointer pointer-var} pointer-utf8 $Tcl_GetCwd_sym
ffidl callout Tcl_InterpDeleted pointer int $Tcl_InterpDeleted_sym
ffidl callout Tcl_GetString pointer-obj pointer-utf8 $Tcl_GetString_sym
ffidl callout TclEvalObjEx {pointer pointer-obj int} int $Tcl_EvalObjEx_sym

set interp [Tcl_CreateInterp]
set script {puts [pwd]}
puts [Tcl_GetString $script]
TclEvalObjEx $interp $script 0
set bufferPtr [binary format [ffidl info format pointer] 0]

set pwd [Tcl_GetCwd $interp bufferPtr] 
puts $pwd
======


** Examples **

   [Getting Windows "special folders" with Ffidl]:   [kostix] offers a solution for getting "special folders" on Windows platforms. While [TWAPI] can do this out-of-the-box, it doesn't work on Win9x and is big. [Ffidl] doesn't have these limitations.

   [calling Fortran routines in a DLL]:   

   [AutoIt]:   ffidl wrapper brought to you by [Michael Jacobsen]

   [Windows Desktop modifications with Ffidl]:   playing around with [Microsoft Windows%|%Windows] desktop properties.


----

from [Rolf Schroedter] on c.l.t

--- file foo.h: ---

======c
int foo_init( int adr, int log );
int foo_done( void );
int foo_info( FOO_INFO *infoPtr ); /* FOO_INFO is a structure */
int foo_open( const char *port );
======

--- file foo.tcl: ---

======
load ffidl05.dll
set DLL foo.dll
ffidl::callout foo_init {int int} int  [ffidl::symbol $DLL foo_init]
ffidl::callout foo_done {} int   [ffidl::symbol $DLL foo_done]
ffidl::callout foo_info {pointer-var} int [ffidl::symbol $DLL foo_info]
ffidl::callout foo_open {pointer-utf8} int [ffidl::symbol $DLL foo_open]
======

----

Explain [Rolf Schroedter]'s [screensaver] [http://groups.google.com/groups?th=ec295f4a4849b362%|%example%|%]

----

======
#Rolf Schroedter
#German Aerospace Center
#Institute of Space Sensor Technology and Planetary Exploration
 
load ffidl05.dll
 
ffidl::callout dll_FindWindow       {pointer-utf8 pointer-utf8} int     [ffidl::symbol user32.dll FindWindowA]
ffidl::callout dll_FindWindowTitle  {int pointer-utf8} int              [ffidl::symbol user32.dll FindWindowA]
ffidl::callout dll_FindWindowClass  {pointer-utf8 int} int              [ffidl::symbol user32.dll FindWindowA]
ffidl::callout dll_SetWindowPos     {int int int int int int int} int   [ffidl::symbol user32.dll SetWindowPos]
ffidl::callout dll_SystemParametersInfo {int int pointer int} int       [ffidl::symbol user32.dll SystemParametersInfoA]

proc FindWindow { class title } {
    if { [string length $class] == 0 } {
        dll_FindWindowTitle 0 $title
    } elseif { [string length $title] == 0 } {
        dll_FindWindowClass $class 0
    } else {
        dll_FindWindow $class $title
    }
}
proc SetWindowPos { hwnd after x y cx cy {flags 0} } {
    array set VAL {TOP 0 BOTTOM 1 TOPMOST -1 NOTOPMOST -2}
    set iAfter $VAL([string toupper $after])
    dll_SetWindowPos $hwnd $iAfter $x $y $cx $cy $flags
}
proc SetupScreenSaver { bool } {
    dll_SystemParametersInfo 97 $bool 0 0   ;# SPI_SCREENSAVERRUNNING=97
}
proc exit? {} {
    set answer [tk_messageBox -message "Really quit?" -type yesno -icon question]
    switch -- $answer {
        yes {
            SetupScreenSaver 0
            exit
        }
        no {}
    }
}
proc ScreenSaver {win} {
    set size(X) [winfo screenwidth .]
    set size(Y) [winfo screenheight .]

    toplevel $win
    wm title $win "TclScreenSaver"     ;# to find the window

    wm overrideredirect $win true
    $win configure -relief flat -bd 0
    $win configure -cursor hand2    ;# Ohne cursor ???

    update idletasks                ;# virtually display $win, allows window to be found
    set hwnd [FindWindow "" "TclScreenSaver"]
    set res1 [SetWindowPos $hwnd TOPMOST 0 0 $size(X) $size(Y)]   ;# ever makes full screen
    set res2 [SetupScreenSaver 1]

    canvas $win.c -background yellow -width $size(X) -height $size(Y) -relief flat -bd 0
    pack $win.c -expand yes -fill both

    focus -force $win

    bind $win <Key> exit?
    bind $win <Motion> {}
}

wm withdraw .
ScreenSaver .scr
======

----

from [Rob Hegt] on c.l.t,  '''Subject: solution for regaining focus from OpTcl hosted ActiveX control''':

======
load lib/ffidl05.dll
ffidl::callout dll_SetFocus {int} int [ffidl::symbol user32.dll SetFocus]
proc GrabFocus {args} {dll_SetFocus [winfo id .]}
======

Then just bind GrabFocus to some event.  In the post he uses <button> .

======
bind . <Button> +GrabFocus
======

** Example:  Using Pointers **

by [daapp]

C declarations:

======c
typedef short           I16;
typedef unsigned short  U16;


I16 _7443_initial(I16 *existCards);
I16 _7443_close(void);
I16 _7443_version_info(I16 CardNo, U16 *HardwareInfo, U16 *SoftwareInfo, U16 *DriverInfo);
I16 _7443_d_output(I16 CardNo, I16 Ch_No, I16 value);
======

Tcl code:
  
======
namespace eval 7443 {
    variable dll_name PPCI7443.dll
  
    ffidl::callout _initial {pointer-var} sint16 \
        [ffidl::symbol $dll_name _7443_initial]

    ffidl::callout close {} void [ffidl::symbol $dll_name _7443_close]
  
    ffidl::callout _version_info {sint16 pointer-var pointer-var pointer-var} \
        sint16 [ffidl::symbol $dll_name _7443_version_info]

    ffidl::callout d_output {sint16 sint16 sint16} sint16 \
          [ffidl::symbol $dll_name _7443_d_output]

}
  
# varName should containt quantity of available cards
proc 7443::initial {varName} {
    upvar $varName existsCards
    set cards [binary format s 0]
    set result [_initial cards]
    binary scan $cards s existsCards
    return $result
}

# return: {errorCode hardwareInfo softwareInfo driverInfo}
proc 7443::version_info {cardNumber} {
    set hardwareInfo [binary format s 0]
    set softwareInfo [binary format s 0]
    set driverInfo   [binary format s 0]
  
    set result [_version_info $cardNumber hardwareInfo softwareInfo driverInfo]

    binary scan $hardwareInfo s hi
    binary scan $softwareInfo s si
    binary scan $driverInfo   s di
  
    return [list $result $hi $si $di]
}
======


** Example: Accessing Carbon API's on [Mac OS X] **

[DAS] - The script below is a brief demo of [Ffidl]'s usefulness for accessing
Carbon APIs on [Mac OS X], in particular it shows a carbon event handler
implemented in tcl.  It also shows how to access Tk APIs via the new
[[::ffidl::stubsymbol]].

The demo installs the the system wide hotkey Cmd-Shift-A, pressing it makes the
blue labelframe flash red.  Note how the hotkey works even with Wish not in
front...

======
#!/bin/sh
#
# Let's ffidl with Carbon HotKeys!
#
# Copyright (c) 2005, Daniel A. Steffen <das@users.sourceforge.net>
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
# 
#\
exec wish $0 "$@"

package require Tk
package require Ffidl

namespace eval carbon {

    ::ffidl::typedef EventHotKeyID {unsigned long} uint32
    ::ffidl::typedef EventTypeSpec uint32 uint32
    ::ffidl::typedef EventTargetRef pointer
    ::ffidl::typedef OSStatus sint32
    
    ::ffidl::callout RegisterEventHotKey {uint32 uint32 EventHotKeyID EventTargetRef \
                                          uint32 pointer-var} OSStatus \
            [::ffidl::symbol Carbon.framework/Carbon RegisterEventHotKey]
    
    ::ffidl::callout GetApplicationEventTarget {} EventTargetRef \
            [::ffidl::symbol Carbon.framework/Carbon GetApplicationEventTarget]
    
    ::ffidl::callout InstallEventHandler {EventTargetRef pointer-proc uint32 pointer-byte \
                                          pointer pointer-var} OSStatus \
            [::ffidl::symbol Carbon.framework/Carbon InstallEventHandler]

    ::ffidl::callout XKeysymToKeycode {pointer {unsigned long}} {unsigned long} \
            [::ffidl::stubsymbol tk intXLibStubs 35]; #XKeysymToKeycode
            
    ::ffidl::callout TkStringToKeysym {pointer-utf8} {unsigned long} \
            [::ffidl::stubsymbol tk intStubs 86]; #TkStringToKeysym
}

proc hotkeyHandler {handlerCallRef event userData} {
    .l configure -bg red
    after 200 .l configure -bg blue
    return 0
}

proc installHotKey {key} {
    labelframe .l -width 100 -height 100 -bg blue
    pack .l

    ::ffidl::callback hotkeyHandler {pointer pointer pointer} OSStatus

    set EventHandlerRef [binary format I 0]
    set res [carbon::InstallEventHandler [carbon::GetApplicationEventTarget] hotkeyHandler 1 \
        [binary format a4I keyb 5] 0 EventHandlerRef]
    if {$res} {puts stderr "InstallEventHandler failed: $res"; exit -1}

    set keycode [expr {[carbon::XKeysymToKeycode 0 [carbon::TkStringToKeysym $key]]>>16}]
    set modifiers [expr {1 << 8 | 1 << 9}]; #Cmd-Shift
    #set modifiers [expr {1 << 8}]; #Cmd
    
    set EventHotKeyRef [binary format I 0]
    set res [carbon::RegisterEventHotKey  $keycode $modifiers [binary format a4I wish 1] \
        [carbon::GetApplicationEventTarget] 0 EventHotKeyRef]
    if {$res} {puts stderr "RegisterEventHotKey failed: $res"; exit -1}
}

installHotKey A
======

----

[DAS] - How to set the application menu name at runtime on [Mac OS X] using
undocumented Apple SPI:

======
package require Tk
package require Ffidl 0.6

::ffidl::callout CPSSetProcessName {pointer-byte pointer-utf8} sint32 \
    [::ffidl::symbol /System/Library/Frameworks/ApplicationServices.framework/Frameworks/CoreGraphics.framework/CoreGraphics CPSSetProcessName]
CPSSetProcessName [binary format I2 {0 2}] "MyCoolApp"
======

and how to show or hide the current application: (also see [tclCarbonProcesses])

======
::ffidl::callout ShowHideProcess {pointer-byte int} sint32 [::ffidl::symbol Carbon.framework/Carbon ShowHideProcess]
ShowHideProcess [binary format I2 {0 2}] 1; #Show
ShowHideProcess [binary format I2 {0 2}] 0; #Hide
======

----

[DAS]: [http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/849ace20fcb95806%|%another example%|%] DAS] for [Mac OS X] in response to a question on [c.l.t.] from Steven Myers

How to set the current application's dock tile from a [png] file (c.f. API docs [http://developer.apple.com/documentation/Carbon/Reference/Dock_Manager/]):

======
#!/bin/sh
#
# Set the Dock Tile from a png file with Ffidl
#
# Copyright (c) 2005, Daniel A. Steffen <das@users.sourceforge.net>
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
# 
#\
exec wish $0 "$@"

package require Tk
package require Ffidl

namespace eval carbon {
    proc api {name argl ret lib} {::ffidl::callout $name $argl $ret \
        [::ffidl::symbol $lib.framework/$lib $name]}
    proc type {name type} {::ffidl::typedef $name $type}
    proc const {name args} {variable {}; eval set [list ($name)] $args}
    
    type OSStatus sint32
    type bool int
    type CFURLRef pointer
    type CGDataProviderRef pointer
    type CGImageRef pointer
    type CGColorRenderingIntent int
    const kCGRenderingIntentDefault 0

    api CFURLCreateFromFileSystemRepresentation {pointer pointer-utf8 \
            int bool} CFURLRef CoreFoundation
    api CFRelease {pointer} void CoreFoundation
    api CGDataProviderCreateWithURL {CFURLRef} CGDataProviderRef \
            ApplicationServices
    api CGImageCreateWithPNGDataProvider {CGDataProviderRef pointer \
            bool CGColorRenderingIntent} CGImageRef ApplicationServices
    api SetApplicationDockTileImage {CGImageRef} OSStatus Carbon

    proc setDockTileToPNG {pngFile} {
        if {[file exists $pngFile]} {
            set url [CFURLCreateFromFileSystemRepresentation 0 $pngFile \
                    [string bytelength $pngFile] 0]
            if {$url} {
                set dp [CGDataProviderCreateWithURL $url]
                if {$dp} {
                    set img [CGImageCreateWithPNGDataProvider $dp 0 1 \
                            [const kCGRenderingIntentDefault]]
                    if {$img} {
                        SetApplicationDockTileImage $img
                        CFRelease $img
                    }
                    CFRelease $dp
                }
                CFRelease $url
            }
        }
    }
}

carbon::setDockTileToPNG test.png
======

----

[DAS] - Yet another [Mac OS X] example on how to find the user's preferred
locale (as set in system preferences 'International') via the CFLocale API:

Note that [kroc] has since found a way to get this info without resorting to
Ffidl: [[exec defaults read NSGlobalDomain AppleLocale]]

======
#!/bin/sh
#
# Ffidling CFLocale
#
# Copyright (c) 2005, Daniel A. Steffen <das@users.sourceforge.net>
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
#
#\
exec tclsh $0 "$@"

package require Ffidl 0.6

namespace eval corefoundation {
    proc api {name argl ret} {::ffidl::callout $name $argl $ret \
        [::ffidl::symbol CoreFoundation.framework/CoreFoundation $name]}
    api CFLocaleCopyCurrent {} pointer
    api CFLocaleGetIdentifier pointer pointer
    api CFStringGetLength pointer sint32
    ::ffidl::typedef CFRange sint32 sint32
    api CFStringGetCharacters {pointer CFRange pointer-var} void
    api CFRelease pointer void

    proc getLocaleIdentifier {} {
        set cfloc [CFLocaleCopyCurrent]
        set cfstr [CFLocaleGetIdentifier $cfloc]
        set len [CFStringGetLength $cfstr]
        set buf [binary format x[expr {2*$len}]]
        set range [binary format [::ffidl::info format CFRange] 0 $len]
        CFStringGetCharacters $cfstr $range buf
        CFRelease $cfloc
        encoding convertfrom unicode $buf
    }
}

puts [corefoundation::getLocaleIdentifier]
======


** Example:  Microsoft's '''net send''' **

[http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netmgmt/netmgmt/netmessagebuffersend.asp%|%A wrapper for the Microsoft API-Call, '''NetMessageBufferSend'''%|%]:

======
package require Ffidl 0.5
ffidl::callout dll_netSend {pointer-utf16 pointer-utf16 pointer-utf16 pointer-utf16 long} long \
                           [ffidl::symbol netapi32.dll NetMessageBufferSend]
proc netSend {dest mesg {srv {}}} {
    set from $::tcl_platform(user)
    # or:
    # set from [info host]
    #  (only these two alternatives seems to work...)
    return [dll_netSend $srv $dest $from $mesg [expr [string length $mesg]*2]]
}
======

This is to send small messages to computers or users or work groups, which will
immediately pop-up on the screen (using NT/2000/XP, if the messenger service is
started, or with DOS/Win3x/9x, if winpopup/netpop.exe is running) - a task
often needed by administrators! Note: The data-type-definitions are somewhat
tricky.... 

With the '''srv''' Argument it is theoretically possible to specify the system
which will perform the sending task - (example: \\machine1), but this involves
some complex security aspects...

** Example: expand a path containing [Microsoft Windows] environment variables **

contributed by [FM]

expand strings like `%ProgramFiles%:

======
ffidl::callout dll_ExpandEnvironmentStringsForUser \
    {int pointer-utf16  pointer-utf16 long} int \
    [ffidl::symbol Userenv.dll ExpandEnvironmentStringsForUserW]

proc {ExpandEnvironmentStringsForUser} {WPath} {
    set TclPath [string repeat \u0000 300]
    if [dll_ExpandEnvironmentStringsForUser 0 $WPath $TclPath 300] {
        set ix [string first \u0000 $TclPath]
        if {$ix > 0} {
            return [string range $TclPath 0 [expr {$ix - 1}]]
        } else {
            return {}
        }
    } else {
        return {}
    }
}
======

let's try it:

======
ExpandEnvironmentStringsForUser {%ProgramFiles%\windows media player\wmplayer.exe}
======

result:

======none
C:\Program Files\windows media player\wmplayer.exe
======

** Misc **

[DLR] Including ffidl in the core would be a huge boost to Tcl, and specially,
Tcllib, as many modules could be written in pure Tcl. Part of the success of
[Mono]/[.NET] is its [P/Invoke] feature which allows it to effortlessly wrap
native libraries. The Mono implementation uses (or at least used to do) ffidl
at its core. 

[Lectus]: This is a must have functionality in Tcl. Any chance of moving it to
core?

** See Also **

   [TWAPI]:   an alternative to ffidl for accessing the Win32API
   [critcl]:   provides an alternative approach for "calling functions in arbitrary dynamic libraries"
[http://www.equi4.com/critlib/dyncall.README].
   [Yet another dll caller]:   provides advanced data type handling over FFidl in a Windows-only version. 
The examples are quite impressive. [RT]


----
'''[vinniyo] - 2014-03-06 19:54:56'''

Hello, Im trying to use crypt32.dll without success. Could someone provide assistance? Thank you!
======
package require Ffidl
set handle [ffidl::symbol [file join C:/ Windows System32 crypt32.dll] CryptProtectData]
ffidl::callout CryptProtectData_callout {pointer-utf8 pointer-utf8 pointer-utf8 pointer-utf8 pointer-utf8 int pointer-utf8} int $handle stdcall

proc CryptProtectData {data} {
    set value ""
    if [CryptProtectData_callout $data NULL NULL 0 NULL 0 $value] {
        puts $value
    } else {
        puts "crypt returned 0: $value"
        return {}
    }
}

CryptProtectData "hello how are you"
======

------
[Tim Tomkinson%|%TLT%|%] 2014-07-23 - This is a fairly complicated example of Ffidl. It demonstrates the following techniques:

   * Using typedefs to simplify the code and increase portability.
   * Using the Ffidlrt helper routines [[::ffidl::get-bytearray-from-obj]] and [[::ffidl::new-bytearray]].
   * Allocating space for output data structures with [[[binary format] x]] and [[::ffidl::info sizeof]].
   * Converting structures with [[::ffidl::info format]].
   * Passing NULL pointers.

The input and output arguments to CryptProtectData() and CryptUnprotectData() are pointers to DATA_BLOBs, which are themselves structures. The Ffidlrt command get-bytearray-from-obj is used to get a pointer to the data, which is then stored in the DATA_BLOB along with its length. After calling the functions, the output DATA_BLOBs are converted back into Tcl byte-arrays using new-bytearray.

======
# Encrypts and decrypts data using CryptProtectData() and CryptUnprotectData().

package require Ffidl
package require Ffidlrt

# typedefs
::ffidl::typedef DWORD     {unsigned long}
::ffidl::typedef BOOL      int
::ffidl::typedef DATA_BLOB DWORD pointer

# function declarations
::ffidl::callout CryptProtectData {pointer-byte pointer pointer pointer pointer DWORD pointer-var} BOOL \
    [ffidl::symbol crypt32.dll CryptProtectData] stdcall
::ffidl::callout CryptUnprotectData {pointer-byte pointer pointer pointer pointer DWORD pointer-var} BOOL \
    [ffidl::symbol crypt32.dll CryptUnprotectData] stdcall

proc cryptProtectData {data} {

    # Get a pointer to the data.
    set dataLen [binary format n 0]
    set bData [::ffidl::get-bytearray-from-obj $data dataLen]

    # Initialize the input DATA_BLOB.
    set dataIn [binary format [::ffidl::info format DATA_BLOB] [string length $data] $bData]

    # Initialize the output DATA_BLOB.
    set dataOut [binary format x[::ffidl::info sizeof DATA_BLOB]]

    # Call CryptProtectData().
    set CRYPTPROTECT_LOCAL_MACHINE 0x4
    set status [CryptProtectData $dataIn 0 0 0 0 $CRYPTPROTECT_LOCAL_MACHINE dataOut]
    if {$status == 0} {
        error "CryptProtectData error"
    } else {

        # Convert the output DATA_BLOB to a byte-array.
        binary scan $dataOut [::ffidl::info format DATA_BLOB] cbData bData
        set result [::ffidl::new-bytearray $bData $cbData]
        return $result
    }
}

proc cryptUnprotectData {data} {

    # Get a pointer to the data.
    set dataLen [binary format n 0]
    set bData [::ffidl::get-bytearray-from-obj $data dataLen]

    # Initialize the input DATA_BLOB.
    set dataIn [binary format [::ffidl::info format DATA_BLOB] [string length $data] $bData]

    # Initialize the output DATA_BLOB.
    set dataOut [binary format x[::ffidl::info sizeof DATA_BLOB]]

    # Call CryptUnprotectData().
    set status [CryptUnprotectData $dataIn 0 0 0 0 0 dataOut]
    if {$status == 0} {
        error "CryptUnprotectData error"
    } else {

        # Convert the output DATA_BLOB to a byte-array.
        binary scan $dataOut [::ffidl::info format DATA_BLOB] cbData bData
        set result [::ffidl::new-bytearray $bData $cbData]
        return $result
    }
}

set result [cryptProtectData "hello how are you"]
puts [cryptUnprotectData $result]
======
------
[YS] 2014-09-14: I've noticed that ffidl (ffidlrt, actually) doesn't work in starkits or starpacks on Windows. I needed it to work, so applied this ugly hack to ffidlrt.tcl:
======
...
namespace eval ::ffidl:: {
    set ffidl_lib [find-pkg-lib Ffidl]
      #HORRIBLE HACK goes here <<<:
      set CopyTo [file dirname $::starkit::topdir]
      file copy -force $ffidl_lib $CopyTo
      set ffidl_lib [file join $CopyTo [file tail $ffidl_lib]]
      unset CopyTo
      #>>>
======

----
'''[Boltar] - 2015-09-07 11:08:09'''

i just started using ffidel to access a dll from a middleware and run into some small problems which I hope one of you can clearify for me

Inside the dll there is a function '''myVersion ''' which returns a long value and sets the version information inside the parameter '''szVersion''' (so szVersion is an out Parameter):
======
long myVersion (char szVersion[257])
======

I first tried to define the variable callout like this:
======
set szVersion [binary format [::ffidl::info format char]257 [lrepeat 257 0x20]]

ffidl::callout _MyVersion {char} long [ffidl::symbol $DLL myVersion] stdcall
set result [_MyVersion $szVersion]
======

But this didn't work. The error msg tells me, that an integer value was assumed but the function got "     ".
Therefore I tried different approches but none of them worked. With the following one I don't get an error, but I still don't get the Version (szVersion still is filled with 257 spaces):
======
set szVersion [binary format [::ffidl::info format char]257 [lrepeat 257 0x20]]

ffidl::callout _MyVersion {pointer-obj} long [ffidl::symbol $DLL myVersion] stdcall
set result [_MyVersion szVersion]
binary scan $szVersion a* szVersion
======
The function return 10 (which is defined as OK) but the variable szVersion still doesn't have the Version info.

Additionally what should I do if I have an in parameter which is defined as follows
======
char szXMLAdditionalParameters[513]
======

How can I alloc the size for it (like above?) and set the needed Information string inside it. 

I'm stuck at this point. I guess that  I'm not seeing the wood for the trees 

Thanks in advance!

<<categories>> Package | Foreign Interfaces | Mac | Windows