Net Find Component

[Alberto Meyer 0]

Hello. I downloaded the Net Find component from the ICS website but I'm having difficulties adapting to the new versions of Delphi and ICS. Can someone help me? Thank you very much.

 

Problem is in uses Wsocket, WsocketS. If i change to new ICS sockets, get a problem in  TSockAddrIn

 

{
  NetFind
  =======
  Developed by Sven Schmidts (schmidts@cdesign.de)

  Use this component to make a broadcast and find all PC's, on wich this
  component is running. You can send your own data to the PC's and receive
  the data, that is send back within addional strings.

  Using:
  1. Drop the component on the form
  2. Set "Timeout", this is the time (mSek) to wait for answers
  3. Set the "Port", this must be the same as on the client. Requests and answer
     are made on the same port!
  4. Define the events
     - OnClientFound (called on Server-side)
       This is called if a client answer to your request. You can handle it
       by your own or let the component do the work. Every answer is saved into
       an internal array, so you can handle it later.
     - OnFoundDone (called on Server-side)
       This is called after "Timeout" is reached. Now you have access to the Array
       "ClientList", wich save the answers from the clients.
     - OnRequest (called on Client-Side)
       Is called, if a request comes in. You can answer with a string or let the
       component do the work.
  5. Start the application on server an client
  6. On Server call ".Find" Method with an optional initial-string
  7. Have fun ... ;)
}
unit NetFind;

interface

uses
  Windows, Classes, SysUtils, ExtCtrls, WSocket, WSocketS, WinSock;

type

  TFoundEvent  = Procedure(Sender:TObject;Client:TWSocket;FromIP,FromPCName,Data:String) of object;
  TRequestEvent  = Procedure(Sender:TObject;Client:TWSocket;FromIP,FromPCName,Data:String;
                             var Answer: string) of object;
  TFoundDoneEvent = Procedure(Sender:TObject) of object;

  RClients = Record
    IP    :String;
    Name  :String;
    Answer:String;
  end;

  TNetFind = class(TComponent)
  private
    { Private-Deklarationen }
  protected
    FActive:Boolean;
    FPort:String;
    FLocalPCName:String;
    FTimeout:DWord;
    FTimer:TTimer;
    FTagStr:String;
    SocketServer:TWSocketServer;
    FOnClientFound : TFoundEvent;
    FOnRequest: TRequestEvent;
    FFoundDoneEvent: TFoundDoneEvent;
    procedure SocketServerDataAvailable(Sender: TObject; Error: Word);
    procedure SetActive(Value:Boolean);
    procedure SetPCName(Default:String);
    function ExtractPCName(var Source:String):String;
    procedure TimerTimeout(Sender: TObject);
  public
    ClientList: Array of RClients;
    procedure Find(InitMessage:String);
  published
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    property TagStr:String read FTagStr write FTagStr;
    property Active:Boolean read FActive write SetActive;
    property Port:String read FPort write FPort;
    property LocalPCName:String read FLocalPCName;
    property FindTimeout: DWord read FTimeout write FTimeout default 3000;
    property OnClientFound:TFoundEvent read FOnClientFound
                                       write FOnClientFound;
    property OnRequest: TRequestEvent read FOnRequest
                                      write FOnRequest;
    property OnFoundDone: TFoundDoneEvent read FFoundDoneEvent
                                          write FFoundDoneEvent;
  end;

procedure Register;

implementation

const
  IsRequest = #17;
  IsAnswer  = #20;
  Delimiter = '|';

procedure Register;
begin
  RegisterComponents('FPiette', [TNetFind]);
end;

constructor TNetFind.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  if not (csDesigning in ComponentState) then begin
    SocketServer := TWSocketServer.Create(self);
    SocketServer.Proto := 'udp';
    SocketServer.OnDataAvailable := SocketServerDataAvailable;
    FTimer := TTimer.Create(Self);
    FTimer.Enabled := false;
    FTimer.OnTimer := TimerTimeout;
  end;
  FPort       := '2899';
  FindTimeout := 3000;
  SetPCName('netfindpc');
  SetLength(ClientList,0);
