Sample Program in Non-Transparent Mode

program imf3270 (input, output, parm);const   SCREENSIZE    = 1920;   LINESIZE      = 80;{ constant for OPEN3270 }   TERMINAL      = -2;{ constants for action code of PRINT3270 }   OPEN_FILE     = 0;   PRINT_SCREEN  = 2;   PRINT_BANNER  = 3;   CLOSE_FILE    = 4;{ constants for AID of TRAN3270 }   SYS_REQ_KEY   = 48;   ENTER_KEY     = 39;{ constants for ACQUIRE3270 }   LU_T3         = -3;   SPOOLER_FILE  = 6;type   shortint      = -32768..32767;     { 16 bits = 2 bytes }   string        = packed array[1..LINESIZE] of char;   screen        = packed array[1..SCREENSIZE] of char;{ type for OPEN3270: }{ This type takes up 2 bytes.  It can be replaced by the shortint type. }{ This type is defined for ease of assigning values to each }{ of the different bit groups }   flags_type = packed record      filler     : 0..1023;  { ten bits }      dbcs       : 0..1;     { one bit }      unbind     : 0..1;     { one bit }      LUT1_LUT3  : 0..1;     { one bit }      int_trace  : 0..1;     { one bit }      trans_mode : 0..1;     { one bit }      IO_mode    : 0..1;     { one bit }   end;                      { total of 16 bits = 2 bytes }{ type for ACQUIRE3270: }{ This type takes up two bytes.  It can be replaced by the shortint type. }{ This type is defined for ease of assigning values to each }{ of the different bit groups }{ Note that the readTO field takes up nine bits, but the legal }{ range of values is 10-255, which only takes up 8 bits. }{ So, the range is set at 10-256 to take up nine bits, }{ but a value of 256 or higher is not allowed. }   options_type = packed record      filler     : 0..1;     { one bit }      int_trace  : 0..1;     { one bit }      sPriority  : 1..13;    { four bits }      readTO     : 10..256;  { nine bits.  256 is illegal value. }      LJ2        : 0..1;     { one bit }   end;                      { total of 16 bits = 2 bytes }Global variables: }{ These variables are global because they must be used in a number of }{ procedures.  Some of them are used to actually pass parameters }{ to other procedures.  Making them global simplifies the code }{ and makes intuitive sense. }var   terminalid     : shortint;  { terminalid used for intrinsics }   result         : shortint;  { result code of intrinsic calls }   fileid         : shortint;  { ID of file printed to }   action         : shortint;  { action code for PRINT3270 }   priority       : shortint;  { priority given to spooler file }   cursorrow      : shortint;  { current cursor row position }   cursorcolumn   : shortint;  { current cursor column position }   numfields      : shortint;  { number of fields in the current screen }   error          : boolean;   { global error flag }   location       : string;    { location string used by PRINT3270 }   parm           : shortint;  { parameter specified in command line }procedure VERS3270;     intrinsic;procedure ERR3270;      intrinsic;procedure ACQUIRE3270;  intrinsic;procedure ATTRLIST;     intrinsic;procedure CLOSE3270;    intrinsic;procedure FIELDATTR;    intrinsic;procedure OPEN3270;     intrinsic;procedure PRINT3270;    intrinsic;procedure READSCREEN;   intrinsic;procedure RECV3270;     intrinsic;procedure SCREENATTR;   intrinsic;procedure TRAN3270;     intrinsic;procedure WRITEFIELD;   intrinsic;procedure READFIELD;    intrinsic;{ * The following procedure takes an errorcode, which is usually a result code * from another intrinsic call, and prints out the corresponding message. * The conversion is done by ERR3270.  ERR3270 takes an errorcode, fills msgbuf * with the corresponding message, assigns msglen to the message length, * and sets result to the result code.}procedure print_message (errorcode: shortint);var   msgbuf  : packed array[1..144] of char;   msglen  : shortint;begin{ Set flag if any fatal errors have occurred. }{ errorcode=0 (and errorcode=9 on MPE V) are not errors. }   if errorcode <<>> 0 then      error := TRUE;   msgbuf := ' '   ERR3270 (errorcode, msgbuf, msglen, result);{ Check whether the ERR3270 intrinsic generated any errors. }   if result = 0 then      writeln (msgbuf:msglen)   else begin      writeln ('INTERNAL ERROR in program:  ERR3270 result = ', result:2);      error := TRUE;   end  { if - else }end;

