home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / comm / pwhostb.zip / HOST.WAS < prev    next >
Text File  |  1992-10-02  |  39KB  |  1,130 lines
  1. ;Host Mode script
  2.  
  3. ;***********************************************************************
  4. ;*                                                                     *   
  5. ;* HOST.WAS                                                            *
  6. ;* Copyright (C) 1992 Datastorm Technologies, Inc.                     *     
  7. ;* All rights reserverd.                                               * 
  8. ;*                                                                     * 
  9. ;* Purpose: Provides an interface for a remote user to send and        *
  10. ;*          receive files and electronic mail.                         *
  11. ;*                                                                     * 
  12. ;***********************************************************************
  13.  
  14. ;***********************************************************************
  15. ;*                                                                     *
  16. ;*  WARNING!!!!                                                        *
  17. ;*                                                                     *
  18. ;*  Do not modify this script file unless you have a good under-       *
  19. ;*  standing of the Windows ASPECT language.  If you do modify this    *
  20. ;*  script, PLEASE MAKE A BACKUP before doing so.                      *
  21. ;*                                                                     *
  22. ;***********************************************************************
  23.  
  24. ;***********************************************************************
  25. ;*                                                                     *
  26. ;*   MACRO DEFINITIONS                                                 *
  27. ;*                                                                     *
  28. ;***********************************************************************
  29. #define FALSE 0         ; Boolean variables
  30. #define TRUE  1         ;
  31.  
  32. #define NAMEMAX 30      ; maximum length for user name
  33. #define PSWDMAX 8       ; maximum user passwrd length
  34.  
  35. #define DISP 1          ; show characters for input
  36. #define MASK 0          ; hide characters for password input
  37.  
  38. #define MODEM_CON    0  ; Connection type is a MODEM
  39. #define DIRECT_CON   1  ; Connection type is direct cable / no MODEM
  40.  
  41. #define OPEN_SYSTEM   0 ; anyone can login
  42. #define CLOSED_SYSTEM 1 ; only users already in the HOST.USR can login
  43.  
  44. ; access_level levels for users
  45. #define NEWUSER      0  ; new - can't do file xfers
  46. #define REGUSER      1  ; normal-can do file xfers to upload/download areas
  47. #define SUPERUSER    2  ; super-can do file xfers to/from any drive/directory
  48.  
  49. #define FLD_SEP    59   ; Field separator is ACSII 59 (semi-colon)
  50.  
  51. #define HOSTUSRFILE  "HOST.USR" ; User data file
  52. #define HOSTLOGFILE  "HOST.LOG" ; Log of Host activity
  53. #define HOSTPRMFILE  "HOST.PRM" ; Parameter file
  54. #define HOSTHLPFILE  "HOST.HLP" ; Help file
  55. #define HOSTNWSFILE  "HOST.NWS" ; News file
  56. #define HOSTNUFILE   "HOST.NUF" ; New user file
  57. #define HOSTDNLDFILE "HOST.DNL" ; Download file list
  58.  
  59. ;Mail Defines
  60. #define HOSTMSGFILE  "HOST.MSG" ; Mail message file
  61. #define HOSTHDRFILE  "HOST.HDR" ; Mail header file
  62. #define PUBLIC     0    ; Mail message flags
  63. #define PRIVATE    1    ;
  64. #define NEWMAIL    2    ;
  65. #define DELETED    4    ;
  66.  
  67. ;***********************************************************************
  68. ;*                                                                     *
  69. ;*   GLOBAL VARIABLES                                                  *
  70. ;*                                                                     *
  71. ;***********************************************************************
  72. string welcome_msg, upload_path, dnload_path, ontime, offtime
  73. string record, name, first, last, passwrd, access_level, remarks, msg
  74. string logfile, parmfile, usrfile, newsfile, hlpfile, dnldfile
  75. string nufile, _time, _date, message, searchstr
  76. string hdrfile, msgfile, tempfile
  77. integer new_usr_level, connect_type, system_type, goodbye_option
  78. integer old_menu, new_menu, tempkey, status, msg_number
  79. integer action_status, dial_status, setup_status, meta_status
  80. integer local_logon, jump, sysop
  81.  
  82. ;***********************************************************************
  83. ;*                                                                     *   
  84. ;* MAIN                                                                *
  85. ;*                                                                     *
  86. ;* This is the main program loop.                                      *
  87. ;*                                                                     *
  88. ;* Calls: SAVE_PRM, HOSTSETUP, HOSTLOG, WAITFORCALL,  GETUSER,         *
  89. ;*        DISPLAYFILE, CHECKMAIL, HOSTMENU                             *
  90. ;*                                                                     *
  91. ;* Modifies globals: action_status, meta_status, dial_status, name,    *
  92. ;*                   setup_status, jump, local_logon, new_menu, sysop, *
  93. ;*                   connect_type, newsfile, msg, access_level,        *
  94. ;*                   parmfile                                          *
  95. ;*                                                                     *
  96. ;***********************************************************************
  97. #include "SUBS.WAS"             ;host subroutine library
  98. #include "MAIL.WAS"             ;host mail routines
  99.  
  100. proc main
  101.  
  102.    set aspect spawn on                 ; allow spawning of scripts
  103.    fetch aspect scriptpath parmfile    ; build a path to the HOST.PRM
  104.    addfilename parmfile HOSTPRMFILE
  105.  
  106.    if not isfile parmfile              ; if the .PRM doesn't exist
  107.       execute "HOSTUTIL"               ; run HOSTUTIL.WAS
  108.    endif
  109.                                        ; get the status of the
  110.    action_status=$ACTIONBAR            ; programs modeless windows
  111.    meta_status=$METAKEYS
  112.    dial_status=$DIALDIR
  113.    setup_status=$SETUP
  114.    if action_status                    ; if action bar is on
  115.       actionbar off                    ;  turn it off
  116.     endif
  117.    if meta_status                      ; if metakeys are on
  118.       metakeys off                     ;  turn them off
  119.    endif
  120.  
  121.    if dial_status                      ; if dialing directory is on
  122.       dialdir off                      ;  turn it off
  123.    endif
  124.  
  125.    if setup_status                     ; if setup is on
  126.       setup off                        ;  turn it off
  127.    endif
  128.  
  129.    while 1
  130.       statmsg " "
  131.       setjmp 1 jump
  132.       HostSetup()            ; set system variables and open HOST.PRM
  133.       HostLog("Host mode online.", "")
  134.       pwtitlebar "PROCOMM PLUS for Windows - Host Mode 1A"
  135.       WaitForCall()
  136.  
  137.       if local_logon
  138.          menuitem new_menu 3 "&Recycle!"
  139.          showmenu new_menu
  140.       else
  141.          enable menu 2
  142.       endif
  143.  
  144.       menuitem new_menu 4 "E&xit Host!"
  145.       showmenu new_menu
  146.  
  147.       if !sysop
  148.          GetUser()               ; Wait for someone to login
  149.          if success              ; If user logged on,
  150.             if (! $carrier) && (connect_type==MODEM_CON)
  151.                HostLog("Lost Carrier.", "")
  152.                loopwhile
  153.             endif
  154.             DisplayFile(newsfile, 23)
  155.             strfmt msg "Remote user %s online" name
  156.             pwtitlebar msg
  157.             if local_logon
  158.                HostLog(name, "logged in locally.")
  159.             else
  160.                HostLog(name, "logged in.")
  161.             endif
  162.             CheckMail()
  163.             HostMenu()
  164.          endif
  165.       else
  166.          name = "SYSOP"
  167.          access_level="2"
  168.          CheckMail()
  169.          HostMenu()
  170.       endif
  171.    endwhile
  172. endproc
  173.  
  174. ;***********************************************************************
  175. ;*                                                                     *   
  176. ;* HOSTMENU                                                            *
  177. ;*                                                                     *
  178. ;* This procedure is the main menu for the remote user.                *
  179. ;*                                                                     *
  180. ;*                                                                     * 
  181. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, DISPLAYFILE,        *
  182. ;*        FILELIST, UPLOAD, DOWNLOAD, CHAT, READMAIL, LEAVEMAIL,       *
  183. ;*        HOSTHANGUP, EXITHOST, HOSTGETYN, RESTORE_PRM, SWITCHDIR      *
  184. ;*                                                                     *
  185. ;* Modifies globals: access_level, connect_type, dnldfile, local_logon,*
  186. ;*                   hlpfile, offtime, ontime, goodbye_option, name,   *
  187. ;*                   action_status, meta_status,  dial_status,         *
  188. ;*                   setup_status                                      *
  189. ;*                                                                     *
  190. ;***********************************************************************
  191. proc HostMenu
  192. integer security
  193. string key, auto_ans_off
  194.    ;convert access_level level into an integer
  195.    atoi access_level security
  196.  
  197.    set txpace 0
  198.    while 1
  199.       HostPutS("`r`n")
  200.       HostPutS("`r`nF)iles      U)pload      D)ownload")
  201.       HostPutS("`r`nH)elp       T)ime        C)hat")
  202.       HostPutS("`r`nR)ead mail  L)eave mail  G)oodbye")
  203.  
  204.       if security==2
  205.          HostPutS("`r`n`r`nS)witch directory")
  206.          HostPutS("`r`nO)perating System Shell")
  207.          HostPutS("`r`nA)bort (SHUT DOWN host mode)")
  208.       endif
  209.  
  210.       HostPutS("`r`n`r`nYour Choice? ")
  211.  
  212.       if (! $carrier) && (connect_type==MODEM_CON)
  213.          HostLog("Lost Carrier", "")
  214.          SetFailure()
  215.          exitwhile
  216.       endif
  217.  
  218.       HostGetC(&key)
  219.       if failure
  220.          exitwhile
  221.       endif
  222.  
  223.       HostPutS(key)
  224.  
  225.       switch key
  226. ;****************
  227. ;* F)iles       *
  228. ;****************
  229.          case "F"
  230.             if security!=2
  231.                fetch aspect scriptpath dnldfile
  232.                addfilename dnldfile HOSTDNLDFILE
  233.                DisplayFile(dnldfile, 23)
  234.                if not success
  235.                   FileList()
  236.                endif
  237.             else
  238.                FileList()
  239.             endif
  240.          endcase
  241. ;****************
  242. ;* U)pload      *
  243. ;****************
  244.          case "U"
  245.             if local_logon
  246.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  247.             else
  248.                if security==0
  249.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  250.                else
  251.                   Upload()
  252.                endif
  253.             endif
  254.          endcase
  255. ;****************
  256. ;* D)ownload    *
  257. ;****************
  258.          case "D"
  259.             if local_logon
  260.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  261.             else
  262.                if security==0
  263.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  264.                else
  265.                   Download()
  266.                endif
  267.             endif
  268.          endcase
  269. ;****************
  270. ;* H)elp        *
  271. ;****************
  272.          case "H"
  273.             fetch aspect scriptpath hlpfile
  274.             addfilename hlpfile HOSTHLPFILE
  275.             DisplayFile(hlpfile, 23)
  276.             if not success
  277.                HostPutS("`r`nHelp not available.`r`n")
  278.             endif
  279.          endcase
  280. ;****************
  281. ;* T)ime        *
  282. ;****************
  283.          case "T"
  284.             time offtime
  285.             HostPutS("`r`n`r`nOnline at: ")
  286.             HostPutS(ontime)
  287.             HostPutS("`r`nIt is now: ")
  288.             HostPuts(offtime)
  289.             HostPutS("`r`n`r`n")
  290.          endcase
  291. ;****************
  292. ;* C)hat        *
  293. ;****************
  294.          case "C"
  295.             if local_logon
  296.                HostPutS("`r`n`r`nYou can't chat during a local logon!`r`n`r`n")
  297.             else
  298.                Chat()
  299.             endif
  300.          endcase
  301. ;****************
  302. ;* R)ead Mail   *
  303. ;****************
  304.          case "R"
  305.             ReadMail()
  306.          endcase
  307. ;****************
  308. ;* L)eave Mail  *
  309. ;****************
  310.          case "L"
  311.             LeaveMail(0,"", "")
  312.          endcase
  313. ;****************
  314. ;* G)oodbye     *
  315. ;****************
  316.          case "G"                                ;Goodbye
  317.             time offtime
  318.             HostPutS("`r`n`r`nOnline at: ")
  319.             HostPutS(ontime)
  320.             HostPutS("`r`nIt is now: ")
  321.             HostPuts(offtime)
  322.             HostPutS("`r`n`r`n")
  323.                 
  324.             if connect_type==MODEM_CON
  325.                HostHangup()
  326.             endif
  327.             if goodbye_option==1
  328.                clear
  329.                ExitHost()
  330.             endif
  331.             HostLog(name, "logged out.")
  332.             exitwhile
  333.          endcase
  334. ;****************
  335. ; O)perating    *
  336. ;****************
  337.          case "O"
  338.             if security==2
  339.                HostPutS("`r`n`r`nShell to DOS (Y/N)?")
  340.                HostGetYN()
  341.                if success
  342.                   HostPutS("`r`n`r`nShelling to DOS ...`r`n")
  343.                   HostLog(name, "shell to DOS.")
  344.                   execute "redir.wax"
  345.                endif
  346.             endif
  347.          endcase
  348. ;****************
  349. ; A)bort        *
  350. ;****************
  351.          case "A"
  352.             if security==2
  353.                HostPutS("`r`n`r`nAbort Host Mode (Y/N)?")
  354.                HostGetYN()
  355.                if success
  356.                   HostPutS("`r`nAborting ...`r`n")
  357.                   HostLog(name, "remote shutdown.")
  358.                   if connect_type==MODEM_CON
  359.                      HostPutS("`r`nHangup line (Y/N)?")
  360.                      HostGetYN()
  361.                      if success
  362.                         HostHangup()
  363.                         ; get modem auto answer string
  364.                         fetch modem autoansoff auto_ans_off   
  365.                         set txpace 50
  366.                         transmit auto_ans_off
  367.                         waitfor "OK" 5
  368.                         restore_prm()
  369.                      endif
  370.                   endif
  371.                   if action_status
  372.                      actionbar on
  373.                   endif
  374.                   if meta_status
  375.                      metakeys on
  376.                   endif
  377.                   if dial_status
  378.                      dialdir on
  379.                   endif
  380.                   if setup_status
  381.                      setup on
  382.                   endif
  383.                   clear
  384.                   statmsg " "
  385.                   pwtitlebar "PROCOMM PLUS for Windows"
  386.                   halt
  387.                endif
  388.             endif
  389.          endcase
  390. ;****************
  391. ; S)witch       *
  392. ;****************
  393.          case "S"
  394.             if security==2
  395.                SwitchDir()
  396.             endif
  397.          endcase
  398. ;***************
  399.       endswitch
  400.    endwhile
  401. endproc
  402.  
  403. ;***********************************************************************
  404. ;*                                                                     *   
  405. ;* FILELIST                                                            *
  406. ;*                                                                     *
  407. ;* This procedure displays a file directory for the user like the      *
  408. ;* DOS "DIR" command.                                                  *
  409. ;*                                                                     * 
  410. ;* Calls: HOSTPUTS, HOSTGETS, HOSTGETC                                 *
  411. ;*                                                                     *
  412. ;* Modifies globals: access_level, dnload_path,  msg                   *
  413. ;*                                                                     *
  414. ;***********************************************************************
  415. proc FileList
  416. string filespec, filepath, key, dirflag="<DIR>"
  417. integer security, again=0, linenum=1, maxlen=40
  418.     
  419.    atoi access_level security
  420.  
  421.    HostPutS("`r`nEnter FILE SPEC: (Carriage Return = *.*)`r`n> ")
  422.    HostGetS(&filespec, maxlen, DISP)
  423.  
  424.    strcmp filespec ""
  425.    if success
  426.       filespec="*.*"
  427.    endif
  428.  
  429.    if security!=2
  430.       strcpy filepath dnload_path
  431.       addfilename filepath filespec
  432.    else
  433.       getdir 0 filepath
  434.       strfind filespec "\"
  435.       if not found
  436.          addfilename filepath filespec
  437.       else
  438.          strcpy filepath filespec
  439.       endif
  440.    endif
  441.  
  442.    findfirst filepath "D"
  443.    if found
  444.       strfind $FATTR "D"
  445.       if found
  446.          strfmt msg "`r`n`r`n %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  447.       else
  448.          strfmt msg "`r`n`r`n %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  449.       endif
  450.       HostPutS(msg)
  451.       linenum++
  452.       again=1
  453.    else
  454.       HostPutS("`r`n`r`nNo files found.`r`n")
  455.    endif
  456.    while again
  457.       if linenum==23
  458.          linenum=1
  459.          HostPutS("-MORE-")
  460.          HostGetC(&key)
  461.          HostPutS("`b`b`b`b`b`b")
  462.          strupr key
  463.          strcmp key "N"
  464.          if success
  465.             exitwhile
  466.          endif
  467.       endif
  468.  
  469.       findnext
  470.       if found
  471.          strfind $FATTR "D"
  472.          if found
  473.             strfmt msg " %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  474.          else
  475.             strfmt msg " %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  476.          endif
  477.          HostPutS(msg)
  478.          linenum++
  479.       else
  480.          HostPutS("`r`n-End of list.-`r`n")
  481.          exitwhile
  482.       endif
  483.    endwhile
  484. endproc
  485.  
  486. ;***********************************************************************
  487. ;*                                                                     *   
  488. ;* UPLOAD                                                              *
  489. ;*                                                                     *
  490. ;* This procedure provides a menu for the remote user to send files    *
  491. ;* to the host system.                                                 *
  492. ;*                                                                     * 
  493. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  494. ;*        ISWILDCARD, TXWAIT                                           *
  495. ;*                                                                     *
  496. ;* Modifies globals: connect_type, status, msg, name                   *
  497. ;*                                                                     *
  498. ;***********************************************************************
  499. proc upload
  500. string filename, choice
  501. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  502.  
  503. integer calledfrom = 0
  504.  
  505.    while 1
  506.       HostPutS("`r`n")
  507.       HostPutS("`r`nK) Kermit      X) Xmodem")
  508.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  509.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  510.       HostPutS("`r`nZ) Zmodem")
  511.       HostPutS("`r`n")
  512.       HostPutS("`r`nYour choice? ")
  513.  
  514.       if (! $carrier) && (connect_type==MODEM_CON)
  515.          HostLog("Lost Carrier", "")
  516.          SetFailure()
  517.          exitwhile
  518.       endif
  519.       HostGetC(&choice)
  520.       if failure
  521.          exitwhile
  522.       endif
  523.       HostPutS(choice)
  524.  
  525.       switch choice
  526. ;****************
  527. ;* K)ermit      *
  528. ;****************
  529.          case "K"
  530.             GetFname(&filename, calledfrom)
  531.             if failure
  532.                exitwhile
  533.             endif
  534.             HostPutS(xferbegin)
  535.             txwait()
  536.             getfile kermit
  537.          endcase
  538. ;****************
  539. ;* X)modem      *
  540. ;****************
  541.          case "X"
  542.             GetFname(&filename, calledfrom)
  543.             if failure
  544.                exitwhile
  545.             endif
  546.             IsWildcard(&filename)
  547.             if failure
  548.                exitwhile
  549.             endif
  550.             HostPutS(xferbegin)
  551.             txwait()
  552.             getfile xmodem filename
  553.          endcase
  554. ;****************
  555. ;* Z)modem      *
  556. ;****************
  557.          case "Z"
  558.             GetFname(&filename, calledfrom)
  559.             if failure
  560.                exitwhile
  561.             endif
  562.             HostPutS(xferbegin)
  563.             txwait()
  564.             getfile zmodem
  565.          endcase
  566. ;****************
  567. ;* Y)modem      *
  568. ;****************
  569.          case "Y"
  570.             GetFname(&filename, calledfrom)
  571.             if failure
  572.                exitwhile
  573.             endif
  574.             HostPutS(xferbegin)
  575.             txwait()
  576.             getfile ymodem
  577.          endcase
  578. ;****************
  579. ;* O) 1K Xmodem *
  580. ;****************
  581.          case "O"
  582.             GetFname(&filename, calledfrom)
  583.             if failure
  584.                exitwhile
  585.             endif
  586.             IsWildcard(&filename)
  587.             if failure
  588.                exitwhile
  589.             endif
  590.             HostPutS(xferbegin)
  591.             txwait()
  592.             getfile 1kxmodem filename
  593.          endcase
  594. ;****************
  595. ;* E) 1K XmodemG*
  596. ;****************
  597.          case "E"
  598.             GetFname(&filename, calledfrom)
  599.             if failure
  600.                exitwhile
  601.             endif
  602.             IsWildcard(&filename)
  603.             if failure
  604.                exitwhile
  605.             endif
  606.             HostPutS(xferbegin)
  607.             txwait()
  608.             getfile 1kxmodemg filename
  609.          endcase
  610. ;****************
  611. ;* Y)modem-G    *
  612. ;****************
  613.          case "G"
  614.             GetFname(&filename, calledfrom)
  615.             if failure
  616.                exitwhile
  617.             endif
  618.             HostPutS(xferbegin)
  619.             txwait()
  620.             getfile ymodemg
  621.          endcase
  622. ;****************
  623. ;* Default      *
  624. ;****************
  625.          default
  626.             exitwhile
  627.          endcase
  628.       endswitch
  629.  
  630.       pause 1
  631.  
  632.       status=$FILEXFER
  633.     
  634.       while status==1
  635.          ;loop here while xfer is going on
  636.          status=$FILEXFER
  637.       endwhile
  638.  
  639.       if status==2
  640.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  641.          strfmt msg "uploaded %s successfully." filename
  642.          HostLog(name, msg) ;log a sucessful upload
  643.       elseif status==3
  644.          ;log a failed upload
  645.          pause 2
  646.          rxflush
  647.          txflush
  648.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  649.          strfmt msg "failed to upload %s." filename
  650.          HostLog(name, msg) ;log a sucessful upload
  651.       endif
  652.       exitwhile
  653.    endwhile
  654. endproc
  655.  
  656. ;***********************************************************************
  657. ;*                                                                     *   
  658. ;* DOWNLOAD                                                            *
  659. ;*                                                                     *
  660. ;* This procedure provides a menu for the remote user to receive       *
  661. ;* files.                                                              *
  662. ;*                                                                     * 
  663. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  664. ;*        ISWILDCARD, TXWAIT                                           *
  665. ;*                                                                     *
  666. ;* Modifies globals: connect_type, status, msg, name                   *
  667. ;*                                                                     *
  668. ;***********************************************************************
  669. proc download
  670.  
  671. string filename, choice
  672. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  673. integer calledfrom = 1
  674.  
  675.    while 1
  676.       HostPutS("`r`n")
  677.       HostPutS("`r`nK) Kermit      X) Xmodem")
  678.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  679.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  680.       HostPutS("`r`nZ) Zmodem")
  681.       HostPutS("`r`n")
  682.       HostPutS("`r`nYour choice? ")
  683.  
  684.       if (! $carrier) && (connect_type==MODEM_CON)
  685.          HostLog("Lost Carrier", "")
  686.          SetFailure()
  687.          exitwhile
  688.       endif
  689.  
  690.       HostGetC(&choice)
  691.       if failure
  692.          exitwhile
  693.       endif
  694.  
  695.       HostPutS(choice)
  696.  
  697.       switch choice
  698. ;****************
  699. ;* K)ermit      *
  700. ;****************
  701.          case "K"
  702.             GetFname(&filename, calledfrom)
  703.             if failure
  704.                exitwhile
  705.             endif
  706.             HostPutS(xferbegin)
  707.             txwait()
  708.             sendfile kermit filename
  709.          endcase
  710. ;****************
  711. ;* X)modem      *
  712. ;****************
  713.          case "X"
  714.             GetFname(&filename, calledfrom)
  715.             if failure
  716.                exitwhile
  717.             endif
  718.             IsWildcard(&filename)
  719.             if failure
  720.                exitwhile
  721.             endif
  722.             HostPutS(xferbegin)
  723.             txwait()
  724.             sendfile xmodem filename
  725.          endcase
  726. ;****************
  727. ;* Z)modem      *
  728. ;****************
  729.          case "Z"
  730.             GetFname(&filename, calledfrom)
  731.             if failure
  732.                exitwhile
  733.             endif
  734.             HostPutS(xferbegin)
  735.             txwait()
  736.             sendfile zmodem filename
  737.          endcase
  738. ;****************
  739. ;* Y)modem      *
  740. ;****************
  741.          case "Y"
  742.             GetFname(&filename, calledfrom)
  743.             if failure
  744.                exitwhile
  745.             endif
  746.             HostPutS(xferbegin)
  747.             txwait()
  748.             sendfile ymodem filename
  749.          endcase
  750. ;****************
  751. ;* O) 1K Xmodem *
  752. ;****************
  753.          case "O"
  754.             GetFname(&filename, calledfrom)
  755.             if failure
  756.                exitwhile
  757.             endif
  758.             IsWildcard(&filename)
  759.             if failure
  760.                exitwhile
  761.             endif
  762.  
  763.             HostPutS(xferbegin)
  764.             txwait()
  765.             sendfile 1kxmodem filename
  766.          endcase
  767. ;****************
  768. ;* E) 1K XmodemG*
  769. ;****************
  770.          case "E"
  771.             GetFname(&filename, calledfrom)
  772.             if failure
  773.                exitwhile
  774.             endif
  775.             IsWildcard(&filename)
  776.             if failure
  777.                exitwhile
  778.             endif
  779.             HostPutS(xferbegin)
  780.             txwait()
  781.             sendfile 1kxmodemg filename
  782.          endcase
  783. ;****************
  784. ;* Y)modem-G    *
  785. ;****************
  786.          case "G"
  787.             GetFname(&filename, calledfrom)
  788.             if failure
  789.                exitwhile
  790.             endif
  791.             HostPutS(xferbegin)
  792.             txwait()
  793.             sendfile ymodemg filename
  794.          endcase
  795. ;****************
  796. ;* Default      *
  797. ;****************
  798.          default
  799.             exitwhile
  800.          endcase
  801.       endswitch
  802.  
  803.       pause 1
  804.  
  805.       status=$FILEXFER
  806.     
  807.       while status==1
  808.          ;loop here while xfer is going on
  809.          status=$FILEXFER
  810.       endwhile
  811.         
  812.       rxflush
  813.       txflush
  814.       pause 1
  815.         
  816.       if status==2
  817.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  818.          strfmt msg "downloaded %s successfully." filename
  819.          HostLog(name, msg) ;log a sucessful download
  820.       elseif status==3
  821.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  822.          strfmt msg "failed to download %s." filename
  823.          HostLog(name, msg) ;log a sucessful download
  824.       endif
  825.       exitwhile
  826.    endwhile
  827. endproc
  828.  
  829. ;***********************************************************************
  830. ;*                                                                     *   
  831. ;* GETFNAME                                                            *
  832. ;*                                                                     *
  833. ;* This procedure validates a filename for upload or download.         *
  834. ;*                                                                     *
  835. ;* Input:  string fname (filename to be validated)                     *
  836. ;*         integer calledfrom (upload or download menu)                *
  837. ;*                                                                     *
  838. ;* Return:  Success for vaild filename, Failure on invalid filename    *
  839. ;*                                                                     *
  840. ;*                                                                     *
  841. ;* Notes:  Keeps level 1 users from downloading any file they want     *
  842. ;*                                                                     *
  843. ;* Calls: HOSTPUTS, HOSTGETS, SETFAILURE, SETSUCCESS, HOSTGETYN        *                                                     *
  844. ;*                                                                     *
  845. ;* Modifies globals: dnload_path,  access_level, msg                   *
  846. ;*                                                                     *
  847. ;*                                                                     *
  848. ;***********************************************************************
  849. proc GetFname
  850. strparm fname
  851. intparm calledfrom
  852. string filepath
  853. integer security, length
  854.  
  855.  
  856.    if calledfrom==0              ; user is uploading
  857.       filepath=upload_path
  858.    else
  859.       filepath=dnload_path       ; user is downloading
  860.    endif
  861.  
  862.    atoi access_level security
  863.  
  864.    HostPutS("`r`n`r`nFile name? ")
  865.  
  866.    HostGetS(&fname, 50, DISP)    ; get the filename
  867.    if failure
  868.       SetFailure()
  869.       return
  870.    endif
  871.  
  872.    strcmp fname ""               ; make sure user didn't hit
  873.    if success                    ; ENTER for the filename
  874.       SetFailure()
  875.       return
  876.    endif
  877.  
  878.    if security!=2
  879.       strlen fname length
  880.       if length>12
  881.          HostPutS("`r`nFilename is too long!`r`n`r`n")
  882.          SetFailure()
  883.          return
  884.       endif
  885.    endif
  886.  
  887.    strupr fname                  ; uppercase the filename
  888.    HostPutS("`r`n")
  889.    if security!=2
  890.       strfind fname ":"          ; don't let regular users upload to
  891.       if found                   ; another drive
  892.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  893.          HostPutS(msg)
  894.          SetFailure()
  895.          return
  896.       endif
  897.  
  898.       strfind fname "\"          ; don't let regular users upload to
  899.       if found                   ; another path
  900.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  901.          HostPutS(msg)
  902.          SetFailure()
  903.          return
  904.       endif
  905.  
  906.       addfilename filepath fname ; build a fullpath for the filename
  907.       fname=filepath
  908.    else
  909.       getdir 0 filepath             ; level 2 users will upload to
  910.       usermsg "Filepath: %s" filepath
  911.       set dnldpath filepath
  912.       addfilename filepath fname    ; the current directory
  913.       fname=filepath
  914.    endif
  915.  
  916.    findfirst fname                  ; find the file to see if it exist
  917.    if not found
  918.       if calledfrom == 1            ; if user is downloading
  919.          HostPutS("`r`nFile not found!`r`n")
  920.          SetFailure()
  921.          return
  922.       else
  923.          SetSuccess()
  924.          return
  925.       endif
  926.    else
  927.       if calledfrom == 0           ; user is uploading
  928.          if security !=2
  929.             HostPutS("`r`nFile already exists!`r`n")
  930.             SetFailure()
  931.             return
  932.          else
  933.             HostputS("`r`nFile exists, overwrite? ")
  934.             HostGetYN()
  935.             if success
  936.                HostPutS("`r`n")
  937.                delfile fname
  938.                if not success
  939.                   HostPutS("`r`n`r`nCan't delete file!`r`n")
  940.                   SetFailure()
  941.                   return
  942.                endif
  943.                SetSuccess()
  944.                return
  945.             else
  946.                SetFailure()
  947.                return
  948.             endif
  949.             HostPutS("`r`n")
  950.             SetFailure()
  951.             return
  952.          endif
  953.       endif
  954.       SetSuccess()
  955.    endif
  956.    HostPutS("`r`n")
  957. endproc
  958.  
  959. ;***********************************************************************
  960. ;*                                                                     *   
  961. ;* ISWILDCARD                                                          *
  962. ;*                                                                     *
  963. ;* This procedure keeps users from specifying wildcard characters in   *
  964. ;* a filename for transfer protocols that do no support them.          *
  965. ;*                                                                     *
  966. ;* Input:  string fname (filename to validate)                         *
  967. ;*                                                                     *
  968. ;* Return:  Success for valid filename, Failure otherwise              *
  969. ;*                                                                     * 
  970. ;* Calls: HOSTPUTS, SETFAILURE, SETSUCCESS                             *
  971. ;*                                                                     *
  972. ;* Modifies globals: none                                              *
  973. ;*                                                                     *
  974. ;***********************************************************************
  975. proc IsWildcard
  976. strparm fname
  977. string error = "`r`nNo wildcards allowed!`r`n"
  978.  
  979.    strfind fname "*"
  980.    if found
  981.       HostPutS(error)
  982.       SetFailure()
  983.       return
  984.    endif
  985.  
  986.    strfind fname "?"
  987.    if found
  988.       HostPutS(error)
  989.       SetFailure()
  990.       return
  991.    endif
  992.  
  993.    SetSuccess()
  994. endproc
  995.  
  996. ;***********************************************************************
  997. ;*                                                                     *   
  998. ;* SWITCHDIR                                                           *
  999. ;*                                                                     *
  1000. ;* This procedure allows a level 2 user to change the working          *
  1001. ;* directory                                                           *
  1002. ;*                                                                     * 
  1003. ;* Calls: HOSTPUTS, HOSTGETS, ISWILDCARD, HOSTLOG                      *
  1004. ;*                                                                     *
  1005. ;* Modifies globals: msg, name                                         *
  1006. ;*                                                                     *
  1007. ;***********************************************************************
  1008. proc SwitchDir
  1009. string filepath, newpath
  1010.  
  1011.    getdir 0 filepath
  1012.    strfmt msg "`r`nCurrent directory is %s`r`n" filepath
  1013.    HostPutS(msg)
  1014.    HostPutS("Change to what directory? ")
  1015.    HostGetS(&newpath, 50, DISP)
  1016.    if success
  1017.       IsWildcard(newpath)
  1018.       HostPuts("`r`n")
  1019.       chdir newpath
  1020.       strfmt msg "changed directory to %s." newpath
  1021.       HostLog(name, msg)
  1022.       getdir 0 newpath
  1023.       strfmt msg "`r`nCurrent directory is now %s`r`n" newpath
  1024.       HostPuts(msg)
  1025.    endif
  1026. endproc
  1027.  
  1028. ;***********************************************************************
  1029. ;*                                                                     *   
  1030. ;* HOSTLOG                                                             *
  1031. ;*                                                                     *
  1032. ;* This procedure puts an activity message into the HOST.LOG file.     *
  1033. ;*                                                                     * 
  1034. ;* Calls: HOSTMSGBOX                                                   *
  1035. ;*                                                                     *
  1036. ;* Modifies globals: logfile, msg                                      *
  1037. ;*                                                                     *
  1038. ;***********************************************************************
  1039. proc HostLog
  1040. strparm activity1
  1041. strparm activity2
  1042.  
  1043.    isfile logfile
  1044.    if not success                       ;if new file put header at top
  1045.       fopen 1 logfile CREATE TEXT
  1046.       if success
  1047.          fputs 1 "  DATE      TIME             ACTIVITY"
  1048.          fputs 1 "--------  ----------   --------------------------------"
  1049.          fclose 1
  1050.       else
  1051.          HostMsgBox("Can't create HOST.LOG file!")
  1052.          return
  1053.       endif
  1054.    endif
  1055.         
  1056.    fopen 1 logfile WRITE TEXT
  1057.    if not success
  1058.       HostMsgBox("Can't open HOST.LOG file!")
  1059.       return
  1060.    endif
  1061.    fseek 1 0 2
  1062.    strfmt msg "%s  %s   %s %s" $DATE $TIME activity1 activity2
  1063.    fputs 1 msg
  1064.    fclose 1
  1065. endproc
  1066.  
  1067. ;***********************************************************************
  1068. ;*                                                                     *   
  1069. ;* SAVE_PRM                                                            *
  1070. ;*                                                                     *
  1071. ;* This procedure save_prm renames PW.PRM to PW.PRX and saves the      *
  1072. ;* current setup.                                                      *
  1073. ;*                                                                     * 
  1074. ;* Calls: nothing                                                      *
  1075. ;* Called by: MAIN                                                     *
  1076. ;* Modifies globals: none                                              *
  1077. ;*                                                                     *
  1078. ;***********************************************************************
  1079. proc save_prm
  1080. string prmfile
  1081. string oldprm="PW.PRM"
  1082. string newprm="PRM.BAK"
  1083.  
  1084.    prmfile=$PWTASKPATH
  1085.    addfilename prmfile oldprm
  1086.    oldprm=prmfile
  1087.  
  1088.    prmfile=$PWTASKPATH
  1089.    addfilename prmfile newprm
  1090.    newprm=prmfile
  1091.    breakpoint
  1092.    copyfile oldprm newprm
  1093.    savesetup
  1094. endproc
  1095.  
  1096. ;***********************************************************************
  1097. ;*                                                                     *   
  1098. ;* RESTORE_PRM                                                         *
  1099. ;*                                                                     *
  1100. ;* This procedure restore_prm restores the setup from disk and         *
  1101. ;* renames the PW.PRX file back to PW.PRM.                             *
  1102. ;*                                                                     * 
  1103. ;* Calls: NONE                                                         *
  1104. ;* Called by: ExitHost                                                 *
  1105. ;* Modifies globals: none                                              *
  1106. ;*                                                                     *
  1107. ;***********************************************************************
  1108. proc restore_prm
  1109. string prmfile
  1110. string oldprm="PW.PRM"
  1111. string newprm="PRM.BAK"
  1112.  
  1113.    restsetup
  1114.    prmfile=$PWTASKPATH
  1115.    addfilename prmfile oldprm
  1116.    oldprm=prmfile
  1117.  
  1118.    prmfile=$PWTASKPATH
  1119.    addfilename prmfile newprm
  1120.  
  1121.    newprm=prmfile
  1122.    delfile oldprm
  1123.    copyfile newprm oldprm
  1124.    isfile newprm
  1125.    delfile newprm
  1126. endproc
  1127.  
  1128. ;**** End of HOST.WAS ****
  1129.  
  1130.