home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyCTB.p < prev    next >
Encoding:
Text File  |  1996-06-01  |  7.1 KB  |  327 lines  |  [TEXT/CWIE]
  1. unit MyCTB;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Connections;
  7.  
  8.     function CTBInit: OSErr;
  9.     procedure CTBFinish;
  10.     function CTBJustConfigure: OSErr;
  11.     function CTBMakeConnection (var cn: connHandle): OSErr;
  12.     procedure CTBDestroy (var cn: connHandle);
  13.     function MyCMOpen (cn: ConnHandle; timeout: longint): OSErr;
  14.     function MyCMClose (cn: ConnHandle): OSErr;
  15.     function MyCMRead (cn: ConnHandle; buffer: univ Ptr; var size: longint): OSErr;
  16.     function MyCMWrite (cn: ConnHandle; buffer: univ Ptr; var size: longint): OSErr;
  17.     procedure MyCMIdle (cn: ConnHandle);
  18.     function MyCMDataAvailable (cn: ConnHandle): longint;
  19.  
  20. implementation
  21.  
  22.     uses
  23.         Resources, MyUtils, CommResources;
  24.  
  25.     const
  26.         Buffer_Size = 10000;
  27.         userCancelled = -10;
  28.  
  29.     var
  30.         RcvBuffer: Handle;
  31.  
  32.     type
  33.         AsyncStuff = record
  34.                 pending: boolean;
  35.                 errCode: OSErr;
  36.                 asyncCount: CMBufferSizes;
  37.             end;
  38.         AsyncStuffPtr = ^AsyncStuff;
  39.  
  40. {$S Main}
  41. {$PUSH}
  42. {$D-}
  43. { CTBComplete - completion routine }
  44.     procedure CTBComplete (cn: ConnHandle);
  45.         var
  46.             stuffP: AsyncStuffPtr;
  47.     begin
  48.         stuffP := AsyncStuffPtr(cn^^.refcon);
  49.         stuffP^.errCode := cn^^.errCode;
  50.         BlockMove(@cn^^.asyncCount, @stuffP^.asyncCount, SizeOf(CMBufferSizes));
  51.         stuffP^.pending := false;
  52.     end;
  53. {$POP}
  54. {$S}
  55.  
  56.     function WaitOn (var b: boolean): OSErr;
  57.         var
  58.             er: EventRecord;
  59.             oe: OSErr;
  60.             dummy: boolean;
  61.     begin
  62.         oe := noErr;
  63.         while b do begin
  64.             dummy := WaitNextEvent(everyEvent, er, 5, nil);
  65.             if er.what = keyDown then begin
  66.                 oe := userCancelled;
  67.                 leave;
  68.             end;
  69.         end;
  70.         WaitOn := oe;
  71.     end;
  72.  
  73.     procedure CTBTrouble (oe: OSErr);
  74.     begin
  75.         if oe <> noErr then
  76.             DebugStr(StringOf('CTBTrouble Error ', oe));
  77.     end;
  78.  
  79. { CTBExists - is the CTB installed? }
  80.     function CTBExists: boolean;
  81.         const
  82.             CTBTrap = $8B;
  83.             UnimplementedTrap = $9F;
  84.     begin
  85.         CTBExists := NGetTrapAddress(UnimplementedTrap, OSTrap) <> NGetTrapAddress(CTBTrap, OSTrap);
  86. { Why not use Gestalt??? }
  87.     end;
  88.  
  89.     function CTBGetTool (var tool: Str255; var procID: integer): OSErr;
  90.         var
  91.             oe: OSErr;
  92.     begin
  93.         oe := noErr;
  94.         tool := 'TGE TCP Tool';
  95.         procID := CMGetProcID(tool);
  96.         if procID < 0 then begin
  97.             oe := CRMGetIndToolName(classCM, 1, tool);
  98.             if (oe = noErr) and (tool = '') then
  99.                 oe := -1;
  100.             if oe = noErr then begin
  101.                 procID := CMGetProcID(tool);
  102.                 if procID < 0 then
  103.                     oe := -1;
  104.             end;
  105.         end;
  106.         CTBGetTool := oe;
  107.     end;
  108.  
  109.     function CTBCreate (var cn: connHandle; procID: integer; flags: CMRecFlags): OSErr;
  110.         var
  111.             oe: OSErr;
  112.             bs: CMBufferSizes;
  113.     begin
  114.         oe := noErr;
  115.         BlockZero(@bs, sizeof(bs));
  116.         flags := cmNoMenus; { | cmQuiet? }
  117.         cn := CMNew(procID, flags, bs, 0, 0);
  118.         if cn = nil then
  119.             oe := -1;
  120.         CTBCreate := oe;
  121.     end;
  122.  
  123.     function CTBConfigure (var cn: connHandle; var tool: Str255; must_config: boolean): OSErr;
  124.         var
  125.             oe: OSErr;
  126.             cfigH: Handle;
  127.             result: OSErr;
  128.             pt: Point;
  129.     begin
  130.         oe := noErr;
  131.         cfigH := GetNamedResource('CTfg', tool);
  132.         if cfigH <> nil then begin
  133.             if GetPtrSize(cn^^.config) = GetHandleSize(cfigH) then begin
  134.                 BlockMove(cfigH^, cn^^.config, GetPtrSize(cn^^.config));
  135.                 BlockMove(cfigH^, cn^^.oldConfig, GetPtrSize(cn^^.oldConfig));
  136.             end;
  137.             ReleaseResource(cfigH);
  138.         end;
  139.  
  140.         if must_config | CMValidate(cn) then begin
  141.             SetPt(pt, 10, 40);
  142.             result := CMChoose(cn, pt, nil);
  143.             case result of
  144.                 chooseDisaster, chooseFailed, chooseAborted: 
  145.                     oe := result;
  146.                 chooseOKMajor, chooseOKMinor:  begin
  147.                 { save the name string }
  148.                     CMGetToolName(cn^^.procID, tool);
  149.                     BlockMove(cn^^.config, cn^^.oldConfig, GetPtrSize(cn^^.config));
  150.                 end;
  151.                 otherwise
  152.                     ;
  153.             end;
  154.         end;
  155.  
  156.         CTBConfigure := oe;
  157.     end;
  158.  
  159.     procedure CTBDestroy (var cn: connHandle);
  160.     begin
  161.         if cn <> nil then begin
  162.             CMDispose(cn);
  163.             cn := nil;
  164.         end;
  165.     end;
  166.  
  167. { Configure tool and save configurationo prefs file - yeah right :-}
  168.     function CTBJustConfigure: OSErr;
  169.         var
  170.             tool: Str255;
  171.             procID: integer;
  172.             oe: OSErr;
  173.             cn: connHandle;
  174.     begin
  175.         oe := CTBGetTool(tool, procID);
  176.  
  177.         if oe = noErr then
  178.             oe := CTBCreate(cn, procID, cmNoMenus);
  179.  
  180.         if oe = noErr then begin
  181.             oe := CTBConfigure(cn, tool, true);
  182.             CTBDestroy(cn);
  183.         end;
  184.  
  185.         CTBJustConfigure := oe;
  186.     end;
  187.  
  188. { Create a connection and configure it if necessary }
  189.     function CTBMakeConnection (var cn: connHandle): OSErr;
  190.         var
  191.             tool: Str255;
  192.             procID: integer;
  193.             oe: OSErr;
  194.     begin
  195.         oe := CTBGetTool(tool, procID);
  196.         if oe = noErr then
  197.             oe := CTBCreate(cn, procID, cmNoMenus);
  198.  
  199.         if oe = noErr then begin
  200.             oe := CTBConfigure(cn, tool, false);
  201.             if oe <> noErr then
  202.                 CTBDestroy(cn);
  203.         end;
  204.  
  205.         CTBMakeConnection := oe;
  206.     end;
  207.  
  208. { InitCTB - initialize the CommToolbox }
  209.     function CTBInit: OSErr;
  210.         var
  211.             oe: OSErr;
  212.     begin
  213.         RcvBuffer := nil;
  214.         oe := noErr;
  215.         if not CTBExists then
  216.             oe := cmGenericError;
  217.         if oe = noErr then
  218.             oe := InitCTBUtilities;
  219.         if oe = noErr then
  220.             oe := InitCRM;
  221.         if oe = noErr then
  222.             oe := InitCM;
  223.         CTBInit := oe;
  224.     end;
  225.  
  226.     procedure CTBFinish;
  227.     begin
  228.     end;
  229.  
  230. { MyCMOpen - call CMOpen }
  231.     function MyCMOpen (cn: ConnHandle; timeout: longint): OSErr;
  232.     begin
  233.         MyCMOpen := CMOpen(cn, false, nil, timeout);
  234.     end;
  235.  
  236. { MyCMClose - call CMClose }
  237.     function MyCMClose (cn: ConnHandle): OSErr;
  238.     begin
  239.         MyCMClose := CMClose(cn, false, nil, -1, true);
  240.     end;
  241.  
  242. { MyCMRead - call CMRead }
  243.     function MyCMReadAsync (cn: ConnHandle; buffer: univ Ptr; var size: longint; timeout: longint): OSErr;
  244.         var
  245.             oe: OSErr;
  246.             stuff: AsyncStuff;
  247.             junk: CMFlags;
  248.     begin
  249.         cn^^.refcon := ord(@stuff);
  250.         stuff.pending := true;
  251.         oe := CMRead(cn, buffer, size, cmData, true, @CTBComplete, timeout, junk);
  252.         if oe = noErr then begin
  253.             oe := WaitOn(stuff.pending);
  254.             if oe = noErr then
  255.                 oe := stuff.errCode;
  256.             if oe = userCancelled then
  257.                 oe := CMIOKill(cn, ord(cmDataIn));
  258.         end
  259.         else begin
  260.             size := 0;
  261.         end;
  262.         MyCMReadAsync := oe;
  263.     end;
  264.  
  265.     function MyCMRead (cn: ConnHandle; buffer: univ Ptr; var size: longint): OSErr;
  266.         var
  267.             oe: OSErr;
  268.             junk: CMFlags;
  269.     begin
  270.         oe := CMRead(cn, buffer, size, cmData, false, nil, 1, junk);
  271.         MyCMRead := oe;
  272.     end;
  273.  
  274. { MyCMWrite - call CMWrite }
  275.     function MyCMWriteAsync (cn: ConnHandle; buffer: univ Ptr; var size: longint): OSErr;
  276.         var
  277.             oe: OSErr;
  278.             stuff: AsyncStuff;
  279.     begin
  280.         cn^^.refcon := ord(@stuff);
  281.         stuff.pending := true;
  282.         oe := CMWrite(cn, buffer, size, cmData, true, @CTBComplete, -1, 0);
  283.         if oe = noErr then begin
  284.             oe := WaitOn(stuff.pending);
  285.             if oe = noErr then
  286.                 oe := stuff.errCode;
  287.             if oe = userCancelled then
  288.                 oe := CMIOKill(cn, ord(cmDataOut));
  289.         end;
  290.         if oe = noErr then
  291.             size := stuff.asyncCount[cmDataOut]
  292.         else
  293.             size := 0;
  294.         CTBTrouble(oe);
  295.         MyCMWriteAsync := oe;
  296.     end;
  297.  
  298. { MyCMWrite - call CMWrite }
  299.     function MyCMWrite (cn: ConnHandle; buffer: univ Ptr; var size: longint): OSErr;
  300.         var
  301.             oe: OSErr;
  302.     begin
  303.         oe := CMWrite(cn, buffer, size, cmData, false, nil, -1, 0);
  304.         MyCMWrite := oe;
  305.     end;
  306.  
  307. { MyCMIdle - do the things I should do at CMIdle time }
  308.     procedure MyCMIdle (cn: connHandle);
  309.     begin
  310.         CMIdle(cn);
  311.     end;
  312.  
  313. { CTBDataCount - how much data do we have? }
  314.     function MyCMDataAvailable (cn: connHandle): longint;
  315.         var
  316.             flags: CMStatFlags;
  317.             sizes: CMBufferSizes;
  318.             oe: OSErr;
  319.     begin
  320.         oe := CMStatus(cn, sizes, flags);
  321.         if (oe = noErr) and (BAND(flags, cmStatusDataAvail) <> 0) then
  322.             MyCMDataAvailable := sizes[cmDataIn]
  323.         else
  324.             MyCMDataAvailable := 0;
  325.     end;
  326.  
  327. end.