{ * The following procedure calls RECV3270 to receive and print a screen. * The variables terminalid, fileid, action, location, and priority are * global.  terminalid is set by OPEN3270.  fileid is set by the first * PRINT3270 call, which is the call that opens the print file.  The variables * action, location, and priority are set in procedure initialize. * Note that the priority variable isn't checked after the first call * to PRINT3270, which opened the print file.}procedure call_recv3270;begin   write (' RECV3270.........');   RECV3270 (terminalid, result);   print_message (result);   write (' PRINT3270 print to file.....')   PRINT3270 (terminalid, fileid, action, location, priority, result);   print_message (result);end; * The following procedure prints the internal screen image to the spooler * file before it calls TRAN3270.  The variables terminalid, fileid, action, * location, priority, cursorrow, and cursorcolumn are global. * terminalid is set by OPEN3270.  fileid is set by the first PRINT3270 call, * which is the call that opens the print file.  The variables * action, location, and priority are set in procedure initialize. * Note that priority is not checked after the first call to PRINT3270, * the call that opened the print file. * cursorrow and cursorcolumn are set by the previous call to SCREENATTR. * Usually, call_recv3270 follows shortly after a call to this procedure, * because RECV3270 is usually the first intrinsic called after TRAN3270.}procedure call_tran3270 (aid:shortint);begin   write (' PRINT3270 print to file.....');   PRINT3270 (terminalid, fileid, action, location, priority, result);   print_message (result);   write (' TRAN3270...................');   TRAN3270 (terminalid, aid, cursorrow, cursorcolumn, result);   print_message (result);end;{ * The following procedure writes a string to the specified field * in the internal screen.  The variable terminalid is global and * is set by OPEN3270.}procedure call_writefield (outbuf:string; outbuflen, fieldnum:shortint);var   offset : shortint;begin   offset := 0;   write (' WRITEFIELD..............');   WRITEFIELD (terminalid, fieldnum, offset, outbuf, outbuflen, result);   print_message (result);end;{ * The following procedure calls READSCREEN to read the internal screen * image and output it to standard output.  The variable terminalid * is global and is set by OPEN3270.}procedure call_readscreen;var   offset       : shortint;   maxinbuflen  : shortint;   actinbuflen  : shortint;   inbuf        : screen;begin   offset := 0;   maxinbuflen := SCREENSIZE;   inbuf := ' ';   write (' READSCREEN.............');   READSCREEN (terminalid, offset, maxinbuflen, inbuf, actinbuflen, result);   print_message (result);   writeln ('                          the screen read is shown below:')   writeln (inbuf:actinbuflen);end;

 * The following procedure calls ATTRLIST to find all the attribute characters * in the internal screen and their positions (thereby locating all the fields). * ATTRLIST sets the variable actlistlen, which then indicates the number of * fields in the screen.  The procedure then calls SCREENATTR to find the * number of fields, the print format, the current cursor position, and other * screen information.  SCREENATTR returns the number of fields through * the numfields parameter, which is global and is used outside of * this procedure after SCREENATTR sets it.  SCREENATTR's numfields parameter * and ATTRLIST's actlistlen parameter should contain the same value, * since they both represent the number of fields in the screen. * This procedure also calls FIELDATTR once for each field, to get * information about each of the fields.  Finally, it calls the call_readscreen * procedure to output the screen image.  The variable terminalid * is global and is set by OPEN3270.}procedure check_screen;var{ ATTRLIST parameters }   offset        : shortint;   subscreensize : shortint;   maxlistlen    : shortint;   offsetlist    : array[1..20] of shortint;   actlistlen    : shortint;   fieldnum      : shortint;{ SCREENATTR parameters }   printformat   : shortint;   startprint    : shortint;   soundalarm    : shortint;   keyboardlock  : shortint;   screenstatus  : shortint;{ FIELDATTR parameters }   protectedattr   : shortint;   currentfieldlen : shortint;   fieldrow        : shortint;   fieldcolumn     : shortint;   numericattr     : shortint;   displayattr     : shortint;   mdt             : shortint;   maxfieldlen     : shortint;begin   writeln;   writeln ('Checking screen.....');   offset := 0;   subscreensize := SCREENSIZE;   maxlistlen := 20;   write (' ATTRLIST.............');   ATTRLIST (terminalid, offset, subscreensize, maxlistlen, fieldnum,             offsetlist, actlistlen, result);   print_message (result);   if actlistlen = 0 then      writeln ('                  no attribute characters');   else      for fieldnum := 1 to actlistlen do         writeln ('               attribute character #', fieldnum:1,                  ' position = ', offsetlist[fieldnum]:2);   write (' SCREENATTR.............');   SCREENATTR (terminalid, printformat, startprint, soundalarm,               keyboardlock, numfields, screenstatus, cursorrow,               cursorcolumn, result);   print_message (result);   writeln ('              printformat = ', printformat:2,            '                numfields = ', numfields:2);   writeln ('                cursorrow = ', cursorrow:2,            '             cursorcolumn = ', cursorcolumn:2);   for fieldnum := 1 to numfields do   begin     write (' FIELDATTR ', fieldnum:1, '.............');     FIELDATTR (terminalid, fieldnum, fieldrow, fieldcolumn,                protectedattr, numericattr, displayattr, mdt,                currentfieldlen, maxfieldlen, result);      print_message (result);      writeln ('        protectedattr = ', protectedattr:2,               '             fieldlen = ', currentfieldlen:2);   end;   call_readscreen;end;

