Un exemple complet : DLL pour ADES connecté à la prise imprimante (1e prise parallèle)

(retour au menu programmation 32 bits)
 

(programmation en Delphi 5 d'une DLL pour ADES)
(programmation des DLL en FreePascal)
(programmation en C++Builder 4 d'une DLL pour un appareil fictif)
(programmation des DLL en PureBasic)

Programmation en Delphi 5 d'une DLL pour ADES (connecté à la prise imprimante, 1e prise parallèle)

library xadestar;

uses
  adesunit,sysutils,wintypes;

type array100= array[0..100] of char;
type pdouble=^double;
var memosb:array[0..3]of boolean;
    memosad:double;

function stdea(n:integer):integer;stdcall;export;
var o,n1,n2:word;
begin
  o:=n;
  stdea:=-777;
  if (n=0)or(n=1)then lit_niveau(n1,n2);
  case o of 0: stdea:=n1;
            1: stdea:=n2;
            2: ades_off;
            3: ades_on;
            end;
end;

function stdnea(n:integer):pchar;stdcall;export;
begin
if (n=0)
    then stdnea:='E. analogique 0'+chr(0)
      else if n=1 then stdnea:='E. analogique 1'+chr(0)
      else if n=2 then stdnea:='RAZ pour impression'+chr(0)
             else if n=3 then stdnea:='Réinitialisation'+chr(0)
    else stdnea:=chr(0);
end;

function stdead(n:word):double;stdcall;export;
var aux:integer;
begin
  if (n=0) or (n=1)or (n=2) or (n=3)
     then begin aux:=stdea(n); stdead:=(5.0*aux)/1024; end
     else stdead:=-777;
end;

function stdnead(n:integer):pchar;stdcall;export;
begin
  if (n=0)
    then stdnead:='E. analogique 0'+chr(0)
      else if n=1 then stdnead:='E. analogique 1'+chr(0)
      else if n=2 then stdnead:='RAZ pour impression'+chr(0)
             else if n=3 then stdnead:='Réinitialisation'+chr(0)
    else stdnead:=chr(0);
end;

function stdsa(n:integer; valeur:integer):integer;stdcall;export;
begin
 stdsa:=-777; (*Ades n'a pas de sortie analogique*)
end;

function stdnsa(n:word):pchar;stdcall;export;
begin
if n=0 then  stdnsa:='SA fictive'+chr(0) else stdnsa:=''+chr(0);
end;

function stdsad(n:integer ; valeur:double):double;stdcall;export;
begin
MEMOsad:=valeur; stdsad:=0;
end;

function stdnsad(n:integer):pchar;stdcall;export;
begin
   if n=0 then stdnsad:='SA fictive'+chr(0)else stdnsad:=''+chr(0);
end;

function stdrsa(n:integer):integer;stdcall;export;
begin       (*état de la sortie analogique fictive*)
if n=0 then stdrsa:=2 else stdrsa:=-777;
end;

function stdrsad(n:integer):double;stdcall;export;
begin
  if n=0 then stdrsad:=2 else stdrsad:=-777;
end;
 

function stdeb(n:integer):integer;stdcall;export;
begin  (*entrées logiques fictives, inexistantes sur ADES*)
 if n=0 then stdeb:=0 else if n=1 then stdeb:=1 else stdeb:=-777;
end;

function stdneb(n:integer):pchar;stdcall;export;
begin
 if n=0 then stdneb:='EB fictive 0'+chr(0)
        else if n=1 then stdneb:='EB fictive 1'+chr(0)
                    else stdneb:=chr(0);
end;

function stdsb(n:integer; etat:integer):integer;stdcall;export;
begin
 case n of
   0..3 : begin relais[n+1]:=(etat=1);
   stdsb:=n*100+etat;
   pilote_relais(0);
   memosb[n]:=(etat=1);
          end;
   else stdsb:=-777;
    end;
end;
 
 

function stdnsb(n:integer):pchar;stdcall;export;
begin
result:=chr(0);
if n=0 then result:='relais A'+chr(0);
if n=1 then result:='relais B'+chr(0);
if n=2 then result:='relais C'+ chr(0);
if n=3 then result:='relais D'+chr(0);
end;

function stdrsb(n:integer):integer;stdcall;export;
begin
  if n in [0..3] then if memosb[n] then stdrsb:=1 else stdrsb:=0
                else stdrsb:=-777;
end;
 

function stdtitre : pchar;stdcall;export;
begin stdtitre:='ADES en LPT1:'+chr(0);end;
function detail : pchar;
begin stddetail:='essai de DLL (32 bits) pour ADES 10 bits en LPT1:, par P. Dieumegard, le 10 août 2002'+chr(0);end;

(*les deux fonctions qui suivent sont pour EXCEL ???*)
function peaD(n:integer):pdouble;export;
var dloc:double;
begin dloc:=eaD(n);pead:=@dloc;end;

function PSAD(n:integer;valeur:pdouble):pdouble;export;
var dloc1,dloc2:double;
begin dloc1:=valeur^;dloc2:=SAD(n,dloc1);psad:=@dloc2;end;

(*les fonctions " double " qui suivent sont pour StarOffice ;
en fait, il est possible que les fonctions stdxxx soient aussi possibles*)
function eadouble(x:double):double;
var nloc:integer;
begin  nloc:=round(x);  eadouble:=ead(nloc);end;

function neadouble(x:double):pchar;
begin
  neadouble:=nead(round(x));
end;

function sadouble(x:double;xval:double):double;
begin sadouble:=sad(round(x),xval);end;

function nsadouble(x:double):pchar;
begin nsadouble:=nsad(round(x));end;

function rsadouble(x:double):double;
begin rsadouble:=rsad(round(x));end;

function ebdouble(x:double):double;
begin ebdouble:=eb(round(x));end;

function nebdouble(x:double):pchar;
begin nebdouble:=neb(round(x));end;

function sbdouble(n:double;etat:double):double;
begin sbdouble:=sb(round(n),round(etat));end;

function nsbdouble(n:double):pchar;
begin nsbdouble:=nsb(round(n));end;

function rsbdouble(n:double):double;
begin rsbdouble:=rsb(round(n));end;

function ea(n:integer):integer;  begin ea:=stdea(n);end;
function nea(n:integer):pchar;  begin nea:=stdnea(n);end;
function ead(n:integer):double;  begin ead:=stdead(n);end;
function nead(n:integer):pchar; begin nead:=stdnead(n);end;
function sa(n:integer ; valeur:integer):integer ; begin sa:=stdsa(n,valeur);end;
function nsa(n:integer):pchar; begin nsa:=stdnsa(n);end;
function rsa(n:integer):integer; begin rsa:=stdrsa(n);end;
function sad(n:integer; valeur:double):double; begin sad:=stdsad(n,valeur);end;
function rsad(n:integer):double; begin rsad:=stdrsad(n);end;
function eb(n:integer):integer; begin eb:=stdeb(n);end;
function neb(n:integer):pchar; begin neb:=stdneb(n);end;
function sb(n:integer;etat:integer):integer; begin sb:=stdsb(n,etat);end;
function nsb(n:integer):pchar; begin nsb:=stdnsb(n);end;
function rsb(n:integer):integer; begin rsb:=stdrsb(n);end;
function titre:pchar; begin titre:=stdtitre;end;
function detail:pchar; begin detail:=stddetail;end;
(*titre et detail ne sont pas indispe
exports
  pead ,
  psad ,

 eadouble ,
  neadouble ,
  sadouble,nsadouble,rsadouble,
  ebdouble,nebdouble,
  sbdouble, nsbdouble,rsbdouble,
  stdea, stdnea,stdsa,stdnsad,stdtitre,stddetail,
  stdead,stdnead,stdsad,stdnsad,stdeb,stdneb,stdsb,stdnsb,stdrsad,stdrsb,
  ea,nea,ead,nead,sa,nsa,rsa,sad,nsad,rsad,
  eb,neb,sb,nsb,rsb,detail,titre;

var i:word;
begin
 nbitades:=10;
 initialise_ades(888);
 ades_on;
 for i:=0 to 3 do memosb[i]:=false;
end.
(retour au début de la page)

Programmation des DLL en FreePascal

FreePascal est une langage pascal gratuit, existant pour plusieurs systèmes d'exploitation, en particulier MS-Windows et Linux. Comme Delphi, il peut faire les DLL et les utiliser.
Le compilateur est très (trop?) adaptable, et on peut changer un très (trop ?) grand nombre de réglages.
Une information très utile pour éviter du travail inutile : pour que FreePascal soit «vraiment» compatible avec Delphi ou TurboPascal, il faut lui en donner l'ordre en cochant les cases correspondantes dans la boite de dialogue «Options Compiler».

De même, il y a plusieurs options pour l'utilisation d'instructions en assembleur. Apparemment, le mieux est de choisir le style «Intel».
Enfin, pour que les DLL compilées par FreePascal soient utilisables par Delphi, il faut prendre le mode «normal» et non «debug».

Finalement, la bibliothèque initialement faite pour Delphi 5 est compilable par FreePascal avec peu de modifications, et le résultat est utilisable par les logiciels écrits en Delphi.
(retour au début de la page)

Une bibliothèque pour un appareil fictif, en C++Builder 4

Dans cette bibliothèque, initialement nommée xdllvide_cpp.cpp, il n'y a que les fonctions «stdcall» : comme on l'a vu précédemment, des problèmes peuvent se poser dans la transmission des paramètres, et le type «stdcall» semble le plus répandu. C'est donc lui qui a été choisi.
//---------------------------------------------------------------------------
//#include <vcl.h>
#include <SysUtils.hpp>
#pragma hdrstop
int memosa;
double memosad;
bool memosb[4];

typedef unsigned char * tpchar;
//pour avoir la correspondance avec le type pchar de Delphi
//Avec Linux, il faut supprimer le «unsigned», mais en C++Builder,
//cela fonctionne quand même

int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
{          return 1;}

extern "C" __declspec(dllexport) __stdcall int stdea(int n);
extern "C" __declspec(dllexport)  __stdcall tpchar stdnea(int n);
extern "C" __declspec(dllexport) __stdcall double stdead(int n);
extern "C" __declspec(dllexport) __stdcall tpchar stdnead(int n);
extern "C" __declspec(dllexport) __stdcall int stdsa(int n,int val);
extern "C" __declspec(dllexport) __stdcall tpchar stdnsa(int n);
extern "C" __declspec(dllexport) __stdcall double stdsad(int n, double val);
extern "C" __declspec(dllexport) __stdcall tpchar stdnsad(int n);
extern "C" __declspec(dllexport) __stdcall int stdrsa(int n);
extern "C" __declspec(dllexport) __stdcall double stdrsad(int n);
extern "C" __declspec(dllexport) __stdcall int stdeb(int n);
extern "C" __declspec(dllexport) __stdcall tpchar stdneb(int n);
extern "C" __declspec(dllexport) __stdcall int stdsb(int n , int etat);
extern "C" __declspec(dllexport) __stdcall tpchar stdnsb(int n);
extern "C" __declspec(dllexport) __stdcall int stdrsb(int n);
extern "C" __declspec(dllexport) __stdcall tpchar stddetail(void);
extern "C" __declspec(dllexport) __stdcall tpchar stdtitre(void);

//---------------------------------------------------------------------------
int  __stdcall stdea(int n)
{ if (n>-1&&n<3) {return n*3;}else{return -777;} }

tpchar  __stdcall stdnea(int n)
{
tpchar chloc;
 chloc="\0";
 if (n==0) chloc="entrée analogique 0\0";
 if (n==1) chloc="EA 1 (volts)\0";
 if (n==2) chloc="température °C\0";
   return chloc; }

double  __stdcall stdead(int n)
{
double varloc;
if (n>-1&&n<3) {varloc= n*3.33;}else{varloc= -777;}
return varloc;
 }

tpchar __stdcall stdnead(int n)
{
tpchar chloc;
 chloc="\0";
 if (n==0) chloc="entrée analogique 0\0";
 if (n==1) chloc="EA 1 (volts)\0";
 if (n==2) chloc="température °C\0";
   return chloc;  }

int  __stdcall stdsa(int n , int val)
{ if (n==0) {memosa=val ;return val;}else{return -777;}
}

tpchar  __stdcall stdnsa(int n)
{ tpchar chloc;
if (n==0) chloc="sortie analogique\0"; else chloc="\0";
return chloc; }
 

double  __stdcall stdsad(int n, double val)
{ if (n==0){memosad=val; return val;} else return -777;
}

tpchar  __stdcall stdnsad(int n)
{if (n==0) return "SA 0 (volts)\0"; else return "\0"; }

int  __stdcall stdrsa(int n)
{ if (n==0) return memosa; else return -777; }

double __stdcall stdrsad(int n)
{ if(n==0) return memosad; else return -777;}

int  __stdcall stdeb(int n)
{
if (n==0)
        return 0;
        else if (n==1)
                return 1;
                else return -777;
}

tpchar  __stdcall stdneb(int n)
{ if (n==0)
        return "EB fictive 0\0";
        else if (n==1)
                return "EB fictive 1\0";
                else return "\0";
}

int  __stdcall stdsb(int n, int etat)
{ int varloc;
  varloc=-777;
//mettre ici la commande des sorties binaires,
// ainsi que la mémorisation dans le tableau memosb;
  if (n==0) varloc=0;
  if (n==1) varloc=1;
  if (n==2) varloc=1;
  if (n==3) varloc=0;
  return varloc;
  }

tpchar  __stdcall stdnsb(int n)
{tpchar varloc;
varloc=="\0";
if (n==0) varloc="Relais 0\0";
if (n==1) varloc="Relais 1\0";
if (n==2) varloc="Relais 2\0";
if (n==3) varloc="Relais 3\0";
return varloc;  }

int  __stdcall stdrsb(int n)
{int varloc;
varloc=-777;
if (n==0) varloc=memosb[0];
if (n==1) varloc=memosb[1];
if (n==2) varloc=memosb[2];
if (n==3) varloc=memosb[3];
return varloc ;}

tpchar  __stdcall stdtitre(void)
{return "Appareil fictif\0";}

tpchar  __stdcall stddetail(void)
{return "Appareil fictif, DLL programmée en Borland C++ par P. Dieumegard, le 19 nov 2002\0";
}
(retour au début de la page)

PureBasic et les DLL

PureBasic est un langage de type Basic, mais très évolué. Il existe pour divers systèmes d'exploitation, MS-Windows, Linux et Amiga. Il est disponible en téléchargement sur le site www.purebasic.com : la version de démonstration (permettant d'utiliser les DLL) est gratuite, mais la version complète (permettant de faire les DLL) est payante, bon marché (une cinquantaine d'euros).
La description de PureBasic est faite dans le paragraphe «utilisation de ces DLL». Ce langage Basic compilé est très agréable à utiliser, et sa version commerciale permet de faire les DLL.
Actuellement, PureBasic emploie les réels de type «single», alors que les autres langages de programmation emploient les réels de type «double». Le résultat est qu'il y a une incompatibilité pour les fonctions travaillant avec des réels.
Bien sûr, on pourrait faire des fonctions eas, sas, etc, qui travailleraient avec des «single» au lieu de travailler avec des «double». Normalement, les concepteurs de PureBasic travaillent à adapter leur langage au type «double», et j'espère que PureBasic sera bientôt compatible avec les autres langages.
Il est donc prématuré de vouloir faire des DLL compatibles au moyen de PureBasic, mais on peut espérer que cela viendra.
En attendant, on peut utiliser les DLL faites avec C++ ou Pascal, mais sans utiliser les fonctions mettant en jeu des paramètres (ou des résultats) de type «double»)

(retour au début de la page)