ich versuch mich gerade mit den Grundlagen von Threadprogrammen.
Wenn ich das mal soweit hinkriege, möchte ich ein kleines Konsolenprogramm schreiben,
das jeweils in einem eigenen Thread serielle Schnittstellen (mittels Synaser) und TCP/IP Verbindungen (über LNet)
bearbeitet. Zum Schluß, deshalb Konsole, soll das auf Linux laufen.
Ich hab mir jetzt folgenden Code aus Beispielen zusammengestupft:
Code: Alles auswählen
program Threadtest_001;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, Synaser, Lnet
{ you can add units after this };
type
{ TLTCPThreadA }
TLTCPThreadA = class(TThread)
private
FConA: TLTCP; // THE server connection
procedure OnErA(const msg: string; aSocket: TLSocket);
procedure OnAcA(aSocket: TLSocket);
procedure OnReA(aSocket: TLSocket);
procedure OnDsA(aSocket: TLSocket);
protected
procedure Execute; override; // main loop with CallAction
public
constructor Create(CreateSuspended: boolean);
destructor Destroy; override;
end;
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
TCPThreadA : TLTCPThreadA;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
const
PortA : word = 3001; // Port zum KSP
{ TLTCPThreadA }
procedure TLTCPThreadA.OnAcA(aSocket: TLSocket);
begin
writeln('OnAcA');
end;
procedure TLTCPThreadA.OnErA(const msg: string; aSocket: TLSocket);
begin
writeln('OnErA');
end;
procedure TLTCPThreadA.OnReA(aSocket: TLSocket);
var
s: string;
n: Integer;
begin
writeln('OnReA');
if aSocket.GetMessage(s) > 0 then begin
writeln(s);
end;
end;
procedure TLTCPThreadA.OnDsA(aSocket: TLSocket);
begin
writeln('OnDsA');
end;
constructor TLTCPThreadA.Create(Createsuspended:boolean);
begin
inherited Create(true);
FreeOnTerminate := True;
FConA := TLTCP.Create(nil); // create new TCP connection
FConA.OnError := @OnErA; // assign all callbacks
FConA.OnReceive := @OnReA;
FConA.OnDisconnect := @OnDsA;
FConA.OnAccept := @OnAcA;
FConA.Timeout := 100; // responsive enough, but won't hog cpu
FConA.ReuseAddress := True;
end;
destructor TLTCPThreadA.Destroy;
begin
FConA.Free;
inherited Destroy;
end;
procedure TLTCPThreadA.Execute;
begin
writeln('Listen');
if FConA.Listen(PortA) then writeln('Listen 2');
repeat
try
FConA.CallAction;
except
// this is not supposed to happen. No exception should
// propagate up to this point. This must be a bug!
//LogException('BUG: during CallAction()');
end;
until Terminated;
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
{ add your program here }
writeln('Hallo Welt');
readln;
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
TCPThreadA := TLTCPThreadA.Create(false);
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
begin
Application:=TMyApplication.Create(nil);
Application.Run;
Application.Free;
end.
Im Hauptprogramm passiert eigendlich bis auf ein readln gar nichts.
Wenn das Programm läuft, soll es einen Listenerport (3001) öffnen und warten bis was empfangen wurde.
Wenn was kommt, einfach mit writeln darstellen.
Kompilieren kann ich das jetzt, allerdings tut es nicht.
Wäre nett wenn da mal einer einen Blick drauf werfen würde.
Ich geh davon aus, daß da noch ganz grobe Schnitzer drin sind. Ich hab mich da in den letzten Tagen
echt wundgegoogled und vermische da vielleicht Win-Api und Konsole.
Das Prinzip von Threads (auch mit Synchronisation von Variablenzugriffen usw.) hab ich grundsätzlich ja mal verstanden
aber wie ich das Lazarus beibringe halt noch nicht so ganz.
Ich bin für jeden Hinweis dankbar was da falsch ist.
Danke schon mal für eure Mühe
Gruß NoCee