{ * The following function uses READFIELD to check all the fields of * the current screen for the string "READY".  This function is used * to tell when the host is finished sending screens.  It calls SCREENATTR * to get the number of fields in the screen.  SCREENATTR returns this * value through the parameter numfields.  The variable terminalid is * global and is set by OPEN3270.}function ready : boolean;var   returnval      : boolean;{ SCREENATTR parameters }   printformat    : shortint;   startprint     : shortint;   soundalarm     : shortint;   keyboardlock   : shortint;   screenstatus   : shortint;{ READFIELD parameters }   fieldnum       : shortint;   maxinbuflen    : shortint;   actinbuflen    : shortint;   inbuf          : string;   offset         : shortint;begin   returnval := FALSE;   write (' SCREENATTR..............');   SCREENATTR (terminalid, printformat, startprint, soundalarm,               keyboardlock, numfields, screenstatus, cursorrow,               cursorcolumn, result);   print_message (result);   writeln ('               printformat = ', printformat:2,            '                 numfields = ', numfields:2);   writeln ('                 cursorrow = ', cursorrow:2,            '              cursorcolumn = ', cursorcolumn:2);offset := 0;   maxinbuflen := LINESIZE;   for fieldnum := 1 to numfields do   begin      inbuf := ' ';      write (' READFIELD ', fieldnum:1, '................');      READFIELD (terminalid, fieldnum, offset, maxinbuflen, inbuf,                 actinbuflen, result);      print_message (result);      writeln ('        inbuf = "', inbuf:actinbuflen, '"');      if inbuf = 'READY' then         returnval := TRUE   end;   ready := returnval;end;

{ * The following procedure calls OPEN3270, simulating powering on an * IBM display station.  OPEN3270 assigns a value to the global variable * terminalid.  This value is used to reference the device in all subsequent * SNA IMF intrinsic calls.  This procedure also uses PRINT3270 to * open a spooler file, and it prints the attribute characteristic banner * to the file.  Note that RECV3270 must be called after a call to OPEN3270 * to receive the unowned screen.}procedure initialize;var{ VERS3270 parameter}   version         : string;{ OPEN3270 parameters }   devicenum    : shortint;   snalnkinfo   : string;   flags        : flags_type;   devtype      : shortint;   ffindex      : shortint;   { not used by SNA IMF. Included }                              { for backwards compatibility. }   screensize   : shortint;   timeout      : packed array[1..2] of shortint;begin   writeln (' VERS3270..............');   VERS3270 (version);   writeln ('                       version = ', version:14);   devicenum := TERMINAL;   snalnkinfo := 'IBMNODE#IMFCLASS ';  { non-alphanumeric character }                                       { marks end of string }   with flags do   begin      filler := 0;      dbcs := 0;       { disable double byte character set option }      unbind := 0;     { disable unbind option }      LU1_LU3 := 0;    { not applicable to terminal emulation. Set to 0. }      int_trace := 0;  { internal tracing off }      trans_mode := 0; { transparent mode off }      IO_mode := 0;    { standard I/O mode }   end;   ffindex := 0;   timeout[1] := 30;   timeout[2] := 30;   writeln ('Now opening LU.T2 session.....');   write (' OPEN3270.....................');   OPEN3270 (devicenum, snalnkinfo, flags, terminalid, devtype,             ffindex, screensize, timeout, result);   print_message (result);   action := OPEN_FILE;   { set action to open spooler file }   location := ' ';   priority := 6;   write (' PRINT3270 open...............');   PRINT3270 (terminalid, fileid, action, location, priority, result);   print_message (result);   action := PRINT_BANNER;  { set action to print attribute character banner }   write (' PRINT3270 print banner.......');   PRINT3270 (terminalid, fileid, action, location, priority, result);   print_message (result);action := PRINT_SCREEN;  { set action to print internal screen image }                            { for the rest of the PRINT3270s }   writeln;   writeln ('Receiving unowned screen.....');   call_recv3270;   check_screen;   error := FALSE;end;

