Solved

NT Service

Posted on 2001-07-16
4
314 Views
Last Modified: 2010-04-04
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.


0
Comment
Question by:tweety_sven
  • 2
4 Comments
 
LVL 1

Expert Comment

by:bnemmers
Comment Utility
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.
0
 
LVL 3

Expert Comment

by:vladh
Comment Utility
listening...
0
 

Author Comment

by:tweety_sven
Comment Utility
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.
0
 
LVL 1

Accepted Solution

by:
bnemmers earned 200 total points
Comment Utility
Make sure the TClientSocket ClientType is set to ctBlocking
and the TServerSocket ServerType is set to stThreadBlocking

Bill :)
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now