home *** CD-ROM | disk | FTP | other *** search
-
- SCRIPT OdyHost;
-
- (************************************************************************)
- (* *)
- (* Odyssey Host Mode Script *)
- (* Copyright (c) Don Milne, September 1994 *)
- (* *)
- (************************************************************************)
-
- VAR DefaultBaudRate:Number;
- GotLeaveCmd,PrivUser,LostCarrier:Flag;
- CurrDir,OrigDir:String;
- FileOK,GotChar,Carrier,AlreadyConnected,Busy:Flag;
- OldCrMode:Number;
-
- (* Host mode info, configured in Odyssey by user *)
- VAR NormPass,PrivPass,Welcome,HostDir:String;
- MNPwanted:Flag;
-
- (*.........................................*)
-
- FUNC CarrierLost():Flag;
-
- VAR tempcarrier:Flag;
-
- BEGIN
- IF LostCarrier THEN RETURN(TRUE) END;
- tempcarrier := OnLine();
- IF (Carrier<>tempcarrier) AND (NOT tempcarrier) THEN
- Delay(1);
- IF NOT OnLine() THEN
- LostCarrier:=TRUE;
- Carrier := FALSE;
- AlreadyConnected := FALSE;
- RETURN TRUE
- END;
- END;
- RETURN FALSE;
- END;
-
- (*.........................................*)
-
- PROC SendString(s:String);
- BEGIN
- Write(s); Transmit(s);
- END;
-
- (*.........................................*)
-
- FUNC GetString(VAR s:String; Timout:Number):Flag;
- BEGIN
- IF Receive(s,Timout) THEN
- Write(s+"|");
- RETURN TRUE;
- END;
- RETURN FALSE;
- END;
-
- (*.........................................*)
-
- FUNC LeaveHostMode():Flag;
- BEGIN
- IF NOT GotLeaveCmd THEN
- WHILE KeyPressed() DO (* leave host mode? *)
- IF RdKey()=27 THEN
- GotLeaveCmd := TRUE;
- END;
- END;
- END;
- RETURN GotLeaveCmd;
- END;
-
- (*.........................................*)
-
- FUNC GetPassWord():Flag;
-
- VAR Attempts:Number;
- GotPassword,Failure:Flag;
- Password:String[20];
-
- BEGIN
- PrivUser := FALSE;
- GotPassword := FALSE;
- Failure := FALSE;
- Attempts := 0;
- REPEAT
- SendString("|Enter Password: ");
- Receive(Password,10,NoEcho);
- IF Password = PrivPass THEN
- PrivUser := TRUE;
- GotPassword := TRUE
- ELSIF Password = NormPass THEN
- GotPassword := TRUE
- ELSE
- SendString("Incorrect ("+Password+")"); INC(Attempts);
- Failure := (Attempts>=3);
- IF Failure THEN
- SendString("||Wrong too often.. Byeee|");
- HangUp();
- END;
- END
- UNTIL GotPassword OR Failure;
- RETURN GotPassword;
- END;
-
- (*.........................................*)
-
- PROC ChangeDirectory();
-
- VAR Temp:String;
-
- BEGIN
- SendString("|Directory? ");
- IF GetString(Temp,30) THEN
- IF Temp="" THEN RETURN END;
- IF ChDir(Temp) THEN
- CurrDir := Temp
- ELSE
- SendString("No such directory");
- ChDir(CurrDir);
- END;
- END;
- END;
-
- (*.........................................*)
-
- PROC DirectoryListing();
-
- VAR Lines,Count,f_attr:Number;
- GotFile:Flag;
- Temp:String;
- Name:String[20];
-
- BEGIN
- SendString("Dir Mask? ");
- IF NOT GetString(Temp,30) THEN RETURN END;
- SendString('|');
- IF Temp="" THEN Temp:="*.*" END;
- GotFile := FFirst(Temp,0,Name,f_attr);
- IF GotFile THEN
- Count:=0; Lines:=0;
- WHILE (GotFile) AND (NOT CarrierLost()) DO
- Temp := Name;
- Temp := SubStr(Temp+" ",0,14);
- SendString(Temp);
- GotFile := FNext(Name,f_attr);
- INC(Count);
- IF Count % 5 = 0 THEN
- INC(Lines); SendString('|');
- IF Lines=20 THEN
- SendString("||More...");
- GetString(temp,30);
- IF CarrierLost() THEN RETURN END;
- SendString('||');
- END;
- END;
- END;
- ELSE
- SendString("No matching files.|");
- END;
- SendString('||');
- END;
-
- (*................................................*)
-
- FUNC GetFilename(VAR Filename:String; MustExist:Flag):Flag;
- BEGIN
- SendString("|Filename? ");
- IF NOT GetString(Filename,30) THEN
- SendString('|');
- ELSE
- IF (Length(Filename)>12) OR (Pos(":",Filename)>=0) OR (Pos("\",Filename)>=0) THEN
- (* for security reasons, path and drive names are not allowed *)
- SendString("|Bad File name|");
- RETURN FALSE;
- END;
- IF IsFile(Filename) THEN
- IF MustExist THEN
- RETURN TRUE
- ELSE
- SendString("|Filename used already - pick another!|");
- END;
- ELSIF MustExist THEN
- SendString("|File not found.|");
- ELSE
- RETURN TRUE
- END;
- END;
- RETURN FALSE;
- END;
-
- (*................................................*)
-
- FUNC GetFTMethod(AsciiOK:Flag):Number;
-
- VAR c:String[2];
- x:Number;
-
- BEGIN
- SendString("Choose method=>|");
- IF AsciiOK THEN SendString("A(scii|") END;
- SendString("X(modem|W(xmodem|Y(modem|B(atch Ymodem|K(ermit|Z(modem|?");
- REPEAT
- IF NOT GetString(c,30) THEN
- RETURN -1;
- ELSIF c<>"" THEN
- x:=Pos(ToUpper(c),"AXYBWKZ");
- ELSIF CarrierLost() THEN
- RETURN -1;
- END;
- UNTIL ((x=0) AND (AsciiOK)) OR ((x>=1) AND (x<=6));
- RETURN x;
- END;
-
- (*................................................*)
-
- PROC SayProtocol(prot:Number; AddDelay:Flag);
- BEGIN
- CASE prot OF
- 0:SendString("ASCII");
- | 1:SendString("Xmodem");
- | 2:SendString("Ymodem");
- | 3:SendString("Ymodem Batch");
- | 4:SendString("WXmodem");
- | 5:SendString("Kermit");
- | 6:SendString("Zmodem");
- END;
- SendString(" protocol.|");
- IF AddDelay THEN Delay(5) END;
- END;
-
- (*................................................*)
-
- PROC SayResult();
- BEGIN
- SendString("|File Transfer ");
- IF FileOK THEN
- SendString("Complete.|")
- ELSE
- SendString("Failed.|")
- END;
- END;
-
- (*................................................*)
-
- FUNC TransferFile(down:Flag; protocol:Number; FileSpec:String):Flag;
- BEGIN
- IF down THEN
- RETURN Download(protocol,FileSpec,ResumeTransfer);
- ELSE
- RETURN Upload(Protocol,FileSpec);
- END;
- END;
-
- (*................................................*)
-
- PROC GetFileFromUser();
-
- VAR x:Number;
- Filename:String;
-
- BEGIN
- x := GetFTMethod(FALSE);
- IF x<0 THEN RETURN END;
- IF (x=XMODEM) OR (x=WXMODEM) OR (x=YMODEM) THEN
- IF NOT GetFilename(Filename,FALSE) THEN RETURN END;
- END;
- SendString("|Ready to receive file using ");
- SayProtocol(x,FALSE);
- FileOK := TransferFile(TRUE,x,Filename);
- SayResult();
- END;
-
- (*................................................*)
-
- PROC SendFileToUser();
-
- VAR x:Number;
- f:File;
- blocks,bytes:String[10];
- Filename:String;
-
- BEGIN
- x := GetFTMethod(TRUE);
- IF x<0 THEN RETURN END;
- IF NOT GetFilename(Filename,TRUE) THEN RETURN END;
- FOpen(f,Filename);
- FileSize(f,bytes,blocks);
- FClose(f);
- SendString("|File: "+Filename+"| "+bytes+" bytes, ("+blocks+" Xmodem blocks).|");
- SendString("About to send file using ");
- SayProtocol(x,TRUE);
- Filename := FQualify(Filename);
- FileOK := TransferFile(FALSE,x,Filename);
- SayResult();
- END;
-
- (*................................................*)
-
- PROC GetMenu();
-
- VAR c:String[2];
- x:Number;
-
- BEGIN
- REPEAT
- IF CarrierLost() OR LeaveHostMode() THEN RETURN END;
- UNTIL GetString(c,5);
- CASE c OF
-
- "C":IF PrivUser THEN
- ChangeDirectory();
- END;
- | "F":DirectoryListing();
- | "U":GetFileFromUser();
- | "D":SendFileToUser();
- | "G":SendString("||Goodbye from Odyssey Host.|Please hang up now!!|");
- Delay(1);
- HangUp();
- ELSE
- IF c<>"" THEN SendString("|Error.|") END;
- END;
- END;
-
- (*................................................*)
-
- PROC DisplayMenu();
- BEGIN
- CurrDir := CurrentDir();
- REPEAT
- IF CarrierLost() OR LeaveHostMode() THEN RETURN END;
- IF PrivUser THEN
- SendString("|Directory=> "+CurrDir+"|C(hange dir, ");
- ELSE
- SendString('|')
- END;
- SendString("F(iles, U(pload, D(ownload, G(oodbye|? ");
- GetMenu();
- UNTIL FALSE;
- END;
-
- (*.........................................*)
-
- PROC HostSession();
-
- VAR done,Ok:Flag;
-
- BEGIN
- (* We get here when a carrier is detected *)
- SetHelp("");
- SetHelp(" Odyssey Host Mode: { Call in Progress } ");
- IF NOT AlreadyConnected THEN
- Delay(1);
- SendString("||ODYSSEY "+OdyVersion()+" HOST MODE||");
- SendString(Welcome);
- Ok := GetPassword();
- ELSE
- Ok := TRUE;
- END;
-
- IF Ok THEN
- done := FALSE;
- REPEAT
- IF CarrierLost() OR LeaveHostMode() THEN
- done:=TRUE
- ELSE
- DisplayMenu();
- END;
- UNTIL done;
- END;
- SetHelp("");
- END;
-
- (*.........................................*)
-
- PROC EnterHostMode();
- VAR CallResult,cTimeout:Number;
- BEGIN
- Delay(1); (* wait for any characters to clear *)
- REPEAT
- SetHelp("[20]Odyssey Host Mode[20]{ Waiting for Call }[0]Press Esc to leave host mode.");
- CallResult := WaitForCall();
- IF CallResult=1 THEN (* escape hit *)
- GotLeaveCmd := TRUE;
- RETURN;
- ELSIF CallResult=0 THEN
- cTimeout := 10;
- WHILE (cTimeout>0) AND (NOT OnLine()) DO
- Delay(1);
- DEC(cTimeout);
- END;
- IF OnLine() THEN
- LostCarrier := FALSE;
- Carrier := TRUE;
- HostSession();
- Carrier := FALSE;
- Delay(1);
- PortInit(DefaultBaudRate,8,None,1);
- AutoAnswer(TRUE);
- ChDir(HostDir);
- END;
- ELSE
- RETURN;
- END;
- UNTIL FALSE;
- END;
-
- (*.........................................*)
-
- PROC InitHost();
- BEGIN
- Emulate("TTY");
- DefaultBaudRate := DTESpeed();
- AlreadyConnected := OnLine();
- GotLeaveCmd := FALSE;
- CRoutTranslation(CRLF);
- OrigDir := CurrentDir();
- GetHostInfo(NormPass,PrivPass,Welcome,HostDir,MNPwanted);
- IF HostDir="" THEN HostDir:=OrigDir END;
- SetZmodem(FALSE,TRUE,FALSE); (* disable Zmodem auto-receive *)
- SetASCII(0,0,FALSE);
- IF NOT OnLine() THEN AutoAnswer(TRUE) END;
- ChDir(HostDir);
- END;
-
- (*.........................................*)
-
- PROC ShutDown();
- BEGIN
- ChDir(OrigDir);
- IF NOT OnLine() THEN AutoAnswer(FALSE) END;
- SetHelp("");
- RestoreDefaults();
- END;
-
- (*.........................................*)
-
- BEGIN
- ClrScr();
- Carrier := OnLine();
- Priority(TRUE);
- CanEscape(FALSE);
- InitHost();
- EnterHostMode();
- ShutDown();
- END;
-
-