www.pudn.com > tp60src.zip > FNAMES.PAS

unit FNames; 
 
{$O+,F+,S-} 
 
interface 
 
uses TDos; 
 
procedure ConvertPath(var Path: PathStr; MaxLen: Integer); 
procedure ShortenPath(var Path: PathStr; MaxLen: Integer); 
 
implementation 
 
function Begins(A, B: string): Boolean; near; assembler; 
asm 
        PUSH    DS 
        XOR     AX,AX 
        LES     DI,B 
        LDS     SI,A 
        LODSB 
        XCHG    AX,CX 
        INC     DI 
        CLD 
        REPE    CMPSB 
        MOV     AX,0 
        JNE     @@1 
        INC     AX 
@@1:    POP     DS 
end; 
 
procedure ShortenDir(var Dir: DirStr); 
var 
  Root: Boolean; 
  I: Integer; 
begin 
  if Dir = '\' then 
    Dir := '' 
  else 
  begin 
    if Dir[1] = '\' then 
    begin 
      Root := True; 
      Dir := Copy(Dir, 2, 255); 
    end else 
      Root := False; 
    if Dir[1] = '.' then 
      Dir := Copy(Dir, 5, 255); 
    I := Pos('\', Dir); 
    if I <> 0 then 
      Dir := '...\' + Copy(Dir, I + 1, 255) 
    else 
      Dir := ''; 
    if Root then 
      Dir := '\' + Dir; 
  end; 
end; 
 
procedure ConvertPath(var Path: PathStr; MaxLen: Integer); 
var 
  Drive: string[3]; 
  Dir: DirStr; 
  Name: NameStr; 
  Ext: ExtStr; 
  CurDir: DirStr; 
begin 
  if Path = '' then 
    Exit; 
  FSplit(Path, Dir, Name, Ext); 
  Drive := ''; 
  if (Length(Dir) > 2) and (Dir[2] = ':') then 
  begin 
    if (Dir[1] = 'A') or (Dir[1] = 'B') then 
      Dir := '' 
    else 
    begin 
      CurDir := GetCurDir(UpCase(Path[1])); 
      if Length(CurDir) > 3 then 
        CurDir := CurDir + '\'; 
      Dir := Copy(Dir, 3, 255); 
      CurDir := Copy(CurDir, 3, 255); 
      if Begins(CurDir, Dir) then 
        Dir := Copy(Dir, Length(CurDir) + 1, 255); 
    end; 
    if GetCurDrive <> Path[1] then 
      Drive := Path[1] + ':'; 
  end; 
  Path:=Drive + Dir + Name + Ext; 
  ShortenPath(Path, MaxLen); 
end; 
 
procedure ShortenPath(var Path: PathStr; MaxLen: Integer); 
var 
  Drive: string[3]; 
  Dir: DirStr; 
  Name: NameStr; 
  Ext: ExtStr; 
begin 
  FSplit(Path, Dir, Name, Ext); 
  if Dir[2] = ':' then 
  begin 
    Drive := Copy(Dir, 1, 2); 
    Dir := Copy(Dir, 3, 255); 
  end else 
    Drive := ''; 
  while (Length(Path) > MaxLen) and 
    ((Length(Dir) <> 0) or (Length(Drive) <> 0)) do 
  begin 
    if Dir = '\...\' then 
    begin 
      Drive := ''; 
      Dir := '...\'; 
    end else 
      if Dir = '' then 
        Drive := '' 
      else 
        ShortenDir(Dir); 
    Path := Drive + Dir + Name + Ext; 
  end; 
end; 
 
end.