//----------------------------------------------------------------------
// Service-Events
//----------------------------------------------------------------------
//Damit der Service in der Liste der Dienste
//auch eine vernünftige Beschreibung bekommt:
procedure TPortaleSperrenServer.ServiceAfterInstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ
or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('
\SYSTEM\CurrentControlSet\Services\' +
Name, false)
then
begin
Reg.WriteString('
Description', ServiceDescription);
//ServiceDescription ist eine String-Konstante mit der Beschr.
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TPortaleSperrenServer.ServiceStart(Sender: TService;
var Started: Boolean);
begin
CoInitialize(
nil);
//Brauch ich wg. Datenbankzugriffen, kann ggf. weg
//Kann man im Prinzip alles reinmachen, was man sonst vllt.
//bei Form Create reinmachen würde
end;
procedure TPortaleSperrenServer.ServiceExecute(Sender: TService);
begin
//Hier auch:
//Kann man im Prinzip alles reinmachen, was man sonst vllt.
//bei Form Create reinmachen würde
Server.Port:=5555;
SA_Waitlist:=TStringlist.Create;
Server.Open;
//Nun die Schleife, in der der Eigentliche Service Thread läuft
try
while not Terminated
do
begin
ServiceThread.ProcessRequests(true);
//false
//Sleep(10);
end;
except on E:
Exception do
begin
LogEvent('
Server als Dienst','
Letzte Nachricht','
',e.
Message);
end;
end;
end;
procedure TPortaleSperrenServer.ServicePause(Sender: TService;
var Paused: Boolean);
begin
ServerSocket.Close;
end;
procedure TPortaleSperrenServer.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
Server.Open;
end;
procedure TPortaleSperrenServer.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Server.Close;
if SA_WaitList <>
nil then SA_WaitList.Free;
CoUnInitialize;
end;
procedure TPortaleSperrenServer.ServiceShutdown(Sender: TService);
begin
Server.Close;
if SA_WaitList <>
nil then SA_WaitList.Free;
CoUnInitialize;
end;
//----------------------------------------------------------------------
// HTTPServer-Events
//----------------------------------------------------------------------
//Einkommende Sendungen vom Programm A:
procedure TMain.HTTPServerCommandGet(AThread: TIdPeerThread;
RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
begin
//Die direkte weiterleitung der Daten
if HTTPRedirect
then Redirect(RequestInfo.UnparsedParams);
//Wenn A eine Antwort braucht, das alles angekommen ist:
if HTTPResponse
then
begin
ResponseInfo.ResponseNo:=200;
ResponseInfo.ResponseText:='
OK';
ResponseInfo.WriteContent;
end;
//(HTTPRedirect,HTTPResponse = Boolche Konstante):
//Zur weiterbearbeitung der Daten:
EvalCallInfo(RequestInfo.Params.Values['
event'],
RequestInfo.Params.Values['
date'],
RequestInfo.Params.Values['
src_if'],
RequestInfo.Params.Values['
src_cgpn'],
RequestInfo.Params.Values['
src_cdpn'])
end;
//Die Funktion, um die Daten direkt weiterzusenden.
//Damit könnte man natürlich auch veränderte Daten senden.
//Benutzt wird ein IdHTTP-Client, der immer neu erzeugt wird,
//keine Ahnung, warum das nicht mit einer globalen Kompo gemacht wird
procedure TMain.Redirect(
const Params:
String);
var
url:
String;
HTTP: TIdHTTP;
begin
url:='
http://'+RedirectIP+'
:'+RedirectHost+'
/?'+Params;
HTTP:=TIdHTTP.Create(self);
try
HTTP.Get(
url);
finally
HTTP.Free;
end;
end;