{ * The following procedure makes the major procedure calls. * It does the following: *    1. Sends a system request to the host and receives the LU-SSCP screen. *    2. Logs onto the host (starting an LU-LU session).  Note that *       after receiving the logon message, the host may send more than one *       screen before it is ready to receive again. *    3. Logs off the host. * Note that a call_recv3270 follows shortly after each call_tran3270.}procedure process;var   outbuf     : string;   outbuflen  : shortint;   fieldnum   : shortint;begin{ Transmit System Request Key and receive LU-SSCP screen. }   writeln;   writeln ('Transmitting System Request Key and receiving LU-SSCP screen');   call_tran3270 (SYS_REQ_KEY);   call_recv3270;   check_screen;{ Write logon message to LU-SSCP screen. }   writeln;   writeln ('Writing "logon applid...." to field 0');   outbuf := 'logon applid(tso) data(sales/sales) logmode(imf2k)';   outbuflen := 50;   fieldnum := 0;   call_writefield (outbuf, outbuflen, fieldnum);   call_readscreen;{ Transmit ENTER key to send logon message to host. }   writeln;   writeln ('Transmitting ENTER key.....');   call_tran3270 (ENTER_KEY);{ The host may send more than one screen here, so we have to make sure }{ the host is finished sending before we try to send.  Function ready }{ checks to see if the host is finished by searching for the string "READY" }{ in the screens received from the host.  We could just as easily have }{ waited for a RECV3270 to time out to tell us when the host was finished }{ sending and ready to receive, but searching for "READY" is more efficient. }   repeat      writeln;      writeln ('Receiving screen and checking for READY or error.....');      call_recv3270;   until error or ready;   check_screen;{ Write logoff to unprotected field. }   outbuf := 'logoff';   outbuflen := 6;   fieldnum := numfields - 1;  { Write to second-to-last field }                               { because it's the unprotected field. }   if fieldnum << 0 then fieldnum := 0;   writeln;   writeln ('Writing "logoff" to field ', fieldnum:2, '.....');   call_writefield (outbuf, outbuflen, fieldnum);{ Transmit ENTER key to send logoff message to host. }   writeln;   writeln ('Transmitting ENTER key.....');   call_tran3270 (ENTER_KEY);   call_recv3270;end;

{ * The following procedure does some cleanup.  It closes the spooler file, * and it calls CLOSE3270, which simulates powering off the device.}procedure terminate;begin   action := CLOSE_FILE;   write (' PRINT3270 close.........');   PRINT3270 (terminalid, fileid, action, location, priority, result);   print_message (result);   write (' CLOSE3270............');   CLOSE3270 (terminalid, result);   print_message (result);end;{ * The following procedure calls ACQUIRE3270, starting a Pass Thru session * on an LU.T3 printer.  The printer must be free from MPE control when * ACQUIRE3270 is called, or an error will occur.}procedure call_acquire;var   snalnkinfo  : string;   devicenum   : shortint;   ldev        : shortint;   enhance     : shortint;   priority    : shortint;   blanks      : shortint;   format      : shortint;   flags       : shortint;   options     : options_type;   pfn         : string;begin   snalnkinfo := 'IBMNODE#IMFCLASS ';  { non-alphanumeric character }                                       { marks end of string }   devicenum := LU_T3;   ldev := SPOOLER_FILE;   enhance := 0;   priority := 6;   blanks := 0;    { convert leading blanks to nulls }   format := 2;    { print screen as it appears on terminal }   flags := 2;     { continue execution after Pass Thru is activated }   with options do   begin      filler := 0;      int_trace := 1;   { internal trace on }      sPriority := 7;   { spooler file priority = 7 }      readTO := 15;     { terminal timeout, not used in this case }      LJ2 := 1;         { LaserJet II option is on }   end;   pfn := 'example ';   { non-alphanumeric character marks end of string }   writeln ('Now starting Pass Thru session with spooler file.....');   write (' ACQUIRE3270........');   ACQUIRE3270 (snalnkinfo, devicenum, ldev, enhance, priority,                blanks, format, flags, options, pfn, result);   print_message (result);end;begin  { main }   if parm >> 0 then      call_acquire   else begin      initialize;      process;      terminate;   end;end.