[Back to DOS SWAG index] [Back to Main SWAG index] [Original]
{
I've made a Windows 95 long filename DOS unit. The file opening part is
missing, maybe I will add it someday. A simple test program is after the end
of part 2. }
{ Long filename DOS unit, Arne de Bruijn, 19960402, Public Domain }
{ All functions return the errorcode, and store it in DosError in }
{ the Dos unit. }
{ The functions work only if Windows 95 is loaded! }
unit ldos;
interface
uses dos;
type
TLSearchRec=record
Attr:longint;
CreationTime,LastAccessTime,LastModTime:comp; { See below for conversion }
HiSize,LoSize:longint;
Reserved:comp;
Name:array[0..259] of char;
ShortName:array[0..13] of char; { Only if longname exists }
Handle:word;
end;
function LFindFirst(FileSpec:pchar; Attr:word; var SRec:TLSearchRec):word;
{ Search for files }
function LFindNext(var SRec:TLSearchRec):word;
{ Find next file }
function LFindClose(var SRec:TLSearchRec):word;
{ Free search handle }
function LTruename(FileName:pchar; Result:pchar):word;
{ Return complete path, if relative uppercased longnames added, }
{ in buffer Result (261 bytes) }
function LGetShortName(FileName:pchar; Result:pchar):word;
{ Return complete short name/path for input file/path in buffer }
{ Result (79 bytes) }
function LGetLongName(FileName:pchar; Result:pchar):word;
{ Return complete long name/path for input file/path in buffer }
{ Result (261 bytes) }
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:\' }
{ Flags: }
{ bit
{ 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 LErase(Filename:pchar):word;
{ Erase file }
function LMkDir(Directory:pchar):word;
{ Make directory }
function LRmDir(Directory:pchar):word;
{ Remove directory }
function LChDir(Directory:pchar):word;
{ Change current directory }
function LGetDir(Drive:byte; Result:pchar):word;
{ Get current drive and directory. Drive: 0=current, 1=A: etc. }
function LGetAttr(Filename:pchar; var Attr:word):word;
{ Get file attributes}
function LSetAttr(Filename:pchar; Attr:word):word;
{ Set file attributes }
function LRename(OldFilename,NewFilename:pchar):word;
{ Rename file }
function LTimeToDos(var LTime:comp):longint;
{ Convert 64-bit number of 100ns since 01-01-1601 UTC to local DOS format time
}{ (LTime is var to avoid putting it on the stack) }
procedure UnpackLTime(var LTime:comp; var DT:DateTime);
{ Convert 64-bit time to date/time record }
implementation
function LFindFirst(FileSpec:pchar; Attr:word; var SRec:TLSearchRec):word;
assembler;
{ Search for files }
asm
push ds
lds dx,FileSpec
les di,SRec
mov cx,Attr
xor si,si
mov ax,714eh
int 21h
pop ds
sbb bx,bx
mov es:[di].TLSearchRec.Handle,ax
and ax,bx
mov [DosError],ax
end;
function LFindNext(var SRec:TLSearchRec):word; assembler;
{ Find next file }
asm
mov ax,714fh
xor si,si
les di,SRec
mov bx,es:[di].TLSearchRec.Handle
int 21h
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
{ corrects bug in LDOS .. }
function LFindClose(var SRec:TLSearchRec):word; assembler;
{ Free search handle }
asm
{mov ax,714fh}
mov ax,71A1h
mov bx,es:[di].TLSearchRec.Handle
int 21h
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LTrueName(FileName:pchar; Result:pchar):word; assembler;
{ Return complete path, if relative uppercased longnames added, }
{ in buffer Result (261 bytes) }
asm
push ds
mov ax,7160h
xor cx,cx
lds si,FileName
les di,Result
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LGetShortName(FileName:pchar; Result:pchar):word; assembler;
{ Return complete short name/path for input file/path in buffer }
{ Result (79 bytes) }
asm
push ds
lds si,FileName
les di,Result
mov ax,7160h
mov cx,1
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LGetLongName(FileName:pchar; Result:pchar):word; assembler;
{ Return complete long name/path for input file/path in buffer }
{ Result (261 bytes) }
asm
push ds
lds si,FileName
les di,Result
mov ax,7160h
mov cx,2
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LFileSystemInfo(RootName:pchar; FSName:pchar; FSNameBufSize:word;
var Flags,MaxFileNameLen,MaxPathLen:word):word; assembler;
{ Return File System Information, for FSName 32 bytes should be sufficient }
asm
push ds
lds dx,RootName
les di,FSName
mov cx,FSNameBufSize
mov ax,71a0h
int 21h
pop ds
les di,Flags
mov es:[di],bx
les di,MaxFileNameLen
mov es:[di],cx
les di,MaxPathLen
mov es:[di],dx
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LTimeToDos(var LTime:comp):longint; assembler;
{ Convert 64-bit number of 100ns since 01-01-1601 UTC to local DOS format time
}{ (LTime is var to avoid putting it on the stack) }
asm
push ds
lds si,LTime
xor bl,bl
mov ax,71a7h
int 21h
pop ds
mov ax,cx
cmc
sbb cx,cx
and ax,cx
and dx,cx
end;
procedure UnpackLTime(var LTime:comp; var DT:DateTime);
{ Convert 64-bit time to date/time record }
begin
UnpackTime(LTimeToDos(LTime),DT);
end;
function LMkDir(Directory:pchar):word; assembler;
asm
push ds
lds dx,Directory
mov ax,7139h
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LRmDir(Directory:pchar):word; assembler;
asm
push ds
lds dx,Directory
mov ax,713ah
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LChDir(Directory:pchar):word; assembler;
asm
push ds
lds dx,Directory
mov ax,713bh
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
mov ax,7141h
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LGetAttr(Filename:pchar; var Attr:word):word; assembler;
asm
push ds
lds dx,Filename
mov ax,7143h
xor bl,bl
int 21h
pop ds
les di,Attr
mov es:[di],cx
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LSetAttr(Filename:pchar; Attr:word):word; assembler;
asm
push ds
lds dx,Filename
mov ax,7143h
mov bl,1
mov cx,Attr
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LGetDir(Drive:byte; Result:pchar):word; assembler;
asm
cld
les di,Result
mov al,Drive
mov dl,al
dec al
jns @GotDrive
mov ah,19h
int 21h
@GotDrive:
add al,41h
mov ah,':'
stosw
mov ax,'\'
stosw
push ds
push es
pop ds
mov si,di
dec si
mov ax,7147h
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
function LRename(OldFilename,NewFilename:pchar):word; assembler;
asm
push ds
lds dx,OldFilename
les di,NewFilename
mov ax,7156h
int 21h
pop ds
sbb bx,bx
and ax,bx
mov [DosError],ax
end;
end.
=== LDOSTEST.PAS
{ Simple sample for LDOS unit, Arne de Bruijn, 19960402, Public Domain }
uses ldos,strings,dos;
type string2=string[2];
function Str0(B:byte):string2;
begin Str0[0]:=#2; Str0[1]:=char(B div 10+48); Str0[2]:=char(B mod 10+48);
end;
var
Buf,BufO:array[0..261] of char;
SRec:TLSearchRec;
DT:DateTime;
LN,SN:pchar;
W1,W2,W3:word;
begin
Write('Enter path:'); ReadLn(Buf);
WriteLn('LFileSystemInfo:',LFileSystemInfo(Buf,BufO,32,W1,W2,W3),
' = ',BufO,',',W1,',',W2,',',W3);
WriteLn('LTruename:',LTrueName(Buf,BufO),' = ',BufO);
WriteLn('LGetShortName:',LGetShortName(Buf,BufO),' = ',BufO);
WriteLn('LGetLongName:',LGetLongName(Buf,BufO),' = ',BufO);
LFindFirst(Buf,16,SRec);
while DosError=0 do begin
UnpackLTime(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 WriteLn(SN,'':13-StrLen(SN),SRec.LoSize:9,
' ',Day:3,'-',Str0(Month),'-',Year,' ',Hour:2,':',Str0(Min),' ',LN);
LFindNext(SRec); end;
LFindClose(SRec);
end.
[Back to DOS SWAG index] [Back to Main SWAG index] [Original]