mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 18:39:30 +02:00
+ check for LFN support at startup on win16
git-svn-id: trunk@31612 -
This commit is contained in:
parent
181ee0b4d2
commit
04cb0cf615
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user