end;

destructor TNetFind.Destroy;
begin
  Try
    If Assigned(SocketServer) then SocketServer.Free;
    If Assigned(FTimer) then FTimer.Free;
    SetLength(ClientList,0);
  Except
  End;
  inherited destroy;
end;

procedure TNetFind.SetPCName(Default:String);
  var
    ComputerName : PChar;
    NameSize : DWORD;
begin
  Try
    If Default<>'' then FLocalPCName := Default;
    ComputerName := #0;
    NameSize := MAX_COMPUTERNAME_LENGTH + 1;
    try
      GetMem(ComputerName, NameSize);
      Windows.GetComputerName(ComputerName, NameSize);
      If Trim(StrPas(ComputerName))<>'' then
        FLocalPCName:= StrPas(ComputerName);
    finally
      FreeMem(ComputerName);
    end;
  Except
  End;
end;

function TNetFind.ExtractPCName(var Source:String):String;
begin
  Result := '';
  If Source='' then exit;
  Result := Copy(Source,0,Pos(Delimiter,Source)-1);
  Source := Copy(Source,Pos(Delimiter,Source)+1,Length(Source));
end;

procedure TNetFind.TimerTimeout(Sender: TObject);
begin
  FTimer.Enabled := false;
  If Assigned(FFoundDoneEvent) then FFoundDoneEvent(Self);
End;

procedure TNetFind.SetActive(Value:Boolean);
begin
  If not Assigned(SocketServer) then exit;
  If Value<>FActive then begin

    If Value then begin
      SocketServer.Addr := '0.0.0.0';
      SocketServer.Port := FPort;
    end;

    If Value then SocketServer.Listen
    Else SocketServer.Close;
    FActive := Value;
  end;
end;

procedure TNetFind.Find(InitMessage:String);
  var TempSocket:TWSocket;
begin
  SetLength(ClientList,0);
  If not Assigned(SocketServer) then exit;
  Try
    If (FLocalPCName='') then SetPCName('netfindpc');
    TempSocket := TWSocket.Create(Self);
    TempSocket.Proto := 'udp';
    TempSocket.Addr := '255.255.255.255';
    TempSocket.Port := FPort;
    TempSocket.LocalAddr := '0.0.0.0';
    TempSocket.Connect;
    TempSocket.SendStr(IsRequest+FLocalPCName+Delimiter+InitMessage);
    TempSocket.Close;
    TempSocket.Free;
    If FTimeout>0 then begin
      FTimer.Interval := FTimeout;
      FTimer.Enabled  := true;
    End else FTimer.Enabled := false;
  Except
  end;
end;

procedure TNetFind.SocketServerDataAvailable(Sender: TObject; Error: Word);
  var
    Buffer : array [0..1023] of char;
    Len    : Integer;
    Src    : TSockAddrIn;
    SrcLen : Integer;
    Client : TWSocket;
    FromIP, FromPCName, Data, DataToSend:String;
    TempSocket:TWSocket;
    DoAnswer:Boolean;
