Release 8

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

blcksock.pas

@@ -1,5 +1,5 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.001.000 |
+| Project : Delphree - Synapse                                   | 001.001.001 |
 |==============================================================================|
 | Content: Library base                                                        |
 |==============================================================================|
@@ -236,7 +236,9 @@ end;
 function TBlockSocket.RecvBuffer(buffer:pointer;length:integer):integer;
 begin
   result:=winsock.recv(FSocket,buffer^,length,0);
-  sockcheck(result);
+  if result=0
+    then FLastError:=WSAENOTCONN
+    else sockcheck(result);
 end;
 
 {TBlockSocket.RecvByte}

smtpsend.pas

@@ -1,7 +1,7 @@
 {==============================================================================|
-| Project : Delphree - Synapse                                   | 001.000.001|
+| Project : Delphree - Synapse                                   | 001.001.000 |
 |==============================================================================|
-| Content: SMTP client                                                        |
+| Content: SMTP client                                                         |
 |==============================================================================|
 | 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     |
@@ -40,6 +40,8 @@ type
   public
     timeout:integer;
     SMTPHost:string;
+    ResultCode:integer;
+    ResultString:string;
     Constructor Create;
     Destructor Destroy; override;
     function login:Boolean;
@@ -79,6 +81,7 @@ var
 begin
   Result:=0;
   s:=sock.recvstring(timeout);
+  ResultString:=s;
   if Length(s)>=3 then Result:=Strtointdef(Copy(s,1,3),0);
   while pos('-',s)=4 do
     begin
@@ -89,6 +92,7 @@ begin
           break;
         end;
     end;
+  ResultCode:=Result;
 end;
 
 {TSMTPSend.login}

sntpsend.pas

@@ -0,0 +1,164 @@
+{==============================================================================|
+| Project : Delphree - Synapse                                   | 001.000.000 |
+|==============================================================================|
+| Content: SNTP client                                                         |
+|==============================================================================|
+| 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/)           |
+|==============================================================================}
+
+
+unit SNTPsend;
+
+interface
+
+uses
+  winsock, SysUtils, windows, blcksock, Synautil, dialogs;
+
+type
+
+  TNtp = packed record
+    mode:Byte;
+    stratum:Byte;
+    poll:Byte;
+    Precision:Byte;
+    RootDelay : longint;
+    RootDisperson : longint;
+    RefID : longint;
+    Ref1, Ref2,
+    Org1, Org2,
+    Rcv1, Rcv2,
+    Xmit1, Xmit2 : longint;
+  end;
+
+TSNTPSend=class(TObject)
+  private
+    Sock:TUDPBlockSocket;
+    Buffer:string;
+  public
+    timeout:integer;
+    SntpHost:string;
+    NTPReply:TNtp;
+    NTPTime:TDateTime;
+    constructor Create;
+    destructor Destroy; override;
+    function DecodeTs(nsec,nfrac:Longint):tdatetime;
+    function GetNTP:Boolean;
+    function GetBroadcastNTP:Boolean;
+end;
+
+implementation
+
+{==============================================================================}
+
+{TSNTPSend.Create}
+Constructor TSNTPSend.Create;
+begin
+  inherited Create;
+  sock:=TUDPBlockSocket.create;
+  sock.CreateSocket;
+  timeout:=5;
+  sntphost:='localhost';
+end;
+
+{TSNTPSend.Destroy}
+Destructor TSNTPSend.Destroy;
+begin
+  Sock.free;
+  inherited destroy;
+end;
+
+{TSNTPSend.DecodeTs}
+function TSNTPSend.DecodeTs(nsec,nfrac:Longint):tdatetime;
+const
+  maxi = 4294967296.0;
+var
+  d, d1: double;
+begin
+  nsec:=htonl(nsec);
+  nfrac:=htonl(nfrac);
+  d:=nsec;
+  if d<0
+    then d:=maxi+d-1;
+  d1 := nfrac;
+  if d1<0
+    then d1:=maxi+d1-1;
+  d1:=d1/maxi;
+  d1:=trunc(d1*1000)/1000;
+  result:=(d+d1)/86400;
+  result := Result + 2;
+end;
+
+
+{TSNTPSend.GetBroadcastNTP}
+function TSNTPSend.GetBroadcastNTP:Boolean;
+var
+  PNtp:^TNtp;
+  x:integer;
+begin
+  Result:=False;
+  sock.bind('0.0.0.0','ntp');
+  if sock.canread(timeout)
+    then begin
+      x:=sock.waitingdata;
+      setlength(Buffer,x);
+      sock.recvbufferFrom(Pointer(Buffer),x);
+      if (sntphost='0.0.0.0') or (sock.GetRemoteSinIP=sntphost) then
+        if x>=SizeOf(NTPReply) then
+          begin
+            PNtp:=Pointer(Buffer);
+            NtpReply:=PNtp^;
+            NTPtime:=DeCodeTs(ntpreply.Xmit1,ntpreply.Xmit2);
+            Result:=True;
+          end;
+    end;
+end;
+
+{TSNTPSend.GetNTP}
+function TSNTPSend.GetNTP:Boolean;
+var
+  q:Tntp;
+  PNtp:^TNtp;
+  x:integer;
+begin
+  Result:=False;
+  sock.Connect(sntphost,'ntp');
+  fillchar(q,SizeOf(q),0);
+  q.mode:=$1b;
+  sock.SendBuffer(@q,SizeOf(q));
+  if sock.canread(timeout)
+    then begin
+      x:=sock.waitingdata;
+      setlength(Buffer,x);
+      sock.recvbuffer(Pointer(Buffer),x);
+      if x>=SizeOf(NTPReply) then
+        begin
+          PNtp:=Pointer(Buffer);
+          NtpReply:=PNtp^;
+          NTPtime:=DeCodeTs(ntpreply.Xmit1,ntpreply.Xmit2);
+          Result:=True;
+        end;
+    end;
+end;
+
+
+{==============================================================================}
+
+
+end.