  {--------------------------------------------------------------------}

  {-                          LFN.IN4 v1.10                           -}

  {-         Ersatzfunktionen fr Unit Dos fr LFN.PAS v1.10          -}

  {--------------------------------------------------------------------}



{$IFDEF UseDos}

  function FExpand(Path : PathStr) : PathStr;

   {-Erweitert einen unvollstndig angegebenen Dateinamen um den

     dazugehrigen Suchpfad.}

  var

    PName : String;

  begin

    if not FlagIsSet(LFN_Proc, bFExpand) then begin

      FExpand := Dos.FExpand(Path);

      Exit;

    end;



    PName := JustPathName(Path);

    if PName = '' then begin

      {-Nur ein Dateiname wurde angegeben}

      GetDir(0, PName);

      if Regs.AX = $7100 then begin

        {-Function nicht verfgbar, deaktivieren}

        ClearFlag(LFN_Proc, bFExpand);

        {-Original aufrufen}

        FExpand := Dos.FExpand(Path);

        Exit;

      end;

      FExpand := AddBackSlash(PName)+Path;

    end

    else begin

      {-Den korrekten Pfad ermittlen}

      PName := TruePathName(PName);

      if Regs.AX = $7100 then begin

        {-Function nicht verfgbar, deaktivieren}

        ClearFlag(LFN_Proc, bFExpand);

        {-Original aufrufen}

        FExpand := Dos.FExpand(Path);

        Exit;

      end;

      FExpand := AddBackSlash(PName)+JustName(Path);

    end;

  end;

{$ENDIF}



type

  LongSearchRec =

    record

      Attr : LongInt;             {-Dateiattribute}

      CreationTime,               {-Datum/Zeit der Erstellung}

      AccessTime,                 {-Datum/Zeit des letzen Zugriffs}

      ModifyTime,                 {-Datum/Zeit der letzen Vernderung}

      Size : Comp;                {-Gráe der Datei}

      Reserved : array[0..7] of Char;

      LongName : array[0..259] of Char; {-ASCIIZ des langen Dateinamens}

      ShortName : array[1..14] of Char; {-ASCIIZ des kurzen Dateinamens}

    end;



  procedure ConvertSearchRec(L : LongSearchRec; var S : SearchRec);

    {-Kopiert die bentigten Felder des LongSearchRec nach SearchRec}

  type

    CompRec =

      record

        LowC, HighC : LongInt;

      end;

  var

    I : Word;

  begin

    S.Attr := L.Attr;

    S.Time := CompRec(L.ModifyTime).LowC;

    S.Size := CompRec(L.Size).HighC;

    {$IFDEF Windows}

    OemToAnsi(L.LongName, L.LongName);                                 {!!.06}

    {$ENDIF}

    {$IFDEF CompatToDos}

    S.Name := Asc2Str(L.LongName);

    {$ELSE}

    Move(L.LongName, S.Name, AscSize(L.LongName)+1);

    {$ENDIF}

  end;



{$IFDEF CompatToDos}

  procedure FindFirst(Path : String; Attr : Word; var F : SearchRec);

{$ELSE}

  procedure FindFirst(Path : PChar; Attr : Word; var F : SearchRec);

{$ENDIF}

    {-Sucht ein Verzeichnis nach dem ersten Vorkommen eines Dateinamens ab.}

  var

    LSR : LongSearchRec;

{$IFDEF CompatToDos}

    DSR : Dos.SearchRec absolute F;

{$ELSE}

    DSR : WinDos.TSearchRec absolute F;                                {!!.06}

{$ENDIF}

  begin

    {DosError := 0;}                                                   {!!.04}

    if not FlagIsSet(LFN_Proc, bFindFirstNext) then begin

      {-Funktion nicht aktiv, Original aufrufen}

    {$IFDEF CompatToDos}

      Dos.FindFirst(Path, Attr, DSR);

    {$ELSE}

      WinDos.FindFirst(Path, Attr, DSR);                               {!!.06}

    {$ENDIF}

      Exit;

    end;



    DosError := 0;                                                     {!!.04}



  {$IFDEF CompatToDos}

    {-String zu Verwendung als ASCIIZ erweitern}

    AddZero(Path);

  {$ENDIF}

  {$IFDEF Windows}

    AnsiToOem(Path, F.Name);                                           {!!.06}

  {$ENDIF}

    with Regs do begin

      AX := $714E;

      CL := Attr;

      {-CH = required-attributes mask}

      CH := 0;

