home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / TCPOOExample / TCPOOExample.p < prev    next >
Encoding:
Text File  |  1993-07-01  |  2.4 KB  |  121 lines  |  [TEXT/PJMM]
  1. program TCPOOExampleCode;
  2.  
  3. { You can do anything you want with this code - if you can make any money out of it, you'll be doing well! }
  4.  
  5.     uses
  6.         TCPTypes, TCPStuff, TCPOOConnections;
  7.  
  8.     const
  9.         user_name = 'peter';
  10.         dest_name = 'cujo.curtin.edu.au';
  11.         dest_port = 79;
  12.  
  13.     var
  14.         quitNow: boolean;
  15.  
  16.     type
  17.         MyAddressSearchObject = object(AddressSearchObject)
  18.                 procedure Failed (oe: OSErr);
  19.                 override;
  20.                 procedure FoundAddress (ip: longInt);
  21.                 override;
  22.             end;
  23.  
  24.     type
  25.         FingerObject = object(LineConnectionObject)
  26.                 procedure LineAvailable (line: str255);
  27.                 override;
  28.                 procedure Established;
  29.                 override;
  30.                 procedure Closing;
  31.                 override;
  32.                 procedure Destroy;
  33.                 override;
  34.                 procedure Failed (oe: OSErr);
  35.                 override;
  36.             end;
  37.  
  38.     procedure FingerObject.Failed (oe: OSErr);
  39.     begin
  40.         writeln('Failed to open with error ', oe);
  41.         quitNow := true;
  42.     end;
  43.  
  44.     procedure FingerObject.Established;
  45.     begin
  46.         writeln('Established');
  47.         SendLine(user_name);
  48.     end;
  49.  
  50.     procedure FingerObject.Closing;
  51.     begin
  52.         writeln('Closing');
  53.         Close;
  54.     end;
  55.  
  56.     procedure FingerObject.Destroy;
  57.     begin
  58.         quitNow := true;
  59.         writeln('Closed');
  60.         inherited Destroy;
  61.     end;
  62.  
  63.     procedure FingerObject.LineAvailable (line: str255);
  64.     begin
  65.         writeln('>', line);
  66.     end;
  67.  
  68.     procedure MyAddressSearchObject.Failed (oe: OSErr);
  69.     begin
  70.         writeln('Failed to find the address with error ', oe);
  71.         quitNow := true;
  72.     end;
  73.  
  74.     procedure MyAddressSearchObject.FoundAddress (ip: longInt);
  75.         var
  76.             oe: OSErr;
  77.             obj: FingerObject;
  78.     begin
  79.         writeln('Found address ', ConnectionsAddrToStr(ip));
  80.         new(obj);
  81.         oe := obj.NewActiveConnection(0, ip, dest_port);
  82.         obj.crlf := CL_CRLF;
  83.         writeln('NewActiveConnection gives ', oe);
  84.     end;
  85.  
  86.     procedure HandleEvents;
  87.         var
  88.             dummy: boolean;
  89.             er: eventRecord;
  90.     begin
  91.         dummy := WaitNextEvent(everyEvent, er, 15, nil);
  92.         if er.what = keyDown then
  93.             quitNow := true;
  94.         dummy := HandleConnections(2);
  95.     end;
  96.  
  97.     var
  98.         oe: OSErr;
  99.         addrobj: MyAddressSearchObject;
  100. begin
  101.     ShowText;
  102.     quitNow := false;
  103.     oe := InitConnections; { Startup the TCP units }
  104.     writeln('Init Connections gives ', oe);
  105.     if oe = noErr then begin
  106.         new(addrobj);
  107.         oe := addrobj.FindAddress(dest_name);
  108.         writeln('Find Address gives ', oe);
  109.         while not quitNow do begin
  110.             HandleEvents;
  111.         end;
  112.  
  113.         FinishConnections; { Close everything, clean up }
  114. { ALWAY CALL THIS, OR YOU WILL BE SORRY! }
  115.  
  116.     end;
  117.  
  118.     writeln('Click to quit');
  119.     while not Button do
  120.         ;
  121. end.