[Back to FILES SWAG index] [Back to Main SWAG index] [Original]

     {***************************************************************************}
     {                                                                           }
     {   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.

[Back to FILES SWAG index] [Back to Main SWAG index] [Original]