;Wincomm character based Host Program!
; to change password edit the next line and recompile
pass$="WINCOMM"
superpass$="WIN3"
                                                       
diag = 1 modem=1
dwndir$ = GETSESSSTR(27)
ports$="com1:,com2:,com3:,com4:"
port$="com1:"
   DIALOGBOX 54, 10, 217, 126, 21, "WinComm Character Based Host"
      LTEXT 3, 6, 208, 16, "The Download Directory to be useed by this Host program must be specified."
      RTEXT 3, 27, 72, 9, "Download Directory:"
      EDIT 78, 25, 134, 12, DWNDIR$
      RTEXT 6, 42, 69, 8, "Password:"
      EDIT 79, 40, 134, 12, pass$
      RTEXT 0, 57, 75, 8, "Super User Password:"
      EDIT 79, 55, 134, 12, superpass$
      RTEXT 15, 71, 59, 8, "Connection:"
      COMBOBOX 79, 69, 46, 42, PORTS$, PORT$
      CHECKBOX 102, 88, 111, 10, "Show File Transfer Status Box", DIAG
      CHECKBOX 6, 88, 93, 10, "Modem Host Connection", MODEM
      DEFPUSHBUTTON 47, 106, 50, 14, "&Ok"
      CANCELBUTTON 124, 106, 50, 14, "&Cancel"
   DEND
DO dg=DIALOG? UNTIL(dg !=255)
if(dg==0) HALT
PUTSESSSTR(27,dwndir$)

OPEN("HOST.WSF","",modem+1)             ; this sets modem in answer mode
if(modem) PUTSESSINT(3,0)               ; set for modem
else PUTSESSINT(3,1)
port = VALINT(RIGHT(port$,2))-1
PUTSESSINT(2,port)

start_over:
START
DO i = ONLINE? UNTIL(i>0)
if(i>2) GOTO start_over                 ; error on connect
i=0 ptry=0 status=0			; initailize
cmd_line$ = ""                                                               
;-----------------------------------------------------------------
main1:
;-----------------------------------------------------------------
   PROMPT                               
        PKEY(1,27)                      ; if escape is pressed terminate macro
	PSTR(2,2,"^C")                  ; if Ctl "C" is recieved, start
	PSTR(2,2,"^M")                  ; if Ctl "C" is recieved, start
	PWAIT(3,50)			; wait 5 Seconds for a response
	PDCD(10)   		        ; if loss of carrier
   PEND
   DO 
	i=PROMPT?
   	IF(i==1) GOTO terminate
   	IF(i==2) GOTO welcome
	IF(i==3){
		ptry=ptry+1
		IF(ptry>4) GOTO bye
		SEND("^M^JPress 'Enter' to log on!^M^J")
		GOTO main1
	}
   	IF(i==10) GOTO bye
   UNTIL(i)
   ptry=0
;-----------------------------------------------------------------


;-----------------------------------------------------------------
welcome:
;-----------------------------------------------------------------
       stime = time?
       SEND("^L^M^J^M^J^M^JWelcome to WINCOMM Host Mode!^M^J^M^J^M^")
       SEND("First Name: ")
       pw=0 GOSUB cmd_line
       fname$=cmd_line$
       SEND("^M^J Last Name: ")
       pw=0 GOSUB cmd_line
       lname$=cmd_line$
       SEND("^M^J"+fname$+" "+lname$+"^M^JIs this correct (Y/N)? ")
       PROMPT                             
	  PSTR(2,1,"Y")                  ; confirm name
	  PSTR(2,2,"N")
	  PWAIT(3,600)			 ; wait for 60 seconds for a response
	  PDCD(3)			 ; if loss of carrier leave
       PEND
       DO i=PROMPT? UNTIL(i)
       IF(i==3) GOTO bye
       IF(i==1){
	       PRINT("^M^J"+fname$+" "+lname$+"^M^J")
	       GOTO pass_wd
       }
       SEND("N^M^J^M^J^M^J")
       GOTO welcome 
