Black Box 4/BlackBox.cdr/os2/pmcom109.arj/HOST.CMD

Text File | 1991-09-04 | 31.4 KB | 982 lines

/*                       PMCOMM HOST MODE                            */
/*                      (C) Copyright 1990                           */
/*                    Multi-Net Communications                       */

Signal ON SYNTAX  NAME SYNTAX_ERROR
Signal ON NOVALUE NAME SYNTAX_ERROR
Signal ON HALT    NAME KILL_HOST_MODE
Parse arg port portname screen_handle dde_output dde_input semaphore
Parse source . . fn .

Call RxFuncAdd "init_dll","RxPmcomm","init_dll"
Call init_dll

Expose_list = 'cr crlf bs esc port screen_handle connection  dde_output  priv' ,
              'dir_line. dir_name. dir_desc. fname  lname  default_dir' ,
              'protocol last_login  total_logins  audit_file temp_file' ,
              'pass_file pword semaphore upload_dir cmd_name. cmd_desc.',
              'num_of_cmds help_file cmd_reqs dde_input'

Call Clear_buffer
Call Drop_DTR port
Call Sleep "2000"
Call Raise_DTR port
Call Getcom "baud",port
initial_baud = result

Begin:
Do Main = 1

header_file  = "D:\PMCOMM\SCRIPT\HOSTHEAD.FLE"
pass_file    = "D:\PMCOMM\SCRIPT\HOSTPASS.FLE"
temp_file    = "D:\PMCOMM\SCRIPT\HOST$$$$.FLE"
audit_file   = "D:\PMCOMM\SCRIPT\HOSTAUDT.FLE"
help_file    = "D:\PMCOMM\SCRIPT\HOSTHELP.FLE"
newuser_file = "D:\PMCOMM\SCRIPT\HOSTNEWU.FLE"
dir_file     = "D:\PMCOMM\SCRIPT\HOSTDIR.FLE"
upload_dir   = "D:\PMCOMM\UPLOAD"
modem_string = "AT &C1&D2 S0=1 X4"
system       = "OPEN"                    /*    OPEN or CLOSED    */
connection   = "MODEM"                   /*   MODEM or DIRECT    */
Baud         = "AUTO"                    /*     AUTO or rate     */

Call Setcom initial_baud,"","","",port

max_attempts = 3
bs   = '08'x
cr   = '0d'x
esc  = '1b'x
crlf = '0d0a'x

Parse value Directory() with orgdir

Call read_timeout "5000",port
If connection = 'MODEM' then
  Do
     Do Forever
       Call Put_s 'ATZ'||cr,port
       Call wait_for "OK",port
       Call Sleep "2000"
       Call Put_s modem_string||cr,port
       Call wait_for "OK",port
       If result = 1 then leave
    End
End

If system = 'CLOSED' then
   Do
     Parse value state_file(pass_file) with rc
     If rc = '' then
        Do
          Call Put_s 'Password file missing' crlf,screen_handle
          Call Put_s 'The password file must exist for CLOSED system operation ...' crlf,screen_handle
          Signal Kill_Host_mode
        End
   End

Parse value state_file(dir_file) with rc
If rc = '' then
   Do
     Call Put_s 'Directory file missing ...' crlf,screen_handle
     Signal Kill_Host_mode
   End
