home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 3 Comm / 03-Comm.zip / pmcom233.zip / HOST.CMD < prev    next >
OS/2 REXX Batch file  |  1996-01-02  |  32KB  |  984 lines
  1. /*                       PMCOMM HOST MODE                            */
  2. /*                      (C) Copyright 1992                           */
  3. /*                    Multi-Net Communications                       */
  4.  
  5. Signal ON SYNTAX  NAME SYNTAX_ERROR
  6. Signal ON NOVALUE NAME SYNTAX_ERROR
  7. Signal ON HALT    NAME KILL_HOST_MODE
  8. Parse arg port portname screen_handle dde_output dde_input semaphore
  9. Parse source . . fn .
  10.  
  11. Call RxFuncAdd "init_32dll","RxPmc32","init_32dll"
  12. Call init_32dll
  13.  
  14. Expose_list = 'cr crlf bs esc port screen_handle connection  dde_output  priv' ,
  15.               'dir_line. dir_name. dir_desc. fname  lname  default_dir' ,
  16.               'protocol last_login  total_logins  audit_file temp_file' ,
  17.               'pass_file pword semaphore upload_dir cmd_name. cmd_desc.',
  18.               'num_of_cmds help_file cmd_reqs dde_input'
  19.  
  20. Call Clear_buffer
  21. Call Drop_DTR port
  22. Call Sleep "2000"
  23. Call Raise_DTR port
  24. Call Getcom "baud",port
  25. initial_baud = result
  26.  
  27. Begin:
  28. Do Main = 1
  29.  
  30. header_file  = "D:\PMCOMM\SCRIPT\HOSTHEAD.FLE"
  31. pass_file    = "D:\PMCOMM\SCRIPT\HOSTPASS.FLE"
  32. temp_file    = "D:\PMCOMM\SCRIPT\HOST$$$$.FLE"
  33. audit_file   = "D:\PMCOMM\SCRIPT\HOSTAUDT.FLE"
  34. help_file    = "D:\PMCOMM\SCRIPT\HOSTHELP.FLE"
  35. newuser_file = "D:\PMCOMM\SCRIPT\HOSTNEWU.FLE"
  36. dir_file     = "D:\PMCOMM\SCRIPT\HOSTDIR.FLE"
  37. upload_dir   = "D:\PMCOMM\UPLOAD"
  38. modem_string = "AT &C1&D2 S0=1 X4"
  39. system       = "OPEN"                    /*    OPEN or CLOSED    */
  40. connection   = "MODEM"                   /*   MODEM or DIRECT    */
  41. Baud         = "AUTO"                    /*     AUTO or rate     */
  42.  
  43. Call Setcom initial_baud,"","","",port
  44.  
  45. max_attempts = 3
  46. bs   = '08'x
  47. cr   = '0d'x
  48. esc  = '1b'x
  49. crlf = '0d0a'x
  50.  
  51. Parse value Directory() with orgdir
  52.  
  53. Call read_timeout "5000",port
  54. If connection = 'MODEM' then
  55.   Do
  56.      Do Forever
  57.        Call Put_s 'ATZ'||cr,port
  58.        Call wait_for "OK",port
  59.        Call Sleep "2000"
  60.        Call Put_s modem_string||cr,port
  61.        Call wait_for "OK",port
  62.        If result = 1 then leave
  63.     End
  64. End
  65.  
  66. If system = 'CLOSED' then
  67.    Do
  68.      Parse value state_file(pass_file) with rc
  69.      If rc = '' then
  70.         Do
  71.           Call Put_s 'Password file missing' crlf,screen_handle
  72.           Call Put_s 'The password file must exist for CLOSED system operation ...' crlf,screen_handle
  73.           Signal Kill_Host_mode
  74.         End
  75.    End
  76.  
  77. Parse value state_file(dir_file) with rc
  78. If rc = '' then
  79.    Do
  80.      Call Put_s 'Directory file missing ...' crlf,screen_handle
  81.      Signal Kill_Host_mode
  82.    End
  83. i=0
  84. Do until lines(dir_file) = 0
  85.    Parse value linein(dir_file) with temp_line
  86.    If substr(temp_line,1,1) = '*' then iterate
  87.    i=i+1
  88.    Parse var temp_line dir_line.i
  89.    Parse var dir_line.i dir_name.i dir_desc.i
  90.    tempname = pos("\",dir_name.i)
  91.    If tempname = 0 then dir_name.i = dir_name.i||'\'
  92.    dir_desc.i = space(dir_desc.i)
  93.    dir_name.i = translate(dir_name.i)
  94. End
  95. dir_line.0 = i
  96. Parse value stream(dir_file,"c","close") with rc
  97.  
  98. Parse value Directory(dir_name.1) with default_dir
  99. If default_dir \= '' then
  100.    Do
  101.      Call Clear
  102.      Call Put_s 'Default directory changed to' default_dir crlf,screen_handle
  103.    End
  104.    Else do
  105.      Call Clear
  106.      Call Put_s 'Default directory' default_dir 'not found ...' crlf,screen_handle
  107.      Signal Kill_Host_mode
  108.    End
  109.  
  110. If upload_dir \= '' then Call Set_Download_Path upload_dir,dde_output
  111.  
  112.  
  113. Connection_Pending:
  114. Call Put_s 'PMCOMM now running in HOST mode' crlf crlf,screen_handle
  115. Call Put_s 'Waiting for connection ...' crlf,screen_handle
  116. Call read_timeout "60000",port
  117. If connection = 'MODEM' then
  118.   Do
  119.     If baud = "AUTO" then
  120.     Do
  121.        Do Forever
  122.           Call Wait_fore '1200','2400','4800','9600','19200','57600',port,screen_handle
  123.           match = result
  124.           Select
  125.                When match = 0 then iterate
  126.                When match = 1 then Call Setcom "1200","N","8","1",port
  127.                When match = 2 then Call Setcom "2400","N","8","1",port
  128.                When match = 3 then Call Setcom "4800","N","8","1",port
  129.                When match = 4 then Call Setcom "9600","N","8","1",port
  130.                When match = 5 then Call Setcom "19200","N","8","1",port
  131.                When match = 6 then Call Setcom "57600","N","8","1",port
  132.                Otherwise nop
  133.           End
  134.        Leave
  135.        End
  136.     End
  137.     Else Do
  138.        Call Setcom baud,"N","8","1",port
  139.        Do Forever
  140.           Call Wait_fore 'CONNECT',port,screen_handle
  141.           If result = 1 then leave
  142.        End
  143.      End
  144. End
  145.  
  146. Call Sleep "5000"
  147. Parse value Header(header_file) with rc
  148. invalid_login_count = 0
  149.  
  150. Sign_on:
  151. Do Forever
  152. fname = '' ; lname = '' ; pword = '' ; nuser = 'N'
  153. Parse value read_with_echo("Your first name?-> ") with rc fname .
  154. If rc \=0 then leave main
  155. If fname = '' then iterate
  156. Parse value read_with_echo(" Your last name?-> ") with rc lname .
  157. If rc \=0 then leave main
  158. If lname = '' then iterate
  159.  
  160. Parse value read_password_file(pass_file) with rc priv protocol r_pass total_logins last_login
  161. If rc \= 0  then
  162.  Do
  163.    If system = 'OPEN' then
  164.       Do
  165.          Parse value read_with_echo(fname lname||", correct - [Y]es or [Return], [N]o?->") with rc okname .
  166.          If rc \=0 then leave main
  167.          If okname \= 'Y' & okname \= '' then iterate
  168.          Parse value Header(newuser_file) with rc
  169.          Parse value read_with_echo("Would you like to register - [Y]es or [Return], [N]o?->") with rc nuser .
  170.          If rc \=0 then leave main
  171.          If nuser \= 'Y' & nuser \= '' then leave main
  172.          r_pass = ''
  173.       End
  174.       Else Do
  175.          Call Put_s crlf||"Closed System, no access allowed" crlf,port
  176.          Call Put_s crlf||"Closed System, no access allowed" crlf,screen_handle
  177.          Leave main
  178.       End
  179.  End
  180.  
  181. Parse value read_without_echo("Enter your password (.'s will echo)-> ") with rc pword .
  182. If pword = '' then iterate
  183. If rc \=0 then leave main
  184. If r_pass = '' then r_pass = pword
  185. If nuser  = 'Y' | nuser = '' then Call Add_password_file(pass_file)
  186. If pword \== r_pass then
  187.   Do
  188.     If invalid_login_count = max_attempts then leave main
  189.     Call Put_s crlf||"Invalid Login Attempt - Try again" crlf,port
  190.     Call Put_s crlf||"Invalid Login Attempt - Try again" crlf,screen_handle
  191.     invalid_login_count = invalid_login_count + 1
  192.     Iterate
  193. End
  194. Leave
  195. End
  196.  
  197. login_msg = "Login by" fname "at" time('C') 'on' date('L') ', last login was on' last_login
  198. Call Put_s crlf crlf||login_msg crlf,port
  199. Call Put_s crlf crlf||Login_msg crlf,screen_handle
  200. Call Audit(date('L') time('C') "- Login by" fname lname)
  201. rc = time("R")
  202.  
  203. Menu_loop:
  204.  
  205. Do Forever
  206. Call Put_s crlf crlf, port
  207. Call Put_s crlf crlf, screen_handle
  208.  
  209. Call Build_Menu
  210.  
  211. cmdline = ''
  212. heading = crlf crlf crlf center("--- Main Options Menu ---",79)
  213. Call Put_s heading crlf crlf,port
  214. Call Put_s heading crlf,screen_handle
  215. Do i = 1  by 2 to num_of_cmds
  216.    j=i+1
  217.    line = overlay(cmd_name.j cmd_desc.j,cmd_name.i cmd_desc.i,40)
  218.    Call Put_s line crlf,port
  219.    Call Put_s line crlf,screen_handle
  220.    cmdline = cmdline substr(cmd_name.i,2,1) substr(cmd_name.j,2,1)
  221. End
  222. cmdline = space(cmdline,1,',')
  223. Parse value read_with_echo("Enter choice" cmdline||"?-> ") with rc pick .
  224. If rc \= 0 then leave main
  225. If pick = '' then iterate
  226. if  pos(pick, cmd_reqs) = 0  then  iterate
  227.  
  228. Select
  229.      When pick = "C" then Parse value Change_Dir() with rc
  230.      When pick = "D" then Parse value File_Transfer("DOWNLOAD") with rc
  231.      When pick = "F" then Parse value List_Files() with rc
  232.      When pick = "G" then Parse value Good_Bye() with rc
  233.      When pick = "H" then Parse value Help_Text() with rc
  234.      When pick = "I" then Parse value User_Information() with rc
  235.      When pick = "L" then Parse value List_Directories() with rc
  236.      When pick = "S" then Parse value Shell_OS2() with rc
  237.      When pick = "T" then Signal Kill_Host_Mode
  238.      When pick = "U" then Parse value File_Transfer("UPLOAD") with rc
  239.      Otherwise iterate
  240. End
  241. If rc \=0 then leave main
  242. End
  243.  
  244. Call Clear_buffer
  245. Call Drop_DTR port
  246. Call Sleep "2000"
  247. Call Raise_DTR port
  248. Call Put_s crlf||'PMComm Host Mode Recycling' crlf,screen_handle
  249.  
  250. End
  251.  
  252. Call Clear_buffer
  253. Call Drop_DTR port
  254. Call Sleep "2000"
  255. Call Raise_DTR port
  256. Call Put_s crlf||'PMComm Host Mode Recycling' crlf,screen_handle
  257. Signal Begin
  258.  
  259.  
  260.  
  261.  
  262. /*  Here are all the subroutines that the MAINLINE section of HOST   */
  263. /*  uses.  HOST  mode is structured so that all call return to the   */
  264. /*  main loop(s).                                                    */
  265.  
  266. /* Clear Screen Routine                                              */
  267. Clear: Procedure expose (expose_list)
  268. Call put_s "1b5b324a"x,screen_handle
  269. Call put_s "1b5b324a"x,screen_handle
  270. Call put_s "1b5b324a"x,port
  271. Call put_s "1b5b324a"x,port
  272. Return
  273.  
  274.  
  275. /* Standard handler for SIGNAL on ERROR, will help in the debuging   */
  276. syntax_error:
  277. fp = filespec("path",fn)
  278. fd = filespec("drive",fn)
  279. errormsg='REXX error' rc 'in line' sigl':' errortext(rc)
  280. errorfile = fd||fp||"SCRIPT.ERR"
  281. rc = lineout(errorfile,date() time() fn '-' errormsg)
  282. rc = lineout(errorfile,date() time() fn '-' sourceline(sigl))
  283. Exit
  284.  
  285.  
  286. /* Standard file transfer routine for all protocols that PMCOMM has  */
  287. File_Transfer: Procedure expose (expose_list)
  288. Parse arg direction
  289.  
  290. Do i=1 until i=dir_line.0
  291.    If default_dir = dir_name.i then
  292.       Do
  293.          Call Put_s crlf||'Current directory is ['||i||'] -' dir_desc.i crlf,port
  294.          Call Put_s crlf||'Current directory is ['||i||'] -' dir_desc.i crlf,screen_handle
  295.          i = 0
  296.          Leave
  297.       End
  298. End
  299. If i \=0 then
  300.    Do
  301.       Call Put_s crlf||"Current directory is " default_dir crlf,port
  302.       Call Put_s crlf||"Current directory is " default_dir crlf,screen_handle
  303.    End
  304.  
  305. If protocol \= 'NONE' then
  306.    Do
  307.       Call Put_s "Current file transfer protocol is" protocol crlf,port
  308.       Call Put_s "Current file transfer protocol is" protocol crlf,screen_handle
  309.       t_protocol = protocol
  310.    End
  311. Do Forever
  312.   Parse value read_with_echo("Enter file name or Tap [Return] to abort?-> ") with rc dfn .
  313.   If rc \=0 then return rc
  314.   Parse var dfn fn '.' ft
  315.   If dfn = '' then return 0
  316.   If ft = '' then
  317.      Do
  318.        Call Put_s crlf||"Invalid filename ..." crlf,port
  319.        Call Put_s crlf||"Invalid filename ..." crlf,screen_handle
  320.        Iterate
  321.      End
  322.   If direction = "DOWNLOAD" then
  323.      Do
  324.        tempname = reverse(default_dir)
  325.        If pos("\",tempname) = 1 then file_name = default_dir||dfn
  326.           else file_name = default_dir||"\"||dfn
  327.        Parse value State_file(file_name) with rc
  328.        If rc = '' then
  329.           Do
  330.             Call Put_s crlf||"File not found ..." crlf,port
  331.             Call Put_s crlf||"File not found ..." crlf,screen_handle
  332.             Iterate
  333.           End
  334.      End
  335.   If direction = "UPLOAD" then
  336.      Do
  337.        tempname = reverse(default_dir)
  338.        If pos("\",tempname) = 1 then file_name = default_dir||dfn
  339.           else file_name = default_dir||"\"||dfn
  340.        Parse value State_file(file_name) with rc
  341.        If rc = file_name then
  342.           Do
  343.             Call Put_s crlf||"File already exists ..." crlf,port
  344.             Call Put_s crlf||"File already exists ..." crlf,screen_handle
  345.             Iterate
  346.           End
  347.      End
  348. Leave
  349. End
  350.  
  351. Parse value read_with_echo("Logoff after file transfer - [N]o or [Return], [Y]?-> ") with rc auto .
  352. If rc \=0 then return rc
  353. If protocol = 'NONE' then
  354.    Do
  355.       Parse value Set_protocol('NONE') with rc
  356.       t_protocol = protocol
  357.       protocol = 'NONE'
  358.    End
  359.  
  360. Select
  361.     When t_protocol = "XMODEM" & direction = "DOWNLOAD"  then
  362.          do
  363.             Call Put_s crlf||"Ready to send file ..." crlf,port
  364.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  365.             Call xmodem_chk_send file_name,dde_output,dde_input
  366.             ft_rc = result
  367.          end
  368.     When t_protocol = "XMODEM" & direction = "UPLOAD"  then
  369.          do
  370.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  371.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  372.             Call xmodem_chk_receive file_name,dde_output,dde_input
  373.             ft_rc = result
  374.          end
  375.     When t_protocol = "XMODEM-CRC" & direction = "DOWNLOAD"  then
  376.          do
  377.             Call Put_s crlf||"Ready to send file ..." crlf,port
  378.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  379.             Call xmodem_send file_name,dde_output,dde_input
  380.             ft_rc = result
  381.          end
  382.     When t_protocol = "XMODEM-CRC" & direction = "UPLOAD"  then
  383.          do
  384.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  385.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  386.             Call xmodem_receive file_name,dde_output,dde_input
  387.             ft_rc = result
  388.          end
  389.     When t_protocol = "XMODEM-1K" & direction = "DOWNLOAD"  then
  390.          do
  391.             Call Put_s crlf||"Ready to send file ..." crlf,port
  392.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  393.             Call xmodem_1k_send file_name,dde_output,dde_input
  394.             ft_rc = result
  395.          end
  396.     When t_protocol = "XMODEM-1K" & direction = "UPLOAD"  then
  397.          do
  398.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  399.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  400.             Call xmodem_1k_receive file_name,dde_output,dde_input
  401.             ft_rc = result
  402.          end
  403.     When t_protocol = "YMODEM" & direction = "DOWNLOAD"  then
  404.          do
  405.             Call Put_s crlf||"Ready to send file ..." crlf,port
  406.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  407.             Call ymodem_send file_name,dde_output,dde_input
  408.             ft_rc = result
  409.          end
  410.     When t_protocol = "YMODEM" & direction = "UPLOAD"  then
  411.          do
  412.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  413.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  414.             Call ymodem_receive dde_output,dde_input
  415.             ft_rc = result
  416.          end
  417.     When t_protocol = "YMODEMG" & direction = "DOWNLOAD"  then
  418.          do
  419.             Call Put_s crlf||"Ready to send file ..." crlf,port
  420.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  421.             Call ymodemg_send file_name,dde_output,dde_input
  422.             ft_rc = result
  423.          end
  424.     When t_protocol = "YMODEMG" & direction = "UPLOAD"  then
  425.          do
  426.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  427.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  428.             Call ymodemg_receive dde_output,dde_input
  429.             ft_rc = result
  430.          end
  431.     When t_protocol = "KERMIT" & direction = "DOWNLOAD"  then
  432.          do
  433.             Call Put_s crlf||"Ready to send file ..." crlf,port
  434.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  435.             Call kermit_send file_name,dde_output,dde_input
  436.             ft_rc = result
  437.          end
  438.     When t_protocol = "KERMIT" & direction = "UPLOAD"  then
  439.          do
  440.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  441.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  442.             Call kermit_receive dde_output,dde_input
  443.             ft_rc = result
  444.          end
  445.     When t_protocol = "ZMODEM" & direction = "DOWNLOAD"  then
  446.          do
  447.             Call Put_s crlf||"Ready to send file ..." crlf,port
  448.             Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
  449.             Call zmodem_send file_name,dde_output,dde_input
  450.             ft_rc = result
  451.          end
  452.     When t_protocol = "ZMODEM" & direction = "UPLOAD"  then
  453.          do
  454.             Call Put_s crlf||"Ready to receive file ..." crlf,port
  455.             Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
  456.             Call zmodem_receive dde_output,dde_input
  457.             ft_rc = result
  458.          end
  459.     Otherwise return 0
  460.     End
  461.  
  462. If ft_rc \= 0 then
  463.    Do
  464.      Call Sleep "3000"
  465.      Call Put_s crlf||'File transfer complete 'ft_rc||crlf,port
  466.      Call Put_s crlf||'File transfer complete 'ft_rc||crlf,screen_handle
  467.      If auto = "Y" then
  468.         Do
  469.           Parse value Good_bye() with rcode
  470.           return rcode
  471.         End
  472.      return 0
  473.    End
  474.    Else do
  475.      Call Sleep "3000"
  476.      Call Put_s crlf||'File transfer aborted' crlf,port
  477.      Call Put_s crlf||'File transfer aborted' crlf,screen_handle
  478.      If auto = "Y" then
  479.         Do
  480.           Parse value Good_bye() with rcode
  481.           return rcode
  482.         End
  483.      return 0
  484.    End
  485.  
  486.  
  487. Read_with_echo: Procedure expose (expose_list)
  488. Parse arg screen_output
  489.  
  490. Call Clear_buffer
  491. Call Read_timeout '3000',port
  492. Call Put_s crlf||screen_output,port
  493. Call Put_s crlf||screen_output,screen_handle
  494. line = ''
  495. j=0
  496. time_out = 0
  497.  
  498. Do Forever
  499. Parse value  Get_CH(port) with char_in
  500. If connection = 'MODEM' then
  501.   Do
  502.     Call DCD port
  503.     If result = 0 then return 99
  504.   End
  505.  
  506. If char_in = "-1" then
  507.    Do
  508.      time_out = time_out+1
  509.      If time_out = 60 then
  510.         Do
  511.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,port
  512.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,screen_handle
  513.            Parse value Good_bye() with rcode
  514.            return rcode
  515.         End
  516.      Iterate
  517.    End
  518.  
  519. If char_in = cr then
  520.    Do
  521.      Call Put_s crlf,port
  522.      Call Put_s crlf,screen_handle
  523.      line = space(line)
  524.      line = translate(line)
  525.      return 0 line
  526.    End
  527.  
  528. If char_in = bs then
  529.    Do
  530.      If j > 0 then
  531.        Do
  532.          line = delstr(line,j,1)
  533.          Call Put_s bs,port
  534.          Call Put_s bs,screen_handle
  535.          j=j-1
  536.        End
  537.    End
  538.    Else Do
  539.      line = line||char_in
  540.      Call Put_s char_in,port
  541.      Call Put_s char_in,screen_handle
  542.      j=j+1
  543.    End
  544. End
  545.  
  546.  
  547. Read_without_Echo: Procedure expose (expose_list)
  548. Parse arg screen_output
  549.  
  550. Call Clear_buffer
  551. Call Read_timeout '3000',port
  552. Call Put_s crlf||screen_output,port
  553. Call Put_s crlf||screen_output,screen_handle
  554. line = ''
  555. j=0
  556. time_out = 0
  557.  
  558. Do Forever
  559. Parse value  Get_CH(port) with char_in
  560. If connection = 'MODEM' then
  561.   Do
  562.     Call DCD port
  563.     If result = 0 then return 99
  564.   End
  565.  
  566. If char_in = "-1" then
  567.    Do
  568.      time_out = time_out+1
  569.      If time_out = 60 then
  570.         Do
  571.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,port
  572.            Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,screen_handle
  573.            Parse value Good_bye() with rcode
  574.            return rcode
  575.         End
  576.      Iterate
  577.    End
  578.  
  579. If char_in = cr then
  580.    Do
  581.      Call Put_s crlf,port
  582.      Call Put_s crlf,screen_handle
  583.      line = space(line)
  584.      line = translate(line)
  585.      return 0 line
  586.    End
  587.  
  588. If char_in = bs then
  589.    Do
  590.      If j > 0 then
  591.        Do
  592.          line = delstr(line,j,1)
  593.          Call Put_s bs,port
  594.          Call Put_s bs,screen_handle
  595.          j=j-1
  596.        End
  597.    End
  598.    Else Do
  599.      line = line||char_in
  600.      Call Put_s ".",port
  601.      Call Put_s char_in,screen_handle
  602.      j=j+1
  603.    End
  604. End
  605.  
  606.  
  607. Clear_buffer: Procedure expose (expose_list)
  608. Call Read_timeout '0',port
  609. Do Forever
  610.    Parse value Get_CH(port) with rc
  611.    If rc = "-1" then return
  612. End
  613. Return
  614.  
  615.  
  616. Help_text: Procedure expose (expose_list)
  617. Parse value Header(help_file) with rc
  618. If rc \=0 then
  619.    Do
  620.       Call put_s crlf||'Help file not available ...' crlf,port
  621.       Call put_s crlf||'Help file not available ...' crlf,screen_handle
  622.    End
  623. Return 0
  624.  
  625.  
  626. Read_password_file: Procedure expose (expose_list)
  627. Parse arg pass_file
  628. protocol = "NONE"
  629. r_fname = '' ; r_lname = '' ; r_pass = '' ; r_priv = ''
  630. r_protocol = protocol ; r_total_logins = '' ; r_last_login = ''
  631. Do until lines(pass_file) = 0
  632.    Parse value linein(pass_file) with pass_line
  633.    If substr(pass_line,1,1) = '*' then iterate
  634.    Parse upper var pass_line r_fname r_lname r_pass r_priv r_protocol r_total_logins r_last_login
  635.    If fname \== r_fname | lname \== r_lname then iterate
  636.    If r_protocol = '' then r_protocol = protocol
  637.    If r_total_logins = '' then r_total_logins = 0
  638.    r_total_logins = r_total_logins + 1
  639.    If r_last_login = '' then r_last_login = 'UNKNOWN'
  640.    Parse value stream(pass_file,"c","close") with rc
  641.    return 0 r_priv r_protocol r_pass r_total_logins r_last_login
  642. End
  643. Parse value stream(pass_file,"c","close") with rc
  644. Return 99 1 protocol 'DUMMY' 1 date('L')
  645.  
  646.  
  647. Update_Password_file: Procedure expose (expose_list)
  648. Parse arg pass_file temp_file
  649. Do until lines(pass_file) = 0
  650.    Parse value linein(pass_file) with pass_line
  651.    Parse upper var pass_line r_fname r_lname r_pass r_priv .
  652.    If fname \== r_fname | lname \== r_lname then
  653.       Do
  654.         Parse value lineout(temp_file,pass_line) with rc
  655.       End
  656.       Else Do
  657.         last_login = Date('L')
  658.         pass_line = r_fname r_lname pword r_priv protocol total_logins last_login
  659.         Parse value lineout(temp_file,pass_line) with rc
  660.       End
  661. End
  662. Parse value stream(pass_file,"c","close") with rc
  663. Parse value stream(temp_file,"c","close") with rc
  664. Address CMD "ERASE" pass_file
  665. pass_name = filespec("name",pass_file)
  666. Address CMD "RENAME" temp_file pass_name
  667. Return 0
  668.  
  669.  
  670. Add_Password_file: Procedure expose (expose_list)
  671. Parse arg pass_file
  672. pass_line = fname lname pword 1 protocol 1 date('L')
  673. Parse value lineout(pass_file,pass_line) with rc
  674. Parse value stream(pass_file,"c","close") with rc
  675. Return 0
  676.  
  677.  
  678. Header: Procedure expose (expose_list)
  679. Parse arg text_file
  680. Parse value state_file(text_file) with rc
  681. If rc = '' then return 99
  682. Call put_s crlf,port
  683. Call put_s crlf,screen_handle
  684. Do until lines(text_file) = 0
  685.    Parse value linein(text_file) with head_line
  686.    If substr(head_line,1,1) = '*' then iterate
  687.    Call put_s head_line crlf,port
  688.    Call put_s head_line crlf,screen_handle
  689. End
  690. Parse value stream(text_file,"c","close") with rc
  691. Return 0
  692.  
  693.  
  694. Audit: Procedure expose (expose_list)
  695. Parse arg audit_record
  696. Parse value lineout(audit_file,audit_record) with rc
  697. Return rc
  698.  
  699.  
  700. Build_Menu: Procedure expose (expose_list)
  701. command_tbl.   = ''
  702. command_tbl.1  = "[C]hange Active Directory (or drive) ; 5"
  703. command_tbl.2  = "[D]ownload A File ; 1"
  704. command_tbl.3  = "[F]iles (List current directory) ; 1"
  705. command_tbl.4  = "[G]oodbye (Disconnect) ; 0"
  706. command_tbl.5  = "[H]elp (Main command help) ; 0"
  707. command_tbl.6  = "[I]nformation (User defaults) ; 0"
  708. command_tbl.7  = "[L]ist File Directories ; 0"
  709. command_tbl.8  = "[S]hell To OS/2 ; 9"
  710. command_tbl.9  = "[T]erminate Host mode ; 9"
  711. command_tbl.10 = "[U]pload A File ; 1"
  712.  
  713. cmd_desc. = ''
  714. cmd_name. = ''
  715. cmd_reqs  = ''
  716.  
  717. j = 0
  718. Do i = 1 until command_tbl.i = ''
  719.    Parse var command_tbl.i tbl_command tbl_desc ';' tbl_priv
  720.    If tbl_priv > priv then iterate
  721.  
  722.    /*==================================================================*/
  723.    /*  Look for "[" in command Next Letter is Command, Save this       */
  724.    /*       command character for later checking                       */
  725.    /*==================================================================*/
  726.    start = pos('[', tbl_command) + 1
  727.    cmd_reqs = cmd_reqs || substr(tbl_command, start, 1)
  728.  
  729.    j = j + 1
  730.    cmd_name.j = tbl_command
  731.    cmd_desc.j = tbl_desc
  732. End
  733. num_of_cmds = j
  734. Return
  735.  
  736.  
  737. List_files: Procedure expose (expose_list)
  738. Parse value read_with_echo("Enter wildcard for files or Tap [Return] for ALL files?-> ") with rc wildcard .
  739. If rc \=0 then return rc
  740.  
  741. Do i=1 until i=dir_line.0
  742.    If default_dir = dir_name.i then
  743.       Do
  744.          Call Put_s crlf||'Directory ['||i||'] -' dir_desc.i crlf,port
  745.          Call Put_s crlf||'Directory ['||i||'] -' dir_desc.i crlf,screen_handle
  746.          Leave
  747.       End
  748. End
  749.  
  750. queue = 'PMCOMMQ'
  751. rc = rxqueue('delete',queue)
  752. rc = rxqueue('create',queue)
  753. rc = rxqueue('set',queue)
  754. Address CMD 'DIR' wildcard '/N 2>NUL | RXQUEUE' queue
  755. If queued() <= 5 then
  756.    Do
  757.      Call put_s crlf||'No files Found or Directory Empty' crlf,port
  758.      Call put_s crlf||'No Files Found or Directory Empty' crlf,screen_handle
  759.      rc = rxqueue('delete',queue)
  760.      Return 0
  761.    End
  762. Do 4
  763.    Parse pull .
  764. End
  765. Do i=1 until queued()-1 <= 0
  766.    Parse pull d_date d_time d_bytes . d_file
  767.    If priv < 5 & datatype(d_bytes,'N') = 0 then iterate
  768.     outline = left(d_file,13) right(d_bytes,8) right(d_date,10)
  769.     Call Put_s outline crlf,port
  770.     Call Put_s outline crlf,screen_handle
  771.     x = i // 21
  772.     If x = 0 then
  773.       Do
  774.         Parse value read_with_echo("More - Tap [Return] to continue or Q to abort?-> ") with rc more .
  775.         If rc \=0 then return rc
  776.         If more \= '' then leave
  777.       End
  778. End
  779. rc = rxqueue('delete',queue)
  780. Return 0
  781.  
  782.  
  783. List_Directories: Procedure expose (expose_list)
  784. Do forever
  785. Parse value read_with_echo("List - [1.."||dir_line.0||"], [L]ist, [Return] to abort?-> ") with rc func .
  786. If rc \=0 then return rc
  787. If func = '' then return 0
  788. If func = 'L' then
  789.   Do
  790.     Do i=1 until i=dir_line.0
  791.        Call Put_s '['||i||']' dir_desc.i crlf,port
  792.        Call Put_s '['||i||']' dir_desc.i crlf,screen_handle
  793.        x = i // 21
  794.        If x = 0 then
  795.          Do
  796.             Parse value read_with_echo("More - Tap [Return] to continue or Tap Any Key to abort?-> ") with rc more .
  797.             If rc \=0 then return rc
  798.             If more \= '' then leave
  799.          End
  800.     End
  801. Iterate
  802. End
  803.  
  804. If datatype(func,'N')=1 then
  805.    Do
  806.      If func > 0 & func <= dir_line.0 then
  807.         Do
  808.            Parse value directory(dir_name.func) with default_dir
  809.            Parse value List_Files() with rc
  810.         End
  811.    End
  812. Iterate
  813. End
  814. Return 0
  815.  
  816.  
  817. Change_dir: Procedure expose (expose_list)
  818. Parse value directory() with default_dir
  819.  
  820. Call Put_s crlf||"Current directory is " default_dir crlf,port
  821. Call Put_s crlf||"Current directory is " default_dir crlf,screen_handle
  822. Do Forever
  823.   Parse value read_with_echo("Enter new directory name or Tap [Return] to abort?-> ") with rc newdir .
  824.   If rc \=0 then return rc
  825.   If newdir = '' then return 0
  826.   Parse value directory(newdir) with tempdir
  827.   If tempdir  \= '' then
  828.      Do
  829.        Call Put_s 'Default directory changed to' newdir crlf,port
  830.        Call Put_s 'Default directory changed to' newdir crlf,screen_handle
  831.        default_dir = newdir
  832.        upload_dir  = newdir
  833.        Call Set_Download_Path newdir,dde_output
  834.      End
  835.        Else do
  836.        Call Clear
  837.        Call Put_s crlf||'Directory' newdir 'not found ...' crlf,port
  838.        Call Put_s crlf||'Directory' newdir 'not found ...' crlf,screen_handle
  839.        Iterate
  840.      End
  841.   Return 0
  842. End
  843.  
  844.  
  845. Set_protocol: Procedure expose (expose_list)
  846. protocol_sel = "[X]modem [C]rc-Xmodem [1]k-Xmodem [B]atch-Ymodem [Y]modem-G [K]ermit [Z]modem [N]one"
  847. Parse arg call_type
  848. If call_type = '' then
  849.    Do
  850.      Call Put_s crlf||"Current file transfer protocol is" protocol crlf,port
  851.      Call Put_s crlf||"Current file transfer protocol is" protocol crlf,screen_handle
  852.    End
  853.    Else Do
  854.      Call Put_s crlf crlf,port
  855.      Call Put_s crlf,screen_handle
  856.    End
  857.  
  858. cmdline = ''
  859. Do i = 1 to words(protocol_sel)
  860.    Call Put_s word(protocol_sel,i) crlf ,port
  861.    Call Put_s word(protocol_sel,i) crlf ,screen_handle
  862.    cmdline = cmdline substr(word(protocol_sel,i),2,1)
  863. End
  864. cmdline = space(cmdline,1,',')
  865.  
  866. Do Forever
  867.   Parse value read_with_echo("Enter choice" cmdline "or Tap [Return] to abort?-> ") with rc pick .
  868.   If rc \=0 then return rc
  869.   If pick = '' then return 0
  870.   Select
  871.        When pick = "X" then protocol = "XMODEM"
  872.        When pick = "C" then protocol = "XMODEM-CRC"
  873.        When pick = "1" then protocol = "XMODEM-1K"
  874.        When pick = "B" then protocol = "YMODEM"
  875.        When pick = "Y" then protocol = "YMODEMG"
  876.        When pick = "Z" then protocol = "ZMODEM"
  877.        When pick = "K" then protocol = "KERMIT"
  878.        When pick = "N" then protocol = "NONE"
  879.        Otherwise iterate
  880.   End
  881.   Leave
  882. End
  883. Return 0
  884.  
  885.  
  886. Set_password: Procedure expose (expose_list)
  887. Parse value read_with_echo("Enter new password or Tap [Return] to abort?-> ") with rc tword .
  888. If rc \=0 then return rc
  889. If tword = '' then return 0
  890. pword = tword
  891. Call Update_password_file(pass_file temp_file)
  892. Call Put_s crlf||'Password changed ...' crlf crlf,port
  893. Call Put_s crlf||'Password changed ...' crlf crlf,screen_handle
  894. Return 0
  895.  
  896.  
  897. Shell_OS2: Procedure expose (expose_list)
  898. Call OS2_Shell port,port
  899. Return 0
  900.  
  901.  
  902. User_Information: Procedure expose (expose_list)
  903. Call Put_s 'Information - Self User Alterations' crlf crlf,port
  904. Call Put_s 'Information - Self User Alterations' crlf crlf,screen_handle
  905. Call Put_s "- First name ... :" fname crlf,port
  906. Call Put_s "- First name ... :" fname crlf,screen_handle
  907. Call Put_s "- Last name .... :" lname crlf,port
  908. Call Put_s "- Last name .... :" lname crlf,screen_handle
  909. Call Put_s "- Password ..... :" pword crlf,port
  910. Call Put_s "- Password ..... :" pword crlf,screen_handle
  911. Call Put_s "- Trans Protocol :" protocol crlf,port
  912. Call Put_s "- Trans Protocol :" protocol crlf,screen_handle
  913. Call Put_s "- Privilage .... :" priv crlf,port
  914. Call Put_s "- Privilage .... :" priv crlf,screen_handle
  915. Call Put_s "- Directory .... :" default_dir crlf crlf,port
  916. Call Put_s "- Directory .... :" default_dir crlf crlf,screen_handle
  917. Call Put_s "- Last call was on" last_login crlf,port
  918. Call Put_s "- Last call was on" last_login crlf,screen_handle
  919. Call Put_s "- Total number of calls todate is" total_logins crlf crlf,port
  920. Call Put_s "- Total number of calls todate is" total_logins crlf crlf,screen_handle
  921. Call Put_s "- Current date is" date() ", current time is" time('C') crlf,port
  922. Call Put_s "- Current date is" date() ", current time is" time('C') crlf,screen_handle
  923. Call Put_s "- Elapsed time this call is" time("E")%60 "minute(s)" crlf,port
  924. Call Put_s "- Elapsed time this call is" time("E")%60 "minute(s)" crlf,screen_handle
  925.  
  926.  
  927. Parse value read_with_echo("User Alterations - [P]assword, [T]rans, [Return] to quit?->") with rc attr
  928. If rc \=0 then return rc
  929. Select
  930.   When attr = 'T' then Parse value Set_protocol('NONE') with rc
  931.   When attr = 'P' then Parse value Set_password() with rc
  932.   Otherwise return 0
  933. End
  934. Return rc
  935.  
  936.  
  937. State_file: Procedure
  938. Parse arg file_name
  939. If file_name = '' then return file_name
  940. return(stream(file_name,'c','query exists'))
  941.  
  942.  
  943. Good_Bye: Procedure expose (expose_list)
  944. If fname = '' | lname = '' then return 99
  945. Call Put_s crlf||time("E")%60 "minute(s) logged this time." crlf,port
  946. Call Put_s crlf||time("E")%60 "minute(s) logged this time." crlf,screen_handle
  947. Call Put_s "Tap [Enter] to LogOff now." crlf,port
  948. Call Put_s "Tap [Enter] to LogOff now." crlf,screen_handle
  949. Call Put_s "Tap [Esc] to abort LogOff." crlf crlf,port
  950. Call Put_s "Tap [Esc] to abort LogOff." crlf crlf,screen_handle
  951. Call Clear_Buffer
  952. Call Read_timeout "1000",port
  953. Do i=9 by -1 until i = 0
  954.   Call Put_s "Hanging up in :" i "seconds" cr,port
  955.   Call Put_s "Hanging up in :" i "seconds" cr,screen_handle
  956.   Parse value Get_CH(port) with char_in
  957.   If char_in = "-1" then iterate
  958.   If char_in = esc then return 0
  959.   Leave
  960. End
  961. Call Put_s crlf||"Loggoff for" fname lname "complete" crlf,port
  962. Call Put_s crlf||"Loggoff for" fname lname "complete" crlf ,screen_handle
  963. Call Audit(date() time('C') "- Logoff by" fname lname)
  964. Call Update_Password_file(pass_file temp_file)
  965. Return 99
  966.  
  967.  
  968. Kill_host_mode:
  969. Parse value directory(orgdir) with rc
  970. Call Put_s crlf||"Directory reset to" orgdir crlf,screen_handle
  971. Call Put_s "PMComm Host Mode Terminating ..." crlf,port
  972. Call Put_s "PMComm Host Mode Terminating ..." crlf,screen_handle
  973. If connection = 'MODEM' then
  974.   Do
  975.     Call Clear_buffer
  976.     Call Drop_DTR port
  977.     Call Sleep "2000"
  978.     Call Raise_DTR port
  979.     Call Put_s 'ATZ'||cr,port
  980.     Call wait_for "OK",port
  981.     Call Sleep "2000"
  982.   End
  983. Exit
  984.