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.
![Delphi-PRAXiS [en]](https://en.delphipraxis.net/uploads/monthly_2018_12/logo.png.be76d93fcd709295cb24de51900e5888.png){kind=logo}
