mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 01:39:35 +01:00
d66d15aad3
* renamed platform-specific pchar versions of those rouines to do_*() and
changed them to either rawbytestring or unicodestring depending on the
FPCRTL_FILESYSTEM_SINGLE_BYTE_API/FPCRTL_FILESYSTEM_TWO_BYTE_API setting
* implemented generic shortstring versions of those routines on top of either
rawbytestring or unicodestring depending on the API-kind (in case of the
embedded target, if ansistring are not supported they will map directly
to shortstring routines instead)
* all platform-specific *dir() routines with rawbytestring parameters now
receive their parameters in DefaultFileSystemCodePage
- removed no longer required ansistring variants from the objpas unit
- removed no longer required FPC_SYS_MKDIR etc aliases
* factored out empty string and inoutres<>0 checks from platform-specific
*dir() routines to generic ones
o platform-specific notes:
o amiga/morphos: check new pathconv(rawbytestring) function
o macos TODO: convert PathArgToFSSpec (and the routines it calls) to
rawbytestring
o nativent: added SysUnicodeStringToNtStr() function
o wii: convert dirio callbacks to use rawbytestring to avoid conversion
+ test for unicode mk/ch/rm/getdir()
git-svn-id: branches/cpstrrtl@25048 -
134 lines
3.2 KiB
PHP
134 lines
3.2 KiB
PHP
{*****************************************************************************
|
|
Directory Handling
|
|
*****************************************************************************}
|
|
|
|
procedure DosDir(func:byte;const s:rawbytestring);
|
|
var
|
|
buffer : array[0..255] of char;
|
|
regs : trealregs;
|
|
begin
|
|
if length(s)>255 then
|
|
begin
|
|
inoutres:=3;
|
|
exit;
|
|
end;
|
|
move(s[1],buffer,length(s));
|
|
buffer[length(s)]:=#0;
|
|
DoDirSeparators(pchar(@buffer));
|
|
{ True DOS does not like backslashes at end
|
|
Win95 DOS accepts this !!
|
|
but "\" and "c:\" should still be kept and accepted hopefully PM }
|
|
if (length(s)>0) and (buffer[length(s)-1]='\') and
|
|
Not ((length(s)=1) or ((length(s)=3) and (s[2]=':'))) then
|
|
buffer[length(s)-1]:=#0;
|
|
syscopytodos(longint(@buffer),length(s)+1);
|
|
regs.realedx:=tb_offset;
|
|
regs.realds:=tb_segment;
|
|
if LFNSupport then
|
|
regs.realeax:=$7100+func
|
|
else
|
|
regs.realeax:=func shl 8;
|
|
sysrealintr($21,regs);
|
|
if (regs.realflags and carryflag) <> 0 then
|
|
GetInOutRes(lo(regs.realeax));
|
|
end;
|
|
|
|
|
|
procedure do_mkdir(const s : rawbytestring);
|
|
begin
|
|
DosDir($39,s);
|
|
end;
|
|
|
|
|
|
procedure do_rmdir(const s : rawbytestring);
|
|
begin
|
|
if s = '.' then
|
|
begin
|
|
InOutRes := 16;
|
|
exit;
|
|
end;
|
|
DosDir($3a,s);
|
|
end;
|
|
|
|
|
|
procedure do_chdir(const s : rawbytestring);
|
|
var
|
|
regs : trealregs;
|
|
begin
|
|
{ First handle Drive changes }
|
|
if (length(s)>=2) and (s[2]=':') then
|
|
begin
|
|
regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
|
|
regs.realeax:=$0e00;
|
|
sysrealintr($21,regs);
|
|
regs.realeax:=$1900;
|
|
sysrealintr($21,regs);
|
|
if byte(regs.realeax)<>byte(regs.realedx) then
|
|
begin
|
|
Inoutres:=15;
|
|
exit;
|
|
end;
|
|
{ DosDir($3b,'c:') give Path not found error on
|
|
pure DOS PM }
|
|
if length(s)=2 then
|
|
exit;
|
|
end;
|
|
{ do the normal dos chdir }
|
|
DosDir($3b,s);
|
|
end;
|
|
|
|
|
|
procedure do_getdir(drivenr : byte;var dir : RawByteString);
|
|
var
|
|
temp : array[0..255] of char;
|
|
i : longint;
|
|
regs : trealregs;
|
|
begin
|
|
regs.realedx:=drivenr;
|
|
regs.realesi:=tb_offset;
|
|
regs.realds:=tb_segment;
|
|
if LFNSupport then
|
|
regs.realeax:=$7147
|
|
else
|
|
regs.realeax:=$4700;
|
|
sysrealintr($21,regs);
|
|
if (regs.realflags and carryflag) <> 0 then
|
|
Begin
|
|
GetInOutRes(lo(regs.realeax));
|
|
Dir := char (DriveNr + 64) + ':\';
|
|
SetCodePage(dir,DefaultFileSystemCodePage,false);
|
|
exit;
|
|
end
|
|
else
|
|
syscopyfromdos(longint(@temp),251);
|
|
{ conversion to Pascal string including slash conversion }
|
|
i:=0;
|
|
SetLength(Dir,255);
|
|
while (temp[i]<>#0) do
|
|
begin
|
|
if temp[i] in AllowDirectorySeparators then
|
|
temp[i]:=DirectorySeparator;
|
|
dir[i+4]:=temp[i];
|
|
inc(i);
|
|
end;
|
|
dir[2]:=':';
|
|
dir[3]:='\';
|
|
SetLength(Dir,i+3);
|
|
SetCodePage(dir,DefaultFileSystemCodePage,false);
|
|
{ upcase the string }
|
|
if not FileNameCasePreserving then
|
|
dir:=upcase(dir);
|
|
if drivenr<>0 then { Drive was supplied. We know it }
|
|
dir[1]:=char(65+drivenr-1)
|
|
else
|
|
begin
|
|
{ We need to get the current drive from DOS function 19H }
|
|
{ because the drive was the default, which can be unknown }
|
|
regs.realeax:=$1900;
|
|
sysrealintr($21,regs);
|
|
i:= (regs.realeax and $ff) + ord('A');
|
|
dir[1]:=chr(i);
|
|
end;
|
|
end;
|
|
|