AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Eindeutiger Callback bei mehreren Instanzen des selben Programms

Eindeutiger Callback bei mehreren Instanzen des selben Programms

Ein Thema von MaxDelphi · begonnen am 27. Okt 2011 · letzter Beitrag vom 7. Jul 2020
Antwort Antwort
Seite 2 von 2     12
MaxDelphi

Registriert seit: 29. Jun 2009
17 Beiträge
 
#11

AW: Eindeutiger Callback bei mehreren Instanzen des selben Programms

  Alt 28. Okt 2011, 11:57
@himitsu

In der Kürze liegt die Würze, du hast die von mir umrissene Idee schön zusammengefaßt.

Hier jetzt der versprochene Quell-Code und Hinweise:
Man muss das Test-Programm mindestens zweimal aufrufen. Es zeigt dann den Handle aus der DLL an. Man muss dann diesen Handle über kreuz in den jeweiligen Target-Eingabefeldern eintragen. Danach kann man:
- Die LED direkt ein- und ausschalten.
- Die LED über Callback ein- und ausschalten.
- Die LED des Targets umschalten.
Achtung die Handles der anderen Anwendungen werden noch nicht über MMF verwaltet!!

Quellcode der DLL:
Delphi-Quellcode:
library cbDLL;

uses
   JclSysInfo, SysUtils
  ,Classes
  ,Forms
  ,Windows
  ,Messages
  ;

{$R *.res}

type
   // Definition des Callbacks
   TMyCallback = procedure (State: Integer); stdcall;

   // Klasse zum Senden und Empfangen von Botschaften.
   TMyForm = class(TCustomForm)
   private
      procedure MsgHandler(var Msg : TMessage); message WM_USER;
   end;

var
   TheCallback : TMyCallback;
   MyForm : TMyForm;
   State: Boolean;
   SaveExit: Pointer;

// Auslösen des Callbacks
procedure OnOff(State: Integer);
begin
   if assigned(TheCallback) then
      TheCallback(State);
end;

// Einschalten
procedure CallOn; stdcall;
begin
   OnOff(1);
end;

// Ausschalten
procedure CallOff; stdcall;
begin
   OnOff(0);
end;

// Botschaft empfangen
procedure TMyForm.MsgHandler(var Msg : TMessage);
begin
   State := not State;
   if State then
      CallOn
   else
      CallOff;
end;

// Callback Initialisieren.
procedure Init(cb: TMyCallback); stdcall;
begin
   TheCallback := cb;
end;

// Eigenen Handle ermitteln; Adresse an die man senden kann.
function GetHandle: Longword; stdcall;
begin
   result := MyForm.Handle;
end;

// Botschaft senden.
procedure Post(Target: Longword); stdcall;
begin
   PostMessage(Target, WM_USER, 0, 0);
end;

// Freigeben von Ressourcen
procedure LibExit;
begin
   MyForm.Free;
   // ... als letzte Anweisung
   ExitProc := SaveExit; // Kette der Exit-Prozeduren wiederherstellen
end;

// Export-Tabelle
exports
    Init
   ,CallOn
   ,CallOff
   ,GetHandle
   ,Post
   ;

// Initialisierung
begin
   // ... als erste Anweisungen
   SaveExit := ExitProc; // Kette der Exit-Prozeduren speichern
   ExitProc := @LibExit; // Exit-Prozedur LibExit installieren
   State := False;
   MyForm := TMyForm.CreateNew(nil);
