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