pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

Release 8

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@17 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2008-04-23 20:36:57 +00:00
parent ac5a713d77
commit 14abb74784
3 changed files with 174 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
blcksock.pas
View File

@@ -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}

8
smtpsend.pas
View File

@@ -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}

164
sntpsend.pas Normal file
View File

@@ -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.