end.
Quellcode der Testanwendung:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type

   TFunc = procedure(State: Integer); stdcall;

   TStdProcProt = procedure; stdcall;
   TInitProcProt = procedure (AFunc: TFunc); stdcall;
   TGetHndProcProt = function : Longword; stdcall;
   TPostProcProt = procedure (Target: Longword); stdcall;

  TForm1 = class(TForm)
    shpLED: TShape;
    btnOn: TButton;
    btnOff: TButton;
    btnROn: TButton;
    btnROff: TButton;
    Label1: TLabel;
    lblMyHnd: TLabel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label2: TLabel;
    edtTrgt: TEdit;
    btnToggle: TButton;
    procedure btnOnClick(Sender: TObject);
    procedure btnOffClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnROnClick(Sender: TObject);
    procedure btnROffClick(Sender: TObject);
    procedure btnToggleClick(Sender: TObject);
  private
    { Private-Deklarationen }
    fDLLInstance : THandle;
    fDLLInit : TInitProcProt;
    fDLLOn : TStdProcProt;
    fDLLOff : TStdProcProt;
    fDLLGetHandle : TGetHndProcProt;
    fDLLPost : TPostProcProt;
  public
    { Public-Deklarationen }
  end;

    procedure SetLED(State: Integer); stdcall;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SetLED(State: Integer); stdcall;
begin
   if State = 0 then
      Form1.shpLED.Brush.Color := clGreen
   else
      Form1.shpLED.Brush.Color := clLime;
end;

procedure TForm1.btnOnClick(Sender: TObject);
begin
   SetLED(1);
end;

procedure TForm1.btnOffClick(Sender: TObject);
begin
   SetLED(0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   fDLLInstance := 0;
   @fDLLInit := nil;
   @fDLLOn := nil;
   @fDLLOff := nil;
   @fDLLGetHandle := nil;
   @fDLLPost := nil;
   fDllInstance := LoadLibrary('cbDLL.dll');
   if fDllInstance <> 0 then
   begin
      @fDLLInit := GetProcAddress(fDLLInstance, 'Init');
      @fDLLOn := GetProcAddress(fDLLInstance, 'CallOn');
      @fDLLOff := GetProcAddress(fDLLInstance, 'CallOff');
      @fDLLGetHandle := GetProcAddress(fDLLInstance, 'GetHandle');
      @fDLLPost := GetProcAddress(fDLLInstance, 'Post');
   end;
   fDLLInit(SetLED);
   lblMyHnd.Caption := IntToStr(fDLLGetHandle);
end;

procedure TForm1.btnROnClick(Sender: TObject);
begin
   fDLLOn;
end;

procedure TForm1.btnROffClick(Sender: TObject);
begin
   fDLLOff;
end;

procedure TForm1.btnToggleClick(Sender: TObject);
begin
   fDLLPost(StrToInt(edtTrgt.Text));
end;

end.
Damit sehe ich das Thema hiermit für mich als gelöst an.
MfG,
MaxDelphi
  Mit Zitat antworten Zitat
js747a

Registriert seit: 11. Aug 2008
Ort: Nord hessen
43 Beiträge
 
Delphi 7 Enterprise
 
#12

AW: Eindeutiger Callback bei mehreren Instanzen des selben Programms

  Alt 7. Jul 2020, 14:51
Wieder mal ein Beispiel das für andere User nicht zu gebrauchen ist.
Die Unit JclSysInfo kennt warscheinlich nur der Ersteller.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.139 Beiträge
 
Delphi 12 Athens
 
#13

AW: Eindeutiger Callback bei mehreren Instanzen des selben Programms

  Alt 7. Jul 2020, 14:56
JCL = JEDI Code Library

https://wiki.delphi-jedi.org/wiki/JEDI_Code_Library
https://github.com/project-jedi/jcl
https://sourceforge.net/projects/jcl/
http://dn.embarcadero.com/article/22818
...
Bei Google suchendelphi jedi

PS: Bei Google suchenJclSysInfo
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PosEx im Delphi viel seltener praktiziert.
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.624 Beiträge
 
Delphi 12 Athens
 
#14

AW: Eindeutiger Callback bei mehreren Instanzen des selben Programms

  Alt 7. Jul 2020, 14:57
Erster Treffer bei Google: https://github.com/project-jedi/jcl/...JclSysInfo.pas. Das wäre zielführender gewesen, als alte Threads zu kapern, um dort herumzumeckern.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:37 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz