home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / lampdq.zip / LAMPDQ.E next >
Text File  |  1994-01-06  |  30KB  |  803 lines
  1. ; The following makes LAMPDQ.E separately compilable, so you can include the
  2. ; host functions in EPM even if not using the rest of LaMail.
  3.  
  4. ; Compilation logic:
  5. ;   If SMALL is defined, then we're being compiled into the base.
  6. ;   else, if INI_REPLY is defined, then we're being compiled into MAIL
  7. ;   otherwise, we're being compiled as a stand-alone routine that
  8. ;   can be linked in at run time.
  9.  
  10. compile if not defined(SMALL)
  11.  define INCLUDING_FILE = 'LAMPDQ.E'
  12. const
  13.   tryinclude 'mycnf.e'                 -- Include user's configuration
  14.  
  15.  compile if not defined(SITE_CONFIG)
  16.     const SITE_CONFIG = 'SITECNF.E'
  17.  compile endif
  18.  compile if SITE_CONFIG
  19.     tryinclude SITE_CONFIG
  20.  compile endif
  21.  
  22. const
  23.  compile if not defined(HOST_SUPPORT)
  24.     HOST_SUPPORT = 'STD'
  25.  compile endif
  26.  compile if HOST_SUPPORT='STD'
  27.   compile if not defined(HOSTDRIVE)
  28.      HOSTDRIVE= 'H:'
  29.   compile endif
  30.  compile endif
  31. compile endif  -- not defined(SMALL)
  32.  
  33. const
  34. compile if not defined(RSCS)
  35.    RSCS = 'RSCS'
  36. compile endif
  37. compile if not defined(YKT_stuff)
  38. ; This determines whether the Yorktown-specific stuff is included
  39.    YKT_STUFF=0
  40. compile endif
  41. compile if not defined(CORE_stuff)
  42. ; This determines whether the CORE-specific stuff is included
  43.    CORE_STUFF=0
  44. compile endif
  45. compile if not defined(YKT_SERVICES)
  46. ; This determines whether the Yorktown-specific commands (CORE, PHONE, QLUNCH,
  47. ; etc.) are included in the macros and in the menus.
  48.    YKT_SERVICES=0
  49. compile endif
  50. compile if not defined(TILDE_CHAR)
  51.  compile if EVERSION < '5.21'
  52.    TILDE_CHAR = ''
  53.  compile else
  54.    TILDE_CHAR = '~'
  55.  compile endif
  56. compile endif
  57. compile if not defined(HOSTCOPYDRIVE)
  58.    HOSTCOPYDRIVE= 'H'
  59. compile endif
  60. compile if not defined(AUTO_LAMSERV)
  61. ; This determines whether LAMSERV should be started automatically
  62.    AUTO_LAMSERV = 0
  63. compile endif
  64.  
  65. compile if defined(SMALL) or not defined(INI_REPLY)  -- If in base or standalone
  66. definit
  67.    universal host_lt, defaultmenu, activemenu
  68.    universal host_printers
  69.  compile if defined(my_LT)
  70.    host_lt=my_LT           -- Used by LaMail.E; needed for E3EMUL if multiple LTs.
  71.  compile elseif (HOST_SUPPORT = 'EMUL' | HOST_SUPPORT = 'E3EMUL' | HOST_SUPPORT = 'SRPI') & HOST_LT_REQUIRED = 1
  72.    host_lt='A'             -- In case user has HOST_LT_REQUIRED = 1
  73.  compile else
  74.    host_lt=''              -- Used by LaMail.E; needed for SLSRPI if multiple LTs.
  75.  compile endif
  76.  compile if defined(my_HOST_PRINTERS)
  77.    host_printers=my_HOST_PRINTERS  -- List of default host printers
  78.  compile else
  79.    host_printers=''
  80.  compile endif
  81.    deletemenu defaultmenu, 6, 0, 0  -- delete the existing Help menu (we want it to stay at the right)
  82.    call add_VM_cmds_to_menu(defaultmenu)  -- add the VM commands to the action bar
  83.    call add_help_menu(defaultmenu, dos_version()>=1020)  -- rebuild the help menu
  84.  compile if not defined(INI_REPLY)  -- If standalone; if in base, MAIN.E will do this.
  85.    if activemenu=defaultmenu then
  86.       showmenu activemenu  -- show the updated EPM menu
  87.    endif
  88.  compile endif
  89.  
  90. defproc add_VM_cmds_to_menu(menu)
  91.    buildsubmenu menu, 16, TILDE_CHAR'VM cmds', ''\1'Menus for invoking VM-related commands', 0 , 0
  92.      buildmenuitem menu, 16, 1600, 'output ~Inserted here...'\9'VMI',   'commandline VMI '\1'Execute a VM command, and have the output inserted into the current file',0,0
  93.      buildmenuitem menu, 16, 1601, 'output in ~New file...'\9'VMN',     'commandline VMN '\1'Execute a VM command, and see the output in a new file',0,0
  94.      buildmenuitem menu, 16, 1602, 'output in new ~window...'\9'VM',    'commandline VM '\1'Execute a VM command, and see the output in a new edit window',0,0
  95.      buildmenuitem menu, 16, 1620, '~Get a copy of host screen'\9'GETHOST', 'gethostd'\1'Insert a copy of the default host screen after the cursor line',0,0
  96.      buildmenuitem menu, 16, 1603, \0,                                '',      4, 0
  97.      buildmenuitem menu, 16, 1604, '~List host files...'\9'HLIST',    'hlistprompt'\1'Load a filelist of host files into an edit window',0,0
  98.      buildmenuitem menu, 16, 1605, \0,                                '',      4, 0
  99.      buildmenuitem menu, 16, 1606, '~Print current file on host...'\9'HOSTPRT', 'hostprt'\1'Print the current file on a host printer',0,0
  100.      buildmenuitem menu, 16, 1607, \0,                                '',      4, 0
  101.      buildmenuitem menu, 16, 1608, '~Query host for messages'\9'QMSG', 'qmsg'\1'Check to see if any new messages arrived since you started LAMSERV',0, 0
  102.  compile if YKT_SERVICES
  103.      buildmenuitem menu, 16, 1609, \0,                                '',      4, 0
  104.      buildmenuitem menu, 16, 1610, 'Look up p~hone number...'\9'PHONE', 'commandline Phone '\1'Invoke the Yorktown PHONE exec',0, 0
  105.      buildmenuitem menu, 16, 1611, 'Look up ~services...'\9'SERVICES',  'commandline Services '\1'Invoke the Yorktown SERVICES exec',0, 0
  106.      buildmenuitem menu, 16, 1612, \0,                                '',      4, 0
  107.      buildmenuitem menu, 16, 1613, 'See lunch ~menu'\9'QLUNCH',  'VM QLUNCH (NOCLEAR NOHILIGHT'\1'Invoke the Yorktown QLUNCH exec',0, 0
  108.      buildmenuitem menu, 16, 1614, 'See ~coffee cart schedule'\9'QCOFFEE',  'VM QCOFFEE NOCLEAR'\1'Invoke the Yorktown QCOFFEE exec',0, 0
  109. ;; CORE command is only defined if we're in MAIL.E
  110. ;;   buildmenuitem menu, 16, 1615, \0,                                '',      4, 0
  111. ;;   buildmenuitem menu, 16, 1616, 'Append CORE forum'\9'CORE',  'CORE',0, 0
  112.  compile endif
  113. compile endif
  114.  
  115. ;       Procedures for dealing with PDQ from within EPM.
  116. ;
  117. ; Adds the following commands:
  118. ;    VM:    Sends a command to the host; displays the result on the DOS screen.
  119. ;    VMI:   Sends a command to the host; inserts the result into the current file.
  120. ;    VMQ:   Sends a command to the host; throws away the result.
  121. ;    TELL:  Shorthand for VM TELL.
  122. ;    POLL:  Used to restart the poll loop if exited by Ctrl-break.
  123. ;    QMSG:  Queries the host for messages.  (Normally done by POLL)
  124.  
  125. ; Keys defined:
  126. ;    c_M is defined to pop-up the message window whenever a message is
  127. ;        received.  If no message has been received since the last time
  128. ;        the key was pressed, then it will display all previously received
  129. ;        messages (up to 40 lines).
  130.  
  131. ; 88/02/10  Added retry to hostconnect in case user quit PDQ on host, then
  132. ;           restarted it.  Fixed VMI in cases when RC <> 0.  Return RCs as
  133. ;           numbers if in range -32768 .. 32767; else as string x'12345678'.
  134.  
  135. ; 88/05/16  Modified for EOS2.  Uses LAMPDQ for host commands.
  136.  
  137. const
  138. /* SRPI dynalink functions basic constants */
  139.    SA_GET      = 1              /* downloading a file */
  140.    SA_EXEC     = 3              /* executing a command */
  141.  
  142. defc host
  143.    universal host_lt
  144.    parse value upcase(arg(1)) with arg1 rest
  145.    if arg1='?' then
  146.       sayerror 'Current host session is "'host_lt'".'
  147.    elseif arg(1)='' or (length(arg1)=1 & arg1>='A' & arg1<='Z') then
  148.       if not isoption(rest,'Q') then
  149.          sayerror 'Host session was "'host_lt'", now changed to "'arg1'".'
  150.       endif
  151.       host_lt = arg1
  152.    else
  153.       sayerror 'Invalid argument.  ? to query; blank or A-E to set.'
  154.    endif
  155.  
  156. defc TELL
  157.    'VME TELL' arg(1)
  158.  
  159. defc RQ
  160.    'VME RQUERY' arg(1)
  161.  
  162. defc VME
  163.    cmd_rc=sendhostcmdgetrslts(arg(1),hostrc,result)
  164.    if cmd_rc then
  165.       sayerror 'Error' cmd_rc 'trying to issue command.'
  166.       return rc
  167.    endif
  168.    if hostrc then
  169.       parse value upcase(arg(1)) with w1 w2 .
  170.       if w1='CP' | w1='EXEC' then w1=w1 w2; endif
  171.       sayerror w1 'error' hostrc': ' result
  172.    endif
  173.  
  174. defc PHONE
  175.    parse arg who
  176.    if who='' then
  177.       sayerror 'PHONE <name>  Looks up that person in the on-line directory.  PHONE ? for help.'
  178.       return
  179.    endif
  180.    'VMN PHONE' who
  181.    if rc=100 then sayerror 1; endif
  182.  
  183. defc HLIST                    ---- With features by TJR
  184.    if arg(1) = '' then
  185.        hfilespec = '* * A'
  186.    else
  187.        hfilespec = upcase(arg(1))
  188.    endif
  189.    sayerror 'Loading 'hfilespec' host files...'
  190.    'VMN LISTFILE' hfilespec '(HEADER DATE'
  191.    if not rc then
  192.       down; down
  193.       sayerror 'Move cursor to desired file and press Alt-1 to load it.'
  194.    endif
  195.  
  196. defc HLISTPROMPT
  197. compile if EVERSION >= '5.50'
  198.    display -8
  199. compile endif
  200.    sayerror 'Enter file specification.  E.g.,  * SCRIPT *  or  * XEDIT S.  Default is * * A'
  201. compile if EVERSION >= '5.50'
  202.    display 8
  203. compile endif
  204.    'commandline HLIST '
  205. compile if EVERSION < '5.50'
  206.    sayerror 0
  207. compile endif
  208.  
  209. compile if YKT_SERVICES
  210. defc SERVICES
  211.    'VMN SERVICES' arg(1)
  212.    if rc=100 then sayerror 1; endif
  213. compile endif
  214.  
  215. defc VM           -- Send command to VM & display output on DOS screen.
  216.    universal host_lt
  217.    if host_lt then hst='"host' host_lt '/Q" '; else hst=''; endif
  218.    'open' hst"'Postme VM_OPEN_CMD" arg(1)"'"
  219.  
  220. defc VM_OPEN_CMD      -- Passed by VM command as argument of a new session.
  221.    .autosave = 0
  222.    replaceline 'Processing host command' arg(1)
  223.    .filename = '.Output from' arg(1)
  224.    settitletext(.filename)
  225. ;; call showwindow('ON')
  226. ;; repaint_window()
  227.    size=.last
  228.    rc=vmi(arg(1),hostrc)
  229.    if rc then
  230.       msg = 'Error' rc 'attempting to issue host command.'
  231.       replaceline msg
  232.       sayerror msg
  233.    elseif size=.last then
  234.       if hostrc then replaceline '[Host cmd failed with RC' hostrc 'and no output.]'
  235.       else replaceline '[No output]'
  236.       endif
  237.    else
  238.       deleteline 1
  239.       .modify = 0
  240.       if hostrc<>0 then sayerror 'Host cmd failed with RC' hostrc; endif
  241.    endif
  242.    call windowsize1(min(.last+1,24),.windowwidth,0,0,1)  -- Size window to size of file
  243.  
  244. defc VMI          -- Send command to VM & insert output into current file.
  245.    size=.last
  246.    rc=vmi(arg(1),hostrc)
  247.    if rc then
  248.       sayerror 'Error' rc 'attempting to issue host command.'
  249.       return
  250.    endif
  251.    if size=.last then
  252.       if hostrc then sayerror 'Host cmd failed with RC' hostrc 'and no output.'
  253.       else sayerror '[No output]'
  254.       endif
  255.    else
  256.       insertline '.*----- Output from "'arg(1)'" -----',.line+1
  257.       insertline '.*----- [end, RC='hostrc'] -----',.line + .last - size + 1
  258.       if hostrc<>0 then sayerror 'Host cmd failed with RC' hostrc; endif
  259.    endif
  260.    rc=hostrc
  261.  
  262. defproc VMI(cmd,var host_rc)  -- Send command to VM & insert output into current file.
  263.    universal vTEMP_PATH
  264. compile if HOST_SUPPORT = 'SRPI'
  265.    universal hostrc
  266. compile endif
  267.  
  268. compile if HOST_SUPPORT = 'SRPI'
  269.    call issuehostcommand('',cmd)
  270. compile else
  271.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',cmd)
  272. compile endif
  273.    if rc then return rc; endif
  274. compile if HOST_SUPPORT = 'SRPI'
  275.    host_rc = hostrc
  276. compile else
  277.    'get' vTEMP_PATH'HOSTCMD.TMP'
  278.    getline host_rc,.line+1
  279.    deleteline .line+1
  280. compile endif
  281.  
  282. defc VMN       -- Send command to VM & insert output into a new file.
  283.    universal host_lt
  284.    parse value upcase(arg(1)) with w1 w2 .
  285.    if w1='EXEC' | w1='CP' then w1=w2; endif
  286.    if w1='Q' then w1='QUERY'; endif    -- Assumes user didn't change default.
  287.    getfileid cmdfileid,w1 'OUTPUT'
  288.    if cmdfileid='' then
  289.       'E /n /q /c .tmp'
  290.       deleteline 1
  291.       .filename=w1 'OUTPUT'
  292.       oldmodify=0
  293.    else
  294.       activatefile cmdfileid
  295.       .last
  296.       oldmodify=.modify
  297.    endif
  298.    .userstring = .userstring '[lt:'host_lt']'
  299.    oldsize=.last
  300.    'VMI' arg(1)
  301.    hostrc=rc
  302.    .modify=oldmodify
  303.    if .last=0 then 'Q'
  304.    else
  305.       .cursory=1           -- Position so first new line is at top of screen.
  306.       oldsize+1
  307.    endif
  308.    rc=hostrc
  309.  
  310. defc VMQ     -- VM Quiet; send command and throw away output.
  311.    universal vTEMP_PATH
  312. compile if HOST_SUPPORT = 'SRPI'
  313.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',arg(1),'nul')
  314. compile else
  315.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',arg(1))
  316.    call erasetemp(vTEMP_PATH'HOSTCMD.TMP')
  317. compile endif
  318.  
  319. defc gethostd     -- Get a copy of the default host screen; uses the current default.
  320.    universal host_lt
  321.    'gethost' host_lt
  322.  
  323. defc hostprt          -- Print current edit file on host.
  324.    universal host_printers, host_lt
  325. compile if HOST_SUPPORT='EMUL' or HOST_SUPPORT='SRPI'
  326.    universal hostdrive
  327. compile endif
  328.    printer = 3
  329.    if host_printers then
  330.       printer=listbox('Select a host printer',' 'strip(host_printers),'/Print/Cancel/Select other/')
  331.       if printer='' then return; endif
  332.    endif
  333.    if printer=3 then
  334.       printer = entrybox('Enter name of host printer','/Print')
  335.    endif
  336.    if printer then
  337.       'save 'leftstr(hostdrive,1) || host_lt':lamail tmpprt a'
  338.       if rc then
  339.          sayerror 'Error' rc 'trying to save to host; print canceled.'
  340.          return
  341.       endif
  342.       stat=sendhostcommand('lamail files print PC2TEMP 'printer' lamail tmpprt a',hostrc)
  343.       sayerror 0
  344.       if stat then return hostcmderror(stat); endif
  345.       if hostrc then
  346.          sayerror 'Host returned error code' hostrc
  347.       endif
  348.    endif
  349.  
  350. defproc sendhostcommand(cmd,var hostrc)
  351. ;       Throw away results
  352.    return sendhostcmdgetrslts(cmd,hostrc,result)
  353. ;; ret =  sendhostcmdgetrslts(cmd,hostrc,result)            -- Alternative to above,
  354. ;; sayerror 'sendhostcmdgetrslts('cmd') returned "'ret'"'   -- for debugging
  355. ;; return ret
  356.  
  357. ; For SRPI and ECF, this routine gets the output into an E file, and the RC
  358. ; into the variable HOSTRC.
  359. ; For Send/Receive and CP78, the output comes via a disk file, and the RC is
  360. ; given on the first line.
  361. ; The differences are masked by COMPILE IFs in the callers.  (This routine
  362. ; is internal to this file.)
  363.  
  364. defproc issuehostcommand(pcfile, host_cmd)
  365. compile if HOST_SUPPORT = 'EMUL'         -- If using E3EMUL assume SEND/RECEIVE.
  366.    universal host_lt
  367.    universal hostcopy, hostcmd
  368.  compile if USING = 'IBM'
  369. ;; quietshell 'RECEIVE' pcfile host_LT':HOSTCMD ('host_cmd'>nul'
  370.    rc = EHLLAPI_SEND_RECEIVE(91, pcfile host_LT':HOSTCMD ('host_cmd)
  371.  compile elseif USING = 'CM'
  372.   compile if EVERSION >= 5
  373.    call send_HLLAPI_string('@CLAMPDQ HOSTCMD' host_cmd'@E')
  374.   compile else
  375.    if host_lt then
  376.       lt='/'host_lt' '
  377.    else
  378.       lt=''
  379.    endif
  380.    quietshell hostcmd lt'@CLAMPDQ HOSTCMD' host_cmd
  381.   compile endif
  382. compile if EVERSION < 6
  383.    call dynalink('DOSCALLS', '#32', atol_swap(2000))  -- 2 second DOSSLEEP
  384. compile else
  385.    call dynalink32('DOSCALLS', '#229', atol(2000))  -- 2 second DOSSLEEP
  386. compile endif
  387.    quietshell hostcopy  HOSTCOPYDRIVE||host_LT':HOSTCMD CMSUT1 * 'pcfile' /q /ascii'
  388.  compile endif
  389. compile elseif HOST_SUPPORT = 'STD'      -- If using SAVELOAD assume CP78.
  390.    quietshell 'CP78CMD LAMPDQ HOSTCMD' host_cmd'>nul'
  391.    quietshell 'CP78COPY H:HOSTCMD CMSUT1 *' pcfile '/q'
  392. compile elseif HOST_SUPPORT = 'SRPI'     -- If using SRPI then load directly.
  393.    universal exec_server, file_server, hostrc, host_lt
  394.  
  395.    if arg(3) then queue_name=arg(3)\0
  396.    else queue_name = '\QUEUES\EXEQUEUE.000'\0
  397.    endif
  398.    f_s = leftstr(file_server || host_lt, 8)\0
  399.    e_s = leftstr(exec_server || host_lt, 8)\0
  400. compile if AUTO_LAMSERV
  401.    do i=1 to 2
  402. compile endif
  403.    command = host_cmd\0  -- Set inside loop, because after first call it's EBCDIC
  404.    /* call SRPI support for command */
  405.    request = offset(e_s)||selector(e_s)||
  406.              atoi(SA_EXEC)||
  407.              '0000000000'||             /* return codes */
  408.              offset(command)||selector(command)||
  409.              offset(queue_name)||selector(queue_name)||
  410.              offset(f_s)||selector(f_s)||
  411.              '0000'             -- Bytes 29-32 --> command return code
  412.    rc=0
  413.    result= dynalink('SRPILCC',
  414.                     'SERVEXEC',
  415. compile if EVERSION < 6
  416.                     selector(request)||offset(request))
  417. compile else
  418.                     thunk(offset(request)||selector(request)))
  419. compile endif
  420.    dynalink_RC = rc
  421.    if rc=sayerror('Dynalink: Unrecognized library name') then
  422.       if arg(3)='' then call cleanup(queue_name); endif
  423.       if arg(4) then
  424.          call poll('OFF')
  425.          sayerror 'SRPILCC.DLL not found; polling turned off.'
  426.          return '^'             -- Abort chk_msgs.
  427.       else
  428.          messageNwait('SRPILCC.DLL not found; host support can not be used.  Press a key.')
  429.          return dynalink_RC
  430.       endif
  431.    endif
  432.  
  433.    if result <> 0 then
  434. compile if AUTO_LAMSERV
  435.       if not arg(4) then  -- Don't bother if checking messages.
  436.          if sent_LAMSERV(result, request, i, host_LT) then
  437.             if arg(3)='' then call cleanup(queue_name); endif
  438.             iterate;
  439.          endif
  440.       endif
  441. compile endif
  442.       if arg(3)='' then call cleanup(queue_name); endif
  443.       if arg(4) & (result=2) & (ltoa(substr(request, 7, 4), 16)=1000402) then
  444.          return '^' -- No CMSSERV screen active.
  445.       endif
  446.       call show_error(result, request)
  447.       if arg(4) then return '^'; endif  -- Some other error.  Abort chk_msgs.
  448.       rc = result
  449.       return result
  450.    endif
  451. compile if AUTO_LAMSERV
  452.    leave
  453.    enddo
  454. compile endif
  455. /*
  456. temp = substr(request,29,4)
  457. sayerror 'temp=' temp
  458. sayerror 'after cleanup'
  459. display 1
  460. messageNwait('RC = "'temp'" =' asc(leftstr(temp,1)) asc(substr(temp,2,1)) asc(substr(temp,3,1)) asc(substr(temp,4,1)) )
  461. */
  462.    hostrc = ltoa(substr(request,29,4),10)
  463.    if arg(3)='' then  -- read output from the command and insert it in the file
  464.       if pcfile<>'' then 'xcom e /c' pcfile; deleteline 1; endif
  465.       call grabqueue(queue_name)
  466.    endif
  467.    rc = 0
  468. compile else
  469.    messageNwait('No host command support for' HOST_SUPPORT'. Press a key...')
  470.    stop
  471. compile endif
  472.  
  473. defproc gethostfile(pcfile, hostfile, bin)
  474.    universal host_lt
  475. compile if HOST_SUPPORT = 'EMUL'         -- If using E3EMUL assume SEND/RECEIVE.
  476.    universal hostcopy
  477.  compile if USING = 'IBM'
  478.    if bin='B' then opts=''; else opts='(ASCII CRLF'; endif
  479. ;; quietshell 'RECEIVE' pcfile host_LT':'hostfile opts'>nul'
  480.    rc = EHLLAPI_SEND_RECEIVE(91, pcfile host_LT':'hostfile opts)
  481.  compile elseif USING = 'CM'
  482.    if bin='B' then opts='/b'; else opts='/ASCII'; endif
  483.    quietshell hostcopy  HOSTCOPYDRIVE || host_LT':'hostfile pcfile' /q 'opts
  484.  compile endif
  485. compile elseif HOST_SUPPORT = 'STD'      -- If using SAVELOAD assume CP78.
  486.    if bin='B' then opts='/B'; else opts=''; endif
  487.    quietshell 'CP78COPY H:'hostfile pcfile opts '/q'
  488. compile elseif HOST_SUPPORT = 'SRPI'     -- If using SRPI then load directly.
  489.    universal file_server, host_lt
  490.  
  491.    pc_name = pcfile\0
  492.    host_file = hostfile\0
  493. ;; if bin='B' then flag=0; else flag=1; endif    --> flag = bin<>'B'
  494.    f_s = leftstr(file_server || host_lt, 8)\0
  495.    /* building a request */
  496.    request = offset(f_s)||selector(f_s)||
  497.              atoi(SA_GET)||
  498.              '0000000000'||             /* return codes */
  499.              offset(host_file)||selector(host_file)||
  500.              offset(pc_name)||selector(pc_name)||
  501.              atoi(bin<>'B')
  502.  
  503.    /* calling the dynalink function */
  504.    rc = dynalink('SRPILCC',
  505.                  'SERVGET',
  506. compile if EVERSION < 6
  507.                  selector(request)||offset(request))
  508. compile else
  509.                  thunk(offset(request)||selector(request)))
  510. compile endif
  511.    if rc <> 0 then sayerror 'File transfer failed with RC' rc; endif
  512.    return rc
  513. compile else
  514.    messageNwait("Can't use host support" HOST_SUPPORT'. Press a key...')
  515.    stop
  516. compile endif
  517.  
  518. defproc sendhostcmdgetrslts(cmd,var host_rc,var result)
  519.    universal vTEMP_PATH
  520. compile if HOST_SUPPORT = 'SRPI'
  521.    universal hostrc
  522. compile endif
  523.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',arg(1))
  524.    if rc then /* sayerror 'Uh-oh:  RC =' rc; */ return rc; endif
  525. compile if HOST_SUPPORT = 'SRPI'
  526.    result=''
  527.    if arg(4) then              -- Flag to concatenate all lines
  528.       do i=1 to .last
  529.          result=result || textline(i) || \13
  530.          if length(result)=255 then leave; endif
  531.       enddo
  532.    elseif .last then getline result,1
  533.    endif
  534.    host_rc = hostrc              -- Set local parm to universal var. value
  535.    .modify = 0
  536. compile else
  537.    'xcom e /d /q' vTEMP_PATH'HOSTCMD.TMP'
  538.    getline host_rc,1
  539.    if .last=1 then
  540.       result=''
  541.    else
  542.       getline result,2
  543.    endif
  544.    call erasetemp(vTEMP_PATH'HOSTCMD.TMP')
  545. compile endif
  546.    'xcom q'
  547.    return 0
  548.  
  549. ;*****************     Stuff to support message polling follows:   **********
  550. ;  Also, add "Call Poll()" to MYMAIN.E
  551.  
  552.  
  553. defc qmsg    -- Query messages - if you don't want to wait for a time-out.
  554.    universal host_msg_file,msg_file_size
  555.    if host_msg_file <> '' then      -- Make sure it's still valid
  556.       getfileid fileid
  557.       display -2
  558.       rc = 0
  559.       activatefile host_msg_file
  560.       if rc then
  561.          host_msg_file = ''
  562.          msg_file_size = 0
  563.       else
  564.          activatefile fileid
  565.       endif
  566.       display 2
  567.    endif
  568.    if host_msg_file = '' then
  569.       'xcom e /n /q host_messages'
  570.       .titletext = 'Host messages'
  571.       getfileid host_msg_file
  572.       .autosave=0
  573.       deleteline 1
  574.    endif
  575.    status_=chkmsgs()
  576.    if host_msg_file.last=0 then
  577.       .modify = 0
  578.       'xcom q'
  579.       host_msg_file = ''
  580.    endif
  581.    if status_ then
  582.       activatefile host_msg_file
  583.       .cursory = 1
  584.       msg_file_size+1      -- Set .line to first new line.
  585.       msg_file_size = host_msg_file.last
  586.       if status_=1 then call pplay(1)
  587.       elseif status_=2 then call pplay(2)
  588.       elseif status_=3 then call pplay(3)
  589.       endif
  590.    else
  591.       sayerror 'No new messages.'
  592.    endif
  593.  
  594. defproc chkmsgs
  595.    universal msgflag, host_lt
  596.    universal host_msg_file
  597.    universal vTEMP_PATH
  598.    universal hostcopy, hostcmd
  599. compile if HOST_SUPPORT = 'SRPI'     -- If using SRPI then load directly.
  600.    universal hostrc, hostdrive
  601.    if '^' = issuehostcommand('','LAMSERV CHKMSGS','NUL',1)
  602.    then return 0       -- CMSSERV screen not active
  603.    endif
  604.    if hostrc <> 1 then return 0; endif  -- No messages
  605.    getfileid startfile
  606.    call loadfile(hostdrive || host_lt':LAMAIL MSGLOG A','/D /Q')
  607.    call issuehostcommand('','ERASE LAMAIL MSGLOG A','NUL',1)
  608. compile else
  609.    string='12345678'  -- reserve 8 bytes.
  610.  compile if EVERSION < 6
  611.    call dynalink('VIOCALLS',        /* dynamic link library name          */
  612.                  'VIOGETCURTYPE',   /* Video Input Output GET CURsor TYPE */
  613.                  selector(string)|| /* string selector                    */
  614.                  offset(string)||   /* string offset                      */
  615.                  atoi(0))           /* Vio Handle                         */
  616.  compile endif
  617.  compile if HOST_SUPPORT = 'EMUL'
  618.   compile if USING = 'IBM'
  619. ;; quietshell 'RECEIVE' vTEMP_PATH'MSGS.TMP 'host_LT':MSGS >nul'  -- This turns cursor back on.
  620.    rc = EHLLAPI_SEND_RECEIVE(91, vTEMP_PATH'MSGS.TMP 'host_LT':MSGS')
  621.   compile elseif USING = 'CM'
  622.    compile if EVERSION >= 5
  623.    call send_HLLAPI_string('@CLAMPDQ MSGS@E')
  624.    compile else
  625.    if host_lt then
  626.       lt='/'host_lt' '
  627.    else
  628.       lt=''
  629.    endif
  630.    quietshell hostcmd lt'@CLAMPDQ MSGS'
  631.    compile endif
  632. compile if EVERSION < 6
  633.    call dynalink('DOSCALLS', '#32', atol_swap(2000))  -- 2 second DOSSLEEP
  634. compile else
  635.    call dynalink32('DOSCALLS', '#229', atol(2000))  -- 2 second DOSSLEEP
  636. compile endif
  637.    quietshell hostcopy HOSTCOPYDRIVE || host_LT':MSGS CMSUT1 * 'vTEMP_PATH'MSGS.TMP /q /ascii'
  638.   compile endif
  639.  compile else
  640.    quietshell 'CP78CMD LAMPDQ MSGS>nul'
  641.    quietshell 'CP78COPY H:MSGS CMSUT1 *' vTEMP_PATH'MSGS.TMP /q'
  642.  compile endif
  643.    status_=rc
  644.    if substr(string,7,2)==atoi(-1) then
  645.       call cursoroff()  -- turn off cursor
  646.    endif
  647.    if status_ then sayerror '(CHKMSGS) Status =' status_; return 0; endif
  648.    'xcom e /d /q' vTEMP_PATH'MSGS.TMP'
  649. compile endif
  650.    msgflag=0                /* No messages seen yet. */
  651.    if textline(1)<>'' or .last>1 then  -- Some messages
  652.       do i=1 to .last
  653.          call parsehostmessage(textline(i))
  654.       end
  655.    endif
  656.    .modify = 0
  657.    'xcom q'
  658. compile if HOST_SUPPORT = 'SRPI'
  659.    activatefile startfile            -- Restore non-hidden ring.
  660. ;  display 1
  661. compile else                         -- If not using SRPI, erase temp file.
  662.    call erasetemp(vTEMP_PATH'MSGS.TMP')
  663. compile endif
  664.    return msgflag
  665.  
  666.  
  667. defproc ParseHostMessage(msgline)   /* Tailor for yourself. */
  668.    universal new_mail,msgflag
  669. ;  Values for MSGFLAG are:
  670. ;     0 - line not added
  671. ;     1 - line added, low priority (e.g. RSCS progress message)
  672. ;     2 - line added, normal priority (e.g., message from a real user)
  673. ;     3 - line added, high priority (e.g., message from director!)
  674.  
  675.    universal host_msg_file
  676.    lclmsgflag=2          /* Default:  Add line; normal priority. */
  677.    node=''; uid=''
  678.    parse value msgline with f id ':' rest
  679.    if upcase(f)='FROM' then                /* It's a message! */
  680.       uid=id
  681.       if id=RSCS then
  682.          parse value rest with w1 rest2
  683.          if leftstr(w1,5)='YKTVM' then rest=rest2 endif  -- Local YKT-ism
  684.          parse value rest with f id ':' rest2
  685.          if upcase(f)='FROM' then          /* Remote message */
  686.             if pos('(',id)>0 then  /*   from a user */
  687.                parse value id with node '(' uid ')'
  688.                msgline=rest
  689.             else                   /*   from another RSCS mschine */
  690.                node=id
  691.                msgline='From' node'('RSCS'):' rest2
  692.             endif
  693.          else
  694.             parse value upcase(rest) with w1 w2 w3 w4 w5 w6 w7 w8 w9 .
  695. ;  w1   w2     w3      w4 w5   w6 w7  w8    w9
  696. ;  File (5570) spooled to MYID -- ORG RNODE (RUSER)  2/03/88 17:00:32 EST
  697.             if w1='FILE' & w3='SPOOLED' & w4='TO' & w7='ORG' & leftstr(w9,1)='(' then
  698.                node=w8
  699.                parse value w9 with '(' uid ')'
  700.             endif
  701.          endif
  702.       endif
  703.       call setprior(uid,node,lclmsgflag,'MSG',rest)
  704.    else
  705.       lclmsgflag=1  -- CP response - give low priority, but display it.
  706.       parse value upcase(msgline) with w1 w2 w3 w4 w5 w6 w7 .
  707. ;        PUN FILE 3262 FROM IBMPC    COPY 001   NOHOLD
  708. ;        RDR FILE 3334 TRANSFERRED FROM USER RSCS
  709. ; Or, in XA,
  710. ;        RDR FILE 1234 SENT FROM IBMPC  PUN WAS 4321 RECS 0006 CPY 001 B NOHOLD NOKEEP
  711.       if w2='FILE' then
  712.          if w4='FROM' then uid=w5
  713.          elseif w4='TRANSFERRED' then uid=w7
  714.          elseif w4 w5='SENT FROM' then uid=w6
  715.          endif
  716.       endif
  717.       if uid<>'' then new_mail = 1; endif
  718.       call setprior(uid,node,lclmsgflag,'CP',msgline)
  719.    endif
  720.    if lclmsgflag then   /* Insert the line into the message file. */
  721.       insertline msgline,host_msg_file.last+1,host_msg_file
  722. ;  else  -- For debugging...
  723. ;     insertline '(?)' msgline,host_msg_file.last+1,host_msg_file
  724.    endif
  725.    msgflag=max(msgflag,lclmsgflag)
  726.  
  727.  
  728. ;*********** Priorities are set below:                  **********************
  729. defproc setprior(uid,node,var msgflag,how,text)
  730.      if uid=RSCS then     -- From some RSCS machine.  Ignore RSCS messages, but
  731.       if how='MSG' then                   -- not FILE TRANSFERRED FROM RSCS msg.
  732.          if pos('CPQ:',text) then         -- Something we asked RSCS?
  733.             msgflag=2                     -- If so, display it
  734.          else
  735.             msgflag=0                     -- otherwise, discard it.
  736.          endif
  737.       endif
  738. /*  My personal setup; not for product.
  739.    elseif ((uid='WALDBAU' | uid='SERENSO' | uid='CONNORS' |
  740.             uid='CONNELL' | uid='ARMSTRN') &
  741.            (node='' | leftstr(node,5)='YKTVM')) |
  742.           ((uid='RICH' | uid='RON') & (node='THORNVM'))
  743.       then msgflag=3
  744. */
  745.    endif
  746.  
  747. definit
  748.    universal host_msg_file,msg_file_size
  749.    getfileid fileid
  750.    msg_file_size = 0
  751.    host_msg_file = ''
  752.  
  753. ;******************* Following stuff adds the Speaker and Play support *****
  754.  
  755. defproc pplay(prior)
  756.    if     prior=1 then strng='3000 100 2400 100'
  757.    elseif prior=2 then strng='2000 100 2200 100 2400 150'
  758.    elseif prior=3 then strng='800 150 800 150 1000 150 1000 150 1600 180 800 150 900 150'
  759.    else strng=''
  760.    endif
  761.    do forever
  762.       parse value strng with pitch duration strng
  763.       if duration='' then leave; endif
  764.       call beep(pitch,duration)
  765.    end
  766. ;display 1; messageNwait('hostrc=' hostrc'; result="'result'"')
  767.  
  768. compile if EVERSION >= 5 & HOST_SUPPORT = 'EMUL'
  769. defproc send_HLLAPI_string(host_string)     -- Send a string to the  host screen
  770.    universal host_lt
  771.    lt = host_lt
  772.    if lt='' then lt='A'; endif
  773.    result=simple_HLLAPI_call(1, lt)  -- *** Connect to host PS ***
  774.    if result & result<>4 & result<>5 then  -- 4=Busy; 5=Locked
  775.       sayerror 'Error' result 'trying to connect to host session' lt
  776.       stop
  777.    endif
  778.    result=simple_HLLAPI_call(6, 'LaMail Interface Screen')  -- *** Search PS ***
  779.    if result=24 then
  780.       if 'Y' = askyesno('LAMPDQ appears to not be running.  Would you like it started?', 1, 'VM cmds') then
  781.          result=simple_HLLAPI_call(6, 'CMSSERV is Active')  -- *** Search PS ***
  782.          if not result then
  783.             sayerror 'LAMSERV / CMSSERV appears to be active; quitting it...'
  784.             call simple_HLLAPI_call(3, '@3')  -- *** Send key sequence to host ***
  785.          endif
  786.          result=simple_HLLAPI_call(3, '@CLAMPDQ@E')  -- *** Send key sequence to host ***
  787.          if result then
  788.             sayerror 'Error' result 'trying to send LAMPDQ command.'
  789.             stop
  790.          endif
  791.       else
  792.          sayerror 'Host command aborted.'
  793.          stop
  794.       endif
  795.    endif
  796.    result=simple_HLLAPI_call(3, host_string)  -- *** Send key sequence to host ***
  797.    if result then
  798.       sayerror 'Error' result 'trying to send host command.'
  799.       stop
  800.    endif
  801.    call simple_HLLAPI_call(2, '')  -- *** Disconnect from host presentation space ***
  802. compile endif
  803.