i=0
Do until lines(dir_file) = 0
   Parse value linein(dir_file) with temp_line
   If substr(temp_line,1,1) = '*' then iterate
   i=i+1
   Parse var temp_line dir_line.i
   Parse var dir_line.i dir_name.i dir_desc.i
   tempname = pos("\",dir_name.i)
   If tempname = 0 then dir_name.i = dir_name.i||'\'
   dir_desc.i = space(dir_desc.i)
   dir_name.i = translate(dir_name.i)
End
dir_line.0 = i
Parse value stream(dir_file,"c","close") with rc

Parse value Directory(dir_name.1) with default_dir
If default_dir \= '' then
   Do
     Call Clear
     Call Put_s 'Default directory changed to' default_dir crlf,screen_handle
   End
   Else do
     Call Clear
     Call Put_s 'Default directory' default_dir 'not found ...' crlf,screen_handle
     Signal Kill_Host_mode
   End

If upload_dir \= '' then Call Set_Download_Path upload_dir,dde_output


Connection_Pending:
Call Put_s 'PMCOMM now running in HOST mode' crlf crlf,screen_handle
Call Put_s 'Waiting for connection ...' crlf,screen_handle
Call read_timeout "60000",port
If connection = 'MODEM' then
  Do
    If baud = "AUTO" then
    Do
       Do Forever
          Call Wait_fore '1200','2400','4800','9600',port,screen_handle
          match = result
          Select
               When match = 0 then iterate
               When match = 1 then Call Setcom "1200","N","8","1",port
               When match = 2 then Call Setcom "2400","N","8","1",port
               When match = 3 then Call Setcom "4800","N","8","1",port
               When match = 4 then Call Setcom "9600","N","8","1",port
               Otherwise nop
          End
       Leave
       End
    End
    Else Do
       Call Setcom baud,"N","8","1",port
       Do Forever
          Call Wait_fore 'CONNECT',port,screen_handle
          If result = 1 then leave
       End
     End
End

Call Sleep "5000"
Parse value Header(header_file) with rc
invalid_login_count = 0

Sign_on:
Do Forever
fname = '' ; lname = '' ; pword = '' ; nuser = 'N'
Parse value read_with_echo("Your first name?-> ") with rc fname .
If rc \=0 then leave main
If fname = '' then iterate
Parse value read_with_echo(" Your last name?-> ") with rc lname .
If rc \=0 then leave main
If lname = '' then iterate

Parse value read_password_file(pass_file) with rc priv protocol r_pass total_logins last_login
If rc \= 0  then
 Do
   If system = 'OPEN' then
      Do
         Parse value read_with_echo(fname lname||", correct - [Y]es or [Return], [N]o?->") with rc okname .
         If rc \=0 then leave main
         If okname \= 'Y' & okname \= '' then iterate
         Parse value Header(newuser_file) with rc
         Parse value read_with_echo("Would you like to register - [Y]es or [Return], [N]o?->") with rc nuser .
         If rc \=0 then leave main
         If nuser \= 'Y' & nuser \= '' then leave main
         r_pass = ''
      End
      Else Do
         Call Put_s crlf||"Closed System, no access allowed" crlf,port
         Call Put_s crlf||"Closed System, no access allowed" crlf,screen_handle
         Leave main
      End
 End

Parse value read_without_echo("Enter your password (.'s will echo)-> ") with rc pword .
If pword = '' then iterate
If rc \=0 then leave main
If r_pass = '' then r_pass = pword
If nuser  = 'Y' | nuser = '' then Call Add_password_file(pass_file)
If pword \== r_pass then
  Do
    If invalid_login_count = max_attempts then leave main
    Call Put_s crlf||"Invalid Login Attempt - Try again" crlf,port
    Call Put_s crlf||"Invalid Login Attempt - Try again" crlf,screen_handle
    invalid_login_count = invalid_login_count + 1
    Iterate
End
Leave
End

login_msg = "Login by" fname "at" time('C') 'on' date('L') ', last login was on' last_login
Call Put_s crlf crlf||login_msg crlf,port
Call Put_s crlf crlf||Login_msg crlf,screen_handle
Call Audit(date('L') time('C') "- Login by" fname lname)
rc = time("R")

Menu_loop:

Do Forever
Call Put_s crlf crlf, port
Call Put_s crlf crlf, screen_handle

Call Build_Menu

cmdline = ''
heading = crlf crlf crlf center("--- Main Options Menu ---",79)
Call Put_s heading crlf crlf,port
Call Put_s heading crlf,screen_handle
Do i = 1  by 2 to num_of_cmds
   j=i+1
   line = overlay(cmd_name.j cmd_desc.j,cmd_name.i cmd_desc.i,40)
   Call Put_s line crlf,port
   Call Put_s line crlf,screen_handle
   cmdline = cmdline substr(cmd_name.i,2,1) substr(cmd_name.j,2,1)
End
cmdline = space(cmdline,1,',')
Parse value read_with_echo("Enter choice" cmdline||"?-> ") with rc pick .
If rc \= 0 then leave main
If pick = '' then iterate
if  pos(pick, cmd_reqs) = 0  then  iterate

Select
     When pick = "C" then Parse value Change_Dir() with rc
     When pick = "D" then Parse value File_Transfer("DOWNLOAD") with rc
     When pick = "F" then Parse value List_Files() with rc
     When pick = "G" then Parse value Good_Bye() with rc
     When pick = "H" then Parse value Help_Text() with rc
     When pick = "I" then Parse value User_Information() with rc
     When pick = "L" then Parse value List_Directories() with rc
     When pick = "S" then Parse value Shell_OS2() with rc
     When pick = "T" then Signal Kill_Host_Mode
     When pick = "U" then Parse value File_Transfer("UPLOAD") with rc
     Otherwise iterate
End
If rc \=0 then leave main
End

Call Clear_buffer
Call Drop_DTR port
Call Sleep "2000"
Call Raise_DTR port
Call Put_s crlf||'PMComm Host Mode Recycling' crlf,screen_handle

End

Call Clear_buffer
Call Drop_DTR port
Call Sleep "2000"
Call Raise_DTR port
Call Put_s crlf||'PMComm Host Mode Recycling' crlf,screen_handle
Signal Begin




/*  Here are all the subroutines that the MAINLINE section of HOST   */
/*  uses.  HOST  mode is structured so that all call return to the   */
/*  main loop(s).                                                    */

/* Clear Screen Routine                                              */
Clear: Procedure expose (expose_list)
Call put_s "1b5b324a"x,screen_handle
Call put_s "1b5b324a"x,screen_handle
Call put_s "1b5b324a"x,port
Call put_s "1b5b324a"x,port
Return


/* Standard handler for SIGNAL on ERROR, will help in the debuging   */
syntax_error:
fp = filespec("path",fn)
fd = filespec("drive",fn)
errormsg='REXX error' rc 'in line' sigl':' errortext(rc)
errorfile = fd||fp||"SCRIPT.ERR"
rc = lineout(errorfile,date() time() fn '-' errormsg)
rc = lineout(errorfile,date() time() fn '-' sourceline(sigl))
Exit


/* Standard file transfer routine for all protocols that PMCOMM has  */
File_Transfer: Procedure expose (expose_list)
Parse arg direction

Do i=1 until i=dir_line.0
   If default_dir = dir_name.i then
      Do
         Call Put_s crlf||'Current directory is ['||i||'] -' dir_desc.i crlf,port
         Call Put_s crlf||'Current directory is ['||i||'] -' dir_desc.i crlf,screen_handle
         i = 0
         Leave
      End
End
If i \=0 then
   Do
      Call Put_s crlf||"Current directory is " default_dir crlf,port
      Call Put_s crlf||"Current directory is " default_dir crlf,screen_handle
   End

If protocol \= 'NONE' then
   Do
      Call Put_s "Current file transfer protocol is" protocol crlf,port
      Call Put_s "Current file transfer protocol is" protocol crlf,screen_handle
      t_protocol = protocol
   End
Do Forever
  Parse value read_with_echo("Enter file name or Tap [Return] to abort?-> ") with rc dfn .
  If rc \=0 then return rc
  Parse var dfn fn '.' ft
  If dfn = '' then return 0
  If ft = '' then
     Do
       Call Put_s crlf||"Invalid filename ..." crlf,port
       Call Put_s crlf||"Invalid filename ..." crlf,screen_handle
       Iterate
     End
  If direction = "DOWNLOAD" then
     Do
       tempname = reverse(default_dir)
       If pos("\",tempname) = 1 then file_name = default_dir||dfn
          else file_name = default_dir||"\"||dfn
       Parse value State_file(file_name) with rc
       If rc = '' then
          Do
            Call Put_s crlf||"File not found ..." crlf,port
            Call Put_s crlf||"File not found ..." crlf,screen_handle
            Iterate
          End
     End
  If direction = "UPLOAD" then
     Do
       tempname = reverse(default_dir)
       If pos("\",tempname) = 1 then file_name = default_dir||dfn
          else file_name = default_dir||"\"||dfn
       Parse value State_file(file_name) with rc
       If rc = file_name then
          Do
            Call Put_s crlf||"File already exists ..." crlf,port
            Call Put_s crlf||"File already exists ..." crlf,screen_handle
            Iterate
          End
     End
Leave
End

Parse value read_with_echo("Logoff after file transfer - [N]o or [Return], [Y]?-> ") with rc auto .
If rc \=0 then return rc
If protocol = 'NONE' then
   Do
      Parse value Set_protocol('NONE') with rc
      t_protocol = protocol
      protocol = 'NONE'
   End

Select
    When t_protocol = "XMODEM" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call xmodem_chk_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "XMODEM" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call xmodem_chk_receive file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "XMODEM-CRC" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call xmodem_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "XMODEM-CRC" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call xmodem_receive file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "XMODEM-1K" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call xmodem_1k_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "XMODEM-1K" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call xmodem_1k_receive file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "YMODEM" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call ymodem_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "YMODEM" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call ymodem_receive dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "YMODEMG" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call ymodemg_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "YMODEMG" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call ymodemg_receive dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "KERMIT" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call kermit_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "KERMIT" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call kermit_receive dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "ZMODEM" & direction = "DOWNLOAD"  then
         do
            Call Put_s crlf||"Ready to send file ..." crlf,port
            Call Put_s crlf||"Ready to send file ..." crlf,screen_handle
            Call zmodem_send file_name,dde_output,dde_input
            ft_rc = result
         end
    When t_protocol = "ZMODEM" & direction = "UPLOAD"  then
         do
            Call Put_s crlf||"Ready to receive file ..." crlf,port
            Call Put_s crlf||"Ready to receive file ..." crlf,screen_handle
            Call zmodem_receive dde_output,dde_input
            ft_rc = result
         end
    Otherwise return 0
    End

If ft_rc \= 0 then
   Do
     Call Sleep "3000"
     Call Put_s crlf||'File transfer complete 'ft_rc||crlf,port
     Call Put_s crlf||'File transfer complete 'ft_rc||crlf,screen_handle
     If auto = "Y" then
        Do
          Parse value Good_bye() with rcode
          return rcode
        End
     return 0
   End
   Else do
     Call Sleep "3000"
     Call Put_s crlf||'File transfer aborted' crlf,port
     Call Put_s crlf||'File transfer aborted' crlf,screen_handle
     If auto = "Y" then
        Do
          Parse value Good_bye() with rcode
          return rcode
        End
     return 0
   End


Read_with_echo: Procedure expose (expose_list)
Parse arg screen_output

Call Clear_buffer
Call Read_timeout '3000',port
Call Put_s crlf||screen_output,port
Call Put_s crlf||screen_output,screen_handle
line = ''
j=0
time_out = 0

Do Forever
Parse value  Get_CH(port) with char_in
If connection = 'MODEM' then
  Do
    Call DCD port
    If result = 0 then return 99
  End

If char_in = "-1" then
   Do
     time_out = time_out+1
     If time_out = 60 then
        Do
           Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,port
           Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,screen_handle
           Parse value Good_bye() with rcode
           return rcode
        End
     Iterate
   End

If char_in = cr then
   Do
     Call Put_s crlf,port
     Call Put_s crlf,screen_handle
     line = space(line)
     line = translate(line)
     return 0 line
   End

If char_in = bs then
   Do
     If j > 0 then
       Do
         line = delstr(line,j,1)
         Call Put_s bs,port
         Call Put_s bs,screen_handle
         j=j-1
       End
   End
   Else Do
     line = line||char_in
     Call Put_s char_in,port
     Call Put_s char_in,screen_handle
     j=j+1
   End
End


Read_without_Echo: Procedure expose (expose_list)
Parse arg screen_output

Call Clear_buffer
Call Read_timeout '3000',port
Call Put_s crlf||screen_output,port
Call Put_s crlf||screen_output,screen_handle
line = ''
j=0
time_out = 0

Do Forever
Parse value  Get_CH(port) with char_in
If connection = 'MODEM' then
  Do
    Call DCD port
    If result = 0 then return 99
  End

If char_in = "-1" then
   Do
     time_out = time_out+1
     If time_out = 60 then
        Do
           Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,port
           Call Put_s crlf crlf||"Session being cancelled due to inactivity" crlf,screen_handle
           Parse value Good_bye() with rcode
           return rcode
        End
     Iterate
   End

If char_in = cr then
   Do
     Call Put_s crlf,port
     Call Put_s crlf,screen_handle
     line = space(line)
     line = translate(line)
     return 0 line
   End

If char_in = bs then
   Do
     If j > 0 then
       Do
         line = delstr(line,j,1)
         Call Put_s bs,port
         Call Put_s bs,screen_handle
         j=j-1
       End
   End
   Else Do
     line = line||char_in
     Call Put_s ".",port
     Call Put_s char_in,screen_handle
     j=j+1
   End
End


Clear_buffer: Procedure expose (expose_list)
Call Read_timeout '0',port
Do Forever
   Parse value Get_CH(port) with rc
   If rc = "-1" then return
End
Return


Help_text: Procedure expose (expose_list)
Parse value Header(help_file) with rc
If rc \=0 then
   Do
      Call put_s crlf||'Help file not available ...' crlf,port
      Call put_s crlf||'Help file not available ...' crlf,screen_handle
   End
Return 0


Read_password_file: Procedure expose (expose_list)
Parse arg pass_file
protocol = "NONE"
r_fname = '' ; r_lname = '' ; r_pass = '' ; r_priv = ''
r_protocol = protocol ; r_total_logins = '' ; r_last_login = ''
Do until lines(pass_file) = 0
   Parse value linein(pass_file) with pass_line
   If substr(pass_line,1,1) = '*' then iterate
   Parse upper var pass_line r_fname r_lname r_pass r_priv r_protocol r_total_logins r_last_login
   If fname \== r_fname | lname \== r_lname then iterate
   If r_protocol = '' then r_protocol = protocol
   If r_total_logins = '' then r_total_logins = 0
   r_total_logins = r_total_logins + 1
   If r_last_login = '' then r_last_login = 'UNKNOWN'
   Parse value stream(pass_file,"c","close") with rc
   return 0 r_priv r_protocol r_pass r_total_logins r_last_login
End
Parse value stream(pass_file,"c","close") with rc
Return 99 1 protocol 'DUMMY' 1 date('L')


Update_Password_file: Procedure expose (expose_list)
Parse arg pass_file temp_file
Do until lines(pass_file) = 0
   Parse value linein(pass_file) with pass_line
   Parse upper var pass_line r_fname r_lname r_pass r_priv .
   If fname \== r_fname | lname \== r_lname then
      Do
        Parse value lineout(temp_file,pass_line) with rc
      End
      Else Do
        last_login = Date('L')
        pass_line = r_fname r_lname pword r_priv protocol total_logins last_login
        Parse value lineout(temp_file,pass_line) with rc
      End
End
Parse value stream(pass_file,"c","close") with rc
Parse value stream(temp_file,"c","close") with rc
Address CMD "ERASE" pass_file
pass_name = filespec("name",pass_file)
Address CMD "RENAME" temp_file pass_name
Return 0


Add_Password_file: Procedure expose (expose_list)
Parse arg pass_file
pass_line = fname lname pword 1 protocol 1 date('L')
Parse value lineout(pass_file,pass_line) with rc
Parse value stream(pass_file,"c","close") with rc
Return 0


Header: Procedure expose (expose_list)
Parse arg text_file
Parse value state_file(text_file) with rc
If rc = '' then return 99
Call put_s crlf,port
Call put_s crlf,screen_handle
Do until lines(text_file) = 0
   Parse value linein(text_file) with head_line
   If substr(head_line,1,1) = '*' then iterate
   Call put_s head_line crlf,port
   Call put_s head_line crlf,screen_handle
End
Parse value stream(text_file,"c","close") with rc
Return 0


Audit: Procedure expose (expose_list)
Parse arg audit_record
Parse value lineout(audit_file,audit_record) with rc
Return rc


Build_Menu: Procedure expose (expose_list)
command_tbl.   = ''
command_tbl.1  = "[C]hange Active Directory (or drive) ; 5"
command_tbl.2  = "[D]ownload A File ; 1"
command_tbl.3  = "[F]iles (List current directory) ; 1"
command_tbl.4  = "[G]oodbye (Disconnect) ; 0"
command_tbl.5  = "[H]elp (Main command help) ; 0"
command_tbl.6  = "[I]nformation (User defaults) ; 0"
command_tbl.7  = "[L]ist File Directories ; 0"
command_tbl.8  = "[S]hell To OS/2 ; 9"
command_tbl.9  = "[T]erminate Host mode ; 9"
command_tbl.10 = "[U]pload A File ; 1"

cmd_desc. = ''
cmd_name. = ''
cmd_reqs  = ''

j = 0
Do i = 1 until command_tbl.i = ''
   Parse var command_tbl.i tbl_command tbl_desc ';' tbl_priv
   If tbl_priv > priv then iterate

   /*==================================================================*/
   /*  Look for "[" in command Next Letter is Command, Save this       */
   /*       command character for later checking                       */
   /*==================================================================*/
   start = pos('[', tbl_command) + 1
   cmd_reqs = cmd_reqs || substr(tbl_command, start, 1)

   j = j + 1
   cmd_name.j = tbl_command
   cmd_desc.j = tbl_desc
End
num_of_cmds = j
Return


List_files: Procedure expose (expose_list)
Parse value read_with_echo("Enter wildcard for files or Tap [Return] for ALL files?-> ") with rc wildcard .
If rc \=0 then return rc

Do i=1 until i=dir_line.0
   If default_dir = dir_name.i then
      Do
         Call Put_s crlf||'Directory ['||i||'] -' dir_desc.i crlf,port
         Call Put_s crlf||'Directory ['||i||'] -' dir_desc.i crlf,screen_handle
         Leave
      End
End

queue = 'PMCOMMQ'
rc = rxqueue('delete',queue)
rc = rxqueue('create',queue)
rc = rxqueue('set',queue)
Address CMD 'DIR' wildcard '/N 2>NUL | RXQUEUE' queue
If queued() <= 5 then
   Do
     Call put_s crlf||'No files Found or Directory Empty' crlf,port
     Call put_s crlf||'No Files Found or Directory Empty' crlf,screen_handle
     rc = rxqueue('delete',queue)
     Return 0
   End
Do 4
   Parse pull .
End
Do i=1 until queued()-1 <= 0
   Parse pull d_date d_time d_bytes . d_file
   If priv < 5 & datatype(d_bytes,'N') = 0 then iterate
    outline = left(d_file,13) right(d_bytes,8) right(d_date,10)
    Call Put_s outline crlf,port
    Call Put_s outline crlf,screen_handle
    x = i // 21
    If x = 0 then
      Do
        Parse value read_with_echo("More - Tap [Return] to continue or Q to abort?-> ") with rc more .
        If rc \=0 then return rc
        If more \= '' then leave
      End
End
rc = rxqueue('delete',queue)
Return 0


List_Directories: Procedure expose (expose_list)
Do forever
Parse value read_with_echo("List - [1.."||dir_line.0||"], [L]ist, [Return] to abort?-> ") with rc func .
If rc \=0 then return rc
If func = '' then return 0
If func = 'L' then
  Do
    Do i=1 until i=dir_line.0
       Call Put_s '['||i||']' dir_desc.i crlf,port
       Call Put_s '['||i||']' dir_desc.i crlf,screen_handle
       x = i // 21
       If x = 0 then
         Do
            Parse value read_with_echo("More - Tap [Return] to continue or Tap Any Key to abort?-> ") with rc more .
            If rc \=0 then return rc
            If more \= '' then leave
         End
    End
Iterate
End

If datatype(func,'N')=1 then
   Do
     If func > 0 & func <= dir_line.0 then
        Do
           Parse value directory(dir_name.func) with default_dir
           Parse value List_Files() with rc
        End
   End
Iterate
End
Return 0


Change_dir: Procedure expose (expose_list)
Parse value directory() with default_dir

Call Put_s crlf||"Current directory is " default_dir crlf,port
Call Put_s crlf||"Current directory is " default_dir crlf,screen_handle
Do Forever
  Parse value read_with_echo("Enter new directory name or Tap [Return] to abort?-> ") with rc newdir .
  If rc \=0 then return rc
  If newdir = '' then return 0
  Parse value directory(newdir) with tempdir
  If tempdir  \= '' then
     Do
       Call Put_s 'Default directory changed to' newdir crlf,port
       Call Put_s 'Default directory changed to' newdir crlf,screen_handle
       default_dir = newdir
       upload_dir  = newdir
       Call Set_Download_Path newdir,dde_output
     End
       Else do
       Call Clear
       Call Put_s crlf||'Directory' newdir 'not found ...' crlf,port
       Call Put_s crlf||'Directory' newdir 'not found ...' crlf,screen_handle
       Iterate
     End
  Return 0
End


Set_protocol: Procedure expose (expose_list)
protocol_sel = "[X]modem [C]rc-Xmodem [1]k-Xmodem [B]atch-Ymodem [Y]modem-G [K]ermit [Z]modem [N]one"
Parse arg call_type
If call_type = '' then
   Do
     Call Put_s crlf||"Current file transfer protocol is" protocol crlf,port
     Call Put_s crlf||"Current file transfer protocol is" protocol crlf,screen_handle
   End
   Else Do
     Call Put_s crlf crlf,port
     Call Put_s crlf,screen_handle
   End

cmdline = ''
Do i = 1 to words(protocol_sel)
   Call Put_s word(protocol_sel,i) crlf ,port
   Call Put_s word(protocol_sel,i) crlf ,screen_handle
   cmdline = cmdline substr(word(protocol_sel,i),2,1)
End
cmdline = space(cmdline,1,',')

Do Forever
  Parse value read_with_echo("Enter choice" cmdline "or Tap [Return] to abort?-> ") with rc pick .
  If rc \=0 then return rc
  If pick = '' then return 0
  Select
       When pick = "X" then protocol = "XMODEM"
       When pick = "C" then protocol = "XMODEM-CRC"
       When pick = "1" then protocol = "XMODEM-1K"
       When pick = "B" then protocol = "YMODEM"
       When pick = "Y" then protocol = "YMODEMG"
       When pick = "Z" then protocol = "ZMODEM"
       When pick = "K" then protocol = "KERMIT"
       When pick = "N" then protocol = "NONE"
       Otherwise iterate
  End
  Leave
End
Return 0


Set_password: Procedure expose (expose_list)
Parse value read_with_echo("Enter new password or Tap [Return] to abort?-> ") with rc tword .
If rc \=0 then return rc
If tword = '' then return 0
pword = tword
Call Update_password_file(pass_file temp_file)
Call Put_s crlf||'Password changed ...' crlf crlf,port
Call Put_s crlf||'Password changed ...' crlf crlf,screen_handle
Return 0


Shell_OS2: Procedure expose (expose_list)
Call OS2_Shell port,port
Return 0


User_Information: Procedure expose (expose_list)
Call Put_s 'Information - Self User Alterations' crlf crlf,port
Call Put_s 'Information - Self User Alterations' crlf crlf,screen_handle
Call Put_s "- First name ... :" fname crlf,port
Call Put_s "- First name ... :" fname crlf,screen_handle
Call Put_s "- Last name .... :" lname crlf,port
Call Put_s "- Last name .... :" lname crlf,screen_handle
Call Put_s "- Password ..... :" pword crlf,port
Call Put_s "- Password ..... :" pword crlf,screen_handle
Call Put_s "- Trans Protocol :" protocol crlf,port
Call Put_s "- Trans Protocol :" protocol crlf,screen_handle
Call Put_s "- Privilage .... :" priv crlf,port
Call Put_s "- Privilage .... :" priv crlf,screen_handle
Call Put_s "- Directory .... :" default_dir crlf crlf,port
Call Put_s "- Directory .... :" default_dir crlf crlf,screen_handle
Call Put_s "- Last call was on" last_login crlf,port
Call Put_s "- Last call was on" last_login crlf,screen_handle
Call Put_s "- Total number of calls todate is" total_logins crlf crlf,port
Call Put_s "- Total number of calls todate is" total_logins crlf crlf,screen_handle
Call Put_s "- Current date is" date() ", current time is" time('C') crlf,port
Call Put_s "- Current date is" date() ", current time is" time('C') crlf,screen_handle
Call Put_s "- Elapsed time this call is" time("E")%60 "minute(s)" crlf,port
Call Put_s "- Elapsed time this call is" time("E")%60 "minute(s)" crlf,screen_handle


Parse value read_with_echo("User Alterations - [P]assword, [T]rans, [Return] to quit?->") with rc attr
If rc \=0 then return rc
Select
  When attr = 'T' then Parse value Set_protocol('NONE') with rc
  When attr = 'P' then Parse value Set_password() with rc
  Otherwise return 0
End
Return rc


State_file: Procedure
Parse arg file_name
If file_name = '' then return file_name
return(stream(file_name,'c','query exists'))


Good_Bye: Procedure expose (expose_list)
If fname = '' | lname = '' then return 99
Call Put_s crlf||time("E")%60 "minute(s) logged this time." crlf,port
Call Put_s crlf||time("E")%60 "minute(s) logged this time." crlf,screen_handle
Call Put_s "Tap [Enter] to LogOff now." crlf,port
Call Put_s "Tap [Enter] to LogOff now." crlf,screen_handle
Call Put_s "Tap [Esc] to abort LogOff." crlf crlf,port
Call Put_s "Tap [Esc] to abort LogOff." crlf crlf,screen_handle
Call Clear_Buffer
Call Read_timeout "1000",port
Do i=9 by -1 until i = 0
  Call Put_s "Hanging up in :" i "seconds" cr,port
  Call Put_s "Hanging up in :" i "seconds" cr,screen_handle
  Parse value Get_CH(port) with char_in
  If char_in = "-1" then iterate
  If char_in = esc then return 0
  Leave
End
Call Put_s crlf||"Loggoff for" fname lname "complete" crlf,port
Call Put_s crlf||"Loggoff for" fname lname "complete" crlf ,screen_handle
Call Audit(date() time('C') "- Logoff by" fname lname)
Call Update_Password_file(pass_file temp_file)
Return 99


Kill_host_mode:
Parse value directory(orgdir) with rc
Call Put_s crlf||"Directory reset to" orgdir crlf,screen_handle
Call Put_s "PMComm Host Mode Terminating ..." crlf,port
Call Put_s "PMComm Host Mode Terminating ..." crlf,screen_handle
If connection = 'MODEM' then
  Do
    Call Clear_buffer
    Call Drop_DTR port
    Call Sleep "2000"
    Call Raise_DTR port
    Call Put_s 'ATZ'||cr,port
    Call wait_for "OK",port
    Call Sleep "2000"
  End
Exit