home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 5 / ctrom5b.zip / ctrom5b / PROGRAM / DELPHI / LCSIPPT / SAMPLES / MAINFRM.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-11  |  5KB  |  190 lines
  1. unit Mainfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, Ipport, Winsock;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     MainMenu: TMainMenu;
  12.     FileExitItem: TMenuItem;
  13.     StatusBar: TPanel;
  14.     IPPort1: TIPPort;
  15.     Memo1: TMemo;
  16.     Panel1: TPanel;
  17.     FName: TEdit;
  18.     Btn1: TButton;
  19.     Btn2: TButton;  { E&xit }
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure ShowHint(Sender: TObject);
  22.     procedure FileExit(Sender: TObject);
  23.     procedure Btn1Click(Sender: TObject);
  24.     procedure IPPort1DataAvailable(Socket: Word);
  25.     procedure IPPort1SocketClose(Socket: Word);
  26.     procedure IPPort1TimeOut(Socket: Word);
  27.     procedure IPPort1SocketConnect(Socket: Word);
  28.     procedure Btn2Click(Sender: TObject);
  29.     procedure IPPort1DataReady(Socket: Word);
  30.   end;
  31.  
  32. var
  33.   MainForm: TMainForm;
  34.   TSock, FSock: TSocket;
  35.   Hostname, username:  string;
  36.   DataBack : TMemoryStream;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. procedure TMainForm.FormCreate(Sender: TObject);
  43. begin
  44.   Application.OnHint := ShowHint;
  45.   DataBack := TMemoryStream.Create;
  46. end;
  47.  
  48. procedure TMainForm.ShowHint(Sender: TObject);
  49. begin
  50.   StatusBar.Caption := Application.Hint;
  51. end;
  52.  
  53. procedure TMainForm.FileExit(Sender: TObject);
  54. begin
  55.   DataBack.Free;
  56.   Close;
  57. end;
  58.  
  59. procedure TMainForm.Btn1Click(Sender: TObject);
  60. var
  61.     iPos : Integer;
  62. begin
  63.     if FName.Text <> '' Then
  64.     begin
  65.         iPos := Pos('@',FName.Text);
  66.         if iPos > 0 Then
  67.         begin
  68.             Inc(iPos);
  69.             Username := Copy(FName.Text, 1, iPos-2);
  70.             HostName := Copy(FName.Text, iPos, Length(FName.Text));
  71.             IPPort1.RemoteAddress := HostName;
  72.             IPPort1.RemotePort := 'finger';
  73.             FSock := IPPort1.OpenSocket;
  74.             IPPort1.ConnectSocket(FSock);
  75.             StatusBar.Caption := 'Connecting... (' + HostName +')';
  76.             DataBack.Clear;
  77.         end
  78.         else
  79.             MessageDlg('No Local Host names allowed' + #13#10 +
  80.                 'Format is name@host ', mtInformation, [mbOK], 0);
  81.     end
  82.     else
  83.             MessageDlg('Please supply a person to finger' + #13#10 +
  84.                 'Format is person@host ', mtInformation, [mbOK], 0);
  85. end;
  86.  
  87.  
  88. procedure TMainForm.IPPort1DataAvailable(Socket: Word);
  89. var
  90.     Data: TStringList;
  91.     TimeData: LongInt;
  92.     hNetTime : LongInt;
  93.     NetTime: TDateTime;
  94.     DataIn: Integer;
  95.     strDatetime : string;
  96.     timeLow, timeHigh: word;
  97. const
  98.     BASETIME = 693596.0;
  99.     fmtdatetime : string = 'dddddd tt';
  100.     Null : word = $0000;
  101. begin
  102.     Data := TStringList.Create;
  103.     if Socket = FSock then
  104.     begin
  105.         {stream Data to Memory until we disconnect}
  106.         IPPort1.GetData(Socket, Data);
  107.         DataBack.Write(Data.GetText^,StrLen(Data.GetText));
  108.     end
  109.     else
  110.     begin
  111.         {Get Raw Data for Network time}
  112.         DataIn := IPPort1.GetDataRaw(Socket,@TimeData,sizeof(TimeData));
  113.         hNetTime := ntohl(TimeData);
  114.         timeHigh := HIWORD(hNetTime);
  115.         timeLow := LOWORD(hNetTime);
  116.         NetTime := ((timeHigh * 65536.0 ) + timeLow)/86400.0;
  117.         NetTime := NetTime + BASETIME;
  118.         Memo1.Clear;
  119.         DateTimetoString(strDateTime,fmtdatetime,Now);
  120.         Data.Add('System time is : ' + strDateTime);
  121.         DateTimetoString(strDateTime,fmtdatetime,NetTime);
  122.         Data.Add('The Network time is : ' + StrDateTime);
  123.         DataBack.Clear;
  124.         DataBack.write(Data.GetText^,StrLen(Data.GetText));
  125.     end;
  126.     Data.Free;
  127. end;
  128.  
  129. procedure TMainForm.IPPort1SocketClose(Socket: Word);
  130. const
  131.     Null : word = $0000;
  132. begin
  133.     DataBack.Write(Null,2);
  134.     Memo1.SetTextBuf(DataBack.Memory);
  135.     StatusBar.Caption := 'Disconnected.';
  136.     IPPort1.ShutSocket(Socket);
  137. end;
  138.  
  139. procedure TMainForm.IPPort1TimeOut(Socket: Word);
  140. begin
  141.     StatusBar.Caption := 'Failed to Connect to ' + HostName;
  142.     IPPort1.ShutSocket(Socket);
  143. end;
  144.  
  145. procedure TMainForm.IPPort1SocketConnect(Socket: Word);
  146. begin
  147.     StatusBar.Caption := 'Connected to ' + HostName;
  148. end;
  149.  
  150. procedure TMainForm.Btn2Click(Sender: TObject);
  151. var
  152.     iPos : Integer;
  153. begin
  154.     if FName.Text <> '' Then
  155.     begin
  156.         iPos := Pos('@',FName.Text);
  157.         if iPos = 0 Then
  158.         begin
  159.             HostName :=  FName.Text;
  160.             IPPort1.RemoteAddress := HostName;
  161.             IPPort1.RemotePort := 'time';
  162.             TSock := IPPort1.OpenSocket;
  163.             IPPort1.ConnectSocket(TSock);
  164.             StatusBar.Caption := 'Connecting... (' + HostName +')';
  165.         end
  166.         else
  167.             MessageDlg('Invalid host name',mtError,[mbOK],0);
  168.  
  169.     end
  170.     else
  171.         messageDlg('Please supply a network time host',
  172.                     mtInformation,[mbOK],0);
  173.  
  174. end;
  175.  
  176. procedure TMainForm.IPPort1DataReady(Socket: Word);
  177. Var
  178.     Data: TStringList;
  179. begin
  180.     if Socket = FSock Then
  181.     begin
  182.         Data := TStringList.Create;
  183.         Data.Add(Username);
  184.         IPPort1.SendData(Socket,Data);
  185.         Data.Free;
  186.     end;
  187. end;
  188.  
  189. end.
  190.