Release 7

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@15 7c85be65-684b-0410-a082-b2ed4fbef004

blcksck2.pas

@@ -0,0 +1,128 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.000.000 |
+|==============================================================================|
+| Content: Library base for RAW sockets                                        |
+|==============================================================================|
+| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| (the "License"); you may not use this file except in compliance with the     |
+| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
+|                                                                              |
+| Software distributed under the License is distributed on an "AS IS" basis,   |
+| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
+| the specific language governing rights and limitations under the License.    |
+|==============================================================================|
+| The Original Code is Synapse Delphi Library.                                 |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/)           |
+|==============================================================================}
+
+{
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+Remember, this unit work only with Winsock2! (on Win98 and WinNT 4.0 or higher)
+If you must use this unit on Win95, download Wínsock2 from Microsoft
+and distribute it with your application!
+
+In spite of I use Winsock level version 1.1, RAW sockets work in this level only
+if Winsock2 is installed on your computer!!!
+
+On WinNT standardly RAW sockets work if program is running under user with
+administrators provilegies. To use RAW sockets under another users, you must
+create the following registry variable and set its value to DWORD 1:
+
+HKLM\System\CurrentControlSet\Services\Afd\Parameters\DisableRawSecurity
+
+After you change the registry, you need to restart your computer!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+}
+
+unit blcksck2;
+
+interface
+
+uses
+  winsock, SysUtils, windows, blcksock;
+
+type
+
+{TICMPBlockSocket}
+TICMPBlockSocket = class (TBlockSocket)
+public
+  procedure CreateSocket; override;
+end;
+
+{TRAWBlockSocket}
+TRAWBlockSocket = class (TBlockSocket)
+public
+  procedure CreateSocket; override;
+end;
+
+TIPHeader = Record
+   VerLen : Byte;
+   TOS : Byte;
+   TotalLen : Word;
+   Identifer : Word;
+   FragOffsets : Word;
+   TTL : Byte;
+   Protocol : Byte;
+   CheckSum : Word;
+   SourceIp : Dword;
+   DestIp : Dword;
+   Options : Dword;
+ End;
+
+function SetTimeout(Sock:TSocket;Timeout:integer):Boolean;
+
+
+implementation
+
+{======================================================================}
+
+{TICMPBlockSocket.CreateSocket}
+Procedure TICMPBlockSocket.CreateSocket;
+begin
+  FSocket:=winsock.socket(PF_INET,SOCK_RAW,IPPROTO_ICMP);
+  FProtocol:=IPPROTO_ICMP;
+  inherited createSocket;
+end;
+
+
+{======================================================================}
+
+{TRAWBlockSocket.CreateSocket}
+Procedure TRAWBlockSocket.CreateSocket;
+begin
+  FSocket:=winsock.socket(PF_INET,SOCK_RAW,IPPROTO_RAW);
+  FProtocol:=IPPROTO_RAW;
+  inherited createSocket;
+end;
+
+
+{======================================================================}
+
+function SetTimeout(Sock:TSocket;Timeout:integer):Boolean;
+var
+  len,Value,res:integer;
+  r1,r2:Boolean;
+begin
+  Result:=False;
+  r1:=False;
+  r2:=False;
+  Value:=Timeout*1000;
+  len:=SizeOf(Value);
+  Res:=Winsock.setsockopt(sock,SOL_SOCKET,SO_RCVTIMEO,@Value,len);
+  r1:=res<>SOCKET_ERROR;
+  Res:=Winsock.setsockopt(sock,SOL_SOCKET,SO_SNDTIMEO,@Value,len);
+  r2:=res<>SOCKET_ERROR;
+  Result:=r1 and r2;
+end;
+
+end.

blcksock.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.001 |
+| Project : Delphree - Synapse                                   | 001.001.000 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
@@ -14,7 +14,7 @@
 | The Original Code is Synapse Delphi Library.                                 |
 |==============================================================================|
 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999.                    |
+| Portions created by Lukas Gebauer are Copyright (c)1999,2000.                |
 | All Rights Reserved.                                                         |
 |==============================================================================|
 | Contributor(s):                                                              |
@@ -30,9 +30,6 @@ interface
 uses
   winsock, SysUtils, windows;
 
-const
-Copyright='Synapse Library 1.0.0 (c)1999 Lukas Gebauer';
-
 type
 
 {TBlockSocket}
@@ -69,7 +66,6 @@ public
   function WaitingData:integer;
   procedure SetLinger(enable:boolean;Linger:integer);
   procedure GetSins;
-
   function SockCheck(SockResult:integer):integer;
   function LocalName:string;
   function GetLocalSinIP:string;
@@ -78,6 +74,8 @@ public
   function GetRemoteSinPort:integer;
   function CanRead(Timeout:integer):boolean;
   function CanWrite(Timeout:integer):boolean;
+  procedure SendBufferTo(buffer:pointer;length:integer);
+  function RecvBufferFrom(buffer:pointer;length:integer):integer;
 
 published
   property socket:TSocket read FSocket write FSocket;
