program testfile(input,output); type string31 = packed array [1..31] of char; var filename : string31; flag : boolean; procedure readstring(var inp:text;var s:string31; var flag:boolean); var i : integer; procedure skipspaces(var inp:text); begin while (inp^=' ') and not (eoln(inp)or eof(inp)) do get(inp); end; begin skipspaces(inp); { jump past space characters} for i:=1 to 31 do { fill array with spaces} s [i]:=' '; i := 1; while (inp^<>' ') and not (eoln(inp)) and (i<31) do begin s[i] := inp^; {read in the next string of characters stopping when} get(inp); {A) a space is found, B) the end of the line is reached} i := i+1; {or C) the 31 character array is full.} end; for i:= 1 to 31 do {change the string to upper case} if ('a'<=s[i]) and ( s[i]<='z') then s[i] := chr(ord(s[i])-ord('a')+ord('A')); if inp^<>' ' then {set afa failure flag if the next character is not a space} flag := false; {or end of line} end; function fnok(s:string31;writeto:boolean): boolean; var i,dot,sub : integer; fail,ftype : packed array[0..4] of boolean; done : boolean; function ownfile:boolean; type shortword=packed array[1..6]of char; var owner,user:shortword; i:integer; procedure getuser(var u:shortword); const userad=2359296; type string6=packed array[0..6]of char; p=^string6; p2=record dummy:integer; case boolean of true:(userptr:p); false:(addr:integer) end; var find:p2; usr:string6; i:integer; begin find.addr:=userad; usr:=find.userptr^; for i:=1 to 6 do u[i]:=usr[i]; end; begin for i:=1 to 6 do owner[i]:=s[i]; getuser(user); ownfile:= not (owner=user); end; function alphabetical(ch:char): boolean; begin alphabetical := ((ord('A')<=ord(ch))and(ord(ch)<=ord('Z'))) or((ord('a')<=ord(ch))and(ord(ch)<=ord('z'))); end; function alphanumeric(ch:char): boolean; begin alphanumeric := ((ord('0')<=ord(ch))and(ord(ch)<=ord('9'))) or alphabetical(ch); end; begin for i:=0 to 4 do ftype[i]:=false; for i:=0 to 4 do fail[i]:=false; dot := 0; sub := 0; for i:=1 to 31 do if s[i]='.' then dot := i; for i:=31 downto 1 do if s[i]='_' then sub := i; fail[1] := ((dot<>0)and(dot<>7))or((sub<>0)and(dot+1>=sub)) or fail[1]; if dot<>0 then if not fail[1] then for i:=1 to 6 do fail[1]:=fail[1] or not alphanumeric(s[i]); ftype[1] := not fail[1] and (dot<>0); ftype[1]:= ftype[1] and ownfile; fail[0] := fail[1]; if not fail[0] then begin i := dot+1; fail[2] := not alphabetical(s[i]); repeat i := i+1; done := (s[i]=' ')or(s[i]='_'); fail[2] := not ( alphanumeric(s[i]) or(s[i]='#')or done) or fail[2]; until done or fail[2] or (i=dot+12); fail[2] := fail[2] or not done; end; fail[0] := fail[1] or fail[2]; if not fail[0] then begin ftype[3] := sub<>0; if ftype[3] then begin i := sub+1; fail[3] := not alphabetical(s[i]); repeat i := i+1; done := s[i]=' '; fail[3] := fail[3] or not (alphanumeric(s[i]) or done); until done or fail[3] or (i=sub+12); fail[3] := fail[3] or not done; end; end; fail[0] := fail[1] or fail[2] or fail[3] or fail[4]; if fail[0] then begin write('invalid '); if fail[1] then write('username ') else if fail[2] then write('filename ') else if fail[3] then write('membername '); writeln(s); end else begin if writeto then if ftype[1]{other user's file} or ftype[3]{pd file member} then begin write('Sorry but you can''write to '); if ftype[1] then writeln('another user''s file') else writeln('a partitioned file member'); fail[4] := true; end end; fnok := not (fail[1] or fail[2] or fail[3] or fail[4]); end; begin repeat readstring(input,filename,flag); writeln('Can it be written to?: ',fnok(filename,true)); readln(input); until filename[1]='&'; end.