|
@@ -139,6 +139,11 @@ type
|
|
|
|
|
|
procedure MsDos(var Regs: Registers); external name 'FPC_MSDOS';
|
|
|
|
|
|
+{ invokes int 21h with the carry flag set on entry; used for the LFN functions
|
|
|
+ to ensure that the carry flag is set on exit on older DOS versions which don't
|
|
|
+ support them }
|
|
|
+procedure MsDos_Carry(var Regs: Registers); external name 'FPC_MSDOS_CARRY';
|
|
|
+
|
|
|
{$define SYSTEMUNIT}
|
|
|
{$I wintypes.inc}
|
|
|
{$I winprocsh.inc}
|
|
@@ -295,6 +300,27 @@ begin
|
|
|
{$endif FPC_X86_DATA_NEAR}
|
|
|
end;
|
|
|
|
|
|
+function CheckLFN:boolean;
|
|
|
+var
|
|
|
+ regs : Registers;
|
|
|
+ RootName : pchar;
|
|
|
+ buf : array [0..31] of char;
|
|
|
+begin
|
|
|
+{ Check LFN API on drive c:\ }
|
|
|
+ RootName:='C:\';
|
|
|
+{ Call 'Get Volume Information' ($71A0) }
|
|
|
+ FillChar(regs,SizeOf(regs),0);
|
|
|
+ regs.AX:=$71a0;
|
|
|
+ regs.ES:=Seg(buf);
|
|
|
+ regs.DI:=Ofs(buf);
|
|
|
+ regs.CX:=32;
|
|
|
+ regs.DS:=Seg(RootName^);
|
|
|
+ regs.DX:=Ofs(RootName^);
|
|
|
+ MsDos_Carry(regs);
|
|
|
+{ If carryflag=0 and LFN API bit in ebx is set then use Long file names }
|
|
|
+ CheckLFN:=(regs.Flags and fCarry=0) and (regs.BX and $4000=$4000);
|
|
|
+end;
|
|
|
+
|
|
|
procedure SysInitStdIO;
|
|
|
begin
|
|
|
OpenStdIO(Input,fmInput,StdInputHandle);
|
|
@@ -336,4 +362,13 @@ begin
|
|
|
InitWin16Heap;
|
|
|
SysInitExceptions;
|
|
|
initunicodestringmanager;
|
|
|
+{ Use LFNSupport LFN }
|
|
|
+ LFNSupport:=CheckLFN;
|
|
|
+ if LFNSupport then
|
|
|
+ begin
|
|
|
+ FileNameCasePreserving:=true;
|
|
|
+ AllFilesMask := '*';
|
|
|
+ end
|
|
|
+ else
|
|
|
+ AllFilesMask := '*.*';
|
|
|
end.
|