@@ -91,8 +89,7 @@ end;
 TUDPBlockSocket = class (TBlockSocket)
 public
   procedure CreateSocket; override;
-  procedure SendBufferTo(buffer:pointer;length:integer);
+  function EnableBroadcast(Value:Boolean):Boolean;
-  function RecvBufferFrom(buffer:pointer;length:integer):integer;
 end;
 
 {TTCPBlockSocket}
@@ -113,7 +110,7 @@ begin
   inherited create;
   FSocket:=INVALID_SOCKET;
   FProtocol:=IPPROTO_IP;
-  winsock.WSAStartup($101, FWsaData);
+  SockCheck(winsock.WSAStartup($101, FWsaData));
 end;
 
 {TBlockSocket.Destroy}
@@ -140,12 +137,18 @@ begin
     Sin.sin_port:= htons(StrToIntDef(Port,0))
   else
     Sin.sin_port:= ServEnt^.s_port;
-  Sin.sin_addr.s_addr:= inet_addr(PChar(ip));
+  if ip='255.255.255.255'
-  if SIn.sin_addr.s_addr = INADDR_NONE then
+    then Sin.sin_addr.s_addr:=u_long(INADDR_BROADCAST)
-    begin
+    else
-      HostEnt:= gethostbyname(PChar(ip));
+      begin
-      SIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
+        Sin.sin_addr.s_addr:= inet_addr(PChar(ip));
-    end;
+        if SIn.sin_addr.s_addr = u_long(INADDR_NONE) then
+          begin
+            HostEnt:= gethostbyname(PChar(ip));
+            if HostEnt <> nil then
+              SIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
+          end;
+      end;
 end;
 
 {TBlockSocket.GetSinIP}
@@ -445,6 +448,26 @@ begin
   result:=x>0;
 end;
 
+{TBlockSocket.SendBufferTo}
+procedure TBlockSocket.SendBufferTo(buffer:pointer;length:integer);
+var
+  len:integer;
+begin
+  len:=sizeof(FRemoteSin);
+  sockcheck(winsock.sendto(FSocket,buffer^,length,0,FRemoteSin,len));
+end;
+
+{TBlockSocket.RecvBufferFrom}
+function TBlockSocket.RecvBufferFrom(buffer:pointer;length:integer):integer;
+var
+  len:integer;
+begin
+  len:=sizeof(FRemoteSin);
+  result:=winsock.recvfrom(FSocket,buffer^,length,0,FRemoteSin,len);
+  sockcheck(result);
+end;
+
+
 
 {======================================================================}
 
@@ -456,23 +479,16 @@ begin
   inherited createSocket;
 end;
 
-{TUDPBlockSocket.SendBufferTo}
+{TUDPBlockSocket.EnableBroadcast}
-procedure TUDPBlockSocket.SendBufferTo(buffer:pointer;length:integer);
+function TUDPBlockSocket.EnableBroadcast(Value:Boolean):Boolean;
 var
-  len:integer;
+  Opt:integer;
+  Res:integer;
 begin
-  len:=sizeof(FRemoteSin);
+  opt:=Ord(Value);
-  sockcheck(winsock.sendto(FSocket,buffer^,length,0,FRemoteSin,len));
+  Res:=winsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @opt, SizeOf(opt));
-end;
+  SockCheck(Res);
-
+  Result:=res=0;
-{TUDPBlockSocket.RecvBufferFrom}
-function TUDPBlockSocket.RecvBufferFrom(buffer:pointer;length:integer):integer;
-var
-  len:integer;
-begin
-  len:=sizeof(FRemoteSin);
-  result:=winsock.recvfrom(FSocket,buffer^,length,0,FRemoteSin,len);
-  sockcheck(result);
 end;
 
 
@@ -513,6 +529,7 @@ end;
 function GetErrorDesc(ErrorCode:integer): string;
 begin
   case ErrorCode of
+    0                  : Result:= 'OK';
     WSAEINTR           : Result:= 'Interrupted system call';
     WSAEBADF           : Result:= 'Bad file number';
     WSAEACCES          : Result:= 'Permission denied';

pingsend.pas