begin
  If Error<>0 then exit;
  Try
    Client := TWSocket(Sender);
    SrcLen := SizeOf(Src);
    Len    := Client.ReceiveFrom(@Buffer, SizeOf(Buffer), Src, SrcLen);
    If (Len>0) then begin
      FromIP := StrPas(inet_ntoa(Src.sin_addr));
      Data   := Copy(StrPas(Buffer),1,Len);
      DoAnswer := (Data[1]=IsRequest);
      Data := Copy(Data,2,Length(Data));
      If Pos(Delimiter,Data)>0 then FromPCName := ExtractPCName(Data)
      else FromPCName := '';
      DataToSend := 'Hello to '+FromIP;
      { It's an answer to our request ... }
      If not DoAnswer then begin
        SetLength(ClientList,Length(ClientList)+1);
        ClientList[Length(ClientList)-1].IP    := FromIP;
        ClientList[Length(ClientList)-1].Name  := FromPCName;
        ClientList[Length(ClientList)-1].Answer:= Data;
        If Assigned(FOnClientFound) then
          FOnClientFound(Self,Client,FromIP,FromPCName,Data);
      { We received a request, answer ... }
      end else If ((DataToSend<>'') and (FromPCName<>FLocalPCName)) then begin
        DataToSend := '';
        If Assigned(FOnRequest) then
          FOnRequest(Self,Client,FromIP,FromPCName,Data,DataToSend);
        TempSocket := TWSocket.Create(Self);
        TempSocket.Proto := 'udp';
        TempSocket.Addr := FromIP;
        TempSocket.Port := FPort;
        TempSocket.LocalAddr := '0.0.0.0';
        TempSocket.Connect;
        TempSocket.SendStr(IsAnswer+FLocalPCName+Delimiter+DataToSend);
        TempSocket.Close;
        TempSocket.Free;
      End;
    End;
  Except
  End;
end;

end.

 

[FPiette 383]

6 hours ago, Alberto Meyer said:

If i change to new ICS sockets, get a problem in  TSockAddrIn

Please describe the problem you get. And tell us which Delphi version you use.

[Alberto Meyer 0]

Sydney 10.4.2.

 

Code won´t compile. problem uses 

WSocket, WSocketS

When i change for the ICS equivalent, problem in

 

 

Src    : TSockAddrIn;

 

 

[Angus Robertson 574]

But what error are you getting, and when, compile or runtime?. 

 

That ancient program was built for an earlier version of ICS, but should still work once the unit names are corrected. 

 

You may want to change all strings to AnsiStrings and Char to AnsiChar since you are using a unicode compiler.

 

Or are you expecting someone to correct, build and debug it for you?  

 

Angus

 

[FPiette 383]

What is the problem with "Src : TSockAddrIn;" ?

What error message give the compiler.

You really have to help us to help you!

 

[Alberto Meyer 0]

Error in compiling the component. 

I forget to change "AnsiStrings and Char to AnsiChar".  I will try that

 

"Or are you expecting someone to correct, build and debug it for you? "

No, i really ask for help in make this work.  I never touch in this socket stuff before.  I thought that

component was in use for another people. I will try

 

"What error message give the compiler."

 

I will try later today and post here. I really appreciate your efforts. Thanks a lot

 

 

[Angus Robertson 574]

The component probably was in use 15 to 20 years ago, it looks like clean code, but compilers change. 

 

That User Made page is all very old projects for old versions of ICS, several of them are now part of ICS.

 

Angus

 

[Alberto Meyer 0]

I Change "WSocket, WSocketS" to "OverbyteIcsWSocket, OverbyteIcsWSocketS"

Error in "Src: TSockAddrIn"  is

E2023: Types of actual and formal var parameters must be identical at line 220  
    

[FPiette 383]

53 minutes ago, Alberto Meyer said:

I Change "WSocket, WSocketS" to "OverbyteIcsWSocket, OverbyteIcsWSocketS"

You probably forgot to change Winsock to OverbyteIcsWinSock.

The use clause should be this:

uses
  Windows, Classes, SysUtils, ExtCtrls,
  OverbyteIcsWSocket, OverbyteIcsWSocketS, OverbyteIcsWinSock;

 

[Alberto Meyer 0]

Bingo!!!!  Thank you François and all others. Good luck on Catar 2022

[Alberto Meyer 0]

It freezes IDE when PUT in a form. Maybe the component is too oldInsert other media

Edited November 11, 2022 by Alberto Meyer

[FPiette 383]

9 hours ago, Alberto Meyer said:

It freezes IDE when PUT in a form.

You have to try the component in a sample application, creating the component at runtime. When it works, you can consider installing it in the IDE.

That's not specific to that component but it is how any component has to be developed.

When the component is in the sample application, you can use the debugger to understand where and why it blocks.