Пытаюсь создать службу Windows
- Код: Выделить всё
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, DaemonApp, INIFiles, lNet, ukvm_cmd;
type
Tsvctst = class(TDaemon)
private
{ private declarations }
public
{ public declarations }
end;
var
svctst: Tsvctst;
type
TlNetClass = Class
private
FNet,FNetSrv: TLTCP;
tmf: Boolean;
IP: String;
Port, sPort: Word;
procedure onEr(const msg: String; aSocket: TLSocket);
procedure onCn(aSocket: TLSocket);
procedure onRe(aSocket: TLSocket);
procedure onDs(aSocket: TLSocket);
procedure onErSrv(const msg: String; aSocket: TLSocket);
procedure onAcSrv(aSocket: TLSocket);
procedure onReSrv(aSocket: TLSocket);
procedure onDsSrv(aSocket: TLSocket);
procedure Tmr();
public
procedure Run;
constructor Build;
destructor Burn;
end;
implementation
procedure RegisterDaemon;
begin
RegisterDaemonClass(Tsvctst)
end;
{$R *.lfm}
//------------CLIENT------------------------------------------------------------
procedure TlNetClass.onCn(aSocket: TLSocket);
begin
Writeln(UTF8ToConsole('Соединение с сервером установлено'));
tmf := False;
end;
procedure TlNetClass.onRe(aSocket: TLSocket);
var s: String;
begin
if aSocket.GetMessage(s) > 0 then begin
// Writeln(UTF8ToSys(s));
FNet.SendMessage(SysToUTF8(s));
end;
end;
procedure TlNetClass.onDs(aSocket: TLSocket);
begin
Writeln(UTF8ToConsole('Соединение потеряно'));
tmf := True;
Tmr;
end;
procedure TlNetClass.onEr(const msg: String; aSocket: TLSocket);
begin
// Writeln(msg);
tmf := True;
Tmr;
end;
//------------SERVER------------------------------------------------------------
procedure TlNetClass.onAcSrv(aSocket: TLSocket);
begin
Writeln(UTF8ToConsole('Соединение с клиентом ' + aSocket.PeerAddress + ' установлено'));
// tmf := False;
end;
procedure TlNetClass.onReSrv(aSocket: TLSocket);
var s: String;
begin
if aSocket.GetMessage(s) > 0 then begin
s := strCMD(s);
if s <> '' then FNetSrv.SendMessage(s + #13#10);
end;
end;
procedure TlNetClass.onDsSrv(aSocket: TLSocket);
begin
Writeln(UTF8ToConsole('Соединение c клиентом ' + aSocket.PeerAddress + ' потеряно'));
// tmf := True;
// Tmr;
end;
procedure TlNetClass.onErSrv(const msg: String; aSocket: TLSocket);
begin
Writeln(msg);
// tmf := True;
// Tmr;
end;
//------------------------------------------------------------------------------
procedure TlNetClass.Run;
var //q: Boolean;
cfgINI: TINIFile;
begin
cfgINI := TINIFile.Create(ExtractFilePath(paramstr(0)) + 'rmtclient.cfg');
IP := cfgINI.ReadString('rmtserver', 'address', '');
Port := StrToInt(cfgINI.ReadString('rmtserver', 'port', '0'));
sPort := StrToInt(cfgINI.ReadString('rmtclient', 'port', '0'));
tmf := False;
// q := False;
FNet.Connect(IP, Port);
FNetSrv.Listen(sPort);
// if FNet.Connect(Addr, Port) then begin
// Writeln(UTF8ToConsole('''Escape'' - выход'));
repeat
FNetSrv.CallAction;
FNet.CallAction;
// if KeyPressed then begin
// if ReadKey = #27 then q := True;
// end;
until False;
// end;
end;
constructor TlNetClass.Build;
begin
tmf := False;
FNetSrv := TLTcp.Create(nil);
FNet.OnError := @OnEr;
FNet.OnReceive := @OnRe;
FNet.OnDisconnect := @OnDs;
FNet.OnConnect := @OnCn;
FNet.Timeout := 100;
FNet.ReuseAddress := True;
FNetSrv := TLTCP.Create(nil);
FNetSrv.OnError := @OnErSrv;
FNetSrv.OnReceive := @OnReSrv;
FNetSrv.OnDisconnect := @OnDsSrv;
FNetSrv.OnAccept := @OnAcSrv;
FNetSrv.Timeout := 100;
FNetSrv.ReuseAddress := True;
end;
destructor TlNetClass.Burn;
begin
FNet.Free;
FNetSrv.Free;
end;
//------------Таймер------------------------------------------------------------
procedure TlNetClass.Tmr;
begin
if tmf then begin
sleep (3000);
FNet.Connect(IP, Port);
end;
end;
//------------------------------------------------------------------------------
initialization
RegisterDaemon;
with TlNetClass.Build do begin
Run;
Burn;
end;
end.
- Код: Выделить всё
unit daemon;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, DaemonApp;
type
Tsvcmaper = class(TDaemonMapper)
private
{ private declarations }
public
{ public declarations }
end;
var
svcmaper: Tsvcmaper;
implementation
procedure RegisterMapper;
begin
RegisterDaemonMapper(Tsvcmaper)
end;
{$R *.lfm}
initialization
RegisterMapper;
end.
Компилируется проект без ошибок, но при установке службы
svctest.exe -i
появляется ошибка
C:\Project\daemontest>svctest.exe -i
An unhandled exception occurred at $0041829C:
EAccessViolation: Access violation
$0041829C TLNETCLASS__BUILD, line 145 of main.pas
$004184C9 MAIN_$$_init, line 177 of main.pas
$0040DB64
line 177 of main.pas - это строка - with TlNetClass.Build do begin
line 145 of main.pas - это строка - FNet.OnError := @OnEr;
Подскажите что не так сделал?