@@ -0,0 +1,192 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.000.000 |
+|==============================================================================|
+| Content: PING sender                                                         |
+|==============================================================================|
+| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
+| (the "License"); you may not use this file except in compliance with the     |
+| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
+|                                                                              |
+| Software distributed under the License is distributed on an "AS IS" basis,   |
+| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
+| the specific language governing rights and limitations under the License.    |
+|==============================================================================|
+| The Original Code is Synapse Delphi Library.                                 |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2000.                     |
+| All Rights Reserved.                                                         |
+|==============================================================================|
+| Contributor(s):                                                              |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package                           |
+|          (Found at URL: http://www.mlp.cz/space/gebauerl/synapse/)           |
+|==============================================================================}
+
+{
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+Remember, this unit work only with Winsock2! (on Win98 and WinNT 4.0 or higher)
+If you must use this unit on Win95, download Wínsock2 from Microsoft
+and distribute it with your application!
+
+In spite of I use Winsock level version 1.1, RAW sockets work in this level only
+if Winsock2 is installed on your computer!!!
+
+On WinNT standardly RAW sockets work if program is running under user with
+administrators provilegies. To use RAW sockets under another users, you must
+create the following registry variable and set its value to DWORD 1:
+
+HKLM\System\CurrentControlSet\Services\Afd\Parameters\DisableRawSecurity
+
+After you change the registry, you need to restart your computer!
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+}
+
+unit PINGsend;
+
+interface
+
+uses
+  winsock, SysUtils, windows, blcksck2, Synautil, dialogs;
+
+const
+  ICMP_ECHO=8;
+  ICMP_ECHOREPLY=0;
+
+type
+
+TIcmpEchoHeader = Record
+  i_type : Byte;
+  i_code : Byte;
+  i_checkSum : Word;
+  i_Id : Word;
+  i_seq : Word;
+  TimeStamp : ULong;
+End;
+
+TPINGSend=class(TObject)
+  private
+    Sock:TICMPBlockSocket;
+    Buffer:string;
+    seq:integer;
+    id:integer;
+    function checksum:integer;
+  public
+    timeout:integer;
+    PacketSize:integer;
+    PingTime:integer;
+    function ping(host:string):Boolean;
+    constructor Create;
+    destructor Destroy; override;
+end;
+
+function PingHost(host:string):integer;
+
+implementation
+
+{==============================================================================}
+
+{TPINGSend.Create}
+Constructor TPINGSend.Create;
+begin
+  inherited Create;
+  sock:=TICMPBlockSocket.create;
+  sock.CreateSocket;
+  timeout:=5;
+  packetsize:=32;
+  seq:=0;
+end;
+
+{TPINGSend.Destroy}
+Destructor TPINGSend.Destroy;
+begin
+  Sock.free;
+  inherited destroy;
+end;
+
+{TPINGSend.ping}
+function TPINGSend.ping(host:string):Boolean;
+var
+  PIPHeader:^TIPHeader;
+  IpHdrLen:Integer;
+  PIcmpEchoHeader:^TICMPEchoHeader;
+  data:string;
+  n,x:integer;
+begin
+  Result:=False;
+  sock.connect(host,'0');
+  Buffer:=StringOfChar(#0,SizeOf(TICMPEchoHeader)+packetSize);
+  PIcmpEchoHeader := Pointer(Buffer);
+  With PIcmpEchoHeader^ Do Begin
+    i_type:=ICMP_ECHO;
+    i_code:=0;
+    i_CheckSum:=0;
+    id:=Random(32767);
+    i_Id:=id;
+    TimeStamp:=GetTickcount;
+    Inc(Seq);
+    i_Seq:=Seq;
+    for n:=Succ(SizeOf(TicmpEchoHeader)) to Length(Buffer) do
+      Buffer[n]:=#$55;
+    i_CheckSum:=CheckSum;
+  end;
+  sock.sendString(Buffer);
+  if sock.canread(timeout)
+    then begin
+      x:=sock.waitingdata;
+      setlength(Buffer,x);
+      sock.recvbuffer(Pointer(Buffer),x);
+      PIpHeader:=Pointer(Buffer);
+      IpHdrLen:=(PIpHeader^.VerLen and $0F)*4;
+      PIcmpEchoHeader:=@Buffer[IpHdrLen+1];
+      if (PIcmpEchoHeader^.i_type=ICMP_ECHOREPLY) then
+        if (PIcmpEchoHeader^.i_id=id) then
+          begin
+            PingTime:=GetTickCount-PIcmpEchoHeader^.TimeStamp;
+            Result:=True;
+          end;
+    end;
+end;
+
+{TPINGSend.checksum}
+function TPINGSend.checksum:integer;
+type
+  tWordArray=Array[0..0] Of Word;
+var
+  PWordArray:^TWordArray;
+  CkSum:Dword;
+  Num,Remain:Integer;
+  n:Integer;
+begin
+  Num:=length(Buffer) div 2;
+  Remain:=length(Buffer) mod 2;
+  PWordArray:=Pointer(Buffer);
+  CkSum := 0;
+  for n:=0 to Num-1 do
+    CkSum:=CkSum+PWordArray^[n];
+  if Remain<>0 then
+    CkSum:=CkSum+ord(Buffer[Length(Buffer)]);
+  CkSum:=(CkSum shr 16)+(CkSum and $FFFF);
+  CkSum:=CkSum+(CkSum shr 16);
+  Result:=Word(not CkSum);
+end;
+
+{==============================================================================}
+
+function PingHost(host:string):integer;
+var
+  ping:TPINGSend;
+begin
+  ping:=TPINGSend.Create;
+  try
+    if ping.ping(host)
+      then Result:=ping.pingtime
+      else Result:=-1;
+  finally
+    ping.Free;
+  end;
+end;
+
+end.