[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

    {
    Here is a routine I used.  It forces entry of a proper filename,
    not quite what you're looking for, but close:
    }

    uses
      Crt;

    const
      OKFNameChars = ['A'..'Z','a'..'z','0'..'9','$','%','''',
                      '-','@','{','}','~','`','!','#','(',')','&'];

    procedure Backspace;
    begin
      gotoxy(wherex-1,1);write(' ');gotoxy(wherex-1,1);
    end;

    function GetFileName(Prompt : string) : string;
    var
      OKCharSet : set of char;
      ch : char;
      Done : boolean;
      Name : string;
      len : byte absolute Name;
    begin
      OKCharSet := OKFNameChars + ['.',#8,#13,#27];
      write(Prompt);
      Done := false;
      Name := '';
      repeat
        repeat
          ch := upcase(readkey);
        until (ch in OKCharSet);
        case ch of
          #8 : if len > 0 then begin
                 Backspace;
                 dec(len);
               end;
          #13 : Done := true;
          #27 : begin
                  while len > 0 do begin
                    Backspace;
                    dec(len);
                  end;
                  Done := true;
                end;
          '.' : if (len > 0)
                 and (pos('.',Name) = 0) then begin
                  write('.');
                  Name := Name + '.';
                end;
          else if ((pos('.',Name) = 0) and (len < 8))
               or (len - pos('.',Name) < 3) then begin
                 Name := Name + ch;
                 write(ch);
               end;
        end; { case }
      until Done;
      writeln;
      GetFileName := Name;
    end;

    { test follows }
    var
      fname : string;

    begin
      clrscr;
      repeat
        fname := GetFileName('Enter file name: ');
      until fname = '';
    end.

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]