paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 09:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* added getlongname and getshortname

Browse Source
This commit is contained in:
marco 2000-05-26 12:03:13 +00:00
parent 13d8d513b0
commit f210e534e1
1 changed files with 55 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
rtl/win32/dos.pp
View File

@ -139,6 +139,8 @@ Procedure GetFTime(var f; var time: longint);
Function FSearch(path: pathstr; dirlist: string): pathstr; 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 GetLongName(var p : String) : boolean;
{Environment} {Environment}
Function EnvCount: longint; Function EnvCount: longint;
@ -676,9 +678,12 @@ end;
{ <immobilizer> } { <immobilizer> }
function GetFullPathName(lpFileName: PChar; nBufferLength: Longint; lpBuffer: PChar; var lpFilePart : PChar):DWORD; function GetFullPathName(lpFileName: PChar; nBufferLength: Longint; lpBuffer: PChar; var lpFilePart : PChar):DWORD;
external 'kernel32' name 'GetFullPathNameA'; external 'kernel32' name 'GetFullPathNameA';
function GetShortPathName(lpszLongPath:pchar; lpszShortPath:pchar; cchBuffer:DWORD):DWORD;
external 'kernel32' name 'GetShortPathNameA';
function FExpand(const path : pathstr) : pathstr; function FExpand(const path : pathstr) : pathstr;
var value : Array[0..255] of char; var value : Array[0..255] of char;
tmp : PChar; tmp : PChar;
@ -815,6 +820,51 @@ begin
doserror:=getlasterror; doserror:=getlasterror;
end; end;
{ change to short filename if successful win32 call PM }
function GetShortName(var p : String) : boolean;
var
buffer : array[0..255] of char;
ret : longint;
begin
{we can't mess with p, because we have to return it if call is
unsuccesfully.}
if Length(p)>0 then {copy p to array of char}
move(p[1],buffer[0],length(p));
buffer[length(p)]:=chr(0);
{Should return value load loaddoserror?}
ret:=GetShortPathName(@buffer,@buffer,255);
if ret=0 then
p:=strpas(buffer);
GetShortName:=ret<>0;
end;
{ change to long filename if successful DOS call PM }
function GetLongName(var p : String) : boolean;
var
lfn,sfn : array[0..255] of char;
filename : pchar;
ret : longint;
begin
{contrary to shortname, SDK does not mention input buffer can be equal
to output.}
if Length(p)>0 then {copy p to array of char}
move(p[1],sfn[0],length(p));
sfn[length(p)]:=chr(0);
fillchar(lfn,sizeof(lfn),#0);
filename:=nil;
{Should return value load loaddoserror?}
ret:=GetFullPathName(@sfn,255,@lfn,filename);
if ret=0 then
p:=strpas(lfn); {lfn here returns full path, filename only fn}
GetLongName:=ret<>0;
end;
{****************************************************************************** {******************************************************************************
--- Environment --- --- Environment ---
@ -954,7 +1004,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.36 2000-05-19 13:20:37 pierre Revision 1.37 2000-05-26 12:03:13 marco
* added getlongname and getshortname
Revision 1.36 2000/05/19 13:20:37 pierre
* avoid some Range Check errors * avoid some Range Check errors
Revision 1.35 2000/04/17 20:43:27 pierre Revision 1.35 2000/04/17 20:43:27 pierre