Bladeren bron

+ check for LFN support at startup on win16

git-svn-id: trunk@31612 -
nickysn 10 jaren geleden
bovenliggende
commit
04cb0cf615
1 gewijzigde bestanden met toevoegingen van 35 en 0 verwijderingen
  1. 35 0
      rtl/win16/system.pp

+ 35 - 0
rtl/win16/system.pp

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