{*************************************************************************
 *             Unité de transfert de données vers Synchronie             *
 *************************************************************************}
unit LienSync;
{$UNDEF MEMOIREPARTAGEE}


{*************************************************************************}
interface
uses Windows,SysUtils,Messages,Forms,tlHelp32,Dialogs;
{$V-,B-,X+,T-,P+,H-,J-}    //directives indispensables

const NomSynchronie='SYNCHRONIE.EXE';
      CleIdentification='/DATA_TXT/'; {ne pas changer}
      CRLF = #13#10;
      MemoirePartageeSynchronie='MemoireEchangeModule';

      //Constantes de contrôle du comportement de Synchronie
      me_ModuleEXE            = $01;  //indique qu'il s'agit d'un module externe exécutable
      me_InitialiserSynchronie= $02;  //force Synchronie à se réinitialiser
      me_FenetreUnique        = $04;  //Les courbes transmises s'afficheront dans une fenêtre unique
      me_AjouterCourbes       = $08;  //Les courbes transmises s'ajoutent

Type
  TBuffer = object
    PBuf : PChar;
    Indice : Dword;
    Taille : Dword;
    procedure Init(LongueurMax:integer);  {Appel obligatoire; Création et initialisation du buffer}
    function  IntroduireLigne(Texte:string):boolean;  {introduction d'une ligne complète dans le buffer}
    procedure Supprimer;               {suppression du buffer}
    end;

  PStructureLiens = ^TStructureLiens;
  TStructureLiens = packed object
    NomFichier : ShortString; {Nom du fichier si transmission par fichier, sinon laisser vide}
    ControleSynchronie: dword;
    PBuffer : PChar;     {pointeur sur Buffer contenant les données sinon à Nil}
    procedure Init;
    procedure Remplir(NomFic:string; Controle:dword; PBuf:PChar);
    end;

var Buffer : TBuffer;
    HSynchronie : THandle;
    StructureSynchronie: TStructureLiens;

procedure AfficherErreurSysteme;
function  ProcessEnCours(NomCherche:string; var Whandle:THandle):boolean;
function  ChercherHandleProcess(ProcessId:THandle):THandle;
function  SynchroniePresent:boolean;
procedure TransmettreASynchronie(PStructure:pointer);

{*************************************************************************}
implementation

{***************** Méthodes pour l'objet TBuffer *************************}
procedure TBuffer.Init(LongueurMax:integer);
begin
PBuf:=Nil;
GetMem(PBuf,LongueurMax);
if PBuf<>nil then FillChar(PBuf^,LongueurMax,0);
Taille:=LongueurMax;
Indice:=0;
IntroduireLigne(CleIdentification);
end;

function TBuffer.IntroduireLigne(Texte:string):boolean;
var L : Dword;
begin
Result:=PBuf<>Nil;
if PBuf=Nil then exit;
Texte:=Texte+CRLF;
L:=Length(Texte);
if Indice+L<Taille-1 then Move(Texte[1],PBuf[Indice],L) else Result:=false;
Indice:=Indice+L;
end;

procedure TBuffer.Supprimer;
begin
FreeMem(PBuf,Taille);
end;

{******* Méthodes pour l'objet TBuffer ***********************************}
procedure TStructureLiens.Init;
begin
NomFichier:='';
ControleSynchronie:=0;
PBuffer:=Nil;
end;

procedure TStructureLiens.Remplir(NomFic:string; Controle:dword; PBuf:PChar);
begin
NomFichier:=NomFic;
ControleSynchronie:=Controle;
PBuffer:=PBuf;
end;

{******************************************************************************
 *    Envoi des données vers Synchronie par le message wm_CopyData            *
 ******************************************************************************}

procedure AfficherErreurSysteme;
var Err : DWord;
    Ch : array[1..120] of char;
begin
Err:=GetLastError;
if Err<>0 then begin
   FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,Nil,Err,0,@Ch,Sizeof(Ch),Nil);
   MessageDlg(Ch,mtError,[mbOk],0);
   end;
end;

function Majuscule(Ch:string):string;
begin
if Ch<>'' then AnsiUpperBuff(@Ch[1],Length(Ch));
Result:=Ch;
end;

var HModule : THandle;
    HandleProcess : THandle;
function ExplorerProcess(Handle:Hwnd; LP:LParam):boolean; stdcall;
{la forme de cette fonction est imposée par EnumWindow}
var R : dWord;
    Hg : THandle;
    pPid: ^dWord;
begin
Hg:=0;
if Handle=0 then begin Result:=false; exit; end;
TRY
Result:=true;
Hg:=GlobalAlloc(GMEM_SHARE,sizeof(integer));
pPid:=GlobalLock(Hg);
R:=GetWindowThreadProcessId(Handle,pPid);
if R<>0 then
        if pPid^=HandleProcess then begin
           HModule:=Handle;
           Result:=false;
           end;
FINALLY
  GlobalUnlock(Hg);
  GlobalFree(Hg);
  END;
end;

function ChercherHandleProcess(ProcessId:THandle):THandle;
begin
HandleProcess:=ProcessId;
EnumWindows(@ExplorerProcess,0);
Result:=HModule;
end;

function ProcessEnCours(NomCherche:string; var WHandle:THandle):boolean;
{renvoie TRUE et le handle de la fenêtre principale si le process est trouvé}
var LPPE  : TProcessEntry32;
    H     : THandle;
begin
Result := false;
WHandle:=0;
H:=CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
LPPE.DwSize:=Sizeof(TProcessEntry32);
if Process32First(H,LPPE) then begin;
   if  Majuscule(ExtractFileName(LPPE.szexefile))=Majuscule(NomCherche) then Result:=true;
   while not Result and Process32next(h,LPPE) do begin
         if  Majuscule(ExtractFileName(LPPE.szExeFile))=Majuscule(NomCherche) then Result:=true;
         end;
  end;
CloseHandle(H);
if Result then WHandle:=ChercherHandleProcess(LPPE.th32ProcessId);
end;

function SynchroniePresent:boolean;
begin
HSynchronie:=FindWindow('TBureau',Nil);   {autre façon moins générale}
//if not ProcessEnCours(NomSynchronie,HSynchronie) then Hsynchronie:=0;
Result:=HSynchronie>0;
end;

{$IFDEF MEMOIREPARTAGEE}
{Envoi des données vers Synchronie en utilisant la mémoire partagée}
procedure TransmettreASynchronie(PStructure:pointer);
Type  PTCar = ^TCar;
      TCar=array[1..1000] of char;
var   Shm : THandle;
      ShmData : pointer;
      Taille : integer;
      ParFichier : boolean;
      PCar : PtCar;
begin
ParFichier:=StructureSynchronie.NomFichier<>'';
if ParFichier then Taille:=SizeOf(StructureSynchronie) else Taille:=Buffer.Taille;
Shm:=OpenFileMapping(FILE_MAP_WRITE,false,MemoirePartageeSynchronie);
if Shm=0 then begin AfficherErreurSysteme; exit; end;
ShmData:=MapViewOfFile(Shm,FILE_MAP_WRITE,0,0,Taille);
if ShmData=Nil then begin AfficherErreurSysteme; exit; end
   else if ParFichier then Move(StructureSynchronie,ShmData^,Taille)
   else Move(StructureSynchronie.PBuffer^,ShmData^,Taille);
CloseHandle(Shm);
PCar:=PTCar(ShmData);
end;
{$ELSE}
{Envoi des données vers Synchronie en utilisant le message wm_CopyData }
procedure TransmettreASynchronie(PStructure:Pointer);
var CopyDataStructure : TCopyDataStruct;
    PStructureL : PStructureLiens;
begin
PStructureL:=PStructureLiens(Pstructure);
with CopyDataStructure do begin
     dwData:=PStructureL^.ControleSynchronie or me_ModuleEXE;
     if StructureSynchronie.NomFichier='' then begin
             cbData:=Buffer.Taille;
             lpData:=PStructureL^.PBuffer;
             end
        else begin
             cbData:=Sizeof(PStructureL^);
             lpData:=PStructureL;
             end;
     end;
SendMessage(HSynchronie,wm_CopyData,0,LParam(@CopyDataStructure));
end;
{$ENDIF}

{***************** Partie initialisation de l'unité **********************}
begin
{ne pas changer ces lignes}
HSynchronie:=0;
HandleProcess:=0;
StructureSynchronie.Init;
end.









