home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / HAPI.ZIP / HAPI / HAPI_BAS / HSMPLBAS.BAS next >
Encoding:
BASIC Source File  |  1991-09-03  |  48.3 KB  |  1,657 lines
  1. '*********************************************************************
  2. '*                                                                   *
  3. '* FILE NAME: HSMPLBAS.BAS                                           *
  4. '*                                                                   *
  5. '* MODULE NAME= HSMPLBAS.BAS                                         *
  6. '*                                                                   *
  7. '* DESCRIPTIVE NAME= BASIC COMPILER SAMPLE PROGRAM FOR EHLLAPI       *
  8. '*                                                                   *
  9. '* Displays EHLLAPI and session information.                         *
  10. '* Writes string to host.                                            *
  11. '* Searches for written string on host.                              *
  12. '* Displays host session screen.                                     *
  13. '* Manipulates the Presentation Manager properties of                *
  14. '* the emulator session to: change window title name, switch         *
  15. '* list name, make window invisible, query window status,            *
  16. '* window coordinates, change window size, and restore the           *
  17. '* emulator session window to its original conditions.               *
  18. '* Next, the structured field functions are used.  The               *
  19. '* communications buffer is queried, the read and write buffers      *
  20. '* allocated, a connection is initiated to the communications        *
  21. '* buffer, and an asynchronus read structured field is issued        *
  22. '* disabling the inbound host.  Then, the sendkey function is        *
  23. '* used to send the command 'IND$FILE PUT SF_TEST EXEC A'            *
  24. '* to the host which puts a non-existent file from the               *
  25. '* PC to the host using a structured field.  Next, a get             *
  26. '* completion request is issued to determine if the                  *
  27. '* previous asynchronus read structured field is completed,          *
  28. '* Upon completion, a synchronus write structured field is           *
  29. '* issued, the communications buffers are de-allocated, and          *
  30. '* then a disconnect from structured field is issued.                *
  31. '*                                                                   *
  32. '*                                                                   *
  33. '*                                                                   *
  34. '*   COPYRIGHT:  XXXXXXXXX  (C) COPYRIGHT IBM CORP. 1987,1988,1989   *
  35. '*               LICENSED MATERIAL - PROGRAM PROPERTY OF IBM         *
  36. '*               ALL RIGHTS RESERVED                                 *
  37. '*                                                                   *
  38. '*                                                                   *
  39. '* NOTES=                                                            *
  40. '*                                                                   *
  41. '**********************-END OF SPECIFICATIONS-************************
  42. '
  43. '*********************************************************************
  44. '********************** BEGIN INCLUDE FILES **************************
  45. '*********************************************************************
  46.  
  47.  
  48.  
  49. '$INCLUDE: 'HAPI_BAS.INC'
  50.  
  51.  
  52. '*********************************************************************
  53. '*************************** BEGIN CODE ******************************
  54. '*********************************************************************
  55.  
  56. '*********************************************************************
  57. '* MAIN - Main code calls routines to do real work.                  *
  58. '*                                                                   *
  59. '*                                                                   *
  60. '*                                                                   *
  61. '*********************************************************************
  62.  
  63.  
  64. ' The following structures are used to order data for EHLLAPI calls
  65.  
  66.      DIM QRYoSTR        AS QBUFoSTRUCT  'Query Communications Buffer
  67.      DIM ALLOCATEoSTR   AS ABUFoSTRUCT  'Allocate Communications Buffer
  68.      DIM CONNECToSTR    AS STSFoSTRUCT  'Connect To Communications Buffer
  69.      DIM READoSTR       AS RDSFoSTRUCT  'Read Structured Field
  70.      DIM GREQoSTR       AS GCMPoSTRUCT  'Get Asynchronus Complete
  71.      DIM WRITEoSTR      AS WRSFoSTRUCT  'Write Strucured Field
  72.      DIM FREEoBUFFoSTR  AS FBUFoSTRUCT  'Free Communications Buffer
  73.      DIM DISCONNECToSTR AS SPSFoSTRUCT  'Disconnect From Com Buffer
  74.  
  75.      DIM QRSTR (1 TO 12) AS STRING*1    'String with DDM query reply data
  76.      DIM WRoADDRESS AS LONG             'Write Buffer Address
  77.      DIM RDoADDRESS AS LONG             'Read Buffer Address
  78.      DIM BUFFERoLENGTH  AS LONG         'Buffer Length
  79.  
  80.      CLS                                'Clear the screen.
  81.  
  82.      KEY OFF
  83.      GOSUB BUILDTABLES
  84.      EHLLAPI$ = "EHLLAPI"
  85.      TESToNAME$ = "Sample_Test_Name"
  86.      INVISoTEXT$  = "INVISIBLE_WRITE_TEST"
  87.      COMMANDoTEXT$ ="IND$FILE PUT SF_TEST EXEC A@E@0"
  88.      DFToSESS$ = " "
  89.      HDATAoSTR$ = SPACE$(3840)
  90.      MAXoDATAoSIZE = 3840
  91.      MAXoSIZE% = MAXoDATAoSIZE
  92.      ZERO% = 0
  93.  
  94.  
  95.      GOSUB DISPoEHLLAPIoINFO
  96.  
  97.      IF HRC% <> 0 THEN GOTO MRET
  98.  
  99.      PRINT
  100.      INPUT "Press ENTER to continue...", X$
  101.      GOSUB DISPoSESSIONoINFO                 ' Call routine to
  102.                                              ' display Host session
  103.  
  104.      IF HRC% <> 0 THEN GOTO MRET
  105.  
  106.      IF DFToSESS$ = " "  THEN                ' If at least 1 dft sess
  107.        PRINT "NO DFT SESSION SESSION STARTED.":GOTO MRET
  108.      ENDIF
  109.  
  110.      CLS
  111.      HOSToTEXT$ = EHLLAPI$
  112.      PRINT "Press ENTER to send string '";HOSToTEXT$;"' to session short name ";
  113.      PRINT DFToSESS$;"...";
  114. MI1: X$ = INKEY$: IF X$ = "" THEN GOTO MI1
  115.      GOSUB WRITEoSTRo2oHOST
  116.  
  117.      IF HRC% <> 0 THEN GOTO MRET
  118.  
  119.      PRINT "Press ENTER to search for string '";HOSToTEXT$;
  120.      PRINT "' on Host Presentation Space...";
  121. MI2: X$ = INKEY$: IF X$ = "" THEN GOTO MI2
  122.      GOSUB SEARCHoSTRoONoHOST
  123.  
  124.      IF HRC% <> 0 THEN GOTO MRET
  125.  
  126.      PRINT "Press ENTER to display first 1920 bytes of Host ";
  127.      PRINT "presentation space...";
  128. MI3: X$ = INKEY$: IF X$ = "" THEN GOTO MI3
  129.      GOSUB DISPoHOSToSCR
  130.  
  131.      IF HRC% <> 0 THEN GOTO MRET
  132.      PRINT
  133.      PRINT "Press ENTER to change the PM window title. ";
  134. MI4: X$ = INKEY$: IF X$ = "" THEN GOTO MI4
  135.      GOSUB CHANGEoWINDOWoNAME
  136.  
  137.      IF HRC% <> 0 THEN GOTO MRET
  138.  
  139.      PRINT "Press ENTER to change the switch list name. "
  140. MI5: X$ = INKEY$: IF X$ = "" THEN GOTO MI5
  141.      GOSUB CHANGEoSWITCHoLISToNAME
  142.  
  143.      IF HRC% <> 0 THEN GOTO MRET
  144.  
  145.      PRINT "Press ENTER to query the PM session. "
  146. MI6: X$ = INKEY$: IF X$ = "" THEN GOTO MI6
  147.      GOSUB QUERYoPMoSESSION
  148.  
  149.      IF HRC% <> 0 THEN GOTO MRET
  150.  
  151.  
  152.      PRINT "Press ENTER to make the PM session invisible. ";
  153. MI7: X$ = INKEY$: IF X$ = "" THEN GOTO MI7
  154.      GOSUB MAKEoPMoINVISIBLE
  155.  
  156.      HOSToTEXT$ = INVISoTEXT$
  157.      PRINT "Press ENTER to send string '";HOSToTEXT$;"' to session short name ";
  158.      PRINT DFToSESS$;"...";
  159. MI8: X$ = INKEY$: IF X$ = "" THEN GOTO MI8
  160.      GOSUB WRITEoSTRo2oHOST
  161.  
  162.      PRINT "Press ENTER to display first 1920 bytes of Host ";
  163.      PRINT "presentation space...";
  164. MI9: X$ = INKEY$: IF X$ = "" THEN GOTO MI9
  165.      GOSUB DISPoHOSToSCR
  166.      IF HRC% <> 0 THEN GOTO MRET
  167.  
  168.      PRINT
  169.      PRINT "Press ENTER to make the PM screen visible and maximized. ";
  170. MI10: X$ = INKEY$: IF X$ = "" THEN GOTO MI10
  171.      GOSUB MAKEoPMoVISIBLE
  172.  
  173.      IF HRC% <> 0 THEN GOTO MRET
  174.  
  175.      PRINT "Press ENTER to disconnect from the PM session. ";
  176. MI11: X$ = INKEY$: IF X$ = "" THEN GOTO MI11
  177.      GOSUB DISCONNECToPM
  178.  
  179.      IF HRC% <> 0 THEN GOTO MRET
  180.  
  181.      PRINT "Press ENTER to restore the PM window settings. ";
  182. MI12: X$ = INKEY$: IF X$ = "" THEN GOTO MI12
  183.      GOSUB RESTOREoPMoNAMES
  184.  
  185.      IF HRC% <> 0 THEN GOTO MRET
  186.  
  187.      PRINT "The sample program continues with structured field EHLLAPI calls.";
  188.      PRINT "The host session must be active and have access to"
  189.      PRINT "the IND$FILE file transfer application."
  190.      PRINT "Do you wish to continue ?   (Press 'y' or 'n')"
  191.  
  192. MI13: X$ = INKEY$: IF X$ = "" THEN GOTO MI13
  193.  
  194.      IF  X$<>"y"  AND  X$<>"Y"  AND  X$<>"n" AND  X$<>"N"  THEN GOTO MI13
  195.  
  196.      IF  X$="N" OR  X$="n"  THEN GOTO MEND
  197.  
  198.      CLS
  199.      GOSUB RESEToSYSTEM
  200.      IF HRC% <> 0 THEN GOTO MRET
  201.  
  202.      GOSUB QUERYoCOMoBUFFER
  203.      IF HRC% <> 0 THEN GOTO MRET
  204.  
  205.      PRINT "Allocate The Read Buffer."
  206.      BUFFERoLENGTH = QRYoSTR.QBUFoOPToINB
  207.      GOSUB ALLOCATEoCOMoBUFFER
  208.      IF HRC% <> O THEN GOTO MRET
  209.      RDoADDRESS  = ALLOCATEoSTR.ABUFoADDRESS
  210.  
  211.      PRINT "Allocate The Write Buffer."
  212.      BUFFERoLENGTH = QRYoSTR.QBUFoOPToOUTB
  213.      GOSUB ALLOCATEoCOMoBUFFER
  214.      IF HRC% <> O THEN GOTO MRET
  215.      WRoADDRESS  = ALLOCATEoSTR.ABUFoADDRESS
  216.  
  217.      PRINT "Press ENTER to initiate a structured field connection.";
  218. MI14: X$ = INKEY$: IF X$ = "" THEN GOTO MI14
  219.  
  220.      GOSUB CONNECToCOMoBUFFER
  221.      IF HRC% <> O THEN GOTO MRET
  222.  
  223.      PRINT "Press ENTER to read a structured field. ";
  224. MI15: X$ = INKEY$: IF X$ = "" THEN GOTO MI15
  225.  
  226.      GOSUB READoSFoASYNC
  227.      IF HRC% <> O THEN GOTO MRET
  228.  
  229.      PRINT "Press ENTER to create a structured field. ";
  230. MI16: X$ = INKEY$: IF X$ = "" THEN GOTO MI16
  231.  
  232.      GOSUB CREATEoSTRUCTUREDoFIELD
  233.      IF HRC% <> O THEN GOTO MRET
  234.  
  235.      PRINT "Press ENTER to perform an asyncronus completion request. ";
  236. MI17: X$ = INKEY$: IF X$ = "" THEN GOTO MI17
  237.  
  238.      GOSUB GEToASYNCoCOMPLETE
  239.      IF HRC% <> O THEN GOTO MRET
  240.  
  241.      PRINT "Press ENTER to write a structured field.";
  242. MI18: X$ = INKEY$: IF X$ = "" THEN GOTO MI18
  243.  
  244.      GOSUB WRITEoSFoSYNC
  245.      IF HRC% <> O THEN GOTO MRET
  246.  
  247.      PRINT "Press ENTER to free the communication buffers.";
  248. MI19: X$ = INKEY$: IF X$ = "" THEN GOTO MI19
  249.  
  250.      GOSUB FREEoCOMMOoBUFF
  251.      IF HRC% <> O THEN GOTO MRET
  252.  
  253.      GOSUB DISCONNECToFROMoCOMoBUFFER
  254.      IF HRC% <> O THEN GOTO MRET
  255.  
  256.  
  257. MEND:LOCATE 25,1
  258.      PRINT "SAMPLE PROGRAM DONE.  To Exit Program Press ENTER...";
  259. MKEY: X$ = INKEY$: IF X$ = "" THEN GOTO MKEY
  260. MRET:
  261.      END
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270. '********************************************************************
  271. ' DISPoEHLLAPIoINFO - CALLs EHLLAPI QUERYoSYSTEM and then displays  *
  272. '                     the requested info.                           *
  273. '                                                                   *
  274. ' INPUT                                                             *
  275. '                                                                   *
  276. ' OUTPUT                                                            *
  277. '                                                                   *
  278. '********************************************************************
  279. DISPoEHLLAPIoINFO:                      '     Routine to display
  280.                                         '     EHLLAPI info.
  281.  
  282.   HFUNCoNUM% = HAoQUERYoSYSTEM%         '     Issue query
  283.                                         ' system.
  284.  
  285.  
  286.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
  287.                                         '     Call EHLLAPI.
  288.  
  289.   IF HRC% <> HARCoSUCCESS THEN GOTO DEIoERROR
  290.  
  291.   PRINT "                       EHLLAPI INFORMATION"
  292.   PRINT
  293.   PRINT "  EHLLAPI version              : ";
  294.  
  295.   PRINT MID$(HDATAoSTR$,1,1)
  296.  
  297.   PRINT "  EHLLAPI level                : ";
  298.  
  299.   PRINT MID$(HDATAoSTR$,2,2)
  300.  
  301.   PRINT "  EHLLAPI release date         : ";
  302.  
  303.   PRINT MID$(HDATAoSTR$,4,6)
  304.  
  305.   PRINT "  EHLLAPI LIM version          : ";
  306.  
  307.   PRINT MID$(HDATAoSTR$,10,1)
  308.  
  309.   PRINT "  EHLLAPI LIM level            : ";
  310.  
  311.   PRINT MID$(HDATAoSTR$,11,2)
  312.  
  313.   PRINT "  EHLLAPI hardware base        : ";
  314.  
  315.   T$ = MID$(HDATAoSTR$,13,1)
  316.   PRINT T$;
  317.   PRINT " = ";
  318.   IF T$ = "Z" THEN
  319.     PRINT "(See System model/submodel below)";
  320.   ENDIF
  321.   PRINT
  322.  
  323.   PRINT "  EHLLAPI CTRL program type    : ";
  324.  
  325.   T$ = MID$(HDATAoSTR$,14,1)
  326.   PRINT T$;
  327.   PRINT " = ";
  328.   IF T$ = "X" THEN
  329.     PRINT "OS/2";
  330.   ENDIF
  331.   PRINT
  332.  
  333.   PRINT "  EHLLAPI sequence number      : ";MID$(HDATAoSTR$,15,2)
  334.  
  335.   PRINT "  EHLLAPI CTRL program version : ";
  336.  
  337.   PRINT MID$(HDATAoSTR$,17,2)
  338.  
  339.   PRINT "  EHLLAPI PC session name      : ";
  340.  
  341.   PRINT MID$(HDATAoSTR$,19,1)
  342.  
  343.   PRINT "  EHLLAPI extended error 1     : ";
  344.  
  345.   PRINT MID$(HDATAoSTR$,20,4)
  346.  
  347.   PRINT "  EHLLAPI extended error 2     : ";
  348.  
  349.   PRINT MID$(HDATAoSTR$,24,4)
  350.  
  351.   T% = ASC(MID$(HDATAoSTR$,28,1))
  352.   T$ = HEX$(T%)
  353.   IF T% <= &H0F THEN T$ = "0" + T$
  354.   T1% = ASC(MID$(HDATAoSTR$,29,1))
  355.   T1$ = HEX$(T1%)
  356.   IF T1% <= &H0F THEN T1$ = "0" + T1$
  357.   PRINT "  EHLLAPI system model/submodel: ";
  358.   PRINT T$ + T1$;
  359.   PRINT " HEX  ";
  360.   IF T% = &HFC AND T1% = &H00 THEN
  361.     PRINT "= Model PC AT";
  362.   ENDIF
  363.   IF T% = &HFC AND T1% = &H01 THEN
  364.     PRINT "= Model PC AT ENHANCED";
  365.   ENDIF
  366.   IF T% = &HFC AND T1% = &H02 THEN
  367.     PRINT "= Model PC XT Model 286";
  368.   ENDIF
  369.   IF T% = &HFC AND T1% = &H04 THEN
  370.     PRINT "= Model 50";
  371.   ENDIF
  372.   IF T% = &HFC AND T1% = &H05 THEN
  373.     PRINT "= Model 60";
  374.   ENDIF
  375.   IF T% = &HF8 AND T1% = &H00 THEN
  376.     PRINT "= Model 80";
  377.   ENDIF
  378.   IF T% = &HF8 AND T1% = &H09 THEN
  379.     PRINT "= Model 70";
  380.   ENDIF
  381.   PRINT
  382.  
  383.   PRINT "  EHLLAPI National Language    : ";
  384.   PRINT ASC(MID$(HDATAoSTR$,30,1)) + (ASC(MID$(HDATAoSTR$,31,1)) * 256)
  385.  
  386.   PRINT "  EHLLAPI monitor type         : ";
  387.  
  388.   T$ = MID$(HDATAoSTR$,32,1)
  389.   PRINT T$;
  390.   PRINT " = ";
  391.   IF T$ = "M" THEN
  392.     PRINT "PC MONOCHROME";
  393.   ENDIF
  394.   IF T$ = "C" THEN
  395.   PRINT "PC CGA";
  396.   ENDIF
  397.   IF T$ = "E" THEN
  398.     PRINT "PC EGA";
  399.   ENDIF
  400.   IF T$ = "A" THEN
  401.     PRINT "PS MONOCHROME";
  402.   ENDIF
  403.   IF T$ = "V" THEN
  404.     PRINT "PS 8512";
  405.   ENDIF
  406.   IF T$ = "H" THEN
  407.     PRINT "PS 8514";
  408.   ENDIF
  409.   IF T$ = "U" THEN
  410.     PRINT "UNKNOWN monitor type";
  411.   ENDIF
  412.   PRINT
  413.   GOTO DEIoRET
  414.  
  415. DEIoERROR:
  416.   GOSUB ERRORoHAND
  417.  
  418. DEIoRET:
  419.   RETURN
  420.  
  421.  
  422.  
  423.  
  424.  
  425. '********************************************************************
  426. ' DISPoSESSIONoINFO - CALLs EHLLAPI QUERY funtions and then displays*
  427. '                     the requested session info.                   *
  428. '                                                                   *
  429. '                                                                   *
  430. '                                                                   *
  431. '********************************************************************
  432.  
  433.  
  434.  
  435. DISPoSESSIONoINFO:                           ' Routine to display
  436.                                              ' Host session info.
  437.   NUMoSESS% = 0
  438.  
  439.   PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
  440.  
  441.   PRINT "                           SESSION INFO";
  442.   PRINT:PRINT
  443.  
  444.   HFUNCoNUM% = HAoQUERYoSESSIONS%            ' Issue query
  445.                                              ' sessions.
  446.  
  447.   HDSoLEN% = MAXoDATAoSIZE / 12 * 12         ' Make sure len is
  448.                                              ' multiple of 12.
  449.  
  450.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
  451.                                              '  Call EHLLAPI.
  452.  
  453.  
  454.   IF HRC% <> HARCoSUCCESS THEN GOTO DSIoERROR
  455.                                              ' If good rc.
  456.   NUMoSESS% = HDSoLEN%                       ' Number of sessions
  457.                                              ' started.
  458.  
  459.   PRINT "Number of started sessions = "; NUMoSESS%
  460.   PRINT
  461.   PRINT
  462.  
  463.  
  464.   I% = 1
  465.   STRT% = 0   'BASE OFFSET TO START OF ARRAY ELEMENTS.
  466.  
  467.   DO WHILE I% <= NUMoSESS%
  468.                                              ' LOOP thru queried
  469.                                              ' sessions.
  470.  
  471.     PRINT "Session number     : ";I%
  472.  
  473.  
  474.     PRINT "Session Long name  : ";MID$(HDATAoSTR$,STRT%+2,8)
  475.  
  476.     PRINT "Session Short name : ";MID$(HDATAoSTR$,STRT%+1,1)
  477.  
  478.     T$ = MID$(HDATAoSTR$,STRT%+10,1)
  479.     PRINT "Session Type       : ";T$;
  480.     PRINT " = ";
  481.     IF T$ = "H" THEN GOTO DSIoHOST
  482.     GOTO DSIoNEXT
  483.     DSIoHOST:
  484.  
  485.     PRINT "Host";
  486.  
  487.     IF DFToSESS$ = " " THEN                  ' If first HOST not
  488.                                              ' set already
  489.  
  490.       DFToSESS$ = MID$(HDATAoSTR$,STRT%+1,1)
  491.                                              ' Session to write string to.
  492.     ENDIF
  493.  
  494.     DSIoNEXT:
  495.     IF T$ = "P" THEN
  496.  
  497.       PRINT "PC";
  498.     ENDIF
  499.  
  500.     PRINT
  501.  
  502.  
  503.  
  504.     PRINT "Session PS size    : ";
  505.     PRINT ASC(MID$(HDATAoSTR$,STRT%+11,1))+(ASC(MID$(HDATAoSTR$,STRT%+12,1))*256)
  506.  
  507.     HFUNCoNUM% = HAoQUERYoSESSIONoSTATUS%
  508.                                              ' Issue query
  509.                                              ' session status.
  510.  
  511.     HDSoLEN% = 18                            ' Set length.
  512.  
  513.  
  514.     QSST$ = MID$(HDATAoSTR$,STRT%+1,1) + SPACE$(17)
  515.                                              ' Set the short name
  516.  
  517.     CALL BLIM(HFUNCoNUM%, QSST$, HDSoLEN%, HRC%)
  518.                                              ' Call EHLLAPI.
  519.  
  520.     IF HRC% <> HARCoSUCCESS THEN GOTO DSIoERROR
  521.  
  522.     PRINT "Session PS rows    : ";
  523.     PRINT ASC(MID$(QSST$,12,1))+(ASC(MID$(QSST$,13,1))*256)
  524.  
  525.     PRINT "Session PS columns : ";
  526.     PRINT ASC(MID$(QSST$,14,1))+(ASC(MID$(QSST$,15,1))*256)
  527.  
  528.     T$ = MID$(QSST$,10,1)
  529.     PRINT "Session type 2     : ";T$;
  530.     PRINT " = ";
  531.     IF T$ = "F" THEN
  532.       PRINT "5250";
  533.     ENDIF
  534.     IF T$ = "G" THEN
  535.       PRINT "5250 Printer Session";
  536.     ENDIF
  537.     IF T$ = "D" THEN
  538.       PRINT "DFT Host";
  539.     ENDIF
  540.     IF T$ = "P" THEN
  541.       PRINT "PC";
  542.     ENDIF
  543.     PRINT
  544.  
  545.     PRINT "Session supports Extended attributes (EABs)? : ";
  546.     T% = ASC(MID$(QSST$,11,1))
  547.     IF T% >= &H80 THEN
  548.       PRINT "YES"
  549.     ELSE
  550.       PRINT "NO"
  551.     ENDIF
  552.  
  553.  
  554.     PRINT "Session supports Program Symbols (PSS)?      : ";
  555.  
  556.     IF T% >= &HC0 OR (T% < &H80 AND T% >= &H40) THEN
  557.       PRINT "YES"
  558.     ELSE
  559.       PRINT "NO"
  560.     ENDIF
  561.  
  562.     PRINT:PRINT
  563.     INPUT "ENTER ENTER TO CONTINUE...", X$
  564.     I% = I% + 1
  565.     STRT% = STRT% + 12 'GET NEXT START OF QSES ELEMENT.
  566.   LOOP
  567.   GOTO DSIoRET
  568.  
  569. DSIoERROR:
  570.  
  571.   GOSUB ERRORoHAND
  572.  
  573. DSIoRET:
  574.   RETURN
  575.  
  576.  
  577.  
  578.  
  579.  
  580.  
  581.  
  582. '********************************************************************
  583. ' WRITEoSTRo2oHOST  - Connects to first session and writes homeokey *
  584. '                     and string to host.                           *
  585. '                                                                   *
  586. '                                                                   *
  587. '********************************************************************
  588. WRITEoSTRo2oHOST:                            ' Call routine to
  589.                                              ' write string to host.
  590.  
  591.  
  592.  
  593.   HFUNCoNUM% = HAoCONNECToPS%                 ' Issue Connect
  594.                                               ' Presentation Space.
  595.  
  596.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  597.                                               ' Call EHLLAPI.
  598.  
  599.   IF HRC% <> HARCoSUCCESS THEN GOTO WS2HoERROR
  600.  
  601.  
  602.   HFUNCoNUM% = HAoSENDKEY%                    ' Issue sendkey.
  603.  
  604.   HOMEoKEY$ = "@L@0"                          ' String to send to host
  605.  
  606.   HDSoLEN% = LEN(HOMEoKEY$)                   ' Set length of string
  607.                                               ' string. minus null char
  608.  
  609.   CALL BLIM(HFUNCoNUM%, HOMEoKEY$, HDSoLEN%, HRC%)
  610.                                               ' Call EHLLAPI.
  611.  
  612.   IF HRC% <> HARCoSUCCESS THEN GOTO WS2HoERROR
  613.  
  614.  
  615.   HDSoLEN% = LEN(HOSToTEXT$)                  ' Set length of string
  616.                                               ' minus null char
  617.  
  618.   CALL BLIM(HFUNCoNUM%, HOSToTEXT$, HDSoLEN%, HRC%)
  619.                                               ' Call EHLLAPI.
  620.  
  621.   IF HRC% <> HARCoSUCCESS THEN GOTO WS2HoERROR
  622.  
  623.   PRINT "Sent String to Host."
  624.   PRINT
  625.   PRINT
  626.   GOTO WS2HoRET
  627.  
  628. WS2HoERROR:
  629.  
  630.   GOSUB ERRORoHAND
  631.  
  632. WS2HoRET:
  633.   RETURN
  634.  
  635.  
  636.  
  637.  
  638.  
  639. '********************************************************************
  640. ' SEARCHoSTRoONoHOST- Searches for string on host.                  *
  641. '                                                                   *
  642. '                                                                   *
  643. '                                                                   *
  644. '********************************************************************
  645. SEARCHoSTRoONoHOST:                          ' Routine to search
  646.                                              ' for string on host session
  647.  
  648.   HFUNCoNUM% = HAoSEARCHoPS%                 ' Issue search PS.
  649.  
  650.  
  651.   HDSoLEN% = LEN(HOSToTEXT$)                 ' Set length of
  652.                                              ' string. minus null char
  653.  
  654.   CALL BLIM(HFUNCoNUM%, HOSToTEXT$, HDSoLEN%, HRC%)
  655.                                              ' Call EHLLAPI.
  656.  
  657.   IF HRC% <> HARCoSUCCESS THEN GOTO SSOHoERROR
  658.  
  659.   PRINT "Found string '";
  660.   PRINT HOSToTEXT$;
  661.   PRINT "' at PS position ";HDSoLEN%
  662.   PRINT "(press CONTROL-ESCAPE to verify)"
  663.   PRINT
  664.   PRINT
  665.   PRINT
  666.  
  667.   GOTO SSOHoRET
  668.  
  669. SSOHoERROR:
  670.  
  671.   GOSUB ERRORoHAND
  672.  
  673. SSOHoRET:
  674.   RETURN
  675.  
  676.  
  677.  
  678. '********************************************************************
  679. ' DISPoHOSToSCR - Displays first 1920 bytes of host screen.         *
  680. '                                                                   *
  681. '                                                                   *
  682. '                                                                   *
  683. '********************************************************************
  684. DISPoHOSToSCR:                               ' Routine to
  685.                                              ' display host screen.
  686.  
  687.   HFUNCoNUM% = HAoSEToSESSIONoPARMS%         ' Issue Set session
  688.                                              ' Parms.
  689.   T$ = "EAB NOATTRB XLATE"
  690.  
  691.   HDSoLEN% = LEN(T$)
  692.  
  693.   CALL BLIM(HFUNCoNUM%, T$, HDSoLEN%, HRC%)
  694.  
  695.   IF HRC% <> HARCoSUCCESS GOTO DHSoERROR     ' If bad rc error
  696.  
  697.   HFUNCoNUM% = HAoCOPYoPSoTOoSTR%            ' Issue Copy PS 2 str
  698.  
  699.   HDSoLEN% = MAXoDATAoSIZE                   ' Only copy the
  700.                                              ' first 1920 bytes of the PS
  701.  
  702.   HRC% = 1                                   ' Set PS position to
  703.                                              ' top,left corner.
  704.   HDATAoSTR$ = SPACE$(3840)
  705.  
  706.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
  707.  
  708.   IF HRC% <> HARCoSUCCESS GOTO DHSoERROR
  709.  
  710.   CLS
  711.  
  712. ' CALL VIOWRTCELLSTR(BYVAL VARSEG(HDATAoSTR$),BYVAL SADD(HDATAoSTR$),BYVAL MAXoSIZE%,BYVAL ZERO%,BYVAL ZERO%,BYVAL ZERO%)
  713.  
  714. ' PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
  715. ' PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
  716.  
  717.   J% = 2
  718.   FOR I% = 1 TO 3839 STEP 2
  719.  
  720.     COLOR ASC(MID$(HDATAoSTR$,J%,1))
  721.     PRINT MID$(HDATAoSTR$,I%,1);
  722.  
  723.     J% = J% + 2
  724.  
  725.   NEXT
  726.   COLOR 7   'Get back white forground color.
  727.  
  728.   GOTO DHSoRET
  729.  
  730. DHSoERROR:
  731.  
  732.   GOSUB ERRORoHAND
  733.  
  734. DHSoRET:
  735.   RETURN
  736.  
  737.  
  738.  
  739.  
  740. '********************************************************************
  741. ' CHANGE WINDOW NAME - Change the title name on the PM window       *
  742. '                                                                   *
  743. '                                                                   *
  744. '                                                                   *
  745. '********************************************************************
  746. CHANGEoWINDOWoNAME:                          ' Call routine to
  747.                                              ' change PM window name
  748.  
  749.  
  750.  
  751.  
  752.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect
  753.                                              ' Presentation Space
  754.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  755.                                              ' Call EHLLAPI.
  756.   IF HRC% <> HARCoSUCCESS THEN GOTO WNERROR
  757.  
  758.   HFUNCoNUM% = HAoCHANGEoWINDOWoNAME%        ' Issue change window name.
  759.  
  760.   HDATAoSTR$ = DFToSESS$ + CHR$(1) + TESToNAME$                                                                                     '     String to send to host.
  761.  
  762.   HDSoLEN% = LEN(TESToNAME$) + 3             ' Set length of string.
  763.  
  764.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
  765.                                              ' Call EHLLAPI.
  766. WNERROR:
  767.  
  768.   IF HRC% = HARCoSUCCESS THEN
  769.  
  770.     PRINT "Window Title Changed."
  771.     PRINT "(press CONTROL-ESCAPE to verify)"
  772.     PRINT
  773.     PRINT
  774.  
  775.   ELSE
  776.  
  777.     GOSUB ERRORoHAND
  778.  
  779.   ENDIF
  780.  
  781. RETURN
  782.  
  783.  
  784.  
  785. '********************************************************************
  786. ' CHANGE SWITCH LIST NAME - Change the window's name on the         *
  787. '                                               switch list         *
  788. '                                                                   *
  789. '                                                                   *
  790. '********************************************************************
  791. CHANGEoSWITCHoLISToNAME:                     ' Call routine to
  792.                                              ' change switch list name.
  793.  
  794.  
  795.  
  796.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect
  797.                                              ' Presentation Space.
  798.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  799.                                              ' Call EHLLAPI.
  800.   IF HRC% <> HARCoSUCCESS THEN GOTO SLNERROR
  801.  
  802.   HFUNCoNUM% = HAoCHANGEoSWITCHoNAME%        ' Issue change switch name.
  803.  
  804.   HDATAoSTR$ = DFToSESS$ + CHR$(1) + TESToNAME$ ' String to send to host.
  805.  
  806.   HDSoLEN% = LEN(TESToNAME$) + 3             ' Set length of string.
  807.  
  808.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
  809.                                              ' Call EHLLAPI.
  810. SLNERROR:
  811.  
  812.   IF HRC% = HARCoSUCCESS THEN
  813.  
  814.     PRINT "Switch List Title Changed."
  815.     PRINT "(press CONTROL-ESCAPE to verify)"
  816.     PRINT
  817.     PRINT
  818.  
  819.   ELSE
  820.  
  821.     GOSUB ERRORoHAND
  822.  
  823.   ENDIF
  824.  
  825. RETURN
  826.  
  827.  
  828.  
  829.  
  830.  
  831. '********************************************************************
  832. ' QUERY PM SESSION - Obtain PM session information                  *
  833. '                                                                   *
  834. '                                                                   *
  835. '                                                                   *
  836. '********************************************************************
  837. QUERYoPMoSESSION:                            ' Call routine to
  838.                                              ' query PM session.
  839.  
  840.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect
  841.                                              ' Presentation Space.
  842.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  843.  
  844.   IF HRC% <> HARCoSUCCESS THEN GOTO QPMERROR
  845.  
  846.   HFUNCoNUM% = HAoPMoWINDOWoSTATUS%          ' Issue query status.
  847.  
  848.   HDATAoSTR$ = DFToSESS$ + CHR$(2)+ SPACE$(15) ' String to send to host.
  849.  
  850.   HDSoLEN% = 17
  851.  
  852.   CALL HLLAPI(SEG HFUNCoNUM%,BYVAL VARSEG(HDATAoSTR$),BYVAL SADD(HDATAoSTR$), SEG HDSoLEN%,SEG HRC%)
  853.  
  854.   POS3% = ASC(MID$(HDATAoSTR$,3,1))
  855.  
  856.   POS4% = ASC(MID$(HDATAoSTR$,4,1))
  857.  
  858.   IF HRC% <> HARCoSUCCESS GOTO QPMERROR
  859.  
  860.   PRINT
  861.   PRINT "                   PM SESSION STATUS "
  862.   PRINT
  863.  
  864.   IF ( POS3% AND &H08 )   THEN PRINT "STATUS :      The window is visible. "
  865.  
  866.   IF ( POS3% AND &H10 )   THEN PRINT "STATUS :      The window is invisible. "
  867.  
  868.   IF ( POS3% AND &H80 )   THEN PRINT "STATUS :      The window is activated. "
  869.  
  870.   IF ( POS4% AND &H01 )   THEN PRINT "STATUS :      The window is deactivated. "
  871.  
  872.   IF ( POS4% AND &H04 )   THEN PRINT "STATUS :      The window is minimized."
  873.  
  874.   IF ( POS4% AND &H08 )   THEN PRINT "STATUS :      The window is maximized."
  875.  
  876.   HFUNCoNUM% = HAoQUERYoWINDOWoCOORDS%       ' Issue change switch name.
  877.  
  878.   HDATAoSTR$ = DFToSESS$   + SPACE$(16)
  879.  
  880.   HDSoLEN% = 17
  881.  
  882.   CALL HLLAPI(SEG HFUNCoNUM%,BYVAL VARSEG(HDATAoSTR$),BYVAL SADD(HDATAoSTR$), SEG HDSoLEN%,SEG HRC%)
  883.  
  884.   IF HRC% = HARCoSUCCESS THEN
  885.  
  886.   PRINT
  887.   PRINT "                   PM WINDOW COORDINATES "
  888.   PRINT
  889.  
  890.   SDATA$=HDATAoSTR$                          ' initialize strings for
  891.   DLEN%=HDSoLEN%                             ' conversion
  892.   GOSUB CVBIN2HEX                            ' convert binary to hex
  893.  
  894.   PRINT"XLEFT   : "; MID$(HXSDATA$,9,2);  MID$(HXSDATA$,7,2); MID$(HXSDATA$,5,2);  MID$(HXSDATA$,3,2)
  895.  
  896.   PRINT"YBOTTOM : "; MID$(HXSDATA$,17,2); MID$(HXSDATA$,15,2); MID$(HXSDATA$,13,2); MID$(HXSDATA$,11,2)
  897.  
  898.   PRINT"XRIGHT  : "; MID$(HXSDATA$,25,2); MID$(HXSDATA$,23,2); MID$(HXSDATA$,21,2); MID$(HXSDATA$,19,2)
  899.  
  900.   PRINT"YTOP    : "; MID$(HXSDATA$,33,2); MID$(HXSDATA$,31,2); MID$(HXSDATA$,29,2); MID$(HXSDATA$,27,2)
  901.  
  902.   PRINT
  903.   PRINT
  904.   PRINT "(press CONTROL-ESCAPE to verify)"
  905.   PRINT
  906.   PRINT
  907.   ELSE
  908.  
  909. QPMERROR:
  910.     GOSUB ERRORoHAND
  911.  
  912. ENDIF
  913.  
  914. RETURN
  915.  
  916.  
  917.  
  918.  
  919. '********************************************************************
  920. ' MAKE PM INVISIBLE - Make the screen invisible                     *
  921. '                                                                   *
  922. '                                                                   *
  923. '                                                                   *
  924. '********************************************************************
  925. MAKEoPMoINVISIBLE:                           ' Call routine to
  926.                                              ' change switch list name.
  927.  
  928.  
  929.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect
  930.                                              ' Presentation Space.
  931.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)  ' Call EHLLAPI
  932.  
  933.   IF HRC% <> HARCoSUCCESS THEN GOTO MPMERROR
  934.  
  935.   HFUNCoNUM% = HAoPMoWINDOWoSTATUS%          ' Issue change pm status.
  936.  
  937.   HDATAoSTR$ = DFToSESS$+ CHR$(1)+ CHR$(16)+ CHR$(0) ' Set invisible bit.
  938.  
  939.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)  ' Call EHLLAPI.
  940.  
  941. MPMERROR:
  942.  
  943.   IF HRC% = HARCoSUCCESS THEN
  944.     PRINT
  945.     PRINT "The PM session is now invisible."
  946.     PRINT "(press CONTROL-ESCAPE to verify)"
  947.     PRINT
  948.     PRINT
  949.  
  950.   ELSE
  951.  
  952.     GOSUB ERRORoHAND
  953.  
  954.   ENDIF
  955.  
  956. RETURN
  957.  
  958.  
  959.  
  960.  
  961.  
  962. '********************************************************************
  963. ' MAKE PM WINDOW VISIBLE - Change window status to visible          *
  964. '                                            and maximized          *
  965. '                                                                   *
  966. '                                                                   *
  967. '********************************************************************
  968. MAKEoPMoVISIBLE:                             ' Call routine to make
  969.                                              ' session visible and maximized.
  970.  
  971.  
  972.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect
  973.                                              ' Presentation Space.
  974.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  975.                                              ' Call EHLLAPI.
  976.   IF HRC% <> HARCoSUCCESS THEN GOTO MWVERROR
  977.  
  978.   HFUNCoNUM% = HAoPMoWINDOWoSTATUS%          ' Issue change pm status.
  979.  
  980.   HDATAoSTR$ = DFToSESS$ + CHR$(1)+ CHR$(8)+ CHR$(8) ' Set visible bit.
  981.  
  982.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)  ' Call EHLLAPI.
  983.  
  984. MWVERROR:
  985.  
  986.   IF HRC% = HARCoSUCCESS THEN
  987.  
  988.     PRINT "The PM session is now visible and maximized."
  989.     PRINT "(press CONTROL-ESCAPE to verify)"
  990.     PRINT
  991.     PRINT
  992.  
  993.   ELSE
  994.  
  995.     GOSUB ERRORoHAND
  996.  
  997.   ENDIF
  998.  
  999. RETURN
  1000.  
  1001.  
  1002.  
  1003.  
  1004.  
  1005. '********************************************************************
  1006. ' DISCONNECT PM - Disconnect from the Presentation Manager session  *
  1007. '                                                                   *
  1008. '                                                                   *
  1009. '                                                                   *
  1010. '********************************************************************
  1011. DISCONNECToPM:                               ' Call routine to
  1012.                                              ' change switch list name.
  1013.  
  1014.  
  1015.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect
  1016.                                              ' Presentation Space.
  1017.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  1018.  
  1019.   IF HRC% = HARCoSUCCESS THEN
  1020.  
  1021.      HFUNCoNUM% = HAoDISCONNECToPMoSRVCS%    ' Issue change pm status.
  1022.  
  1023.      CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)  ' Call EHLLAPI.
  1024.  
  1025.   ENDIF
  1026.  
  1027.   IF HRC% = HARCoSUCCESS THEN
  1028.     PRINT
  1029.     PRINT "PM Window Disconnected."
  1030.     PRINT
  1031.  
  1032.   ELSE
  1033.  
  1034.     GOSUB ERRORoHAND
  1035.  
  1036.   ENDIF
  1037.  
  1038. RETURN
  1039.  
  1040.  
  1041.  
  1042.  
  1043.  
  1044. '********************************************************************
  1045. ' RESTORE PM NAMES - Restore window name & size and switch name     *
  1046. '                                                                   *
  1047. '                                                                   *
  1048. '                                                                   *
  1049. '********************************************************************
  1050. RESTOREoPMoNAMES:
  1051.  
  1052.  
  1053.   HFUNCoNUM% = HAoCONNECToPMoSRVCS%          ' Issue Connect PS
  1054.  
  1055.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  1056.  
  1057.   IF HRC% <> HARCoSUCCESS THEN GOTO RSTERROR
  1058.  
  1059.   HFUNCoNUM% = HAoCHANGEoSWITCHoNAME%        ' Issue change pm status.
  1060.  
  1061.   HDATAoSTR$ = DFToSESS$ + CHR$(2)           ' Set reset bit.
  1062.  
  1063.   HDSoLEN% = 2
  1064.  
  1065.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)  ' Call EHLLAPI.
  1066.  
  1067.   IF HRC% <> HARCoSUCCESS THEN GOTO RSTERROR
  1068.  
  1069.   PRINT
  1070.   PRINT "Switch Name Restored."
  1071.  
  1072.   HFUNCoNUM% = HAoCHANGEoWINDOWoNAME%        ' Issue change window status.
  1073.  
  1074.   HDATAoSTR$ = DFToSESS$ + CHR$(2)           ' Set reset title bit.
  1075.  
  1076.   HDSoLEN% = 2
  1077.  
  1078.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%) ' Call EHLLAPI
  1079.  
  1080.   IF HRC% <> HARCoSUCCESS THEN GOTO RSTERROR
  1081.  
  1082.   PRINT "PM Window Name Restored."
  1083.  
  1084.   HFUNCoNUM% = HAoPMoWINDOWoSTATUS%          ' Issue change pm status.
  1085.  
  1086.   HDATAoSTR$ = DFToSESS$ + CHR$(1)  + CHR$(0) + CHR$(16)
  1087.                                              ' Set restore window
  1088.   HDSoLEN% = 4
  1089.  
  1090.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)  ' Call EHLLAPI.
  1091.  
  1092. RSTERROR:
  1093.  
  1094.   IF HRC% = HARCoSUCCESS THEN
  1095.  
  1096.     PRINT "PM Window Size Restored."
  1097.     PRINT "(press CONTROL-ESCAPE to verify)"
  1098.     PRINT
  1099.     PRINT
  1100.  
  1101.   ELSE
  1102.  
  1103.     GOSUB ERRORoHAND
  1104.  
  1105.   ENDIF
  1106.  
  1107. RETURN
  1108.  
  1109.  
  1110.  
  1111.  
  1112. '********************************************************************
  1113. ' RESET SYSTEM - Reset EHLLAPI to its original conditions           *
  1114. '                                                                   *
  1115. '                                                                   *
  1116. '                                                                   *
  1117. '********************************************************************
  1118. RESEToSYSTEM :                                ' Call routine to
  1119.                                               ' reset EHLLAPI
  1120.  
  1121.  
  1122.   HFUNCoNUM% = HAoRESEToSYSTEM%               ' Issue Reset System
  1123.  
  1124.   CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
  1125.  
  1126.   IF HRC% = HARCoSUCCESS THEN
  1127.     PRINT "EHLLAPI Reset To Original Conditions."
  1128.     PRINT
  1129.  
  1130.   ELSE
  1131.  
  1132.     GOSUB ERRORoHAND
  1133.  
  1134.   ENDIF
  1135.  
  1136. RETURN
  1137.  
  1138.  
  1139.  
  1140.  
  1141. '********************************************************************
  1142. ' QUERY COMMUNICATIONS BUFFER - Determine the optimal and maximum   *
  1143. '                               buffer sizes                        *
  1144. '                                                                   *
  1145. '                                                                   *
  1146. '********************************************************************
  1147. QUERYoCOMoBUFFER :
  1148.  
  1149.  
  1150.   HFUNCoNUM% = HAoQUERYoBUFFERoSIZE%         ' Issue Query Buffer
  1151.  
  1152.   HDSoLEN% = 9
  1153.  
  1154.   QRYoSTR.QBUFoSHORTNAME = STRING$(1,DFToSESS$)
  1155.  
  1156.   PRINT "Query The Communication Buffer Size."
  1157.  
  1158.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (QRYoSTR),BYVAL VARPTR (QRYoSTR), SEG HDSoLEN%, SEG HRC% )
  1159.  
  1160.   IF HRC% = HARCoSUCCESS THEN
  1161.     PRINT "Optimal Inbound Buffer Size:  ";QRYoSTR.QBUFoOPToINB
  1162.     PRINT "Maximum Inbound Buffer Size:  ";QRYoSTR.QBUFoMAXoINB
  1163.     PRINT "Optimal Outbound Buffer Size: ";QRYoSTR.QBUFoOPToOUTB
  1164.     PRINT "Maximum Outbound Buffer Size: ";QRYoSTR.QBUFoMAXoOUTB
  1165.     PRINT "Query Communications Buffer Complete."
  1166.     PRINT
  1167.  
  1168.   ELSE
  1169.  
  1170.     GOSUB ERRORoHAND
  1171.  
  1172.   ENDIF
  1173.  
  1174. RETURN
  1175.  
  1176.  
  1177.  
  1178. '********************************************************************
  1179. ' ALLOCATE COMMUNICATIONS BUFFER - Allocate a communciations buffer *
  1180. '                                  for structured field transfer    *
  1181. '                                                                   *
  1182. '                                                                   *
  1183. '********************************************************************
  1184. ALLOCATEoCOMoBUFFER :                        ' Call routine to allocate
  1185.                                              ' a communications buffer
  1186.  
  1187.  
  1188.   HFUNCoNUM% = HAoALLOCATEoCOMMOoBUFF%
  1189.  
  1190.   HDSoLEN% = 6
  1191.  
  1192.   ALLOCATEoSTR.ABUFoLENGTH  = BUFFERoLENGTH
  1193.  
  1194.   ALLOCATEoSTR.ABUFoADDRESS = 0
  1195.  
  1196.   PRINT "Buffer Length : "; ALLOCATEoSTR.ABUFoLENGTH
  1197.  
  1198.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (ALLOCATEoSTR),BYVAL VARPTR (ALLOCATEoSTR), SEG HDSoLEN%, SEG HRC% )
  1199.  
  1200.   IF HRC% = HARCoSUCCESS THEN
  1201.     PRINT "Allocate Communications Buffer Complete."
  1202.     PRINT
  1203.  
  1204.   ELSE
  1205.  
  1206.     GOSUB ERRORoHAND
  1207.  
  1208.   ENDIF
  1209.  
  1210. RETURN
  1211.  
  1212.  
  1213.  
  1214.  
  1215.  
  1216. '********************************************************************
  1217. ' CONNECT TO THE COMMUNICATIONS BUFFER - Connect to the             *
  1218. '                                        communication buffer       *
  1219. '                                                                   *
  1220. '                                                                   *
  1221. '********************************************************************
  1222. CONNECToCOMoBUFFER :                         ' Call routine to connect
  1223.                                              ' to the communications buffer
  1224.  
  1225.  
  1226.   QRSTR(1) = CHR$(0)                         ' DDM Query Reply Code
  1227.   QRSTR(2) = CHR$(12)
  1228.   QRSTR(3) = CHR$(129)
  1229.   QRSTR(4) = CHR$(149)
  1230.   QRSTR(5) = CHR$(0)
  1231.   QRSTR(6) = CHR$(0)
  1232.   QRSTR(7) = CHR$(1)
  1233.   QRSTR(8) = CHR$(0)
  1234.   QRSTR(9) = CHR$(1)
  1235.   QRSTR(10) = CHR$(0)
  1236.   QRSTR(11) = CHR$(1)
  1237.   QRSTR(12) = CHR$(1)
  1238.  
  1239.   HFUNCoNUM% = HAoSTARToSTRUCTUREDoFLD%
  1240.  
  1241.   HDSoLEN% = 11
  1242.  
  1243.   CONNECToSTR.STSFoSHORTNAME =  STRING$(1,DFToSESS$)
  1244.  
  1245.   QRoSEG& = CLNG (VARSEG(QRSTR(1)))
  1246.   QRoOFF& = CLNG (VARPTR(QRSTR(1)))
  1247.  
  1248.   QRoSEG1& = QRoSEG&  * CLNG(256)
  1249.   QRoSEG2& = QRoSEG1& * CLNG(256)
  1250.  
  1251.   CONNECToSTR.STSFoQUERY = QRoSEG2&  + QRoOFF&
  1252.  
  1253.   PRINT
  1254.   PRINT "Session Shortname : "; CONNECToSTR.STSFoSHORTNAME
  1255.  
  1256.  
  1257.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (CONNECToSTR),BYVAL VARPTR (CONNECToSTR), SEG HDSoLEN%, SEG HRC% )
  1258.  
  1259.   IF HRC% = HARCoSUCCESS THEN
  1260.     DOID% = CONNECToSTR.STSFoDOID
  1261.     PRINT "Destination / Origin ID :",HEX$(DOID%)
  1262.     PRINT "Connection made to the Communications Buffer."
  1263.     PRINT
  1264.  
  1265.   ELSE
  1266.  
  1267.     GOSUB ERRORoHAND
  1268.  
  1269.   ENDIF
  1270.  
  1271. RETURN
  1272.  
  1273.  
  1274.  
  1275. '********************************************************************
  1276. ' READ ASYNCHRONUS STRUCTURED FIELD - Read asynchronusly from the   *
  1277. '                                     communications buffer         *
  1278. '                                                                   *
  1279. '********************************************************************
  1280. READoSFoASYNC :
  1281.  
  1282.   HFUNCoNUM% = HAoREADoSTRUCTUREDoFLD%
  1283.  
  1284.   HDSoLEN% = 14
  1285.  
  1286.   READoSTR.RDSFoSHORTNAME =  STRING$(1,DFToSESS$)
  1287.  
  1288.   READoSTR.RDSFoOPTION = CHR$(65)            ' A for asynchronus
  1289.  
  1290.   READoSTR.RDSFoDOID   = DOID%
  1291.  
  1292.   READoSTR.RDSFoBUFFER = RDoADDRESS
  1293.  
  1294.   READoSTR.RDSFoREQUESTID = 0
  1295.  
  1296.   READoSTR.RDSFoASEM      = 0
  1297.  
  1298.  
  1299.  
  1300.   TWOo16&  = CLNG(65536)                    ' Calculate segment and offset
  1301.                                             ' to read buffer
  1302.   RDoSEG&  = RDoADDRESS / TWOo16&
  1303.  
  1304.   RDoSEG%  = RDoSEG&
  1305.  
  1306.   RDoOFF&  = RDoADDRESS - (RDoSEG& * TWOo16&)
  1307.  
  1308.   RDoOFF%  = RDoOFF&
  1309.  
  1310.  
  1311.   DEF SEG  = RDoSEG%
  1312.  
  1313.   FOR INDEX%  = 0 TO 9
  1314.      RDoADD%  = RDoOFF% + INDEX%
  1315.      POKE  RDoADD%, 0
  1316.   NEXT
  1317.  
  1318.   POKE (RDoOFF% + 5 ),  5                      ' buffer size 5(00)
  1319.  
  1320.   PRINT "Initiate Read Asynchronus Structured Field."
  1321.   PRINT "Session Shortname : ";  READoSTR.RDSFoSHORTNAME
  1322.   PRINT "Destination / Origin ID : "; HEX$(READoSTR.RDSFoDOID)
  1323.   PRINT "Read Option :  ";  READoSTR.RDSFoOPTION
  1324.  
  1325.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (READoSTR),BYVAL VARPTR (READoSTR), SEG HDSoLEN%, SEG  HRC% )
  1326.  
  1327.  
  1328.   IF (HRC% = HARCoINBOUNDoDISABLED%) THEN   ' successful case
  1329.     REQUESTID% = READoSTR.RDSFoREQUESTID
  1330.     SFoASEM&   = READoSTR.RDSFoASEM
  1331.     PRINT "Read Structured Field Completed."
  1332.     PRINT
  1333.     HRC% = 0
  1334.  
  1335.   ELSE
  1336.  
  1337.     GOSUB ERRORoHAND
  1338.  
  1339.   ENDIF
  1340.  
  1341. RETURN
  1342.  
  1343.  
  1344.  
  1345.  
  1346. '********************************************************************
  1347. ' CREATEoSTRUCTUREDoFIELD  - Connects to first session and writes   *
  1348. '                            homekey and ind$file command to host   *
  1349. '                                                                   *
  1350. '                                                                   *
  1351. '********************************************************************
  1352. CREATEoSTRUCTUREDoFIELD:
  1353.  
  1354.  
  1355.   HFUNCoNUM% = HAoCONNECToPS%                ' Issue Connect
  1356.                                              ' Presentation Space.
  1357.  
  1358.   CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
  1359.                                              ' Call EHLLAPI.
  1360.  
  1361.   IF HRC% <> HARCoSUCCESS THEN GOTO CNSFoERROR
  1362.  
  1363.   HFUNCoNUM% = HAoSENDKEY%                   ' Issue sendkey.
  1364.  
  1365.   HOMEoKEY$ = "@L@0"                         ' String to send to host
  1366.  
  1367.   HDSoLEN% = LEN(HOMEoKEY$)                  ' Set length of string
  1368.                                              ' minus null char
  1369.  
  1370.   CALL BLIM(HFUNCoNUM%, HOMEoKEY$, HDSoLEN%, HRC%)
  1371.                                              ' Call EHLLAPI.
  1372.  
  1373.   IF HRC% <> HARCoSUCCESS THEN GOTO CNSFoERROR
  1374.  
  1375.  
  1376.   HDSoLEN% = LEN(COMMANDoTEXT$)              ' Set length of string
  1377.                                              ' minus null char
  1378.  
  1379.   CALL BLIM(HFUNCoNUM%, COMMANDoTEXT$, HDSoLEN%, HRC%)
  1380.  
  1381.   IF HRC% = HARCoSUCCESS THEN GOTO CNSFoRET
  1382.  
  1383. CNSFoERROR:
  1384.   GOSUB ERRORoHAND
  1385.  
  1386. CNSFoRET:
  1387.   PRINT
  1388.   PRINT "Structured Field Created."
  1389.   PRINT
  1390.   RETURN
  1391.  
  1392.  
  1393.  
  1394.  
  1395. '********************************************************************
  1396. ' GEToCOMPLETIONoREQUEST - Check for completion of an asynchronus   *
  1397. '                                                         process   *
  1398. '                                                                   *
  1399. '********************************************************************
  1400. GEToASYNCoCOMPLETE :
  1401.  
  1402.   HFUNCoNUM% = HAoGEToASYNCoCOMPLETION%
  1403.  
  1404.   HDSoLEN% = 14
  1405.  
  1406.   GREQoSTR.GCMPoSHORTNAME =   STRING$(1,DFToSESS$)
  1407.  
  1408.   GREQoSTR.GCMPoOPTION    =   CHR$(87)      ' W for wait option
  1409.  
  1410.   GREQoSTR.GCMPoREQUESTID =   REQUESTID%
  1411.  
  1412.   GREQoSTR.GCMPoREToFUNCTID = 0
  1413.  
  1414.   GREQoSTR.GCMPoREToDATASTR = 0
  1415.  
  1416.   GREQoSTR.GCMPoREToLENGTH  = 0
  1417.  
  1418.   GREQoSTR.GCMPoREToRETCODE = 0
  1419.  
  1420.   PRINT "Checking For Asynchronus Completion."
  1421.  
  1422.   PRINT "Session Shortname : "; GREQoSTR.GCMPoSHORTNAME
  1423.  
  1424.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (GREQoSTR),BYVAL VARPTR (GREQoSTR), SEG HDSoLEN%, SEG HRC% )
  1425.  
  1426.   IF HRC% = HARCoSUCCESS THEN
  1427.  
  1428.     PRINT "Completion Request Successful."
  1429.     PRINT
  1430.  
  1431.   ELSE
  1432.  
  1433.     GOSUB ERRORoHAND
  1434.  
  1435.   ENDIF
  1436.  
  1437. RETURN
  1438.  
  1439.  
  1440.  
  1441.  
  1442. '********************************************************************
  1443. ' WRITE SYNCHRONUS STRUCTURED FIELD - Write a structured field      *
  1444. '                         synchronusly to the communications buffer *
  1445. '                                                                   *
  1446. '********************************************************************
  1447. WRITEoSFoSYNC :
  1448.  
  1449.   HFUNCoNUM% = HAoWRITEoSTRUCTUREDoFLD%
  1450.  
  1451.   HDSoLEN% = 8
  1452.  
  1453.   WRITEoSTR.WRSFoSHORTNAME = STRING$(1,DFToSESS$)
  1454.  
  1455.   WRITEoSTR.WRSFoOPTION    = CHR$(83)        ' S for synchronous
  1456.  
  1457.   WRITEoSTR.WRSFoDOID      = DOID%           ' Destination / Origin ID
  1458.  
  1459.   WRITEoSTR.WRSFoBUFFER    = WRoADDRESS
  1460.  
  1461.   PRINT "Initiate Write Synchronus Structured Field."
  1462.  
  1463.   PRINT "Session Shortname : "; WRITEoSTR.WRSFoSHORTNAME
  1464.  
  1465.   PRINT "Write Option : ";      WRITEoSTR.WRSFoOPTION
  1466.  
  1467.   PRINT "Destination / Origin ID : "; HEX$(WRITEoSTR.WRSFoDOID)
  1468.  
  1469.  
  1470.   TWOo16&  = CLNG(65536)                    ' Calculate segemnt and offset
  1471.   WRoSEG&  = WRoADDRESS / TWOo16&           ' of the write buffer
  1472.   WRoSEG%  = WRoSEG&
  1473.   WRoOFF&  = WRoADDRESS - (WRoSEG& * TWOo16&)
  1474.   WRoOFF%  = WRoOFF&
  1475.  
  1476.   DEF SEG  = WRoSEG%
  1477.  
  1478.   FOR INDEX%  = 0 TO 1279
  1479.      WRoADD%  = WRoOFF% + INDEX%           ' Clear write buffer contents
  1480.      POKE  WRoADD%, 0
  1481.   NEXT
  1482.                                            ' Write buffer header
  1483.   POKE (WRoOFF% + 2),  5
  1484.   POKE (WRoOFF% + 9),  5
  1485.   POKE (WRoOFF% + 10), 208                 ' destination / origin ID
  1486.   POKE (WRoOFF% + 12), 9
  1487.  
  1488.  
  1489.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (WRITEoSTR),BYVAL VARPTR (WRITEoSTR), SEG HDSoLEN%, SEG HRC% )
  1490.  
  1491.   IF HRC% = HARCoSUCCESS% THEN
  1492.     PRINT "Write Structured Field Completed."
  1493.     PRINT
  1494.  
  1495.     CALL  DosSleep(BYVAL 0, BYVAL 5000 )   ' Give Host time to clear
  1496.                                            ' outstanding responses
  1497.   ELSE
  1498.  
  1499.     GOSUB ERRORoHAND
  1500.  
  1501.   ENDIF
  1502.  
  1503. RETURN
  1504.  
  1505.  
  1506.  
  1507. '********************************************************************
  1508. ' FREE COMMUNICATIONS BUFFER- Return to the shared memory pool the  *
  1509. '                       communications buffers no longer being used *
  1510. '                                                                   *
  1511. '********************************************************************
  1512. FREEoCOMMOoBUFF:
  1513.  
  1514.   HFUNCoNUM% = HAoFREEoCOMMOoBUFF%
  1515.  
  1516.   HDSoLEN% = 6
  1517.  
  1518.   FREEoBUFFoSTR.FBUFoADDRESS = RDoADDRESS
  1519.  
  1520.   FREEoBUFFoSTR.FBUFoLENGTH  = QRYoSTR.QBUFoOPToINB
  1521.  
  1522.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (FREEoBUFFoSTR),BYVAL VARPTR (FREEoBUFFoSTR), SEG HDSoLEN%, SEG HRC% )
  1523.  
  1524.   IF HRC% = HARCoSUCCESS8 THEN
  1525.  
  1526.     PRINT
  1527.     PRINT "Read Buffer De-Allocated."
  1528.  
  1529.   ELSE
  1530.  
  1531.     GOSUB ERRORoHAND
  1532.  
  1533.   ENDIF
  1534.  
  1535.   FREEoBUFFoSTR.FBUFoADDRESS = WRoADDRESS
  1536.  
  1537.   FREEoBUFFoSTR.FBUFoLENGTH  =QRYoSTR.QBUFoOPToOUTB
  1538.  
  1539.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (FREEoBUFFoSTR),BYVAL VARPTR (FREEoBUFFoSTR), SEG HDSoLEN%, SEG HRC% )
  1540.  
  1541.   IF HRC% = HARCoSUCCESS8 THEN
  1542.  
  1543.     PRINT "Write Buffer De-Allocated."
  1544.     PRINT
  1545.  
  1546.   ELSE
  1547.  
  1548.     GOSUB ERRORoHAND
  1549.  
  1550.   ENDIF
  1551.  
  1552. RETURN
  1553.  
  1554.  
  1555.  
  1556.  
  1557.  
  1558. '********************************************************************
  1559. ' DISCONNECT FROM THE STRUCTURED FIELD - Disconnect from the        *
  1560. '                                        communications buffer      *
  1561. '                                                                   *
  1562. '********************************************************************
  1563. DISCONNECToFROMoCOMoBUFFER :
  1564.  
  1565.   HFUNCoNUM% = HAoSTOPoSTRUCTUREDoFLD%
  1566.  
  1567.   HDSoLEN% = 3
  1568.  
  1569.   DISCONNECToSTR.SPSFoSHORTNAME =  STRING$(1,DFToSESS$)
  1570.  
  1571.   DISCONNECToSTR.SPSFoDOID = DOID%
  1572.  
  1573.   PRINT "Initiate Disconnect From Structured Field."
  1574.  
  1575.   PRINT "Session Shortname : "; DISCONNECToSTR.SPSFoSHORTNAME
  1576.  
  1577.   PRINT "Destination / Origin ID : "; HEX$(DISCONNECToSTR.SPSFoDOID)
  1578.  
  1579.   CALL HLLAPI (SEG HFUNCoNUM%,BYVAL VARSEG (DISCONNECToSTR),BYVAL VARPTR (DISCONNECToSTR), SEG HDSoLEN%, SEG HRC% )
  1580.  
  1581.   IF HRC% = HARCoSUCCESS THEN
  1582.  
  1583.     PRINT "Communications Buffer Disconnected."
  1584.     PRINT
  1585.  
  1586.   ELSE
  1587.  
  1588.     GOSUB ERRORoHAND
  1589.  
  1590.   ENDIF
  1591.  
  1592. RETURN
  1593.  
  1594.  
  1595.  
  1596.  
  1597. '********************************************************************
  1598. ' ERRORoHAND - Error handler.                                       *
  1599. '                                                                   *
  1600. '********************************************************************
  1601. ERRORoHAND:                         '     Error handler.
  1602.  
  1603.   PRINT "UNEXPECTED RETURN CODE "; HRC%;" from FUNCTION #";HFUNCoNUM%;"."
  1604.  
  1605.   INPUT "PRESS ENTER TO EXIT ...", X$
  1606.  
  1607.  
  1608.   RETURN
  1609.  
  1610.  
  1611. '***********************************************************************
  1612. '*                                                                     *
  1613. '*    BUILDTABLES :                                                    *
  1614. '*             initializes hex values at the beginning of the program. *
  1615. '*             This is done before calling CVBIN2HEX.                  *
  1616. '*                                                                     *
  1617. '***********************************************************************
  1618.  
  1619. BUILDTABLES:
  1620.  
  1621.   DIM BIN2HEX%(16)
  1622.   DATA &H30%,&H31%,&H32%,&H33%,&H34%,&H35%,&H36%,&H37%,&H38%,&H39%,&H41%
  1623.   DATA &H42%,&H43%,&H44%,&H45%,&H46%
  1624.  
  1625.   FOR I=1 TO 16
  1626.      READ BIN2HEX%(I)
  1627.   NEXT I
  1628.  
  1629. RETURN
  1630.  
  1631.  
  1632.  
  1633. '********************************************************************
  1634. '*                                                                  *
  1635. '*     CVBIN2HEX :                                                  *
  1636. '*            This routine is to converse a string of binary values *
  1637. '*            into hex.                                             *
  1638. '*                                                                  *
  1639. '********************************************************************
  1640.  
  1641. CVBIN2HEX :
  1642.    HXSDATA$ = SPACE$(2*DLEN%)
  1643.    SRC%=SADD(SDATA$)
  1644.    TRG%=SADD(HXSDATA$)
  1645.    TNDX%=0
  1646.    SNDX%=0
  1647.    WHILE SNDX% < DLEN%
  1648.          TMP1% = PEEK(SRC%+SNDX%)\16
  1649.          TMP2% = PEEK(SRC%+SNDX%) - (TMP1%*16)
  1650.          POKE TRG%+TNDX%, BIN2HEX%(TMP1%+1)
  1651.          POKE TRG%+TNDX%+1, BIN2HEX%(TMP2%+1)
  1652.          SNDX%=SNDX%+1
  1653.          TNDX%=TNDX%+2
  1654.   WEND
  1655.   DLEN%=TNDX%
  1656. RETURN
  1657.