LNet dll, Hilfe bei Klasse umschreiben???

[laz847]

Hi Leute,

wie in meinem anderen Thread berichtet, suche ich nach einer Lösung um Daten an den Metatrader 4 zu senden und von dort zu empfangen.

Bin jetzt endlich nach vielen Wochen etwas weiter, ich habe ein Beispiel aus LNet so modifizieren können, dass ich eine dll erstellen konnte, diese ist im MT4 eingebunden und die Funktion connect() geht.

Nur ist es so, dass die Funktion die die Nachricht sendet in einem Loop läuft, dadurch komm ich mit meiner send() Funktion gar nicht dazu den Wert zu ändern.

Wenn ich bei FCon.SendMessage('testtest'); einsetze kommt das bei meinem Server.exe schon an, also Verbindung steht. Das Problem ist die FCon.Callaction;, wenn ich alles richtig verstanden habe, muss das hier geloopt werden damits überhaupt geht. Wie aber krieg ich von aussen meine Nachricht in den laufenden Loop, FQuit2 geht natürlich auch nicht und application.ProzessMessages geht in einer dll nicht oder? Kann sein ich stehe gerade auf dem Schlauch, wenn ja noch besser

Das alles umzuschreiben damit es irgendwie läuft kriege ich evtl hin. Da ich noch nicht so der Profi bin möchte ich es lieber ordentlich machen, nicht das nachher Memory Leaks oder andere Probleme auftauchen, weil ich die Arbeitsweise von LNet irgendwie untergraben habe.

Code: Alles auswählen

library p_test_11;
 
{$mode objfpc}{$H+}
 
uses
  Classes, Crt, SysUtils, lNet, lnetbase;
 
type
  { TLTCPTest }
 
  TLTCPTest = class
   private
    FQuit: boolean;
    FCon: TLTcp;
    procedure OnDs(aSocket: TLSocket);
    procedure OnRe(aSocket: TLSocket);
    procedure OnEr(const msg: string; aSocket: TLSocket);
   public
    constructor Create;
    destructor  Destroy; override;
    procedure   Run;
  end;
 
  var
    FQuit2:Boolean;
     TCP: TLTCPTest;
     STXT:String;
 
// implementation
 
procedure Log(txt:string);
var
  sl: TStringList;
  f:string;
begin
  f:='dll_log.txt';
  sl:=TStringList.Create;
  try
   if(FileExists(f)) then sl.LoadFromFile(f);
   sl.Add(txt);
   sl.SaveToFile(f);
  finally
   sl.free;
  end;
end;
 
constructor TLTCPTest.Create;
begin
  FCon              := TLTCP.Create(nil); // create new TCP connection with no parent component
  FCon.OnError      := @OnEr;             // assign callbacks
  FCon.OnReceive    := @OnRe;
  FCOn.OnDisconnect := @OnDs;
  FCon.Timeout      := 100;              // responsive enough, but won't hog cpu
end;
 
procedure TLTCPTest.OnDs(aSocket: TLSocket);
begin
 Log('Lost connection');
end;
 
procedure TLTCPTest.OnRe(aSocket: TLSocket);
var
  s: string;
begin
  if aSocket.GetMessage(s)>0 then Log(s);
end;
 
procedure TLTCPTest.OnEr(const msg: string; aSocket: TLSocket);
begin
  Log('error --> '+msg);
  FQuit:=true;
end;
 
destructor TLTCPTest.Destroy;
begin
  FCon.Free;
  inherited Destroy;
end;
 
procedure TLTCPTest.Run;
var
  Address: string;
  Port: Word;
begin
 
 Address := '127.0.0.1';
 Port    := 5000;
 
 if FCon.Connect(Address, Port) then begin
 
  Log('Connecting...');
 
  repeat
   FCon.CallAction;
  until FCon.Connected;
 
  Log('Connected...');
 
  repeat
   if(STXT<>'') then 
    begin
       FCon.SendMessage(STXT);
      STXT:='';
      FCon.Callaction;
   end;
  until FQuit or FQuit2;
 
  if(FQuit)  then Log('loop stop FQuit...');
  if(FQuit2) then Log('loop stop FQuit2...'); 
 end; 
 TCP.Free; 
end;
 
function connect():Boolean; stdcall;
begin
  TCP:=TLTCPTest.Create;
  TCP.Run;
  FQuit2:=false;
  result:=true;
end;
 
function send(msg:string):Boolean; stdcall;
begin
 if(msg<>'') then STXT:=msg;
 if(STXT<>'') then result:=false else result:=true;
end;
 
function disconnect():Boolean; stdcall;
begin
 FQuit2:=true;
 Log('disconnect...');
 result:=true;
end;
 
exports connect, send, disconnect;
 
begin
end.

Danköööö

[laz847]

Ok hat sich erledigt habs hinbekommen