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

{ This program uses a proc from my pascal library that I use to get
  true names. Written and tested with tp4  should work with any tp and
  dos 3.1+  gm 05/94 }
uses
  dos;
  {--05/93 gary a. mays --}
  {  this procedure uses the undocumented dos function $60 to fetch the
     canonical name of a file or path specification }
  procedure canonicalize(path: string; var canonical: string;
                          var stat: word);
    var
      regs : registers;
      i : integer;
      bytes : byte absolute canonical;
  begin
    with regs do
    begin
      stat := 0;
      ah := $60;
      path := path + chr(0); { convert to asciz }
      ds := seg(path[1]); { asciz name }
      si := ofs(path[1]);
      es := seg(canonical[1]);{ points to 128 byte result buffer }
      di := ofs(canonical[1]);{ result is asciz }
      msdos(regs); { returns canonical name: does not have to exist... }
      if flags and fcarry > 0 then
        stat := ax
      else
      begin
        bytes := 0;
        while canonical[bytes + 1] <> #0 do inc(bytes); {conv to ascii}
        { not tested on a network - this test will fail on net drive }
        if canonical[2] <> ':' then { bad because of bad path }
          stat := 3;
      end;
    end;
  end; {canonicalize}

  var
    stat : word;
    path : string;
    canonical : string;
begin
  if paramstr(1) = '' then
    path := '.'
  else
    path := paramstr(1);
  canonicalize(path, canonical, stat);
  case stat of
  0: writeln(canonical);
  2: writeln('Invalid path: ',path);
  3: writeln('Invalid drive or malformed path: ',path);
  else writeln('Status: ',stat,' for ',path);
  end; {case}
end.


IL>  I'm looking for an equivalent to the DOS command TRUENAME. Here's an

program TruePath;
uses OpString,DOS;
var
  OldName, NewName : String;
  RegisterSet : Registers;
Begin
  OldName:=ParamStr(1);
  OldName[Length(OldName)+1] := #0;
  NewName[0] := #0;
  With RegisterSet do
  Begin
    AH := $60;
    AL := 0;
    DS := Seg(OldName[1]);
    SI := Ofs(OldName[1]);
    ES := Seg(NewName[1]);
    DI := Ofs(NewName[1]);
  End;
  MsDos(RegisterSet);
  If Odd(RegisterSet.Flags) Then
    Writeln('Failure ',RegisterSet.AX) (* failure code *)
  Else
  Begin
    NewName[0]:=#255;
    NewName[0]:=Chr(Pos(#0,NewName));
    Writeln(NewName);
  End;
End.

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