pass_wd:
       SEND("^M^J^M^JPassword: ")
       pw=1 GOSUB cmd_line
       IF(CMP(pass$,UPPERCASE(cmd_line$))==1) GOTO check_wfile
       IF(CMP(superpass$,UPPERCASE(cmd_line$))==1){
		status=1 GOTO check_wfile
       }
       SEND("^M^J*** Wrong Password!  Re-Enter ***")
       ptry=ptry+1
       if(ptry<4) GOTO pass_wd
       SEND("^M^J Too many attempts!!  Logging off!")
       i=TIME?+1 DO UNTIL(TIME?>i) 
       GOTO bye

check_wfile:
	hs = FOPEN(2,"HOST.MSG")
	if(hs==-1) GOTO menu1
	a$=FREADLN(hs) SEND("^M^J")
	DO
		SEND(a$)
		a$=FREADLN(hs)
	UNTIL(NULL(a$)==1)
	FCLOSE(hs)			   ; close the help file
        SEND("^M^JPress Enter to continue:")
	PROMPT                             
	    PSTR(2,2,"^M")                 ; if CR send more of help file
	    PWAIT(10,600)		   ; wait 60 seconds for a response
	    PDCD(10)			   ; if loss of carrier leave
	PEND
	DO i=PROMPT? UNTIL(i)
	IF(i==10) GOTO bye

menu1:
       SEND("^M^J^M^J^M^J^M^J^M^JF)iles  U)pload  D)ownload^M^JH)elp  T)ime  C)hat  G)oodbye^M^J^M^JYour choice? ")
       PROMPT                             
          PKEY(1,27)                     ; if escape is pressed terminate
	  PSTR(2,2,"F")                  ; Files
	  PSTR(2,3,"U")                  ; Upload
	  PSTR(2,4,"H")                  ; Help
	  PSTR(2,5,"T")                  ; Time
	  PSTR(2,6,"C")                  ; Chat
	  PSTR(2,7,"G")                  ; GoodBye
	  PSTR(2,10,"D")                 ; DownLoad a file
	  PWAIT(7,600)			 ; waited 60 seconds for a response
          PDCD(7)			 ; we lost carrier
       PEND
       DO i=PROMPT? UNTIL(i)
       IF(i==1) GOTO terminate
       IF(i==2) GOTO do_dir
       IF(i==3) GOTO do_upload
       IF(i==4) GOTO send_help
       IF(i==5) GOTO send_time
       IF(i==6) GOTO do_chat
       IF(i==7) GOTO bye
       IF(i==10) GOTO do_down
;-----------------------------------------------------------------

;-----------------------------------------------------------------
send_help:
;-----------------------------------------------------------------
hfile = FOPEN(0,"HOST.TXT")                  ; open 0 = read
IF(hfile == -1){
        ALERT("Cannot find help file 'HHLP.TXT'")
        GOTO menu1
}
GOTO h_prompt
help_prompt:
   SEND("^H ^H^H ^H^H ^H^H ^H^H ^H^H ^H^H")
h_prompt:
   i=0
   WHILE(i<24)
        a$ = FREADLN(hfile)
	IF(NULL(a$) == 0) SEND(a$)
        ELSE{
                FCLOSE(hfile)
                GOTO menu1
        }
        i = i+1
   WEND
   SEND("-MORE-")

PROMPT                             
    PKEY(1,27)                     ; if escape is pressed terminate macro
    PSTR(2,2,"^M")                 ; if CR send more of help file
    PSTR(2,3,"^C")                 ; if ctl "C" terminate help
    PWAIT(10,600)		   ; wait 60 seconds for a response
    PDCD(10)			   ; if loss of carrier leave
PEND
DO i=PROMPT? UNTIL(i)
IF(i==2) GOTO help_prompt
FCLOSE(hfile)			   ; close the help file
IF(i==10) GOTO bye
IF(i==1) GOTO terminate
IF(i==3) GOTO menu1
;-----------------------------------------------------------------



