asked on

NT Service

I am trying to make a Nt service that needs to do the following :

It an environment with 10 clients (Win98 and Win 2000).
If the users log on to the domain, a little program
sends a message to the service on the server.

If the users log off, the program sends again a message
to the service on the server.

By this way, the service can find out if a user is logged on or not.

Every day the service needs to check an Interbase database to see if a user already made some records into
it. If not, the service has to send a message to that user.

The little program at the users side, provides the service
through a message their IP-nr (dynamically) and their Windows-username (which is used in the database).

For the moment I use the components on the Internet-tab
NMMsg and NMMSGServ. But my service is not stable at all.

Can somebody help me with a complete solution to this problem.

On the internet I've only found some services that beeps every 10 seconds (not usefull in my case).

Thanks,

Sven.

bnemmers

Hi,

Here's a little app that send data between two sockets.
If you place the recevied side into your NT service app
this should work fine. I didn't include any code that gets
the IP address or name but I think your app already does that.

Bill :)

unit Client;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp;

type
TData = record
UserName: string[50];
IP: string[15];
end;

TSendThread = class(TThread)
private
fMemStream: TMemoryStream;
protected
procedure Execute; override;
procedure HandleThreadException;
public
constructor Create(aMemStream: TMemoryStream);
destructor Destroy; override;
end;

TReceviedThread = class(TServerClientThread)
private
fMemStream: TMemoryStream;
protected
procedure ClientExecute; override;
procedure HandleExeption;
public
destructor Destroy; override;
property DataStream: TMemoryStream read fMemStream;
end;

TForm1 = class(TForm)
SendDataSocket: TClientSocket;
btnSend: TButton;
lblIP: TLabel;
edtIPAddress: TEdit;
edtName: TEdit;
lblName: TLabel;
ReceviedDataSocket: TServerSocket;
gbRecevied: TGroupBox;
Label1: TLabel;
edtRcvIP: TEdit;
edtRcvName: TEdit;
Label2: TLabel;
procedure SendDataSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure btnSendClick(Sender: TObject);
procedure ReceviedDataSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
procedure ReceviedDataSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

{ TSendThread }

constructor TSendThread.Create(aMemStream: TMemoryStream);
begin
inherited Create(False);
fMemStream := TMemoryStream.Create;
fMemStream.LoadFromStream(aMemStream)
end;

destructor TSendThread.Destroy;
begin
if Assigned(fMemStream) then
fMemStream.Free;
inherited;
end;

procedure TSendThread.Execute;
var
SocketStream: TWinSocketStream;
begin
SocketStream := TWinSocketStream.Create(Form1.SendDataSocket.Socket, 30000);
try
if (not Terminated) and (Form1.SendDataSocket.Active) then
begin
try
SocketStream.CopyFrom(fMemStream, fMemStream.Size)
except
if not(ExceptObject is EAbort) then
Synchronize(HandleThreadException);
end;
end;
finally
Form1.SendDataSocket.Socket.Close;
SocketStream.Free;
end;
end;

procedure TSendThread.HandleThreadException;
begin
// Place exception handling code here
ShowMessage('Exception!');
end;

{ TReceviedThread }

destructor TReceviedThread.Destroy;
begin
if Assigned(fMemStream) then
fMemStream.Free;
inherited;
end;

procedure TReceviedThread.ClientExecute;
var
SocketStream: TWinSocketStream;
Data: TData;
begin
if not Assigned(fMemStream) then
fMemStream := TMemoryStream.Create;

while (not Terminated) and ClientSocket.Connected do
begin
try
SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
try
while SocketStream.WaitForData(30000) do
begin
if not Terminated then
begin
if SocketStream.Read(Data, SizeOf(Data)) = 0 then
ClientSocket.Close
else
fMemStream.Write(Data, SizeOf(Data));
end;
end;
finally
SocketStream.Free;
Terminate;
end;
except
HandleException;
end;
end;
end;

procedure TReceviedThread.HandleExeption;
begin
// Place exception handling code here
ShowMessage('Exception!');
end;

{ TForm1 }

procedure TForm1.SendDataSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
btnSend.Enabled := True;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
MemoryStream: TMemoryStream;
Data: TData;
begin
MemoryStream := TMemoryStream.Create;
try
Data.UserName := edtName.Text;
Data.IP := edtIPAddress.Text;
MemoryStream.Write(Data, SizeOf(Data));
btnSend.Enabled := False;

with SendDataSocket do
begin
Address := '127.0.0.1';
Port := 8999;
try
Open;

if SendDataSocket.Socket.Connected then
TSendThread.Create(MemoryStream);
except
end;
end;
finally
MemoryStream.Free;
end;
end;

procedure TForm1.ReceviedDataSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread := TReceviedThread.Create(False, ClientSocket);
end;

procedure TForm1.ReceviedDataSocketThreadEnd(Sender: TObject; Thread: TServerClientThread);
var
MemoryStream: TMemoryStream;
Data: TData;
begin
MemoryStream := TMemoryStream.Create;
try
MemoryStream.LoadFromStream((Thread as TReceviedThread).DataStream);
MemoryStream.Read(Data, SizeOf(Data));
edtRcvName.Text := Data.UserName;
edtRcvIP.Text := Data.IP;
finally
MemoryStream.Free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ReceviedDataSocket.Active := True;
end;

end.

vladh

listening...

tweety_sven

ASKER

The program on the client-side has 2 problems:

1 : It seems that it doesn't get connected with
the server and therefore doesn't send
the message.
2 : When I execute the line ReceiveDataSocket.Active :=
true then I get the error ESocketError with message
Asynchronous socket error 10061.

