+ check for LFN support at startup on win16

git-svn-id: trunk@31612 -
This commit is contained in:
nickysn 2015-09-11 22:03:50 +00:00
parent 181ee0b4d2
commit 04cb0cf615

View File

@ -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.