;-----------------------------------------------------------------
do_upload:
;-----------------------------------------------------------------
SEND("^M^J^M^JA)scii  K)ermit  X)modem  Y)modem Batch^M^J1)Xmodem1K  C)XmodemCRC  G)Ymodem-G Batch^M^JZ)modem^M^J^M^JYour choice? ")
PROMPT                             
        PKEY(1,27)                     ; if escape is pressed terminate
	PSTR(2,2,"K")                  ; Check user selection
	PSTR(2,3,"X")                  
	PSTR(2,6,"Y")
	PSTR(2,4,"1")
	PSTR(2,5,"C")
	PSTR(2,7,"G")
	PSTR(2,8,"Z")
	PSTR(2,10,"^C")                ; if Ctl 'C' recieved leave
	PSTR(2,10,"^M")                ; if <CR> recieved leave
	PSTR(2,11,"A")                 ; if ESC is recieved start
        PWAIT(12,600)		       ; wait 60 seconds for a response
        PDCD(12)		       ; loss of carrier, leave
PEND
       DO i=PROMPT? UNTIL(i)
       if(i==10) goto menu1
       if(i==12) goto bye
       a$=NEXTCHAR?		       ;eat character in case CR was pressed                                                                                
get_name:                                                                                
   SEND("^M^JFile name? ")                                                             
       pw=0 GOSUB cmd_line
       IF(NULL(cmd_line$) == 1) GOTO menu1
       fname$ = cmd_line$
       IF(FOPEN(16384,dwndir$+"\"+fname$) >= 0 ){
                SEND(" <== File Already exists")
                GOTO get_name
       }
       hfile = FOPEN(4096,dwndir$+"\"+fname$)
       IF(hfile == -1){
                SEND(" <== Invalid File Name")
                GOTO get_name
       }
       FCLOSE(hfile)
SEND("^M^J             |..................|...................|^M^J")
SEND("Description:  ") 
pw=0 GOSUB cmd_line
SEND("^M^JBegin your transfer procedure...")
j = time? + 1
WHILE(time?<j)
WEND
if(i<9){
        PUTSESSINT(6,i-1)
        RECEIVEFILE(diag,fname$)
}
else RECEIVEASCII(diag,fname$)
DO j=XFER? UNTIL(j!=1)
IF(i<9) SEND("^M^J"+STATUSLINE?+"^M^J")				; send result string to remote end
ELSE SEND("^M^J"+"ASCII Upload Complete!"+"^M^J")		; send result string to remote end
IF(i==0){
	ht = FOPEN(2,"UPLOADS.html")
	if(ht==-1){
		ht=FOPEN(4096,"UPLOADS.html")
		if(ht==-1) ALERT( "Cannot Create File -'UPLOADS.TXT'") HALT
	}
	FSEEK(ht,0,2)
	a$=fname$+CHAR(9)+cmd_line$
	FWRITELN(ht,a$)
	FCLOSE(ht)
}
IF(i==5) GOTO bye					; loss of carrier during xfer
GOTO menu1                                                                  
;-----------------------------------------------------------------



;-----------------------------------------------------------------
do_down:
;-----------------------------------------------------------------
SEND("^M^J^M^JA)scii  K)ermit  X)modem  Y)modem Batch^M^J1)Xmodem1K  C)XmodemCRC  G)Ymodem-G Batch^M^JZ)modem^M^J^M^JYour choice? ")
PROMPT                             
        PKEY(1,27)                     ; if escape is pressed terminate
	PSTR(2,2,"K")                  ; Check user selection
	PSTR(2,3,"X")                  
	PSTR(2,6,"Y")
	PSTR(2,4,"1")
	PSTR(2,5,"C")
	PSTR(2,7,"G")
	PSTR(2,8,"Z")
	PSTR(2,10,"^C")                ; if Ctl 'C' recieved leave
	PSTR(2,10,"^M")                ; if <CR> recieved leave
	PSTR(2,11,"A")                 ; if ESC is recieved start
        PWAIT(12,600)		       ; wait 60 seconds for a response
        PDCD(12)		       ; loss of carrier, leave
PEND
DO i=PROMPT? UNTIL(i)
if(i==10) goto menu1
if(i==12) goto bye
get_name1:
a$=NEXTCHAR?			       ;eat character in case CR was pressed                                                                                
SEND("^M^JFile name? ")                                                             
       pw=0  GOSUB cmd_line
       IF(NULL(cmd_line$) == 1) GOTO menu1
       fname$ = cmd_line$
       IF(FOPEN(16384,dwndir$+"\"+fname$) >= 0 ) GOTO beginxfer
       IF(FOPEN(16384,fname$) >= 0 ){
		IF(status) GOTO beginxfer
	      	SEND(" <== Super User Status required")
	        GOTO get_name1
       }
       SEND(" <== File does not exits")
       GOTO get_name1

beginxfer:
SEND("^M^JBegin your transfer procedure...")
if(i<9){
        j = time? + 1
        WHILE(time?<j)
        WEND
        PUTSESSINT(6,i-1)
        SENDFILE(diag,fname$)
}
else {
        SEND("^M^JPress <CR> to begin transfer...^M^J(Ctrl-D aborts)? ")
        PROMPT                             
                PKEY(1,27)                      ; if escape is pressed terminate
		PSTR(2,2,"^M")                  ; if Carrage return recieved
		PSTR(2,3,"^D")                  ; if Ctl 'C' received
		PDCD(4)	                        ; if loss of carrier leave
		PWAIT(4,600)                    ; wait 60 seconds for a response
        PEND
        DO i = PROMPT? UNTIL(i)
        IF(i==1) GOTO terminate
        IF(i==3) GOTO menu1
        IF(i==4) GOTO bye
        SENDASCII(diag,fname$)
}
DO j=XFER? UNTIL(j!=1)
IF(j==5) GOTO bye				; loss of carrier during xfer
IF(i<9) SEND("^M^J"+STATUSLINE?+"^M^J")				; send result string to remote end
ELSE SEND("^M^J"+"ASCII Download Complete!"+"^M^J")			; send result string to remote end
GOTO menu1                                                                  
;-----------------------------------------------------------------



;-----------------------------------------------------------------
send_time:
;-----------------------------------------------------------------
SEND("^M^J^M^JOnLine at: "+strtime(stime))
SEND("^M^JIt is now: "+strtime(time?))                                                             
GOTO menu1                                                                  
;-----------------------------------------------------------------


;-----------------------------------------------------------------
do_dir:
;-----------------------------------------------------------------
SEND("^M^JEnter FILE SPEC:  (Carraige Return = *.*)^M^J> ")
pw=0 GOSUB cmd_line
if(NULL(cmd_line$) == 1) cmd_line$ = "*.*"
SEND("^M^J(Press Ctrl-C to abort display)^M^J")

IF(status){
	dir$="" i=1
again:	a$=EXTRACT("\",cmd_line$,i)
	IF(CMP(cmd_line$,a$)==1) GOTO done
	IF(i>1)dir$=dir$+"\"+a$
	ELSE dir$=dir$+a$
	i=i+1 GOTO again
done: 	IF(NULL(dir$)==1) dir$=dwndir$
	ELSE SUBST(dir$,cmd_line$,"",1)
	filter$=cmd_line$
	SUBST("\",filter$,"",1)
}
ELSE{
	filter$=cmd_line$
	dir$=dwndir$
}
SEND(dir$+"\"+filter$+"^M^J")
file$ = FILEFIND(dir$+"\"+filter$,16)
ii=1

hfile1:
   PROMPT                             
      PKEY(1,27)                     		; if escape is pressed terminate
      PSTR(2,2,"^M")                  		; if ESC is recieved start
      PSTR(2,3,"^C")                  		; if ESC is recieved start
      PWAIT(4,600)                  		; wait for 60 seconds for a response
      PDCD(4)                  		        ; loss of carrier leave
   PEND     
   WHILE( (NULL(file$) ==0 ) && (ii<23) )
         hfile = FOPEN(2,dir$+"\"+file$)        ;2 = read
	 if(hfile==-1)   SEND(file$+"^I<DIR>^M^J")
	 ELSE {	
	         i = filesize(hFile)
        	 j = filetime(hFile)
	         FCLOSE(hFile)
        	 if(len(file$) <8) file$ = file$+"     "
	         SEND(file$+"^I"+strint(i)+"^I"+strtime(j)+"^M^J")
	 }
         file$= FINDNEXT
         ii = ii+1
   WEND
   IF((NULL(file$) == 1) && (ii<20) ) GOTO menu1
   SEND("-MORE-")
   DO i=PROMPT? UNTIL(i)
   IF(i==1)GOTO terminate
   IF(i==3) GOTO menu1
   IF(i==4) GOTO bye
   SEND("^H ^H^H ^H^H ^H^H ^H^H^H")
   ii=0
   GOTO hfile1
;-----------------------------------------------------------------


;-----------------------------------------------------------------
do_chat:
;-----------------------------------------------------------------
SEND("^M^J^M^JPaging Host operator.....")
PROMPT                             
  PKEY(1,27)                     		; if escape is pressed host operator has acknowledged
PEND
j = 0
WHILE(j<5)
	ALARM ALARM i=time?+2
        WHILE(time?<i)
		IF(PROMPT?) GOTO in_chat
        WEND
	j=j+1
WEND
SEND("Host operator has been paged.")
GOTO menu1                                                                  

in_chat:
SEND("^M^JHost operator is now on-line.^M^J")
PRINT("^M^JHost operator is now on-line.^M^J")
PROMPT                             
  PKEY(1,13)                     		; if 'Enter' is pressed sent linefeed
  PKEY(2,27)                     		; if escape is pressed host operator has acknowledged
PEND
MACROTRAP(1)
DO 
	a$=NEXTCHAR?
	IF(NULL(a$)==0){
		SEND(a$) PRINT(a$)
		if(ASC(a$)==13) SEND("^J")
	}
	i=PROMPT?
	if(i==1){
		SEND("^J")
		PROMPT                             
  			PKEY(1,13)
  			PKEY(2,27)
		PEND
	}
UNTIL(i==2)
CLEAR
MACROTRAP(0)
GOTO menu1                                                                  
;-----------------------------------------------------------------




;-----------------------------------------------------------------
cmd_line:       ;pw = 0 char are echoed back 1 "*" are echoed
;-----------------------------------------------------------------
       cmd_line$=""  cnt=0  delay=TIME?+60 
       MACROTRAP(1)
next_char:
       IF(TIME?>delay){
	       MACROTRAP(0) GOTO bye
       }
       a$=NEXTCHAR?
       IF(NULL(a$) == 1) GOTO next_char
       cnt=cnt+1
       IF( (ASC(a$)==13) || (cnt>60) )  GOTO end_getl
       IF(pw != 1) SEND(a$)
       ELSE SEND("*")
       IF(ASC(a$)==8){					; back space
                IF(NULL(cmd_line$)==1){
			cnt=0
			GOTO next_char
		}
		cnt=cnt-2
		IF(cnt<=0){
			cnt=0
			cmd_line$=""
		}
                ELSE cmd_line$=LEFT(cmd_line$, cnt)
       }
       ELSE cmd_line$=cmd_line$+a$
       GOTO next_char
end_getl:
       MACROTRAP(0)
       cmd_line$ = UPPERCASE(cmd_line$)
       RETURN
       
;-----------------------------------------------------------------


bye:
;-----------------------------------------------------------------
   SEND("^M^J Ending Wincomm Host Mode!")
   i=TIME?+1 DO UNTIL(TIME?>i) 
   STOP  i=TIME?+6 DO UNTIL(TIME?>i) GOTO start_over
;-----------------------------------------------------------------


;-----------------------------------------------------------------
terminate:
;-----------------------------------------------------------------
     ALERT("Host Macro Will Terminate")
     HALT
;-----------------------------------------------------------------
END