Solved

Calling Delphi 32-bit DLL from 16 bit Borland C

Posted on 1997-07-15
5
725 Views
Last Modified: 2010-04-06
I've got some Delphi 3 functions, that I would like to call from a 16-bit Borland C program, running on Windows 95 or Windows NT.

Does anyone have examples on know how to do that ?
The C program has to be 16-bit, so just compling the c-program to 16-bit is not an option.
0
Comment
Question by:hustch
  • 2
  • 2
5 Comments
 
LVL 2

Expert Comment

by:icampbe1
ID: 1338909
There are two approaches you can take.

1) Wrap your 32bit dll routines up into an automation wrapper.  When the 16bit app uses it, the cross platform is handled by the marshalling mechanism.  This may not be your best solution though, and is somewhat cumbersome.

2) Use 'Generic' thunking.   It enables 16-bit apps to call 32-bit dlls under Win95 and NT.  This is your most flexible approach (although you haven't said very much.)

Cheers
Ian C
0
 
LVL 1

Author Comment

by:hustch
ID: 1338910
>> (although you haven't said very much.)
Well, neither have you, What do you need to know ?
0
 
LVL 5

Expert Comment

by:ronit051397
ID: 1338911
Is a delphi code (How to use a 32 bit DLL with 16 bit Delphi)
 will help you?
0
 
LVL 1

Author Comment

by:hustch
ID: 1338912
If it works by calling windows api function, I don't think
there should be any problem converting it to c.
0
 
LVL 5

Accepted Solution

by:
ronit051397 earned 200 total points
ID: 1338913
This an answer from Lloyd's Delphi Help File. I assume you can translate it to C:

Q:  How do I use a 32 bit DLL with 16 bit Delphi?

A:  Here is something that I got from compuserve that looks good:

 CALL32nt.pas: Library for Delphi/TPW/BPW to call 32 bit functions in Windows NT or Windows 95

Adapted to Pascal by Christian Ghisler from CALL32.DLL, a DLL for Visual Basic  written and placed in the Public Domain by Peter Golde

This unit is placed in the public domain. Please feel free to redistribute as you wish.   No guarantees are made as to its suitability or usefulness, and no support can be provided.

 

To call a function in a 32-bit DLL, follow these steps:
 
 1. Declare the function you wish to call. Declare it in the ordinary fashion, with the following exceptions:
 
 >  Declare it as a function variable >  Add an additional argument at the end, of type Longint:
 
 For example, if you are calling the function:  (C code)
 
    GetWindowText(HWND hwnd, LPSTR lpsz, int cch)
 
 declare it as follows (remember that ints and all handles are 32 bits, so use a Longint):

 
    var GetWindowText:function(hwnd:Longint;lpsz:PChar;cch:longint;id:Longint):Longint;
 
 2. Each function needs an identifier to distinguish the function from other called functions. Declare this identifier in a var block.

For the above example:

    var id_GetWindowText:longint;

 3. In the initialization section of your application, set the  address of the called function to the address of Call32:

    @GetWindowtext:=@Call32;

 4. Also in the initialization section of your application, declare the actual library and name of the function you

 want to call with the Declare32 function. Pass it the name of the function (CASE SENSITIVE!!!), the library name, and a string describing the argument types.
 
 Each letter in the string declares the type of one argument, and should be either "i" for a 32-bit integer or handle
 type, "p" for any pointer type, or "w" for an HWND parameter to which you want to pass a 16-bit HWND and have it be automatically converted to a 32-bit HWND. Save the return value of Declare32 in a global variable to pass as the last parameter to the function you declared earlier. So, in continuing the example, you would call:

 
   id_GetWindowText:=Declare32('GetWindowText','user32','wpi');
 
 (As a side note, this more properly would be declared as 'GetWindowTextA', since this is the real exported name. However, Declare32 will automatically add an 'A' to the end of a function name if necessary.)
 
 To call the function, you would call:
 
   cbCopy:=GetWindowText(hwnd, sz, cb, id_GetWindowText);
 
 It is important to use the correct data types when calling DLL functions. There are two important points to pay

 attention to when using CALL32NT.PAS.
 
 First, only 32-bit integers can be passed to a DLL procedure. Since virtually all 32-bit functions take int, UINT, LONG, DWORD, or HANDLE parameters, which are all 32 bits, this is not a major restriction. However, you must remember to always declare function arguments as Longint, not Integer.
 
 Second, 16-bit handles and 32-bit handles are not interchangeable. For example, a 16-bit bitmap handle that you get from calling a 16-bit DLL or from the Delphi/TPW environment cannot be passed to a 32-bit function expecting a bitmap handle. Similarly, a 32-bit handle obtained from a 32-bit function cannot be passed to a 16- bit DLL. The only exception is window handles (HWND). If you declare a function parameter with the "w" letter in the argument description string passed to Declare32, the corresponding parameter will be automatically converted from a 16-bit HWND to a 32-bit HWND when the call is made. You must still declare the argument as a LONG. This is convenient, for example, when passing the value returned by the "handle" property of a form/control to a 32-bit DLL function. Only windows created by your application can be translated.

 
 The following is a summary of data types:
 
 C data type    Type specified in Declare   Character for Declare32
   int, UINT           Longint                   i
   LONG, DWORD         Longint                   i
   HANDLE              Longint                   i
   WORD, short         not supported
   HWND                Longint                   w (i for no 16->32 translation)
   LPSTR               PChar                     p
   LPLONG, LPDWORD,
   LPUINT, int FAR *   VAR x:Longint             p

   LPWORD              VAR x:Word                p
 
 Note on Declare32 function names: Declare32 will automatically try three different names for the function name you pass in. First, it uses the exact name you pass in. If it doesn't find that function name, it converts the name to the stdcall decorated name convention by adding an underscore at the beginning and adding "@nn" at the end, where "nn" is the number of bytes of arguments. If it doesn't find that name, it adds an "A" to the end of the original name to try the Win32(R) ANSI function calling convention.

 If there occurs an error in Declare32, the returned id will be less than 0. Also, the variable Call32NTError will be set, so you only have to check one variable to check that all went well. You can use this variable to distinguish between Windows 3.1 and Windows NT/95: if Call32NTError is false, you can use the declared 32-bit functions, otherwise you must use 16-bit replacement functions. This allows you to write programs which work in both 16 and 32 bit environments.

 If you have to pass a record containing a pointer, you must use the function GetVDMPointer32W to create a 0:32 pointer from your 16:16 pointer.

 CALL32NT requires the Microsoft Windows NT operating system or Windows 95 Preview or later to perform its task. The program will also run in Win 3.1, but of course the functions will not work.


Unit Call32nt;
{Delphi/TPW/BPW Unit to call 32-bit functions from 16 bit programs}
{Written in Turbo Pascal for Windows 1.5 /Delphi}

{By Christian Ghisler, CIS: 100332,1175         }
{Released to the public domain on June 14,1995  }

{$W-}
{No Windows Stack frame!}
{$R-}
{No range checking!}

{
Translation by Christian Ghisler, from:
//----------------------------------------------------------
// CALL32.C
//
// This creates a DLL for 16-bit Visual Basic programs to
// call 32-bit DLLs on Windows NT 3.1.  It uses the
// Generic Thunks feature of the WOW subsystem on Windows
// NT to load and call 32 bit DLLs.  This file should

// be compile into a 16-bit DLL.
//
// Writted by Peter Golde.
//----------------------------------------------------------
}
interface

uses wintypes,
     winprocs,
     {$ifdef ver80}sysutils {$else} strings {$endif};

const Call32NTError:boolean=false;

type tPROC32ENTRY=record
    hinst:longint;      { 32-bit instance handle of library                  }
    lpfunc:tfarproc;    { 32-bit function address of function                }
    dwAddrXlat,         { bit mask of params: 1 indicates arg is address     }

    dwHwndXlat,         { bit mask of params: 1 indicates arg is 16-bit hwnd }
    nParams:longint;    { number of parameters                               }
  end;
  pPROC32ENTRY=^tPROC32ENTRY;
  tPROC32LIST=array[0..0] of tPROC32ENTRY;
  pPROC32LIST=^tPROC32LIST;

{ rgProc32Entry points to an array of PROC32ENTRY functions, which
  is grown as needed.  The value returned by Declare32 is an
  index into this array.}
const
  cRegistered:integer=0;          { number of registered functions. }

  cAlloc:integer=0;               { number of alloced PROC32ENTRY structures. }
  rgPROC32ENTRY:pPROC32LIST=nil;  { array of PROC32ENTRY structures. }
  CALLOCGROW=10;                  { number of entries to grow rgProc32Entry by}
  rgProc32handle:thandle=0;       { Handle auf globalen Speicherbereich f|r rgProc32Entry }

{ These are the addresses of the Generic Thunk functions in
  the WOW KERNEL.}  
  fGotProcs:bool=FALSE;        { Did we successfully get the addresses? }

var
  Callproc32W:function (address:pointer;n,c:longint):longint;
  FreeLibrary32W:function(handle:longint):bool;
  GetProcAddress32W:function(module:longint;funcname:pchar):pointer;
  LoadLibraryEx32W:function(libname:pchar;a,b:longint):longint;
  lpvGetLastError:function:pchar;
  lpvGetCapture:pointer;

procedure Call32(iProc:longint);
function Declare32(lpstrName,lpstrLib,lpstrArg:pchar):longint;
function GetVDMPointer32W(name:pchar;Length:word):longint;    {Get 32-bit pointer from 16-bit pointer and length}

implementation



{/-----------------------------------------------------
// XlatHwnd
//   Translates a 16-bit HWND into a 32-bit HWND.
//   The HWND must be one in our 16-bit process.
//   NULL is translated to NULL and doesn't cause
//   and error.
//
//   Unfortunately, WOW does not export a function
//   for doing this, so our procedure is as follows:
//   We do 16-bit SetCapture call to the window
//   to set the capture, and then a 32-bit GetCapture

//   call to get the 32-bit equivalent handle.  The
//   capture is then restored to what it was beforehand.
//
//   May cause VB runtime error, and hence never return.
//-----------------------------------------------------}
procedure XlatHwnd(var phwnd:longint);
var hwnd16,
    hwndCapturePrev:word;
    hwnd32,
    hinstUser:longint;

begin
  hwnd16:=LOWORD(phwnd);         { 16-bit hwnd }

  { Check for valid 16-bit handle. }  
  if (phwnd<>word(hwnd16)) then exit;

  if (hwnd16<>0) and not IsWindow(hwnd16) then exit;

  { Get Address of 32-bit GetCapture }
  if (@lpvGetCapture=nil) then begin
    hinstUser:=LoadLibraryEx32W('user32', 0, 0);
    if (hinstUser<>0) then begin
      lpvGetCapture:=GetProcAddress32W(hinstUser, 'GetCapture');
      FreeLibrary32W(hinstUser);
    end;
    if (@lpvGetCapture=nil) then exit;
  end;

 
  {/ Set capture to window, get capture to get 32-bit handle.
  // Be sure to restore capture afterward.

  // NULL isn't translated }
 
  if (hwnd16<>0) then begin
    hwndCapturePrev:=SetCapture(hwnd16);
    hwnd32:=CallProc32W(lpvGetCapture,0,0);
    if (hwndCapturePrev<>0) then
      SetCapture(hwndCapturePrev)
    else
      ReleaseCapture;
    if (hwnd32=0) then exit;
  end;

  phwnd:=hwnd32;
end;

{/-----------------------------------------------------
// MungeArgs
//   Modify the args array so it can be passed to
//   to CallProc32W.  This uses the PROC32ENTRY structure

//   to set up the arg list correctly on the stack
//   so CallProc32W can be call.  HWND translation is
//   performed.  The frame is changed as follows:
//           In:                 Out:
//            unused              number of params
//   dwArgs-> unused              address xlat mask
//            PROC32ENTRY index   32-bit function address.
//            argument            argument, possible HWND xlated
//            argument            argument, possible HWND xlated

//            ...                 ...
//-----------------------------------------------------}
type plongint=^longint;
     pfarproc=^tfarproc;
procedure MungeArgs(dwArgs:longint);
var pentry:pPROC32ENTRY;
    iArg:integer;
    dwHwndXlat:longint;

begin
  pentry:=@rgProc32Entry^[plongint(dwArgs+4)^];
  iArg:=2;

  plongint(dwArgs-4)^:=pentry^.nParams;
  plongint(dwArgs)^:=pentry^.dwAddrXlat;
  pfarproc(dwArgs+4)^:=pentry^.lpfunc;
  dwHwndXlat:=pentry^.dwHwndXlat;

  while (dwHwndXlat<>0) do begin
    if (dwHwndXlat and 1)<>0 then
    XlatHwnd(plongint(dwArgs+4*iArg)^);
    inc(iArg);
    dwHwndXlat:=dwHwndXlat shr 1;
  end;
end;

{/-----------------------------------------------------
// Call32
//   This function is called by applications directly.
//   Arguments to the function are also on the stack
//   (iProc is the PROC32ENTRY index).  We correctly
//   set up the stack frame, then JUMP to CallProc32W,
//   which eventually returns to the user.

//-----------------------------------------------------}

var dest:tfarproc;          {Destination for jump back!}
var addit:word;             {value to add to sp to restore stack pointer}
var _sp,_bp:word;

procedure Call32(iProc:longint);
begin
  if iProc<0 then begin      {Procedure is invalid -> stop execution!}
    if messagebox(0,'Error calling 32 bit function, continue?','Call32',
      mb_yesno or mb_iconquestion)=idno then halt(1);
    addit:=(-iProc) shl 2;  {4 more for id!}

    asm
      mov sp,bp
      pop bp
      pop di
      mov word(dest),di
      pop di
      mov word(dest+2),di
      add sp,addit
      xor ax,ax             {return 0}
      xor dx,dx
      jmp dest
    end;
  end;

  asm                       { here comes the thunking call! }
    pop     bp              { restore BP }
    mov     bx, sp          { bx = sp on entry }
    sub     sp, 8           { 2 additional words }
    mov     ax, ss:[bx]     { ax = return address offst }

    mov     dx, ss:[bx+2]   { dx = return address segment }
    mov     ss:[bx-8], ax
    mov     ss:[bx-6], dx
    push    ds              { Save our DS }
    push    ss
    push    bx              { Push pointer to args }
    call    MungeArgs       { Munge the args }
    pop     es              { es is our DS }
    jmp    CallProc32W      { Jump to the call thunker }
  end;
end;
 
{/-----------------------------------------------------
// Declare32
//   This function is called directly from VB.

//   It allocates and fills in a PROC32ENTRY structure
//   so that we can call the 32 bit function.
//-----------------------------------------------------}
function Declare32(lpstrName,lpstrLib,lpstrArg:pchar):longint;
var
  hinst:longint;                   { 32-bit DLL instance handle }
  lpfunc:pointer;                  { 32-bit function pointer    }
  dwAddrXlat,                      { address xlat mask          }
  dwHwndXlat,                      { hwnd xlat mask             }

  nParams:longint;                 { number of params           }
  szBuffer:array[0..127] of char;  { scratch buffer             }
  hinstKernel:word;                { Instance handle of WOW KERNEL.DLL }
  hinstKernel32:longint;           { Instance handle of Win32 KERNEL32.DLL }
  rg:record
    lpstrName:pchar;
    nparams:longint;
  end;
  olderror:boolean;                { Was there an error before?}

begin
  {/ First time called, get the addresses of the Generic Thunk

  // functions.  Raise VB runtime error if can't (probably because
  // we're not running on NT). }
  olderror:=Call32NTError;
  Call32NTError:=true;
  Declare32:=-1-lstrlen(lpstrArg);
  if not fGotProcs then begin
    hinstKernel:=LoadLibrary('KERNEL');
    if (hinstKernel < 32) then exit;

    @CallProc32W:=GetProcAddress(hinstKernel, 'CALLPROC32W');
    @FreeLibrary32W:=GetProcAddress(hinstKernel, 'FREELIBRARY32W');
    @LoadLibraryEx32W:=GetProcAddress(hinstKernel, 'LOADLIBRARYEX32W');

    @GetProcAddress32W:=GetProcAddress(hinstKernel, 'GETPROCADDRESS32W');
    FreeLibrary(hinstKernel);

    if (@LoadLibraryEx32W<>nil) and (@GetProcAddress32W<>nil) and (@FreeLibrary32W<>nil) then begin
      hinstKernel32:=LoadLibraryEx32W('kernel32', 0, 0);
      @lpvGetLastError:=GetProcAddress32W(hinstKernel32, 'GetLastError');
      FreeLibrary32W(hinstKernel);
    end;

    if (@CallProc32W=nil) or (@FreeLibrary32W=nil) or (@LoadLibraryEx32W=nil) or
       (@GetProcAddress32W=nil) or (@lpvGetLastError=nil) then begin

      exit;
    end;
    fGotProcs:=TRUE;
  end;  

  { If needed, allocate a PROC32ENTRY structure }
  if (cRegistered = cAlloc) then begin
    if (rgProc32Entry<>nil) then begin
      globalunlock(rgProc32handle);
      rgProc32handle:=GlobalReAlloc(rgProc32handle,
                       (cAlloc + CALLOCGROW) * sizeof(tPROC32ENTRY), GMEM_MOVEABLE);
      rgProc32Entry:=Globallock(rgProc32handle);
    end else begin
      rgProc32handle:=GlobalAlloc(GMEM_MOVEABLE, CALLOCGROW * sizeof(tPROC32ENTRY));

      rgProc32Entry:=Globallock(rgProc32handle);
    end;
    if (rgProc32Entry=nil) then exit;
    inc(cAlloc,CALLOCGROW);
  end;
 
  {/ Process the arg list descriptor string to
  // get the hwnd and addr translation masks, and the
  // number of args. }

  dwAddrXlat:=0;
  dwHwndXlat:=0;
  nParams:=lstrlen(lpstrArg);
  if (nParams > 32) then exit;  {Too many parameters}

  while (lpstrArg[0]<>#0) do begin
    dwAddrXlat:=dwAddrXlat shl 1;
    dwHwndXlat:=dwHwndXlat shl 1;

    case lpstrArg[0] of
      'p':dwAddrXlat:=dwAddrXlat or 1;
      'i': ;
      'w':dwHwndXlat:=dwHwndXlat or 1;
    else
      exit;
    end;
    inc(lpstrArg);
  end;

  {/ Load the 32-bit library. }
  hinst:=LoadLibraryEx32W(lpstrLib, 0, 0);
  if (hinst=0) then begin
    exit;
  end;
 
  {/ Get the 32-bit function address.  Try the following three
  // variations of the name (example: NAME):
  //    NAME
  //    _NAME@nn     (stdcall naming convention: nn is bytes of args)

  //    NAMEA        (Win32 ANSI function naming convention) }
  lpfunc:=GetProcAddress32W(hinst, lpstrName);
  if (lpfunc=nil) and (lstrlen(lpstrName) < 122) then begin
    { Change to stdcall naming convention. }
    rg.lpstrName:=lpstrName;
    rg.nparams:=nParams * 4;
    wvsprintf(szBuffer, '_%s@%d', rg);
    lpfunc:=GetProcAddress32W(hinst, szBuffer);
  end;  
  if (lpfunc=nil) and (lstrlen(lpstrName) < 126) then begin
    { Add suffix "A" for ansi }
    strcopy(szBuffer, lpstrName);

    strcat(szBuffer, 'A');
    lpfunc:=GetProcAddress32W(hinst, szBuffer);
  end;
  if (lpfunc=nil) then begin
    FreeLibrary32W(hinst);
    exit;
  end;
 
  {/ Fill in PROC32ENTRY struct and return index. }
  rgProc32Entry^[cRegistered].hinst:=hinst;
  rgProc32Entry^[cRegistered].lpfunc:=lpfunc;
  rgProc32Entry^[cRegistered].dwAddrXlat:=dwAddrXlat;
  rgProc32Entry^[cRegistered].dwHwndXlat:=dwHwndXlat;
  rgProc32Entry^[cRegistered].nParams:=nParams;
  Declare32:=cRegistered;

  inc(cRegistered);
  Call32NTError:=olderror;  {If there was no error, set Call32NTErrorOccurred to false}
end;

function GetVDMPointer32W(name:pchar;Length:word):longint;
var lpGetVDMPointer32W:function(name:pchar;UINT:word):longint;
begin
  @lpGetVDMPointer32W:=getProcAddress(GetModuleHandle('kernel'),'GetVDMPointer32W');
  if @lpGetVDMPointer32W<>nil then
    GetVDMPointer32W:=lpGetVDMPointer32W(name,Length)
  else
    GetVDMPointer32W:=0;
end;

{/-----------------------------------------------------

// WEP
//   Called when DLL is unloaded.  We free all the
//   32-bit DLLs we were using and clear the
//   PROC32ENTRY list.
//-----------------------------------------------------}
var exitsave:tfarproc;

procedure cleanuplibs; far;
begin
  Exitproc:=Exitsave;
  dec(cRegistered);
  while (cRegistered >= 0) do begin
    FreeLibrary32W(rgProc32Entry^[cRegistered].hinst);
    dec(cregistered);
  end;
  if (rgProc32Entry<>nil) then begin
    globalunlock(rgProc32handle);

    GlobalFree(rgProc32handle);
  end;
  rgProc32Entry:=NIL;
  rgProc32handle:=0;
  cRegistered:=0;
  cAlloc:=0;
end;

begin
  @Callproc32W:=nil;
  @FreeLibrary32W:=nil;
  @GetProcAddress32W:=nil;
  @LoadLibraryEx32W:=nil;
  @lpvGetLastError:=nil;
  lpvGetCapture:=nil;
  exitsave:=exitproc;      
  exitproc:=@cleanuplibs;
end.

{This code came from Lloyd's help file!}
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now