home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S1.ARC / KFIXFNAM.MOD < prev    next >
Encoding:
Text File  |  1987-12-01  |  3.7 KB  |  106 lines
  1. (*----------------------------------------------------------------------*)
  2. (*    Fix_File_Name --- Fix file name from remote to be MS DOS style    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Fix_File_Name( FileName : AnyStr ) : AnyStr;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Fix_File_Name                                        *)
  10. (*                                                                      *)
  11. (*     Purpose:    Fixes received file name to be MS DOS style          *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Fixed_Name := Fix_File_Name( FileName : AnyStr ) : AnyStr;    *)
  16. (*                                                                      *)
  17. (*           FileName  --- name of file from remote system              *)
  18. (*                                                                      *)
  19. (*----------------------------------------------------------------------*)
  20.  
  21. VAR
  22.    Temp_Name : AnyStr;
  23.    Suffix    : STRING[3];
  24.    I         : INTEGER;
  25.    L         : INTEGER;
  26.    Dot_Found : BOOLEAN;
  27.    Done      : BOOLEAN;
  28.  
  29. (* STRUCTURED *) CONST
  30.    Legal_File_Name_Chars : SET OF CHAR = ['A'..'Z','0'..'9','$','&',
  31.                                           '#','%','''','(',')','-',
  32.                                           '@','^','{','}','~','`',
  33.                                           '!','_'];
  34.  
  35. BEGIN (* Fix_File_Name *)
  36.  
  37.    Suffix    := '';
  38.    Temp_Name := '';
  39.    Dot_Found := FALSE;
  40.    Done      := FALSE;
  41.    L         := LENGTH( FileName );
  42.  
  43.                                    (* Throw away anything in front *)
  44.                                    (* of a colon.                  *)
  45.    I := POS( ':' , FileName );
  46.  
  47.    IF ( I > 0 ) THEN
  48.       FileName := COPY( FileName, SUCC( I ), L - I );
  49.  
  50.                                    (* Look for trailing 'name.ext' *)
  51.    L := LENGTH( FileName );
  52.  
  53.    REPEAT
  54.  
  55.       CASE Dot_Found OF
  56.  
  57.          TRUE:  BEGIN
  58.                    IF FileName[L] <> '.' THEN
  59.                       Temp_Name := UpCase( FileName[L] ) + Temp_Name;
  60.                 END;
  61.  
  62.          FALSE: IF FileName[L] = '.' THEN
  63.                    BEGIN
  64.                       Dot_Found := TRUE;
  65.                       IF ( LENGTH( Temp_Name ) <= 3 ) THEN
  66.                          Suffix := Temp_Name
  67.                       ELSE
  68.                          Suffix := COPY( Temp_Name, 1, 3 );
  69.                       Temp_Name := '';
  70.                    END
  71.                 ELSE
  72.                    Temp_Name := UpCase( FileName[L] ) + Temp_Name;
  73.  
  74.       END (* CASE *);
  75.  
  76.       L    := PRED( L );
  77.       Done := Done OR ( L < 1 );
  78.  
  79.    UNTIL Done;
  80.  
  81.                                    (* Evict illegal characters *)
  82.    L := LENGTH( Temp_Name );
  83.  
  84.    FOR I := 1 TO L DO
  85.       IF ( NOT ( Temp_Name[I] IN Legal_File_Name_Chars ) ) THEN
  86.          DELETE( Temp_Name, I, 1 );
  87.  
  88.    L := LENGTH( Suffix );
  89.  
  90.    FOR I := 1 TO L DO
  91.       IF ( NOT ( Suffix[I] IN Legal_File_Name_Chars ) ) THEN
  92.          DELETE( Suffix, I, 1 );
  93.  
  94.                                    (* Truncate name to 8 characters *)
  95.  
  96.    IF ( LENGTH( Temp_Name ) > 8 ) THEN
  97.       Temp_Name := COPY( Temp_Name, 1, 8 );
  98.  
  99.                                    (* Append suffix if '.' found *)
  100.    IF Dot_Found THEN
  101.       Temp_Name := Temp_Name + '.' + Suffix;
  102.  
  103.    Fix_File_Name := Temp_Name;
  104.  
  105. END   (* Fix_File_Name *);
  106.