Solved

NT Service

Posted on 2001-07-16
4
320 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 1

Expert Comment

by:bnemmers
ID: 6286968
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
ID: 6287080
listening...
0
 

Author Comment

by:tweety_sven
ID: 6289103
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
ID: 6290464
Make sure the TClientSocket ClientType is set to ctBlocking
and the TServerSocket ServerType is set to stThreadBlocking

Bill :)
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
This is a high-level webinar that covers the history of enterprise open source database use. It addresses both the advantages companies see in using open source database technologies, as well as the fears and reservations they might have. In this…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…

691 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