home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / source / comm.sit / comm.pas.bin / comm.pas
Encoding:
Pascal/Delphi Source File  |  1989-05-04  |  24.2 KB  |  611 lines  |  [TEXT/MSWD]
  1. {   Title      :  Comm -- a HyperCard XCMD to control a communications session. }
  2. {   Author     :  Chris Knepper                                                 }
  3. {   Date       :  3/30/88                                                       }
  4. {   From       :  DannyGoodman's HyperCard Developer's Guide                    }
  5. {   Publisher  :  Bantam Books, Inc.                                            }
  6. { Copyright 1988 by Danny Goodman. All rights reserved.                         }
  7.  
  8. UNIT CommUnit;
  9. INTERFACE
  10.  
  11.    uses
  12.     MemTypes,
  13.     QuickDraw,
  14.     OSIntf,
  15.     ToolIntf,
  16.     PackIntf,
  17.  
  18.     HyperXCmd;
  19.  
  20. PROCEDURE Comm (paramPtr: XCmdPtr);
  21.  
  22. IMPLEMENTATION
  23.  
  24. PROCEDURE Comm (paramPtr: XCmdPtr);
  25.     label
  26.         1;                    { the END of Comm }
  27.     const
  28.         BUFF_SIZE = $800;    { size of the input serial buffer -- 2K }
  29.     var
  30.         controlStr            { stores 1st param to Comm }
  31.             : Str255;
  32.         inRefNum,            { Stores input reference number }
  33.         outRefNum            { Stores output reference number }
  34.             : integer;
  35.         err                    { stores the error codes of various Device Manager calls }
  36.             : OSErr;
  37.         count                { stores the number of bytes to read~write }
  38.             : longint;
  39.         myBuffPtr            { stores a pointer to the serial input buffer }
  40.             : Ptr;
  41.         myPBlock            { Used in calls to PBRead and PBWrite. }
  42.             : ParamBlockRec;
  43.         myHdl                { Stores handle O-terminated string }
  44.             : Handle;
  45.  
  46. {-----------------------------------------------}
  47. PROCEDURE HandleError (myStr: Str255);
  48.  
  49. { HandleError sets the cursor to the arrow cursor and displays an error Alert }
  50. { informing the user of the error. This PROCEDURE assumes that the ALRT & DITL }
  51. { resources WITH id ~ 3100 exist in HyperCard's resource fork. Although this is a }
  52. { valid assumption in HyperCard versions 1.1 and 1.0.1. Calls to GetResource() verify }
  53. { that these resources DO, in fact, exist. IF they don't, this PROCEDURE produces a beep. }
  54.     const
  55.         ERROR = 3100;                                { use a HC ALRT for error messages. }
  56.     var
  57.         whichItem: integer;                            { stores result of the Alert FUNCTION }
  58.     BEGIN
  59.         IF (GetResource('ALRT', 3100) = nil) or (GetResource('DITL', 3100) = nil) THEN
  60.             SysBeep(60)                                { beep IF no ALRT or DITL resource }
  61.         ELSE
  62.             BEGIN
  63.                 InitCursor;                            { set cursor to the arrow cursor }
  64.                 ParamText(myStr, '', '', '');        { specify the ALRT's text }
  65.                 whichItem := Alert(ERROR, nil);        { display and handle the ALRT}
  66.                 SendCardMessage(paramPtr, 'set cursor to 4'); { set back to watch cursor }
  67.             END;
  68.     END;                                            { PROCEDURE HandleError }
  69.  
  70. {-----------------------------------------------}
  71. function ErrOccurred (errNum: OSErr; routineName: Str255): Boolean;
  72. { ErrOccurred determines IF an error occured by comparing errNum WITH NoErr. }
  73. { IF equal, ErrOccurred returns FALSE indicating that no error occurred. Otherwise, }
  74. { it returns TRUE, indicating that an error occurred and creates a string from }
  75. { errNum and routineName which it THEN passes to HandleError. }
  76.     var
  77.         errStr                                    { store error number as a Pascal string }
  78.             : Str255;
  79.     BEGIN
  80.         IF (errNum = noErr) THEN
  81.             ErrOccurred := FALSE                { no error occurred -- return FALSE }
  82.         ELSE
  83.             BEGIN
  84.                 ErrOccurred := TRUE;            { oops, error occurred -- return TRUE }
  85.                 NumToString(errNum, errStr);    { convert error number to a string }
  86.                 HandleError(Concat(routineName, 'returned', errStr, '.'));    { inform user}
  87.             END;
  88.     END;                                        { function ErrOccurred }
  89.  
  90. {-----------------------------------------------}
  91. function Clear_RefNums_SerBuffPtr: boolean;
  92. { Clear_RefNums_SerBuffPtr sets the HyperTalk global "CommStorage" to }
  93. { empty and returns TRUE IF successful, or FALSE IF not successful. }
  94.     var
  95.         pascalStr: Str255;                            { stores message to send to HC }
  96.     BEGIN
  97.         pascalStr := 'put empty into CommStorage';    { clear CommStorage WITH a..}
  98.         SendCardMessage(paramPtr, pascalStr);        { ...HyperTalk command }
  99.         IF (paramPtr^.result = xResSucc) THEN        { test the callback }
  100.             Clear_RefNums_SerBuffPtr := TRUE        { SendCardMessage succeeded }
  101.         ELSE
  102.             BEGIN
  103.                 Clear_RefNums_SerBuffPtr := FALSE;    { SendCardMessage failed }
  104.                 HandleError('SendCardMessage callback failed.');    { inform user }
  105.             END;
  106.     END;                                            { function Clear RefNums SerBuffPtr }
  107.  
  108. {-----------------------------------------------}
  109. function Set_RefNums_SerBuffPtr (output, input: integer; buffer: Ptr): boolean;
  110. { Set_RefNums_SerBuffPtr stores the input/output refnums and a pointer to }
  111. { the Input buffer in a HyperTalk global called "CommStorage." IF the function }
  112. { fails, it returns FALSE, otherwise it returns TRUE. }
  113.     var
  114.         pascalStr1,                                { converts LONGlNTs, passed to PasToZero }
  115.         pascalStr2                                { converts LONGlNTs }
  116.             : Str255;
  117.     BEGIN
  118.         Set_RefNums_SerBuffPtr := TRUE;            { indicate that no error occurred }
  119.         NumToString(output, pascalStr1 );        { convert output refnum to StRSS }
  120.         NumToString(input, pascalStr2);            { convert input refnum to Str255 }
  121.         pascalStr1 := Concat(pascalStr1, ',', pascalStr2);    { a "," delimitted Str255 }
  122.         NumToString(ORD4(buffer), pascalStr2);    { convert the serial buf ptr to Str255 }
  123.         pascalStr1 := Concat(pascalStr1, ',', pascalStr2);    { a "," delimitted Str255 }
  124.         myHdl := PasToZero(paramPtr, pascalStr1 );            { store Str255 in a handle }
  125.         IF (paramPtr^.result <> xResSucc) THEN
  126.             BEGIN
  127.             Set_RefNums_SerBuffPtr := FALSE;    { indicate that an error occurred }
  128.             HandleError('PasToZero callback failed.');
  129.         END
  130.     ELSE
  131.         BEGIN
  132.             SetGlobal(paramPtr, 'CommStorage', myHdl);        { set the global }
  133.             IF (paramPtr^.result <> xResSucc) THEN
  134.                 BEGIN
  135.                     Set_RefNums_SerBuffPtr := FALSE;        { indicate that an error occurred }
  136.                     HandleError('SetGlobal callback failed.');
  137.                 END
  138.         END;
  139.     END;                                        { function Set_RefNums_SerBuffPtr}
  140.  
  141. {-----------------------------------------------}
  142. function Get_RefNums_SerBuffPtr (var output, input: integer;
  143.         var buffer: Ptr): boolean;
  144. { Get_RefNums_SerBuffPtr gets the refnums which have been stored in the }
  145. { HyperTalk global ~CommStorage.~ n this global is empty, THEN an error }
  146. { has occurred and the function returns FALSE. Otherwise, the function }
  147. { gets the values in CommStorage and returns TRUE. CommStorage contains }
  148. { 3 items. Item 1 is the output refnum, item 2 is the input refnum, and item 3 }
  149. { is the address of the input buffer. }
  150.     label
  151.         5;                                    { the END of Get_RefNums_SerBuffPtr }
  152.     var
  153.         whichItem,                            { used as a FOR loop counter }
  154.         scrInt                                { used when converting strings to nums }
  155.             : Integer;
  156.         scrLongint                            { scratch longint }
  157.             : Longint;
  158.         pascalStr,                            { used FOR local storage of Str255 }
  159.         myExpr                                { used to pass a HyperTalk expression to HC }
  160.             : Str255;
  161.     BEGIN
  162.         Get_RefNums_SerBuffPtr := FALSE;    { return FALSE indicates errors }
  163.         myExpr := 'CommStorage is empty';    { determine IF the global CommStorage..}
  164.         myHdl := EvalExpr(paramPtr, myExpr);    { is empty }
  165.         IF (paramPtr^.result <> xresSucc) THEN    { result is set by EvalExpr }
  166.             BEGIN
  167.                 HandleError('EvalExpr failed to test IF CommStorage is empty.');
  168.                 DisposHandle(myHdl);        { dispose of memory EvalExpr allocated }
  169.                 goto 5;                        { exit Get_RefNums_SerBuffPtr}
  170.             END;
  171.         HLock(myHdl);                        { lock handle before ZeroToPas }
  172.         ZeroToPas(paramPtr, myHdl^, pascalStr);
  173.         DisposHandle(myHdl);
  174.         IF (paramPtr^.result <> xresSucc) THEN            { result is set by ZeroToPas }
  175.             BEGIN
  176.                 HandleError('ZeroToPas failed while testing IF CommStorage is empty.');
  177.                 goto 5;                        { exitGet_RefNums_SerBuffPtr}
  178.             END;
  179.         IF pascalStr = 'true' THEN            { is CommStorage empty? }
  180.             BEGIN
  181.                 HandleError('CommStorage is empty.');    { inform user }
  182.                 goto 5;                        { exit Get_RefNums_SerBuffPtr}
  183.             END;
  184.         FOR whichItem := 1 to 3 DO            { Get 3 items of CommStorage }
  185.             BEGIN
  186.                 NumToString(whichItem, pascalStr);        { convert item to pascalStr }
  187.                 myExpr := Concat('item ', pascalStr, ' of CommStorage');
  188.                 myHdl := EvalExpr(paramPtr, myExpr);    { evaluate the expression }
  189.                 IF ((myHdl = nil) or (paramPtr^.result <> xresSucc)) THEN
  190.                     BEGIN                    { inform user of error }
  191.                         HandleError(Concat('Can''t get item ', pascalStr, ' of CommStorage'));
  192.                         DisposHandle(myHdl);            { dispose of memory EvalExpr allocated }
  193.                         goto 5;                { exit Get_RefNums_SerBuffPtr}
  194.                     END;
  195.                 HLock(myHdl);                { lock handle before ZeroToPas }
  196.                 ZeroToPas(paramPtr, myHdl^, pascalStr);
  197.                 IF (paramPtr^.result <> xresSucc) THEN    { set by ZeroToPas }
  198.                     BEGIN
  199.                         NumToString(whichItem, pascalStr);    { convert item to string }
  200.                         pascalStr := Concat('Can''t convert item ', pascalStr);
  201.                         HandleError(Concat(pascalStr, ' of CommStorage to Pascal string.'));
  202.                         DisposHandle(myHdl);            { dispose of the storage allocated by EvalExpr }
  203.                         goto 5;                { exit Get_RefNums_SerBuffPtr }
  204.                     END;
  205.                 DisposHandle(myHdl);        { dispose of the storage allocated by EvalExpr }
  206.                 StringToNum(pascalStr, scrLongint);        { convert to a number }
  207.                 case whichItem of
  208.                     1:                        { the first item is the output refnum }
  209.                         output := scrLongint;
  210.                     2:                        { the second item is the input refnum }
  211.                         input := scrLongint;
  212.                     3:                        { the third item is the buffer pointer }
  213.                         buffer := POINTER(scrLongint);
  214.                 END;                        { case statement }
  215.         END;                                { FOR loop }
  216.     Get_RefNums_SerBuffPtr := TRUE;            { return TRUE indicates success }
  217. 5:                                            { the END of Get_RefNums_SerBuffPtr }
  218.     END;                                    { function Get_RefNums_SerBuffPtr }
  219.  
  220. {-----------------------------------------------}
  221. function UserConfig (var serConfig: integer): BOOLEAN;
  222. { This function gets the configuration specified by the user in the parameters to }
  223. { Comm. 3rd parameter is baud, 4th parameter is stop bits, 5th parameter is }
  224. { parity, 6th parameter is data bits. IF no parameters are passed (besides "Open") }
  225. { THEN the defaun configuration is returned. IF error occurs, UserConfig returns }
  226. { FALSE, otherwise it returns TRUE. The configuration is returned in serConfig. }
  227.     label
  228.         7;                                    { the END of UserConfig }
  229.     var
  230.         pascalStr: Str255;                    { used when converting to pascal strings }
  231.     BEGIN
  232.         UserConfig := TRUE;
  233.         serConfig := 0;
  234.         IF (paramPtr^.paramCount = 1) THEN    { Assume the 1st parameter was ~open~. }
  235.             serConfig := baud1200 + stop10 + noParity + data8    { Default configuration. }
  236.         ELSE
  237.             BEGIN
  238.                 { *** Get the third parameter -- Baud rate *** }
  239.                 HLock(paramPtr^.params[3]);
  240.                 ZeroToPas(paramPtr, paramPtr^.params[3]^, pascalStr);
  241.                 HUnlock(paramPtr^.params[3]);
  242.                 UprString(pascalStr, FALSE);
  243.                 IF (pascalStr = '300') THEN
  244.                     serConfig := serConfig + baud300
  245.                 ELSE IF (pascalStr = '600') THEN
  246.                     serConfig := serConfig + baud600
  247.                 ELSE IF (pascalStr = '1200') THEN
  248.                     serConfig := serConfig + baud1200
  249.                 ELSE IF (pascalStr = '1800') THEN
  250.                     serConfig := serConfig + baud1800
  251.                 ELSE IF (pascalStr = '2400') THEN
  252.                     serConfig := serConfig + baud2400
  253.                 ELSE IF (pascalStr = '3600') THEN
  254.                     serConfig := serConfig + baud3600
  255.                 ELSE IF (pascalStr = '4800') THEN
  256.                     serConfig := serConfig + baud4800
  257.                 ELSE IF (pascalStr = '7200') THEN
  258.                     serConfig := serConfig + baud7200
  259.                 ELSE IF (pascalStr = '9600') THEN
  260.                     serConfig := serConfig + baud9600
  261.                 ELSE IF (pascalStr = '19200') THEN
  262.                     serConfig := serConfig + baud19200
  263.                 ELSE IF (pascalStr = '57600') THEN
  264.                     serConfig := serConfig + baud57600
  265.                 ELSE
  266.                     BEGIN                    { Error occurred in specifying baud rate. }
  267.                         HandleError('Error in specifying baud rate.');
  268.                         UserConfig := FALSE;
  269.                         goto 7;
  270.                     END;
  271.                 { *** Get the fourth parameter -- Stop bits *** }
  272.                 HLock(paramPtr^.params[4]);
  273.                 ZeroToPas(paramPtr, paramPtr^.params[4]^, pascalStr);
  274.                 HUnlock(paramPtr^.params[4]);
  275.                 UprString(pascalStr, FALSE);
  276.                 IF (pascalStr = '1') THEN
  277.                     serConfig := serConfig + stop10
  278.                 ELSE IF (pascalStr = '1.5') THEN
  279.                     serConfig := serConfig + stop15
  280.                 ELSE IF (pascalStr = '2') THEN
  281.                     serConfig := serConfig + stop20
  282.                 ELSE
  283.                     BEGIN                    { Error occurred in specifying stop bits. }
  284.                         HandleError('Error in specifying stop bits.');
  285.                         UserConfig := FALSE;
  286.                         goto 7;
  287.                     END;
  288.                 { *** Get the fifth parameter -- Parity *** }
  289.                 HLock(paramPtr^.params[5]);
  290.                 ZeroToPas(paramPtr, paramPtr^.params[5]^, pascalStr);
  291.                 HUnlock(paramPtr^.params[5]);
  292.                 UprString(pascalStr, FALSE);
  293.                 IF (pascalStr = 'NO') THEN
  294.                     serConfig := serConfig + noParity
  295.                 ELSE IF (pascalStr = 'ODD') THEN
  296.                     serConfig := serConfig + oddParity
  297.                 ELSE IF (pascalStr = 'EVEN') THEN
  298.                     serConfig := serConfig + evenParity
  299.                 ELSE
  300.                     BEGIN                    { Error occurred in specifying parity. }
  301.                         HandleError('Error in specifying parity.');
  302.                         UserConfig := FALSE;
  303.                         goto 7;
  304.                     END;
  305.                 { *** Get the sixth parameter -- Data bits *** }
  306.                 HLock(paramPtr^.params[6]);
  307.                 ZeroToPas(paramPtr, paramPtr^.params[6]^, pascalStr);
  308.                 HUnlock(paramPtr^.params[6]);
  309.                 UprString(pascalStr, FALSE);
  310.                 IF (pascalStr = '5') THEN
  311.                     serConfig := serConfig + data5
  312.                 ELSE IF (pascalStr = '6') THEN
  313.                     serConfig := serConfig + data6
  314.                 ELSE IF (pascalStr = '7') THEN
  315.                     serConfig := serConfig + data7
  316.                 ELSE IF (pascalStr = '8') THEN
  317.                     serConfig := serConfig + data8
  318.                 ELSE
  319.                     BEGIN                    { Error occurred in specifying data bits. }
  320.                         HandleError('Error in specifying data bits.');
  321.                         UserConfig := FALSE;
  322.                     END;
  323.             END;                            { IF one or more than one parameter }
  324. 7:                                            { label 7 is the END of UserConfig }
  325.     END;                                    { function UserConfig }
  326.  
  327. {-----------------------------------------------}
  328. function PrinterOrModem (var outputStr, inputStr: Str255): boolean;
  329. { PrinterOrModem determines whether the user is opening the printer or }
  330. { modem ports. NOTE: cannot have BOTH the printer AND modem port open at the }
  331. { same time. IF the user calls Comm("Open") THEN default to modem port. The }
  332. { name of printer or modem driver is returned in outputStr and inputStr. }
  333.     var
  334.         pascalStr: Str255;                        { used to convert args to upper case }
  335.     BEGIN
  336.         PrinterOrModem := TRUE;                    { TRUE indicates no errors }
  337.         IF (paramPtr^.paramCount = 1 ) THEN
  338.             BEGIN                                { assume 1st parameter was "open" }
  339.                 inputStr := '.AIn';
  340.                 outputStr := '.AOut';
  341.             END
  342.         ELSE
  343.             BEGIN                                { user specifies modem or printer port }
  344.                 HLock(paramPtr^.params[2]);
  345.                 ZeroToPas(paramPtr, paramPtr^.params[2]^, pascalStr);
  346.                 HUnlock(paramPtr^.params[2]);
  347.                 UprString(pascalStr, FALSE);    { Convert to upper case. }
  348.                 IF (pascalStr = 'MODEM') THEN
  349.                     BEGIN
  350.                         inputStr := '.Aln';
  351.                         outputStr := '.AOut';
  352.                     END
  353.                 ELSE IF (pascalStr = 'PRINTER') THEN
  354.                     BEGIN
  355.                         inputStr := '.BIn';
  356.                         outputStr := '.BOut';
  357.                     END
  358.                 ELSE
  359.                     BEGIN                        { Error in specifying printer or modem. }
  360.                         HandleError('Comm expects Printer or Modem.');
  361.                         PrinterOrModem := FALSE;    { Inform user second param was bad. }
  362.                     END;
  363.             END;                                { IF paramCount = 1. }
  364.     END;                                        { function PrinterOrModem }
  365.  
  366. {-----------------------------------------------}
  367. function MySerShk: SerShk;
  368. { Returns the serial hand shake options and other control information. }
  369.     var
  370.         tempSerShk: SerShk;                { stores the serial handshake settings }
  371.     BEGIN
  372.         WITH tempSerShk DO
  373.             BEGIN
  374.                 fXon :=1;                { Enable XOn/XOff output flow control. }
  375.                 fCTS :=1;                { Enable CTS hardware handshake. }
  376.                 xOn := CHR(17);            { Set to control-e FOR continue. }
  377.                 xOff := CHR(19);        { Set to control-s FOR pause. }
  378.                 errs := 0;                { Errors which abort input requests }
  379.                 evts := 0;
  380.                 fInX := 1;                { Enable XOn/XOff input flow control. }
  381.             END;
  382.         MySerShk := tempSerShk;
  383.     END;                                { function MySerShk }
  384.  
  385. {-----------------------------------------------}
  386. PROCEDURE CheckCumErrs;
  387. { This PROCEDURE checks the input and output serial ports FOR errors. }
  388. { K an error occurred, THEN the Mac beeps. }
  389.     var
  390.         mySerStat: SerStaRec;            { stores status information }
  391.     BEGIN
  392.         err := SerStatus(outRefNum, mySerStat);
  393.         IF (mySerStat.cumErrs <> 0) THEN
  394.             SysBeep(1);                    { beep IF errors in output port }
  395.         err := SerStatus(inRefNum, mySerStat);
  396.         IF (mySerStat.cumErrs <> 0) THEN
  397.             SysBeep(1);                    { beep IF errors in input port }
  398.     END;                                { PROCEDURE CheckCumErrs }
  399.  
  400. {-----------------------------------------------}
  401. PROCEDURE CommOpen;
  402. { CommOpen opens the serial port to initiate communication. }
  403.     label
  404.         1;                            { the END of CommOpen }
  405.     var
  406.         serConfig                    { Stores configuration info FOR the port }
  407.             : integer;
  408.         inputStr,                    { stores either '.Aln' or '.Bln'. }
  409.         outputStr                    { stores either '.AOut' or '.BOut'. }
  410.             : Str255;
  411.     BEGIN
  412.         { Ensure that Comm("Open"...) was called correctly. }
  413.         IF (paramPtr^.paramCount <> 6) and (paramPtr^.paramCount <> 1 ) THEN
  414.             BEGIN
  415.                 HandleError('Error: Comm Open expects 1 or 6 parameters');
  416.                 goto 1;                { exit CommOpen }
  417.             END;
  418.         { Init CommStorage to empty -- later store inRefNum/outRefNum }
  419.         { and a pointer to the serial input buffer here. }
  420.         IF not Clear_RefNums_SerBuffPtr THEN
  421.             goto 1;
  422.         IF not PrinterOrModem(outputStr, inputStr) THEN    { use the Printer or Modem port? }
  423.             goto 1;                    { exit CommOpen }
  424.         IF not UserConfig(serConfig) THEN    { Get the configuration FOR the input/output ports. }
  425.             goto 1;                    { exit CommOpen }
  426.         myBuffPtr := NewPtr(BUFF_SIZE);        { Allocate memory FOR the input buffer. }
  427.         IF ErrOccurred(MemError, 'NewPtr') THEN
  428.             goto 1;                    { exit CommOpen }
  429.         err := OpenDriver(outputStr, outRefNum);        { Open the output port. }
  430.         IF ErrOccurred(err, 'OpenDriver') THEN
  431.             goto 1;                    { exit CommOpen }
  432.         err := OpenDriver(inputStr, inRefNum);            { Open the input port. }
  433.         IF ErrOccurred(err, 'OpenDriver') THEN
  434.             goto 1;                    { exit CommOpen }
  435.         err := SerReset(outRefNum, serConfig);            { Configure the output port. }
  436.         IF ErrOccurred(err, 'SerReset') THEN
  437.             goto 1;                    { exit CommOpen }
  438.         err := SerHShake(outRefNum, MySerShk);            { set up output port handshake }
  439.         IF ErrOccurred(err, 'SerHShake') THEN
  440.             goto 1;                    { exit CommOpen }
  441.         err := SerReset(inRefNum, serConfig);            { Configure the input port. }
  442.         IF ErrOccurred(err, 'SerReset') THEN
  443.             goto 1;                    { exit CommOpen }
  444.         err := SerHShake(inRefNum, MySerShk);            { set up input port handshake }
  445.         IF ErrOccurred(err, 'SerHShake') THEN
  446.             goto 1;                    { exit CommOpen }
  447.         err := SerSetBuf(inRefNum, myBuffPtr, BUFF_SIZE);    { Set up the input buffer. }
  448.         IF ErrOccurred(err, 'SerSetBuf') THEN
  449.             goto 1;                    { exit CommOpen }
  450.         { Save the input/output port refnums and serial input buffer pointer. }
  451.         IF not Set_RefNums_SerBuffPtr(outRefNum, inRefNum, myBuffPtr) THEN
  452.             ;                        { DO nothing, since at END }
  453. 1:                                    { the END of CommOpen }
  454.     END;                            { PROCEDURE CommOpen }
  455.  
  456. {-----------------------------------------------}
  457. PROCEDURE CommWrite;
  458. { CommWrite writes data to the serial port. }
  459.     label
  460.         1;                            { the END of CommWrite }
  461.     BEGIN
  462.         IF (paramPtr^.paramCount <> 2) THEN    { ensure Comm was called correctly }
  463.             BEGIN
  464.                 HandleError('Error: Comm Write expects 2 parameters');
  465.                 goto 1;                { exit CommWrite }
  466.             END;
  467.         { Send the data out the serial port. }
  468.         HLock(paramPtr^.params[2]);
  469.         count := StringLength(paramPtr, paramPtr^.params[2]^);
  470.         WITH myPBlock DO
  471.             BEGIN
  472.                 ioRefNum := outRefNum;
  473.                 ioBuffer := paramPtr^.params[2]^;
  474.                 ioReqCount := count;
  475.                 ioPosMode := 0;        { write from current mark }
  476.             END;
  477.         err := PBWrite(@myPBlock, FALSE);
  478.         HUnlock(paramPtr^.params[2]);
  479.         IF ErrOccurred(err, 'PBWrite') THEN
  480.             ;                        { DO nothing since at END }
  481. 1:                                    { the END of PROCEDURE CommWrite }
  482.     END;                            { PROCEDURE CommWrite }
  483.  
  484. {-----------------------------------------------}
  485. PROCEDURE CommRead;
  486. { CommRead reads data from the serial port. }
  487.     label
  488.         1;                                { the END of CommRead }
  489.     var
  490.         counter,                        { FOR loop counter. }
  491.         scratchInt,                        { Scratch integer necessary FOR BitAnd. }
  492.         noLF_cntr                        { Counts good chars, ie. no line feeds. }
  493.             : integer;
  494.         myCharPtr                        { points to chars in the input stream }
  495.             : Ptr;
  496.     BEGIN
  497.         IF (paramPtr^.paramCount <> 1 ) THEN    { ensure Comm was called correctly }
  498.             BEGIN
  499.                 HandleError('Error: Comm Read expects only 1 parameter');
  500.                 goto 1;                    { exit CommRead }
  501.             END;
  502.         { Look at the serial input buffer -- exit IF there's an error }
  503.         { in looking at it or IF there are no characters in it. }
  504.         err := SerGetBuf(inRefNum, count);
  505.         IF (ErrOccurred(err, 'SerGetBuf') or (count <= 0)) THEN
  506.             goto 1;                        { exit CommRead }
  507.         { Allocate the storage area FOR the result of the read. The size is equal to }
  508.         { the number of characters in the buffer. }
  509.         myHdl := NewHandle(count + 1 );    { add 1 to ensure it's a O-terminated string }
  510.         IF (ErrOccurred(MemError, 'NewHandle') or (myHdl = nil)) THEN
  511.             goto 1;                        { exit CommRead }
  512.         HLock(myHdl);                    { lock it during the call to PBRead }
  513.         WITH myPBlock DO                { set up the parameter block FOR PBRead }
  514.             BEGIN
  515.                 ioRefNum := inRefNum;    { read from the input buffer }
  516.                 ioBuffer := myHdl^;        { point to the storage area }
  517.                 ioReqCount := count;    { read as many characters as are in the buffer }
  518.                 ioPosMode := 0;            { read from current mark }
  519.             END;
  520.         err := PBRead(@myPBlock, FALSE);    { read ! }
  521.         IF ErrOccurred(err, 'PBRead') THEN    { any errors during read? }
  522.             BEGIN                            { IF so, THEN release the space..}
  523.                 DisposHandle(myHdl);        { ..allocated to the handle. }
  524.                 goto 1;                        { exit CommRead }
  525.             END;
  526.         { Since some hosts transmit WITH the high-bit set, we'll turn off the high-bit FOR all }
  527.         { incoming characters. Also, we'll strip all non-printing characters (ASCII $00-$1 F & $7F) }
  528.         { except the carriage return (ASCII $0D). }
  529.         noLF_cntr := 0;
  530.         FOR counter := 0 to (myPBlock.ioActCount - 1 ) DO
  531.             BEGIN
  532.                 myCharPtr := POINTER(ORD(myHdl^) + counter);
  533.                 scratchInt := BitAnd(Byte(myCharPtr^), $7F);    { Turn off high-bit. }
  534.                 IF ((scratchInt > $1F) or (scratchInt = $0D)) and (scratchInt <> $7F) THEN
  535.                     BEGIN
  536.                         myCharPtr := POINTER(ORD(myHdl^) + noLF_cntr);
  537.                         myCharPtr^ := Byte(scratchInt);
  538.                         noLF_cntr := noLF_cntr + 1;
  539.                     END;
  540.             END;
  541.         { make it a zero-terminated string }
  542.         IF (noLF_cntr = 0) THEN
  543.             BEGIN                            { IF no good characters in the input..}
  544.                 DisposHandle(myHdl);        { ..THEN return nothing! }
  545.             END
  546.         ELSE
  547.             BEGIN                            { make last byte a 0 }
  548.                 myCharPtr := POINTER(ORD(myHdl^) + noLF_cntr);
  549.                 myCharPtr^ := Byte(0);
  550.                 SetHandleSize(myHdl, noLF_cntr + 1 );    { set the handle to the correct size }
  551.                 HUnlock(myHdl);                            { unlock it before passing it back to HyperCard }
  552.                 paramPtr^.returnValue := myHdl;            { Return the string read from the input buffer. }
  553.             END;
  554.         CheckCumErrs;        { beep IF there are errors in the driver }
  555. 1:                            { the END of CommRead }
  556.     END;                    { PROCEDURE CommRead }
  557.  
  558. {-----------------------------------------------}
  559. PROCEDURE CommClose;
  560. { CommClose restores the input buffer to the defaun buffer and releases the }
  561. { memory used FOR Comm's input buffer. }
  562.     BEGIN
  563.         err := SerSetBuf(inRefNum, nil, 0);        { restore the input serial buffer }
  564.         IF ErrOccurred(err, 'SerSetBuf') THEN
  565.             ;                                    { DO nothing }
  566.         IF not Clear_RefNums_SerBuffPtr THEN
  567.             ;                                    { DO nothing }
  568.         DisposPtr(myBuffPtr);                    { dispose of the allocated buffer }
  569.         IF ErrOccurred(MemError, 'DisposPtr') THEN
  570.             ;                                    { DO nothing }
  571.     END;                                        { PROCEDURE CommClose }
  572.  
  573. {-----------------------------------------------}
  574. BEGIN { PROCEDURE Comm }
  575.     { Comm requires parameters, so check FOR at least one here. }
  576.     IF (paramPtr^.paramCount < 1) THEN
  577.         BEGIN
  578.             HandleError('No parameters were sent to Comm.');
  579.             goto 1;                        { exit Comm }
  580.         END;
  581.     { Get the first parameter -- this controlStr indicates what Comm should DO. }
  582.     HLock(paramPtr^.params[1]);
  583.     ZeroToPas(paramPtr, paramPtr^.params[1]^, controlStr);
  584.     HUnlock(paramPtr^.params[1 ]);
  585.     UprString(controlStr, FALSE);        { Convert to upper case, strip diacriticals. }
  586.     IF (controlStr = 'OPEN') THEN
  587.         CommOpen                        { open the communications session }
  588.     ELSE
  589.         BEGIN
  590.             { IF we get here, the communications session has already been established, so }
  591.             { get the refnums FOR the input/output ports and serial input buffer pointer. }
  592.             IF not Get_RefNums_SerBuffPtr(outRefNum, inRefNum, myBuffPtr) THEN
  593.                 goto 1;                            { exit Comm }
  594.             IF (controlStr = 'WRITE') THEN
  595.                 CommWrite                        { write to the serial port }
  596.             ELSE IF (controlStr = 'READ') THEN
  597.                 CommRead                        { read from the serial port }
  598.             ELSE IF (controlStr = 'CLOSE') THEN
  599.                 CommClose                        { restore the serial port }
  600.             ELSE
  601.                 { IF we get here, the first parameter to Comm doesn't match any of }
  602.                 { the control strings, so a bad control string was passed in. }
  603.                 HandleError('Comm doesn"t recognize the 1st parameter.'); { inform user }
  604.         END;                                    { IF}
  605. 1:                                                { the END of Comm }
  606.     END;                                        { PROCEDURE Comm }
  607.  
  608. {-----------------------------------------------}
  609. END.                                 { UNIT CommUnit }
  610. {-----------------------------------------------}
  611.