I adjusted your code a little bit for my needs,
but I don't think this has anything to do with the
errors I receive.

Thanks,

Sven.

My Unit of the client-side looks as following:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp,StdCtrls, ExtCtrls, Winsock, Psock, ComCtrls;

type
TUser = record
username : string;
IP : string[15];
status : string;
end;

TSendThread = class(TThread)
private
fMemStream: TMemoryStream;
protected
procedure Execute; override;
procedure HandleThreadException;
public
constructor Create(aMemStream: TMemoryStream);
destructor Destroy; override;
end;

TReceiveThread = class(TServerClientThread)
private
fMemStream: TMemoryStream;
protected
procedure ClientExecute; override;
procedure HandleExeption;
public
destructor Destroy; override;
property DataStream: TMemoryStream read fMemStream;
end;

TWerkstaten_Client = class(TForm)
ReceiveDataSocket: TServerSocket;
SendDataSocket: TClientSocket;
Timer1: TTimer;
procedure ReceiveDataSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
procedure ReceiveDataSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
procedure Timer1Timer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
status : string;
function GetUserNameInfo : string;
function GetIpAddress : string;
procedure Connect;
public
{ Public declarations }
end;

var
Werkstaten_Client: TWerkstaten_Client;

implementation

{$R *.DFM}

{TSendThread}

constructor TSendThread.Create(aMemStream: TMemoryStream);
begin
inherited Create(False);
fMemStream := TMemoryStream.Create;
fMemStream.LoadFromStream(aMemStream)
end;

destructor TSendThread.Destroy;
begin
if Assigned(fMemStream) then
fMemStream.Free;
inherited;
end;

procedure TSendThread.Execute;
var
SocketStream : TWinSocketStream;
begin
SocketStream := TWinSocketStream.Create
(Werkstaten_Client.SendDataSocket.Socket,30000);
try
if (not Terminated) and (Werkstaten_Client.SendDataSocket.Active) then
begin
try
SocketStream.CopyFrom(fMemStream, fMemStream.Size)
except
if not(ExceptObject is EAbort) then
Synchronize(HandleThreadException);
end;
end;
finally
Werkstaten_Client.SendDataSocket.Close;
SocketStream.Free;
end;
end;

procedure TSendThread.HandleThreadException;
begin
//Place exception handling code here
ShowMessage('Exception');
end;

{TReceiveThread}

destructor TReceiveThread.Destroy;
begin
if Assigned(fMemStream) then
fMemStream.Free;
inherited;
end;

procedure TReceiveThread.ClientExecute;
var
SocketStream: TWinSocketStream;
User : TUser;
begin
if not Assigned(fMemStream) then
fMemStream := TMemoryStream.Create;
while (not Terminated) and ClientSocket.Connected do
begin
try
SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
try
while SocketStream.WaitForData(30000) do
begin
if not Terminated then
begin
if SocketStream.Read(User, SizeOf(User)) = 0 then
ClientSocket.Close
else
fMemStream.Write(User, SizeOf(User));
end;
end;
finally
SocketStream.Free;
Terminate;
end;
except
HandleException;
end;
end;
end;

procedure TReceiveThread.HandleExeption;
begin
//Place Exception code here
ShowMessage('Exception');
end;

procedure TWerkstaten_Client.Connect;
var
MemoryStream : TMemoryStream;
User : TUser;
begin
Timer1.interval := 0;
MemoryStream := TMemoryStream.Create;
try
User.username := UpperCase(GetUserNameInfo);
User.IP := GetIpAddress;
User.status := status;
MemoryStream.Write(User, SizeOf(User));
with SendDataSocket do
begin
Address := '192.8.100.23';
Port := 6711;
try
Open;
if SendDataSocket.Socket.Connected then
TSendThread.Create(MemoryStream)
else Timer1.interval := 10000;
except
end;
end;
finally
MemoryStream.Free;
end;
end;

function TWerkstaten_Client.GetIpAddress: string;
var
p: PHostEnt;
s: array[0..128] of char;
begin
GetHostName(@s, 128);
p := GetHostByName(@s);
Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
end;

function TWerkstaten_Client.GetUserNameInfo: string;
const
metTerminator = 11; // string inlezen met null-terminator
var
zonderTerminator : DWord; // string verkleinen zonder null-terminator
userName : string;
begin
zonderTerminator := metTerminator - 1;
SetLength( userName, metTerminator);
GetUserName( PChar(userName), zonderTerminator);
userName := String(PChar(userName));
Result := userName;
end;

procedure TWerkstaten_Client.ReceiveDataSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread := TReceiveThread.Create(False, ClientSocket);
end;

procedure TWerkstaten_Client.ReceiveDataSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
var
MemoryStream : TMemoryStream;
User : TUser;
begin
MemoryStream := TMemoryStream.Create;
try
MemoryStream.LoadFromStream((Thread as TReceiveThread).DataStream);
MemoryStream.Read(User, SizeOf(User));
if User.status = 'Fout-Server' then
begin
Timer1.Interval := 10000;
end else
begin
ShowMessage(User.username + ', Gelieve Uw werkstaten in te vullen!');
end;
finally
MemoryStream.Free;
end;
end;

procedure TWerkstaten_Client.Timer1Timer(Sender: TObject);
begin
status := 'start';
Connect;
end;

procedure TWerkstaten_Client.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
status := 'stop';
Connect;
CanClose := true;
end;

procedure TWerkstaten_Client.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
Close;
end;

procedure TWerkstaten_Client.FormCreate(Sender: TObject);
begin
Timer1.Interval := 1000;
ReceiveDataSocket.Active := true;
end;

end.

ASKER CERTIFIED SOLUTION

bnemmers

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial