Category : OS/2 Files
Archive   : OS2CMAPI.ZIP
Filename : HSMPLBAS.BAS

 
Output of file : HSMPLBAS.BAS contained in archive : OS2CMAPI.ZIP
'*********************************************************************
'* *
'* *
'* FILE NAME: HSMPLBAS.BAS *
'* *
'* MODULE NAME= HSMPLBAS.BAS *
'* *
'* DESCRIPTIVE NAME= BASIC COMPILER SAMPLE PROGRAM FOR EHLLAPI *
'* *
'* Displays EHLLAPI and session information. *
'* Writes string to host. *
'* Searches for written string on host. *
'* Displays host session screen. *
'* *
'* COPYRIGHT: XXXXXXXXX (C) COPYRIGHT IBM CORP. 1987,1988 *
'* LICENSED MATERIAL - PROGRAM PROPERTY OF IBM *
'* ALL RIGHTS RESERVED *
'* *
'* *
'* NOTES= *
'* *
'**********************-END OF SPECIFICATIONS-************************
'
'*********************************************************************
'********************** BEGIN INCLUDE FILES **************************
'*********************************************************************



'$INCLUDE: 'HAPI_BAS.INC'

'********************************************************************
'******************* BEGIN DECLARES *********************************
'********************************************************************




'*********************************************************************
'*************************** BEGIN CODE ******************************
'*********************************************************************

'*********************************************************************
'* MAIN - Main code calls routines to do real work. *
'* *
'* INPUT *
'* *
'* OUTPUT *
'* *
'* *
'*********************************************************************
CLS ' 000 Clear the screen.
KEY OFF
HOSToTEXT$ = "3270 EHLLAPI"
DFToSESS$ = " "
HDATAoSTR$ = SPACE$(3840)
MAXoDATAoSIZE = 3840

GOSUB DISPoEHLLAPIoINFO

IF HRC% <> 0 THEN GOTO MRET
PRINT
INPUT "ENTER ENTER TO CONTINUE...", X$
GOSUB DISPoSESSIONoINFO ' 000 Call routine to
' display Host session

IF HRC% <> 0 THEN GOTO MRET
IF DFToSESS$ = " " THEN ' 000 If at least 1 dft sess
PRINT "NO DFT SESSION SESSION STARTED.":GOTO MRET
ENDIF

CLS
PRINT "PRESS ENTER TO SEND STRING '";HOSToTEXT$;"' TO SESSION SHORT NAME ";
PRINT DFToSESS$;"...";
MI1: X$ = INKEY$: IF X$ = "" THEN GOTO MI1

GOSUB WRITEoSTRo2oHOST
IF HRC% <> 0 THEN GOTO MRET

PRINT "Press ENTER to search for string '";HOSToTEXT$;
PRINT "' on Host Presentation Space...";
MI2: X$ = INKEY$: IF X$ = "" THEN GOTO MI2
GOSUB SEARCHoSTRoONoHOST
IF HRC% <> 0 THEN GOTO MRET

PRINT "Press ENTER to display first 1920 bytes of Host ";
PRINT "presentation space...";
MI3: X$ = INKEY$: IF X$ = "" THEN GOTO MI3
GOSUB DISPoHOSToSCR
IF HRC% <> 0 THEN GOTO MRET

LOCATE 25,1
PRINT "SAMPLE PROGRAM DONE. To Exit Program Press ENTER...";
MI4: X$ = INKEY$: IF X$ = "" THEN GOTO MI4

MRET:
END








'********************************************************************
' DISPoEHLLAPIoINFO - CALLs EHLLAPI QUERYoSYSTEM and then displays *
' the requested info. *
' *
' INPUT *
' *
' OUTPUT *
' *
'********************************************************************
DISPoEHLLAPIoINFO: ' 000 Routine to display
' EHLLAPI info.

HFUNCoNUM% = HAoQUERYoSYSTEM% ' 000 Issue query
' system.


CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS THEN GOTO DEIoERROR

PRINT " EHLLAPI INFORMATION"
PRINT
PRINT " EHLLAPI version : ";

PRINT MID$(HDATAoSTR$,1,1)

PRINT " EHLLAPI level : ";

PRINT MID$(HDATAoSTR$,2,2)

PRINT " EHLLAPI release date : ";

PRINT MID$(HDATAoSTR$,4,6)

PRINT " EHLLAPI LIM version : ";

PRINT MID$(HDATAoSTR$,10,1)

PRINT " EHLLAPI LIM level : ";

PRINT MID$(HDATAoSTR$,11,2)

PRINT " EHLLAPI hardware base : ";

T$ = MID$(HDATAoSTR$,13,1)
PRINT T$;
PRINT " = ";
IF T$ = "A" THEN
PRINT "AT";
ENDIF
IF T$ = "X" THEN
PRINT"XT";
ENDIF
IF T$ = "S" THEN
PRINT "S/2";
ENDIF
IF T$ = "Z" THEN
PRINT "(See System model/submodel below)";
ENDIF
PRINT

PRINT " EHLLAPI CTRL program type : ";

T$ = MID$(HDATAoSTR$,14,1)
PRINT T$;
PRINT " = ";
IF T$ = "X" THEN
PRINT "OS/2";
ENDIF
IF T$ = "C" THEN
PRINT "3270 PC";
ENDIF
IF T$ = "W" THEN
PRINT "WSP";
ENDIF
PRINT

PRINT " EHLLAPI sequence number : ";MID$(HDATAoSTR$,15,2)

PRINT " EHLLAPI CTRL program version : ";

PRINT MID$(HDATAoSTR$,17,2)

PRINT " EHLLAPI PC session name : ";

PRINT MID$(HDATAoSTR$,19,1)

PRINT " EHLLAPI extended error 1 : ";

PRINT MID$(HDATAoSTR$,20,4)

PRINT " EHLLAPI extended error 2 : ";

PRINT MID$(HDATAoSTR$,24,4)

T% = ASC(MID$(HDATAoSTR$,28,1))
T$ = HEX$(T%)
IF T% <= &H0F THEN T$ = "0" + T$
T1% = ASC(MID$(HDATAoSTR$,29,1))
T1$ = HEX$(T1%)
IF T1% <= &H0F THEN T1$ = "0" + T1$
PRINT " EHLLAPI system model/submodel: ";
PRINT T$ + T1$;
PRINT " HEX = ";
IF T% = &HFC AND T1% = &H00 THEN
PRINT "Model PC AT";
ENDIF
IF T% = &HFC AND T1% = &H01 THEN

PRINT "Model PC AT ENHANCED";
ENDIF
IF T% = &HFC AND T1% = &H02 THEN
PRINT "Model PC XT Model 286";
ENDIF
IF T% = &HFA AND T1% = &H01 THEN
PRINT "Model 25";
ENDIF
IF T% = &HFA AND T1% = &H00 THEN
PRINT "Model 30";
ENDIF
IF T% = &HFC AND T1% = &H04 THEN
PRINT "Model 50";
ENDIF
IF T% = &HFC AND T1% = &H05 THEN
PRINT "Model 60";
ENDIF
IF T% = &HF8 AND T1% = &H00 THEN
PRINT "Model 80";
ENDIF
PRINT

PRINT " EHLLAPI National Language : ";
PRINT ASC(MID$(HDATAoSTR$,30,1)) + (ASC(MID$(HDATAoSTR$,31,1)) * 256)

PRINT " EHLLAPI monitor type : ";

T$ = MID$(HDATAoSTR$,32,1)
PRINT T$;
PRINT " = ";
IF T$ = "M" THEN
PRINT "PC MONOCHROME";
ENDIF
IF T$ = "C" THEN
PRINT "PC CGA";
ENDIF
IF T$ = "E" THEN
PRINT "PC EGA";
ENDIF
IF T$ = "A" THEN
PRINT "PS MONOCHROME";
ENDIF
IF T$ = "V" THEN
PRINT "PS 8512";
ENDIF
IF T$ = "H" THEN
PRINT "PS 8514";
ENDIF
IF T$ = "U" THEN
PRINT "UNKNOWN monitor type";
ENDIF
PRINT
GOTO DEIoRET

DEIoERROR:
GOSUB ERRORoHAND

DEIoRET:
RETURN





'********************************************************************
' DISPoSESSIONoINFO - CALLs EHLLAPI QUERY funtions and then displays*
' the requested session info. *
' *
' INPUT *
' *
' OUTPUT *
' *
'********************************************************************



DISPoSESSIONoINFO: ' 000 Routine to display
' Host session info.
NUMoSESS% = 0

PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT

PRINT " SESSION INFO";
PRINT:PRINT

HFUNCoNUM% = HAoQUERYoSESSIONS% ' 000 Issue query
' sessions.

HDSoLEN% = MAXoDATAoSIZE / 12 * 12 ' 000 Make sure len is
' multiple of 12.

CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.


IF HRC% <> HARCoSUCCESS THEN GOTO DSIoERROR
' 000 If good rc.
NUMoSESS% = HDSoLEN% ' 000 Number of sessions
' started.

PRINT "Number of started sessions = "; NUMoSESS%
PRINT
PRINT


I% = 1
STRT% = 0 'BASE OFFSET TO START OF ARRAY ELEMENTS.

DO WHILE I% <= NUMoSESS%
' 000 LOOP thru queried
' sessions.






PRINT "Session number : ";I%


PRINT "Session Long name : ";MID$(HDATAoSTR$,STRT%+2,8)

PRINT "Session Short name : ";MID$(HDATAoSTR$,STRT%+1,1)

T$ = MID$(HDATAoSTR$,STRT%+10,1)
PRINT "Session Type : ";T$;
PRINT " = ";
IF T$ = "H" THEN GOTO DSIoHOST
GOTO DSIoNEXT
DSIoHOST:

PRINT "Host";

IF DFToSESS$ = " " THEN ' 000 If first HOST not
' set already

DFToSESS$ = MID$(HDATAoSTR$,STRT%+1,1)
' Set the session to write string to.
ENDIF

DSIoNEXT:
IF T$ = "P" THEN

PRINT "PC";
ENDIF

PRINT



PRINT "Session PS size : ";
PRINT ASC(MID$(HDATAoSTR$,STRT%+11,1))+(ASC(MID$(HDATAoSTR$,STRT%+12,1))*256)

HFUNCoNUM% = HAoQUERYoSESSIONoSTATUS%
' 000 Issue query
' session status.

HDSoLEN% = 18 ' 000 Set length.


QSST$ = MID$(HDATAoSTR$,STRT%+1,1) + SPACE$(17)
' 000 Set the short
' name.

CALL BLIM(HFUNCoNUM%, QSST$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS THEN GOTO DSIoERROR

PRINT "Session PS rows : ";
PRINT ASC(MID$(QSST$,12,1))+(ASC(MID$(QSST$,13,1))*256)

PRINT "Session PS columns : ";
PRINT ASC(MID$(QSST$,14,1))+(ASC(MID$(QSST$,15,1))*256)

T$ = MID$(QSST$,10,1)
PRINT "Session type 2 : ";T$;
PRINT " = ";
IF T$ = "D" THEN
PRINT "DFT Host";
ENDIF
IF T$ = "P" THEN
PRINT "PC";
ENDIF
PRINT

PRINT "Session supports Extended attributes (EABs)? : ";
T% = ASC(MID$(QSST$,11,1))
IF T% >= &H80 THEN
PRINT "YES"
ELSE
PRINT "NO"
ENDIF


PRINT "Session supports Program Symbols (PSS)? : ";

IF T% >= &HC0 OR (T% < &H80 AND T% >= &H40) THEN
PRINT "YES"
ELSE
PRINT "NO"
ENDIF

PRINT:PRINT
INPUT "ENTER ENTER TO CONTINUE...", X$
I% = I% + 1
STRT% = STRT% + 12 'GET NEXT START OF QSES ELEMENT.
LOOP
GOTO DSIoRET

DSIoERROR:

GOSUB ERRORoHAND

DSIoRET:
RETURN




'********************************************************************
' WRITEoSTRo2oHOST - Connects to first session and writes homeokey *
' and string to host. *
' *
' INPUT *
' *
' OUTPUT *
' *
'********************************************************************
WRITEoSTRo2oHOST: ' 000 Call routine to
' write string to host.




HFUNCoNUM% = HAoCONNECToPS% ' 000 Issue Connect
' Presentation Space.

CALL BLIM(HFUNCoNUM%, DFToSESS$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS THEN GOTO WS2HoERROR


HFUNCoNUM% = HAoSENDKEY% ' 000 Issue sendkey.

HOMEoKEY$ = "@0" ' 000 String to send to
' Host.

HDSoLEN% = LEN(HOMEoKEY$) ' 000 Set length of
' string. minus null
' char.

CALL BLIM(HFUNCoNUM%, HOMEoKEY$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS THEN GOTO WS2HoERROR


HDSoLEN% = LEN(HOSToTEXT$) ' 000 Set length of
' string. minus null
' char.

CALL BLIM(HFUNCoNUM%, HOSToTEXT$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS THEN GOTO WS2HoERROR


PRINT "Sent String to Host."
PRINT
PRINT
GOTO WS2HoRET

WS2HoERROR:

GOSUB ERRORoHAND

WS2HoRET:
RETURN




'********************************************************************
' SEARCHoSTRoONoHOST- Searches for string on host. *
' *
' INPUT *
' *
' OUTPUT *
' *
'********************************************************************
SEARCHoSTRoONoHOST: ' 000 Routine to search
' for string on host
' session.

HFUNCoNUM% = HAoSEARCHoPS% ' 000 Issue search PS.


HDSoLEN% = LEN(HOSToTEXT$) ' 000 Set length of
' string. minus null
' char.

CALL BLIM(HFUNCoNUM%, HOSToTEXT$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS THEN GOTO SSOHoERROR

PRINT "Found string '";
PRINT HOSToTEXT$;
PRINT "' at PS position ";HDSoLEN%
PRINT
PRINT

GOTO SSOHoRET

SSOHoERROR:

GOSUB ERRORoHAND

SSOHoRET:
RETURN



'********************************************************************
' DISPoHOSToSCR - Displays first 1920 bytes of host screen. *
' *
' INPUT *
' *
' OUTPUT *
' *
'********************************************************************
DISPoHOSToSCR: ' 000 Routine to
' display host screen.

HFUNCoNUM% = HAoSEToSESSIONoPARMS% ' 000 Issue Set session
' Parms.

T$ = "EAB NOATTRB XLATE"


HDSoLEN% = LEN(T$)

CALL BLIM(HFUNCoNUM%, T$, HDSoLEN%, HRC%)
' 000 Call EHLLAPI.

IF HRC% <> HARCoSUCCESS GOTO DHSoERROR' 000 If good rc.

HFUNCoNUM% = HAoCOPYoPSoTOoSTR% ' 000 Issue Copy PS 2 str

HDSoLEN% = MAXoDATAoSIZE ' 000 Only copy the
' first 1920 bytes of
' the PS.

HRC% = 1 ' 000 Set PS position to
' top,left corner.

CALL BLIM(HFUNCoNUM%, HDATAoSTR$, HDSoLEN%, HRC%)


IF HRC% <> HARCoSUCCESS GOTO DHSoERROR

CLS
J% = 2
FOR I% = 1 TO 3839 STEP 2

COLOR ASC(MID$(HDATAoSTR$,J%,1))
PRINT MID$(HDATAoSTR$,I%,1);

J% = J% + 2

NEXT
COLOR 7 'Get back white forground color.

GOTO DHSoRET

DHSoERROR:

GOSUB ERRORoHAND

DHSoRET:
RETURN






'********************************************************************
' ERRORoHAND - Error handler. *
' *
' INPUT *
' *
' OUTPUT *
'********************************************************************
ERRORoHAND: ' 000 Error handler.

PRINT "UNEXPECTED RETURN CODE "; HRC%;" from FUNCTION #";HFUNCoNUM%;"."
INPUT "PRESS ENTER TO EXIT TO DOS...", X$


RETURN



  3 Responses to “Category : OS/2 Files
Archive   : OS2CMAPI.ZIP
Filename : HSMPLBAS.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/