Проблема в следующем в гуе приложении все работает нормально. к базе подключается, листенер слушает команды и шлет ответы. обмен данными между клиентом и сервером работает на УРА.
Вот код обычного приложения.
- Код: Выделить всё
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ZConnection,
ZeosProv, ZeosDataServer, DB, ServerProc,
DataProcUtils;
type
{ TForm1 }
TForm1 = class(TForm)
Start: TButton;
ZConnection: TZConnection;
ZeosDataServer: TZeosDataServer;
function ZeosDataServerUserLogonCall(UserName, Password: AnsiString):
TLogonStyle;
procedure StartClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function TForm1.ZeosDataServerUserLogonCall(UserName, Password:
AnsiString): TLogonStyle;
begin
Result := LogedOnServer;
end;
procedure TForm1.StartClick(Sender: TObject);
begin
// writeln('Starting server...');
// writeln('Database connection...');
//init db connect;
ZConnection:=TZConnection.Create(self);
ZConnection.AutoEncodeStrings:=False;
ZConnection.ClientCodepage:='UTF8';
ZConnection.Catalog:='public';
ZConnection.Properties.Text:='AutoEncodeStrings=codepage=UTF8';
//settings
ZConnection.HostName := '127.0.0.1';
ZConnection.Database := 'bd';
ZConnection.User := 'postgres';
ZConnection.Password := 'xxx';
ZConnection.Protocol := 'postgresql-9';
ZConnection.Connect;
if ZConnection.Connected then
// writeln('Conected to: '+ZConnection.User+'@'+ZConnection.Database)
else
begin
// writeln('Connection ERROR...');
sleep(5000);
Application.Terminate;
end;
// writeln('Init Listener...');
ZeosDataServer := TZeosDataServer.Create(self);
ZeosDataServer.ZeosDBConnection := ZConnection;
ZeosDataServer.AuthRequired := True;
ZeosDataServer.Port := '8080';
ZeosDataServer.OnUserLogonCall := @ZeosDataServerUserLogonCall;
ZeosDataServer.ServerName := 'Avalon';
ZeosDataServer.Active := True;
if ZeosDataServer.Active then
// writeln('Listener started on port: '+ZeosDataServer.Port+' with name '+ZeosDataServer.ServerName)
else
begin
// writeln('Listener 4 ERROR...');
sleep(5000);
Application.Terminate;
end;
end;
end.
Но мне нужно консольное приложение так как работать все должно на сервере с линуксом. И вот тут проблема
Из конслои к базе подключаемся, листенер поднимается, о чем сообщает фаервол спрашивая разрешение, но потом...
потом видимость что все работает, порт слушается.. А наделе ничего не получает и не отправляет соответственно.
Вот код
- Код: Выделить всё
program ServerX;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, ZConnection,
ZeosProv, ZeosDataServer, DB, ServerProc,
DataProcUtils
{ you can add units after this };
type
{ TServerX }
TServerX = class(TCustomApplication)
ZConnection: TZConnection;
ZeosDataServer: TZeosDataServer;
function ZeosDataServerUserLogonCall(UserName, Password: AnsiString):
TLogonStyle;
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
procedure Start;
end;
{ TServerX }
function TServerX.ZeosDataServerUserLogonCall(UserName, Password:
AnsiString): TLogonStyle;
begin
Result := LogedOnServer;
end;
procedure TServerX.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;
Start;
{ add your program here }
// stop program loop
Terminate;
end;
constructor TServerX.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
end;
destructor TServerX.Destroy;
begin
inherited Destroy;
end;
procedure TServerX.Start;
begin
writeln('Starting server...');
writeln('Database connection...');
//init db connect;
ZConnection:=TZConnection.Create(self);
ZConnection.AutoEncodeStrings:=False;
ZConnection.ClientCodepage:='UTF8';
ZConnection.Catalog:='public';
ZConnection.Properties.Text:='AutoEncodeStrings=codepage=UTF8';
//settings
ZConnection.HostName := '127.0.0.1';
ZConnection.Database := 'bd';
ZConnection.User := 'postgres';
ZConnection.Password := 'xxx';
ZConnection.Protocol := 'postgresql-9';
ZConnection.Connect;
if ZConnection.Connected then
writeln('Conected to: '+ZConnection.User+'@'+ZConnection.Database)
else
begin
writeln('Connection ERROR...');
sleep(5000);
Terminate;
end;
writeln('Init Listener...');
ZeosDataServer := TZeosDataServer.Create(self);
ZeosDataServer.ZeosDBConnection := ZConnection;
ZeosDataServer.AuthRequired := True;
ZeosDataServer.Port := '8080';
ZeosDataServer.OnUserLogonCall := @ZeosDataServerUserLogonCall;
ZeosDataServer.ServerName := 'Avalon';
ZeosDataServer.Active := True;
if ZeosDataServer.Active then
writeln('Listener started on port: '+ZeosDataServer.Port+' with name '+ZeosDataServer.ServerName)
else
begin
writeln('Listener 4 ERROR...');
sleep(5000);
Terminate;
end;
readln();
end;
procedure TServerX.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TServerX;
begin
Application:=TServerX.Create(nil);
Application.Run;
Application.Free;
end.
Причины такого поведения, если честно не понятны. Нет ни ошибок, ни как ких-то признаков нестандартного поведения. Просто не принимает пакеты от клиента и именно в консольном приложении.
Может быть кто знает в чем может быть проблема. В чем кардинальная разница наследников или у консольной есть какие то особенности, по работе с сетью или в работе с потоками.
Уже все перебрал, ну не понимаю одного, почему?
PS пока все пишится и отлаживается на Win7 x64 (приложения x86) (lazarus 1.2.6 fpc 2.6.4)
