{***************************************************************************}
 {                                                                           }
 {   LFN  -  Free unit for long filename support.  100% asm code.            }
 {           All functions return an error code                              }
 {           and also store it in DosError in the Dos unit.                  }
 {           A demo program is at the end of this unit.                      }
 {                                                                           }
 {   Author: Pino Navato                                                     }
 {   E-Mail: pnavato@poboxes.com                                             }
 {           pnavato@geocities.com                                           }
 {           Pino Navato, 2:335/225.18  (The Bits BBS, Fidonet)              }
 {   WWW:    www.poboxes.com/pnavato                                         }
 {           (currently forwards to  www.geocities.com/SiliconValley/4421)   }
 {                                                                           }
 {   Advertisement:                                                          }
 {     Do you need new CHR fonts for the BGI?  Visit my home page!           }
 {                                                                           }
 {   Acknowledgments:                                                        }
 {     - This unit is partially based on the LDOS unit by Arne de Bruijn.    }
 {     - Technical info obtained from the Ralf Brown's Interrupt List.       }
 {                                                                           }
 {***************************************************************************}


Unit LFN;

interface

uses DOS;


type QuadWord   = array[0..3] of word;  { For W95 file date/time }

     LSearchRec = record
                     Attr            : LongInt;
                     CreationTime,
                     LastAccessTime,
                     LastModTime     : QuadWord; { See below for conversion }
                     HiSize,
                     LoSize          : LongInt;
                     reserved        : array[0..7] of byte;
                     name            : array[0..259] of char;
                     ShortName       : array[0..13] of char; { Only if longname exists }
                     Handle          : word;
                  end;


function LFileSystemInfo(RootName: PChar; FSName: PChar; FSNameBufSize: word;
                         var Flags, MaxFileNameLen, MaxPathLen: word): word;
{ Return File System Information, for FSName 32 bytes should be sufficient }
{ Rootname is, for example, 'C:\' }

{ WARNING: due to a bug in Windows95, this function returns MaxPathLen = 0 }
{          for CD-ROMs!                                                    }

{ Bitfields for long filename volume information flags:       }
{ Bit(s)  Description                                         }
{  0      searches are case sensitive                         }
{  1      preserves case in directory entries                 }
{  2      uses Unicode characters in file and directory names }
{  3-13   reserved (0)                                        }
{  14     supports DOS long filename functions                }
{  15     volume is compressed                                }


function LFindFirst(FileSpec: PChar; Attr: word; var SRec: LSearchRec): word;
{ Search for files }

function LFindNext(var SRec: LSearchRec): word;
{ Find next file }

function LFindClose(SRec: LSearchRec): word;
{ Free search handle }


function LGetTrueName(FileName, TrueName: PChar): word;
{ Return complete path, in buffer TrueName (261 bytes) }

function LGetShortName(FileName, ShortName: PChar): word;
{ Return complete short name/path for input file/path in buffer ShortName (128 bytes) }

function LGetLongName(FileName, LongName: PChar): word;
{ Return complete long name/path for input file/path in buffer LongName (261 bytes) }


function LRename(OldName, NewName: PChar): word;
{ Rename file }

function LErase(Filename: PChar): word;
{ Erase file }

function LMultiErase(FileMask: PChar; SearchAttr, MustMatchAttr: byte): word;
{ Erase files (wildcards allowed) }


function LMkDir(Dir: PChar): word;
{ Make directory }

function LRmDir(Dir: PChar): word;
{ Remove directory }

function LChDir(Dir: PChar): word;
{ Change current directory }

function LGetDir(Drive: byte; Dir: PChar): word;
{ Get current directory (no drive letter nor leading backslash).
  Drive: 0=current, 1=A: etc. }


function LGetFAttr(Filename: PChar; var Attr: word): word;
{ Get file attributes}

function LSetFAttr(Filename: PChar; Attr: word): word;
{ Set file attributes }

function LGetFTime(FileName: PChar; var FTime: LongInt): word;
{ Get last-write date/time }

function LSetFTime(FileName: PChar; FTime: LongInt): word;
{ Set last-write date/time }

function LGetCreationFTime(FileName: PChar; var CFTime: LongInt): word;
{ Get creation file date/time }

function LSetCreationFTime(FileName: PChar; CFTime: LongInt): word;
{ Set creation file date/time }

function LGetLastAccessFDate(FileName: PChar; var LAFDate: LongInt): word;
{ Get last-access file date }

function LSetLastAccessFDate(FileName: PChar; LAFDate: LongInt): word;
{ Set last-access file date }

function LTimeToDos(LTime: QuadWord; var DosTime: LongInt): word;
{ Convert 64-bit W95 file date/time to local DOS date/time (packed format) }

function LUnpackTime(LTime: QuadWord; var DT: DateTime): word;
{ Convert 64-bit time to date/time record }


function LGetPhysicalFSize(FileName: PChar; var Size: LongInt): word;
{ Get physical size of compressed file }



implementation

function LFileSystemInfo(RootName: PChar; FSName: PChar; FSNameBufSize: word;
                         var Flags, MaxFileNameLen, MaxPathLen: word): word; assembler;
{ Return File System Information }
{ WARNING: due to a bug in Windows95, this function returns MaxPathLen = 0 }
{          for CD-ROMs!                                                    }
asm
  push  ds
  lds   dx,RootName
  les   di,FSName
  mov   cx,FSNameBufSize
  mov   ax,71A0h
  stc
  int   21h
  lds   di,Flags
  mov   ds:[di],bx
  lds   di,MaxFileNameLen
  mov   ds:[di],cx
  lds   di,MaxPathLen
  mov   ds:[di],dx
  pop   ds
  sbb   bx,bx      { if CF=1 then BX:=$FFFF else BX:=0 }
  and   ax,bx
  mov   [DosError],ax
end;



function LFindFirst(FileSpec: PChar; Attr: word; var SRec: LSearchRec): word; assembler;
{ Search for files }
asm
  push  ds
  lds   dx,FileSpec
  mov   cx,Attr
  les   di,SRec
  xor   si,si
  mov   ax,714Eh
  stc
  int   21h
  pop   ds
  mov   es:[di].LSearchRec.Handle,ax
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LFindNext(var SRec: LSearchRec): word; assembler;
{ Find next file }
asm
  les   di,SRec
  mov   bx,es:[di].LSearchRec.Handle
  xor   si,si
  mov   ax,714Fh
  stc
  int   21h
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LFindClose(SRec: LSearchRec): word; assembler;
{ Free search handle }
asm
  les   di,SRec
  mov   bx,es:[di].LSearchRec.Handle
  mov   ax,71A1h
  stc
  int   21h
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;



function LGetTrueName(FileName, TrueName: PChar): word; assembler;
{ Return complete path, in buffer TrueName (261 bytes) }
asm
  push  ds
  lds   si,FileName
  les   di,TrueName
  mov   ax,7160h
  xor   cx,cx
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LGetShortName(FileName, ShortName: PChar): word; assembler;
{ Return complete short name/path for input file/path in buffer ShortName (128 bytes) }
asm
  push  ds
  lds   si,FileName
  les   di,ShortName
  mov   ax,7160h
  mov   cx,1    { Return a path containing true path for a SUBSTed drive letter }
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LGetLongName(FileName, LongName: PChar): word; assembler;
{ Return complete long name/path for input file/path in buffer LongName (261 bytes) }
asm
  push  ds
  lds   si,FileName
  les   di,LongName
  mov   ax,7160h
  mov   cx,2    { Return a path containing true path for a SUBSTed drive letter }
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;



function LRename(OldName, NewName: PChar): word; assembler;
asm
  push  ds
  lds   dx,OldName
  les   di,NewName
  mov   ax,7156h
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LErase(Filename: PChar): word; assembler;
asm
  push  ds
  lds   dx,Filename
  xor   si,si        { Wildcards not allowed }
  mov   ax,7141h
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LMultiErase(FileMask: PChar; SearchAttr, MustMatchAttr: byte): word; assembler;
{ Erase files (wildcards allowed) }
asm
  push  ds
  lds   dx,FileMask
  mov   si,1        { Wildcards allowed }
  mov   cl,[SearchAttr]
  mov   ch,[MustMatchAttr]
  mov   ax,7141h
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;



function LMkDir(Dir: PChar): word; assembler;
asm
  push  ds
  lds   dx,Dir
  mov   ax,7139h
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LRmDir(Dir: PChar): word; assembler;
asm
  push  ds
  lds   dx,Dir
  mov   ax,713Ah
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LChDir(Dir: PChar): word; assembler;
asm
  push  ds
  lds   dx,Dir
  mov   ax,713Bh
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LGetDir(Drive:byte; Dir: PChar): word; assembler;
asm
  push  ds
  mov   dl,[Drive]
  lds   si,Dir
  mov   ax,7147h
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;



function LGetFAttr(Filename: PChar; var Attr: word): word; assembler;
asm
  push  ds
  lds   dx,Filename
  mov   ax,7143h
  xor   bl,bl
  stc
  int   21h
  lds   di,Attr
  mov   ds:[di],cx
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LSetFAttr(Filename: PChar; Attr: word): word; assembler;
asm
  push  ds
  lds   dx,Filename
  mov   cx,[Attr]
  mov   ax,7143h
  mov   bl,1
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LGetFTime(FileName: PChar; var FTime: LongInt): word; assembler;
{ Get last-write date/time }
asm
  push  ds
  lds   dx,Filename
  mov   ax,7143h
  mov   bl,4
  stc
  int   21h
  lds   bx,FTime
  mov   ds:[bx],cx
  mov   ds:[bx+2],di
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LSetFTime(FileName: PChar; FTime: LongInt): word; assembler;
{ Set last-write date/time }
asm
  push  ds
  lds   dx,Filename
  mov   cx,word ptr [FTime]
  mov   di,word ptr [FTime+2]
  mov   ax,7143h
  mov   bl,3
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LGetCreationFTime(FileName: PChar; var CFTime: LongInt): word; assembler;
{ Get creation file date/time }
asm
  push  ds
  lds   dx,Filename
  mov   ax,7143h
  mov   bl,8
  stc
  int   21h
  lds   bx,CFTime
  mov   ds:[bx],cx
  mov   ds:[bx+2],di
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LSetCreationFTime(FileName: PChar; CFTime: LongInt): word; assembler;
{ Set creation file date/time }
asm
  push  ds
  lds   dx,Filename
  mov   cx,word ptr [CFTime]
  mov   di,word ptr [CFTime+2]
  xor   si,si
  mov   ax,7143h
  mov   bl,7
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LGetLastAccessFDate(FileName: PChar; var LAFDate: LongInt): word; assembler;
{ Get last-access file date }
asm
  push  ds
  lds   dx,Filename
  mov   ax,7143h
  mov   bl,6
  stc
  int   21h
  lds   bx,LAFDate
  mov   ds:[bx],cx
  mov   ds:[bx+2],di
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LSetLastAccessFDate(FileName: PChar; LAFDate: LongInt): word; assembler;
{ Set last-access file date }
asm
  push  ds
  lds   dx,Filename
  mov   di,word ptr [LAFDate+2]
  mov   ax,7143h
  mov   bl,5
  stc
  int   21h
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LTimeToDos(LTime: QuadWord; var DosTime: LongInt): word; assembler;
{ Convert 64-bit W95 file date/time to local DOS date/time (packed format) }
asm
  push  ds
  lds   si,LTime
  mov   ax,71A7h
  xor   bl,bl
  stc
  int   21h
  lds   di,DosTime
  mov   ds:[di],cx
  mov   ds:[di+2],dx
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


function LUnpackTime(LTime: QuadWord; var DT: DateTime): word; assembler;
{ Convert 64-bit time to date/time record }
var DosTime : LongInt;
asm
  les   di,Ltime
  push  es
  push  di
  lea   di,DosTime
  push  ss
  push  di
  push  cs                    { PUSH CS + CALL NEAR is faster than CALL FAR }
  call  near ptr LTimeToDos   { LTimeToDos(Ltime, DosTime) }
  jc    @end
  push  word ptr [DosTime+2]
  push  word ptr [DosTime]
  les   di,DT
  push  es
  push  di
  call  UnpackTime            { UnpackTime(DosTime, DT) }
  xor   ax,ax
@end:
end;



function LGetPhysicalFSize(FileName: PChar; var Size: LongInt): word; assembler;
{ Get physical size of compressed file }
asm
  push  ds
  lds   dx,Filename
  mov   ax,7143h
  mov   bl,2
  stc
  int   21h
  lds   bx,Size
  mov   ds:[bx],ax
  mov   ds:[bx+2],dx
  pop   ds
  sbb   bx,bx
  and   ax,bx
  mov   [DosError],ax
end;


end.



{***************************************************************************}
{***************************************************************************}

Program LFN_demo;
{$M 4096,0,0}
{$X+}

uses LFN, strings, DOS;

type string2 = string[2];

const  RootName    = 'C:\';
       TempDirName = 'Temporary Directory';
       TempFile0   = 'temp$$$$.tmp';
       TempFile1   = 'Temporary File.tmp';
       TempFile2   = 'Another Temporary File.tmp';
       TempFile3   = 'Yet another temporary file.tmp';

var Buf        : array[0..1023] of char;
    W1, W2, W3 : word;
    f          : text;
    SRec       : LSearchRec;
    DT         : DateTime;
    LN, SN     : Pchar;
    size       : LongInt;
    PDT        : LongInt;  { Packed-format file date/time }


function Str0(B: byte): string2;  { Put a 0 in front of numbers <10 }
begin
   Str0[0] := #2;
   Str0[1] := char(B div 10 + 48);
   Str0[2] := char(B mod 10 + 48);
end;


begin { Main }
    writeln;
    writeln;
    if LFileSystemInfo(RootName, Buf, 32, W1, W2, W3) <> 0 then
       begin
          writeln('Long names not supported!');
          halt
       end;

    if Buf[0] = #0 then                         { This extra check is necessary    }
       begin                                    { if you run the demo from the IDE }
          writeln('Long names not supported!'); { under MS-DOS v6.22               }
          halt                                  { I don't know why.                }
       end;

    writeln('File System name: ', Buf, '   Max Filename Len: ', W2,
            '   Max Path Len: ', W3);
    writeln('Flags:');
    writeln('   Searches are case sensitive = ', W1 and 1 = 1);
    writeln('   Preserves case in directory entries = ', W1 and 2 = 2);
    writeln('   Uses Unicode chars for names = ', W1 and 4 = 4);
    writeln('   Support LFN functions = ', W1 and $4000 = $4000);
    writeln('   Volume is compressed = ', W1 and $8000 = $8000);
    writeln('   Reserved fields = ', W1 and $3FF8);

    writeln;
    writeln('Press ENTER to continue');
    readln;

    writeln('Creating temporary directory.');
    LMkDir(TempDirName);
    writeln('Changing default directory.');
    LChDir(TempDirName);
    write('Default directory is now  ');
    LGetDir(0, Buf);
    writeln(Buf);

    writeln;
    writeln('Creating temporary file #1.');
    assign(f, TempFile0);
    rewrite(f);
    writeln(f, TempFile1);
    close(f);
    writeln('Renaming file #1 to long name.');
    LRename(TempFile0, TempFile1);

    writeln('Creating temporary file #2.');
    rewrite(f);
    writeln(f, TempFile2);
    close(f);
    writeln('Renaming file #2 to long name.');
    LRename(TempFile0, TempFile2);

    writeln('Creating temporary file #3.');
    rewrite(f);
    writeln(f, TempFile3);
    close(f);
    writeln('Renaming file #3 to long name.');
    LRename(TempFile0, TempFile3);

    writeln;
    writeln;
    writeln('Directory of ', Buf);
    writeln;
    LFindFirst('*', AnyFile, SRec);
    while DosError = 0 do
       begin
          LUnpackTime(SRec.LastModTime, DT);
          if SRec.ShortName[0] = #0 then
             begin
                SN := @SRec.name;
                LN := nil
             end
          else
             begin
                SN := @SRec.shortname;
                LN := @SRec.name
             end;
          with DT do                              { Italian-style output }
             WriteLn(SN, '':13-StrLen(SN), SRec.LoSize:9, ' ',
                     Day:3, '/', Str0(Month), '/', Year, ' ',
                     Hour:2, '.', Str0(Min), ' ', LN);
          LFindNext(SRec)
       end;
    LFindClose(SRec);

    writeln;
    writeln('Press ENTER to continue');
    readln;

    writeln('True name of ', SN, ' =');
    LGetTrueName(SN, Buf);
    writeln('   ', Buf);
    writeln('Short name of ', Tempfile3, ' =');
    LGetShortName(TempFile3, Buf);
    writeln('   ', Buf);
    writeln('Long name of ', Buf, ' =');
    LGetLongName(Buf, Buf);
    writeln('   ', Buf);

    if LGetPhysicalFSize(SN, size) <> 0 then
       writeln('Physical size of ', SN, ' = ', size, ' bytes.');

    writeln;
    with DT do
       begin
          Day:= 1;
          Month := 2;
          Year := 1997;
          Hour := 0;
          Min := 1;
          Sec := 2
       end;
    PackTime(DT, PDT);
    LSetCreationFTime(TempFile1, PDT);
    write('Creation date/time of ', TempFile1, ' is now  ');
    LGetCreationFTime(TempFile1, PDT);
    Unpacktime(PDT, DT);
    with DT do                              { Italian-style output }
       WriteLn(Day:3, '/', Str0(Month), '/', Year, ' ',
               Hour:2, '.', Str0(Min), '.', Str0(sec));

    with DT do
       begin
          Day:= 3;
          Month := 4;
          Year := 1997;
          Hour := 4;
          Min := 5;
          Sec := 6
       end;
    PackTime(DT, PDT);
    LSetFTime(TempFile1, PDT);
    write('Last-write date/time of ', TempFile1, ' is now');
    LGetFTime(TempFile1, PDT);
    Unpacktime(PDT, DT);
    with DT do                              { Italian-style output }
       WriteLn(Day:3, '/', Str0(Month), '/', Year, ' ',
               Hour:2, '.', Str0(Min), '.', Str0(sec));

    with DT do
       begin
          Day:= 5;
          Month := 6;
          Year := 1997;
       end;
    PackTime(DT, PDT);
    LSetLastAccessFDate(TempFile1, PDT);
    write('Last-access date of ', TempFile1, ' is now    ');
    LGetLastAccessFDate(TempFile1, PDT);
    Unpacktime(PDT, DT);
    with DT do                              { Italian-style output }
       WriteLn(Day:3, '/', Str0(Month), '/', Year);

    writeln;
    writeln('Setting the hidden file-attribute of ', TempFile1);
    LSetFAttr(TempFile1, archive + hidden);
    write('Checking... ');
    LGetFAttr(TempFile1, W1);
    if W1 = archive + hidden then writeln('OK')
    else
       begin
          writeln('Error!');
          halt
       end;

    writeln;
    writeln('Deleting ', TempFile1);
    LErase(TempFile1);

    writeln('Deleting *.tmp');
    LMultiErase('*.tmp', Archive, Archive);
    LChDir('..');
    writeln('Deleting temporary directory.');
    LRmDir(TempDirName);

    writeln;
    writeln('Done.')
end.