- Код: Выделить всё
.....
type
{ TLinusServer }
TLinusServer = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
end;
type MyServer = Class(TIdTCPServer)
procedure TCPServerExecute(AContext: TIdContext);
Constructor Build;
end;
{ TLinusServer }
var
ServerIOHandlerStack: TIdServerIOHandlerStack;
TCPServer: MyServer;
constructor MyServer.Build;
begin
TCPServer:=MyServer.Create(nil);
ServerIOHandlerStack:=TIdServerIOHandlerStack.Create(nil);
TCPServer.IOHandler:=ServerIOHandlerStack;
TCPServer.OnExecute:=@TCPServerExecute;
TCPServer.DefaultPort:=2048;
writeln('OK');
end;
procedure MyServer.TCPServerExecute(AContext: TIdContext);
var
s:string;
begin
//no
//head.Caption:='запуск';
with AContext.Connection do begin
//принимаем запросы...
s:=AContext.Connection.IOHandler.ReadLn();
send_to_console(s);
extract_get(s,AContext);
end;
end;
procedure TLinusServer.DoRun;
var
ErrorMsg: String;
begin
write('Запуск сервера...');
user_cache_mem:=10;
Tcpserver.Build;
tcpServer.Active:=true;
{ add your program here }
readln;
// stop program loop
Terminate;
end;
constructor TLinusServer.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
end;
destructor TLinusServer.Destroy;
begin
inherited Destroy;
end;
var
Application: TLinusServer;
{$R *.res}
begin
Application:=TLinusServer.Create(nil);
Application.Run;
Application.Free;
end.
естественно это не работает... ругается: Запуск сервера...exception at 0804862A:
Access violation. Такое ощущение, что idTCPserver вообще не создается.
А раньше ругался на какие-то "конкурирующие" потоки. В общем без понятия как заставить это работать.
(lazarus 0.9.30.4 FPC=2.6.0 linux debian i386 gtk2)
