Browse Source

+ getlongname

peter 25 years ago
parent
commit
8a7f1814bd
1 changed files with 33 additions and 1 deletions
  1. 33 1
      rtl/go32v2/dos.pp

+ 33 - 1
rtl/go32v2/dos.pp

@@ -121,6 +121,7 @@ Function  FSearch(path: pathstr; dirlist: string): pathstr;
 Function  FExpand(const path: pathstr): pathstr;
 Function  FExpand(const path: pathstr): pathstr;
 Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
 Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
 function  GetShortName(var p : String) : boolean;
 function  GetShortName(var p : String) : boolean;
+function  GetLongName(var p : String) : boolean;
 
 
 {Environment}
 {Environment}
 Function  EnvCount: longint;
 Function  EnvCount: longint;
@@ -1007,6 +1008,34 @@ begin
 end;
 end;
 
 
 
 
+{ change to long filename if successful DOS call PM }
+function GetLongName(var p : String) : boolean;
+var
+  c : array[0..255] of char;
+begin
+  move(p[1],c[0],length(p));
+  c[length(p)]:=#0;
+  copytodos(@c,length(p)+1);
+  dosregs.ax:=$7160;
+  dosregs.cx:=2;
+  dosregs.ds:=tb_segment;
+  dosregs.si:=tb_offset;
+  dosregs.es:=tb_segment;
+  dosregs.di:=tb_offset;
+  msdos(dosregs);
+  LoadDosError;
+  if DosError=0 then
+   begin
+     copyfromdos(@c,255);
+     move(c[0],p[1],strlen(c));
+     p[0]:=char(strlen(c));
+     GetLongName:=true;
+   end
+  else
+   GetLongName:=false;
+end;
+
+
 {******************************************************************************
 {******************************************************************************
                        --- Get/Set File Time,Attr ---
                        --- Get/Set File Time,Attr ---
 ******************************************************************************}
 ******************************************************************************}
@@ -1140,7 +1169,10 @@ End;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.20  2000-02-02 17:34:49  pierre
+  Revision 1.21  2000-02-09 13:00:32  peter
+    + getlongname
+
+  Revision 1.20  2000/02/02 17:34:49  pierre
    * use int64 typecast to avoid overflows in diskfree and disksize
    * use int64 typecast to avoid overflows in diskfree and disksize
 
 
   Revision 1.19  2000/01/23 16:31:23  peter
   Revision 1.19  2000/01/23 16:31:23  peter