{---

   SI = date/time format

     0000h  use 64-bit file time format

     0001h  use MS-DOS date/time values (see #0971,#0972) in low

            double-word of file time QWORD (date is high word, time is low

            word of double-word)

---}

      SI := 1;

    {$IFDEF CompatToDos}

      DS := Seg(Path);

      DX := Ofs(Path[1]);

    {$ELSE}

     {!!.06 begin}

     {$IFDEF Windows}

      DS := Seg(F.Name);

      DX := Ofs(F.Name);

     {$ELSE}

      DS := Seg(Path^);

      DX := Ofs(Path^);

     {$ENDIF}

     {!!.06 end}

    {$ENDIF}

      ES := Seg(LSR);

      DI := Ofs(LSR);

      Flags := 0;                                                      {!!.07}

      MsDos(Regs);

      if Flags and FCarry <> 0 then

        {-Fehler}

        if AX = $7100 then begin

          {-Funktion nicht verfgbar, deaktivieren}

          ClearFlag(LFN_Proc, bFindFirstNext);

          {-Das Original aufrufen}

        {$IFDEF CompatToDos}

          Dos.FindFirst(Path, Attr, DSR);

        {$ELSE}

          WinDos.FindFirst(Path, Attr, DSR);                           {!!.06}

        {$ENDIF}

        end

        else

          {-Fehlercode setzen}

          DosError := AX

      else begin

        {-FileHandle fr diesen Suchvorgang merken}

        F.Handle := AX;

        {-Den LongSearchRec in den SearchRec umwandeln}

        ConvertSearchRec(LSR, F);

      end;

    end;

  end;



  procedure FindNext(var F : SearchRec);

    {-Setzt eine mit FindFirst begonnene Suche nach der dort angegebenen

      Datei fort.}

  var

    LSR : LongSearchRec;

  {$IFDEF CompatToDos}

    DSR : Dos.SearchRec absolute F;

  {$ELSE}

    DSR : WinDos.TSearchRec absolute F;                                {!!.06}

  {$ENDIF}

  begin

    {DosError := 0;}                                                   {!!.04}

    if not FlagIsSet(LFN_Proc, bFindFirstNext) then begin

      {-Funktion nicht aktiv, Orginal aufrufen}

    {$IFDEF CompatToDos}

      Dos.FindNext(DSR);

    {$ELSE}

      WinDos.FindNext(DSR);                                            {!!.06}

    {$ENDIF}

      Exit;

    end;



    DosError := 0;                                                     {!!.04}



    with Regs do begin

      AX := $714F;

      BX := F.Handle;

      {-SI = date/time format (siehe FindFirst)}

      SI := 1;

      ES := Seg(LSR);

      DI := Ofs(LSR);

      Flags := 0;                                                      {!!.07}

      MsDos(Regs);

      if Flags and FCarry <> 0 then

        {-Fehler}

        if AX = $7100 then begin

          {-Funktion nicht verfgbar, deaktivieren}

          ClearFlag(LFN_Proc, bFindFirstNext);

          {-Das Original aufrufen}

        {$IFDEF CompatToDos}

          Dos.FindNext(DSR);

        {$ELSE}

          WinDos.FindNext(DSR);                                        {!!.06}

        {$ENDIF}

        end

        else begin

          {-Fehlercode setzen}

          DosError := AX;

          {-Keine weiteren Dateien gefunden?}

          if DosError = 18 then

            {-Filehandle wieder freigeben}

            FindClose(F);

        end

      else

        {-Den LongSearchRec in den SearchRec umwandeln}

        ConvertSearchRec(LSR, F);

    end;

  end;



  procedure FindClose(var F : SearchRec);

    {-Beendet eine mit FindFirst begonnene Suche. (FindClose wird von FindNext

      automatisch aufgerufen, wenn keine weitere Datei mehr gefunden wurde)}

  begin

    if not FlagIsSet(LFN_Proc, bFindFirstNext) then

      {-Funktion nicht aktiv}

      Exit;



    if F.Handle < 5 then

      {-Entweder wurde das Filehandle schon freigegeben, oder aber es

        handelt sich um ein Standardhandle von TP}

      Exit;



    {-Das Filehandle freigeben}

    with Regs do begin

      AX := $71A1;

      BX := F.Handle;

      Flags := 0;                                                      {!!.07}

      MsDos(Regs);

      if Flags and FCarry = 0 then

        {-Als freigeben setzen}

        F.Handle := 0

      else

        if AX = $7100 then

          {-Funktion nicht verfgaber, deaktivieren}

          ClearFlag(LFN_Proc, bFindFirstNext);

    end;

  end;



{$IFDEF UseDos}

  procedure FSplit(Path : String; var Dir : DirStr; var Name : NameStr;

                   var Ext : ExtStr);

    {-Zerlegt einen vollstndigen Dateinamen in seine drei Komponenten.}

  var

    I, J : Word;

    dDir : Dos.DirStr absolute Dir;

    dName : Dos.NameStr absolute Name;

    dExt : Dos.ExtStr absolute Ext;

  begin

    if not FlagIsSet(LFN_Proc, bFSplit) then begin

      Dos.FSplit(Path, dDir, dName, dExt);

      Exit;

    end;



    J := Length(Path);

    Dir := '';

    Name := '';

    Ext := '';

    for I := J downto 1 do begin

      case Path[I] of

        '.' :                     {-Extension}

          if Ext = '' then begin                                       {!!.06}

            Ext := Copy(Path, I, J-I+1);

            J := I-1;

          end;

        '\', ':' :                {-Ende des Pfades}

          begin

            Name := Copy(Path, I+1, J-I);

            Dir := Copy(Path, 1, I);

            Exit;

          end;

      end;

    end;

    if J > 0 then

      Name := Copy(Path, I-1, J-I+1);

  end;

{$ENDIF}



type

  {-Format of extended free space structure:}

  ExtendedDisk =

    record

      ReturnedSize,               {- ret: size of returned structure}

      StructureVersion : Word;    {-call: structure version (0h),

                                     ret: actual structure version}

      {-with adjustment for compression:}

      SectorPerCluster,           {-number of sectors per cluster}

      BytesPerSector,             {-number of bytes per sector}

      Avaible,                    {-number of available clusters}

      Total,                      {-total number of clusters}

      {-without adjustment for compression:}

      PhysicalAvaible,            {-number of physical sectors available}

      PhysicalTotal,              {-total number of physical sectors}

      UnitsAvailble,              {-number of available allocation units}

      UnitsTotal : LongInt;       {-total allocation units}

      Reserved : array[0..127] of Byte;

    end;



  function Call7303(Drive : Byte; var ED : ExtendedDisk) : Boolean;

{---

  Anmerkung: Diese Funktion liefert im Programm unter Windows/DOS7.x

  einwandfreie Ergebnisse. Wenn man allerdings das Prg in der IDE (Turbo oder

  BP) entwickelt, dann liefern sie bei mir nur nach dem ersten Run das

  korrekte Ergebnis. Warum entzieht sich meiner Kenntnis.

---}

  const

    DriveName : String[4] = 'C:\'#0;

  begin

    if Drive = 0 then

      DriveName[1] := DefaultDrive

    else

      DriveName[1] := Char(Drive+64);

    ED.ReturnedSize := 0;

    ED.StructureVersion := 0;

    with Regs do begin

      AX := $7303;

      DS := Seg(DriveName);

      DX := Ofs(DriveName[1]);

      ES := Seg(ED);

      DI := Ofs(ED);

      CX := SizeOf(ED);

      Flags := 0;                                                      {!!.07}

      MsDos(Regs);

      Call7303 := (Flags and FCarry = 0) and

                  (ED.ReturnedSize >= SizeOf(ED)-SizeOf(ED.Reserved));

    end;

  end;



  function DiskFree(Drive : Byte) :

    {$IFDEF DFSReturnComp} Comp ; {$ELSE} LongInt; {$ENDIF}

    {-Liefert die Gráe des freien Speicherplatzes auf einem Laufwerk zurck.}

  var

    ED : ExtendedDisk;

    Size : Comp;

  begin

    if not Call7303(Drive, ED) then

    {$IFDEF UseDos}

      DiskFree := Dos.DiskFree(Drive) {$IFDEF DFSReturnKb} div 1024 {$ENDIF}

    {$ELSE}

      DiskFree :=

        WinDos.DiskFree(Drive) {$IFDEF DFSReturnKb} div 1024 {$ENDIF}  {!!.06}

    {$ENDIF}

    else begin

      Size := 1;

      with ED do

        Size := Size*Avaible*SectorPerCluster*BytesPerSector

                {$IFDEF DFSReturnKb} / 1024 {$ENDIF} ;

    {$IFDEF DFSReturnComp}

      DiskFree:= Size;

    {$ELSE}

      if Size > MaxLongInt then

        DiskFree := MaxLongInt

      else

        DiskFree := Trunc(Size);

    {$ENDIF}

    end;

  end;



  function DiskSize(Drive : Byte) :

    {$IFDEF DFSReturnComp} Comp ; {$ELSE} LongInt; {$ENDIF}

    {-Liefert die Gesamtkapazitt eines Laufwerks zurck.}

  var

    ED : ExtendedDisk;

    Size : Comp;

  begin

    if not Call7303(Drive, ED) then

    {$IFDEF UseDos}

      DiskSize := Dos.DiskSize(Drive) {$IFDEF DFSReturnKb} div 1024 {$ENDIF}

    {$ELSE}

      DiskSize :=

        WinDos.DiskSize(Drive) {$IFDEF DFSReturnKb} div 1024 {$ENDIF}  {!!.06}

    {$ENDIF}

    else begin

      Size := 1;

      with ED do

        Size := Size*Total*SectorPerCluster*BytesPerSector

                {$IFDEF DFSReturnKb} / 1024 {$ENDIF} ;

    {$IFDEF DFSReturnComp}

      DiskSize:= Size;

    {$ELSE}

      if Size > MaxLongInt then

        DiskSize := MaxLongInt

      else

        DiskSize := Trunc(Size);

    {$ENDIF}

    end;

  end;



  function FileSearchPrim(Dest : PChar; DestLen : Word;

                          Name, List : PChar) : Boolean; Assembler;    {!!.08}

    {-Sucht eine Liste von Verzeichnissen nach einem Dateieintrag ab.

      Das Ergebnis wird in Dest gespeichert. Ist Dest^ = #0 dann wurde die

      Datei nicht gefunden. Gibt immer True zurck, ausser Win9x untersttzt

      die Funktion nicht.}

  asm

    push    ds

    cld

    lds     si, List

    les     di, Dest

    mov     cx, DestLen

@@1:

    push    ds

    push    si

    jcxz    @@3

    lds     si, Name

@@2:

    lodsb

    or      al, al

    je      @@3

    stosb

    loop    @@2

@@3:

    xor     al, al

    stosb

    les     di, Dest

    mov     ax, 7143h



    push    ds

    lds     dx, Dest

    xor     bx, bx

    int     21h

    pop     ds



    pop     si

    pop     ds

    jc      @@4

    test    cx, 18h

    je      @@9

@@4:

    cmp     ax, 7100h

    jne     @@4a

    mov     al, False

    jmp     @@Done

@@4a:

    cmp     ax, 7143h

    jne     @@4b

    mov     al, False

    jmp     @@Done

@@4b:



    les     di, Dest

    mov     cx, DestLen

    xor     ah, ah

    lodsb

    or      al, al

    je      @@8

@@5:

    cmp     al, ';'

    je      @@7

    jcxz    @@6

    mov     ah, al

    stosb

    dec     cx

@@6:

    lodsb

    or      al, al

    jne     @@5

    dec     si

@@7:

    jcxz    @@1

    cmp     ah, ':'

    je      @@1

    mov     al, '\'

    cmp     al, ah

    je      @@1

    stosb

    dec     cx

    jmp     @@1

@@8:

    stosb

@@9:

    mov     al, True

@@Done:

    pop     ds

  end;



{$IFDEF UseDos}                                                        {!!.09}

  function Win95FSearch(Path : PathStr; DirList : String) : PathStr;   {!!.08}

    {-Sucht eine Liste von Verzeichnissen nach einem Dateieintrag ab.}

  var

    ResultPtr : Pointer;

  begin

    {-Zeiger auf Win95FSearch holen}

    asm

      les     di, @Result

      mov     ResultPtr.word[0], di

      mov     ResultPtr.word[2], es

    end;

    {-Die Parameter zu AsciiZ's umwandeln}

    Str2Asc(Path, Path);

    Str2Asc(DirList, DirList);

    {-Die Datei suchen}

    if not FileSearchPrim(ResultPtr, 255, @Path, @DirList) then begin

      {-Funktion wird nicht unterstzt, deaktivieren}

      DisableLFNFunc(pFSearch);

      {-Original aufrufen}

      POPJumpFAR(@PatchAddr[pFSearch]);

    end

    else

      {-Das Ergebnis in einen String umwandeln}

      Win95FSearch := Asc2Str(ResultPtr^);

  end;



  function Win95GetEnv(EnvVar : String) : String;                      {!!.09}

    {-Liest einen Eintrag aus der Environment-Tabelle}

  var

    I, P : Integer;

    S : String;

  begin

    EnvVar := StUpcase(EnvVar);

    for I := 1 to EnvCount do begin

      S := EnvStr(I);

      P := Pos('=', S);

      if (P > 0) and (StUpcase(Copy(S, 1, P-1)) = EnvVar) then begin

        Win95GetEnv := Copy(S, P+1, 255);

        Exit;

      end;

    end;

    Win95GetEnv := '';

  end;

{$ENDIF}                                                               {!!.09}

