Category : Word Perfect
Archive   : BIBPERF.ZIP
Filename : GETFILE.INC

 
Output of file : GETFILE.INC contained in archive : BIBPERF.ZIP
{File containing procs GetFileName and GetName}

Procedure GetFileName
(Var FullName : String74;
Var FirstName : String70; (* new +/or default firstname *)
FirstDefaltOK : Boolean; (* can use default firstname? *)
Var Extension : String3;
DefaltExt : String3;
ExtDefaltOK : Boolean; (* can use default extension type? *)
Var Abort : Boolean;
Var Error : Boolean);

Var
Ch : Char;
FileChar : Set of Char;
Buff : String[74];
I,J,Start : Integer;
PeriodPosition : Integer;
Numperiods : Integer;
LookForPeriod : Boolean;

Function TESTZ: Boolean; (*look for string of all Z's, u/l case ok*)
Var
Test : Boolean;
Begin
TestZ:=False;
If Length(Buff)>0 then
Begin
Test:=True;
I:=1;
Repeat
If Upcase(Buff[I])<>'Z' then Test:=False;
I:=I+1;
Until (I>Length(Buff)) or (Test=False);
TestZ:=Test;
End;
End; (* testz *)

begin
FileChar:= ['!','#'..')','-','.','0'..'9','@'..'Z','_','a'..'{','}','~'];
Abort:=False;
Error:=False;
FullName:='';
Extension:='';
Read (Buff);
(*Writeln; Writeln ('Buff=',Buff);Writeln('Length(Buff)=',Length(Buff));*)
If Length(Buff)=0
Then (*CR struck*)
If FirstDefaltOK and ExtDefaltOK
Then
Begin
(* no change in firstname *)
Extension := DefaltExt;
FullName := FirstName + '.' + Extension;
End
Else
Error := True
Else
If Not((Length(Buff)>8) and TESTZ) then
Begin

(* get position of last period *)
I := Length(Buff);
PeriodPosition := 0;
NumPeriods:=0;
LookForPeriod:=True;
Repeat
If (Buff[I]='.') then
Begin
If LookForPeriod
Then
Begin
PeriodPosition := I;
LookForPeriod := False;
End
Else
Error:=True;
End;
If Not (Buff[I] in FileChar) then
If Buff[I] in ['\',':']
then LookForPeriod:=False
else Error:=True;
If ((Length(Buff)-I)=3) then LookForPeriod:=False;
I:=I-1;
Until (I=0) or Error;

(* replace default extension name, if one has been specified *)
J:=0;
If PeriodPosition<>0 then J:=Length(Buff)-PeriodPosition;
If J>3 then Error:=True; (* extension too long *)
If (Not Error) then
Begin
If (J>0) then
Extension:= Copy(Buff,(PeriodPosition+1),J);
If (J=0) then (* one way is PeriodPosition=0 *)
If ExtDefaltOK
Then
Extension:= DefaltExt
Else
Error:=True;
End;

(* now replace default firstname, if legal and if supplied *)
(* look for end of a supplied firstname *)
(* "firstname" includes all chars up to the period just before ext *)
If (PeriodPosition <>0) and (Not Error)
Then
Start := PeriodPosition - 1
Else
Start := Length(Buff);
(*Start=0 => PeriodPosition=1 or Length(Buff)=0*)
If (Start=0) and (Not FirstDefaltOK) then Error:=True; (* note, firstname
is already set to the default and we don't do anything for other case *)
If (Start<>0) and (Not Error)
Then
(* use defalt name only if needed and OK to do it*)
(* find beginning of firstname *)
I := Start;
J := 0;
While (Buff[I] in FileChar) and (I>0) do
Begin
I:=I-1;
J:=J+1; (* length of valid usual name string *)
End;
Case J of
0 :If FirstDefaltOK
Then (*use defalt firstname*)
FullName := FirstName + '.' + Extension
Else
Error := True;
1..8 : Begin
FirstName:=Copy(Buff,1,Start);
FullName := FirstName + '.' + Extension;
End;
9..80: Error:=True;
End; (*case J*)

End (* if buff[1]<>^A *)

Else (* ^Z was entered *)
Abort:=True;

end; (* procedure getfilename *)


Procedure GetName (Line:Integer;Age:NewOld;DocDefalt,ExtDefalt:Boolean;
Ext:String3);
Var
OK : Boolean;
Buff : String[2];
Begin
Repeat
GoToXY(1,(Line+3));
Write ('Defaults: Prefix = ',FirstName,', Extension = .',Ext);
Repeat
GoToXY(1,Line);
ClrEOL;
Write (Prompt);
GetFileName (FullName,FirstName,DocDefalt,Extension,Ext,ExtDefalt,
Abort,Error);
LastX:=WhereX; LastY:=WhereY;
Until (Not Error) or Abort;
GoToXY(1,(Line+3)); ClrEOL;
If Abort
then
Begin
GoToXY(1,15);
Write ('Program Aborted by User.');
End
else
Case Age of
Old: OK := Exist(FullName);
New: Begin
If Exist(FullName) (* see if output file already exists *)
Then
Begin
Writeln;
Write ('** ',FullName,' Exists.** Overwrite? [Y/N]:');
Buff:=InKey;
Ch:=Buff[1];
If Ch in ['Y','y']
Then OK:=True
Else OK:=False;
GotoXY(1,WhereY); ClrEOL;
End
Else
OK := GoodName(FullName);
End;
End; (*case*)
Until OK or Abort;
If Not Abort then
Begin
GoToXY(LastX,LastY);
Write (' --> ',FullName);
End;
End; (* procedure getname *)

  3 Responses to “Category : Word Perfect
Archive   : BIBPERF.ZIP
Filename : GETFILE.INC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/