unit lfn;
{pascal unit for _full_ access to the LFN API, no fallbacks.
Most names and parameter lists should be equal to Win32 API,
so you can write code both compilable with Delphi1 and Delphi2.}
{$W-,S-,G+}
{$IFDEF Windows}
{$C MOVEABLE PRELOAD PERMANENT} {same code attributes as unit SYSTEM}
{$ENDIF}
interface
uses WinDos{$IFDEF Windows},WinProcs,WinTypes,Win31{$ENDIF};
{$IFNDEF Windows}
type
Bool=WordBool;
{$ENDIF}
var
ExtraInfo:Word; {CX value for FindFirst, FindNext, CreateFile}
const
DateFormat: Bool=true; {DOS time format for FindFirst, FindNext (SI)}
FindFirst_Attr: Word=$3F; {global for a compatible FindFirstFile call}
var
AliasHint: Word absolute DateFormat; {also: AliasHint for CreateFile}
type
LongRec=record
lo,hi:Word;
end;
LongLong=record
lo,hi:LongInt;
end;
PFileTime=^TFileTime;
TFileTime=record {OK}
dwLowDateTime: LongInt;
dwHighDateTime: LongInt;
end;
PSecurityAttributes=^TSecurityAttributes;
TSecurityAttributes=record {unused!} {NOK}
end;
PWin32FindData=^TWin32FindData;
TWin32FindData=record {OK}
dwFileAttributes: LongInt;
ftCreationTime: TFileTime;
ftLastAccessTime: TFileTime;
ftLastWriteTime: TFileTime;
nFileSizeHigh: LongInt;
nFileSizeLow: LongInt; {unsigned!}
dwReserved0: LongInt;
dwReserved1: LongInt;
cFileName: array[0..259] of Char;
cAlternateFileName: array[0..13] of Char;
end;
PVolumeInformation=^TVolumeInformation;
TVolumeInformation=record
fsname:array[0..15] of Char;
max_path:Word;
max_file:Word;
fs_flags:Word;
end;
const
MAX_PATH=260;
type
TLfnBuf=array[0..MAX_PATH-1] of Char;
const {ExtraInfo code from FindFirst/FindNext}
CF_NoConvert=1;
const {indices for Get/SetFileAttr}
FA_GetAttr=0;
FA_SetAttr=1;
FA_GetPhysSize=2;
FA_SetTimeM=3;
FA_GetTimeM=4;
FA_SetTimeA=5;
FA_GetTimeA=6;
FA_SetTimeC=7;
FA_GetTimeC=8;
const {ExtraInfo codes for FileCreate}
CF_Opened=1;
CF_Created=2;
CF_Truncated=3;
const {TranslateName codes}
TN_SubstDrive=$8000;
TN_Truename=0;
TN_Longname=1;
TN_Shortname=2;
{WIN32?}
function CreateDirectory(dname:PChar; sa:PSecurityAttributes):Boolean; {OK}
function RemoveDirectory(dname:PChar):Boolean; {OK}
function SetCurrentDirectory(dname:PChar):Boolean; {OK}
function GetCurDir(drive:Byte; dname:PChar):Boolean;
function GetCurrentDirectory(slen: Integer; dname:PChar):Integer; {OK}
function DeleteFile(fname:PChar):Boolean; {OK}
function DeleteFiles(filter:PChar; attr:Word):Boolean; {-}
function GetFileAttr(fname:PChar; index:Word; var fa:LongInt):Boolean; {-}
function SetFileAttr(fname:PChar; index:Word; fa:LongInt):Boolean; {-}
function GetFileAttributes(fname:PChar):Word; {OK-}
function SetFileAttributes(fname:PChar; dwFileAttributes:Word):Boolean; {OK-}
function MoveFile(src,dst:PChar):Boolean; {OK}
function FindFirstFile(filter:PChar; var fd:TWin32FindData):Word; {OK}
function FindNextFile(h: Word; var fd: TWin32FindData):Boolean; {OK}
function FindClose(h: Word):Boolean; {OK}
function FileCreate(fname:PChar; attr,creat,share:Word):Word; {-}
function CreateFile(lpFileName:PChar; dwDesiredAccess:Word; {OK-}
dwShareMode:Word; lpSecurityAttributes:PSecurityAttributes;
dwCreationDistribution:Word; dwFlagsAndAttributes:Word;
hTemplateFile: Word):Word;
function TranslateName(fname,tname:PChar;how:Word):Boolean; {-}
function GetVolumeInformation(fname:PChar; var vi:TVolumeInformation):Boolean;
function DosDateTimeToFileTime(Date,Time:Word; {OK-}
var t:TFileTime):Boolean;
function FileTimeToDosDateTime(const t:TFileTime; {OK-}
var Date,Time:Word):Boolean;
{OK-: Definition OK, but not yet implemented}
implementation
{$IFNDEF Windows}
uses Strings; {for strlen}
{$ENDIF}
function SetDOSError:Boolean; assembler;
asm mov dx,0
jc @@err
xchg dx,ax {ohne Fehler [DosError]=0 und DX=Handle}
@@err: mov [DosError],ax
db 0D6h {SetALC}
inc al
end;
{$IFDEF Windows}
procedure AnsiOemSt; near; assembler;
{Name ES:SI auf Stack konvertieren, PA: SS:SP=OEM-Name, VR: alle außer AX}
asm pop di {Rücksprung!}
push ax
push es
push es
push si
call lstrlen {Länge in AX}
pop es
pop cx
inc ax
inc ax
and al,not 1 {gerade aufrunden}
sub sp,ax
mov ax,sp
push cx
push es
push si
push ss
push ax
call AnsiToOem
pop ax
jmp di
end;
procedure AnsiOem; assembler; {von DS:SI nach SS:AX}
asm push es
push ds
push si
push ss
push ax
call AnsiToOem
pop es
end;
procedure CallDOS_DSDX; assembler;
var
OemBuf: TLfnBuf;
asm push ds
pusha {hier: AX,BX,CX,DX,SI}
mov si,dx
lds si,ss:[si]
lea ax,OemBuf
call AnsiOem
popa
push ss
pop ds
lea dx,OemBuf
stc
int 21h
pop ds
call SetDosError
end;
procedure CallDOS_DSSI; assembler;
var
OemBuf: TLfnBuf;
asm push ds
pusha {hier: AX,BX,CX,DX}
lds si,ss:[si]
lea ax,OemBuf
call AnsiOem
popa
push ss
pop ds
lea si,OemBuf
stc
int 21h
pop ds
call SetDosError
end;
procedure OemAnsi; assembler;
asm push ax
push es
push bx
push es
push bx
call OemToAnsi
pop ax
end;
{$ELSE}
procedure CallDOS_DSDX; assembler;
asm push ds
push si
mov si,dx
lds dx,ss:[si]
pop si
stc
int 21h
pop ds
call SetDosError
end;
procedure CallDOS_DSSI; assembler;
asm push ds
lds si,ss:[si]
stc
int 21h
pop ds
call SetDosError
end;
{$ENDIF}
function CreateDirectory(dname:PChar;
sa:PSecurityAttributes):Boolean; assembler;
asm lea dx,dname
mov ax,7139h
call CallDOS_DSDX
end;
function RemoveDirectory(dname:PChar):Boolean; assembler;
asm lea dx,dname
mov ax,713Ah
call CallDOS_DSDX
end;
function SetCurrentDirectory(dname:PChar):Boolean; assembler;
asm lea dx,dname
mov ax,713Bh
call CallDOS_DSDX
end;
function GetCurDir(drive:Byte; dname:PChar):Boolean; assembler;
asm push ds
mov dl,[drive] {0=current, 1='A' etc.}
mov al,dl
dec al
jns @@1
mov ah,19h
int 21h
@@1: add al,'A'
lds si,[dname]
mov byte ptr [si],al
inc si
mov word ptr [si],'\:'
inc si
inc si
mov ax,7147h
stc
int 21h
pop ds
call SetDosError
{$IFDEF Windows}
jc @@e
les bx,[dname]
call OemAnsi
@@e:
{$ENDIF}
end;
function GetCurrentDirectory;
begin
GetCurrentDirectory:=0;
if GetCurDir(0,dname)
then GetCurrentDirectory:=
{$IFDEF Windows}lstrlen{$ELSE}strlen{$ENDIF}(dname);
end;
function DeleteFile(fname:PChar):Boolean; assembler;
asm xor si,si
lea dx,fname
mov ax,7141h
call CallDOS_DSDX
end;
function DeleteFiles(filter:PChar; attr:Word):Boolean; assembler;
asm mov si,1
lea dx,filter
mov cx,[attr]
mov ax,7141h
call CallDOS_DSDX
end;
function GetFileAttr(fname:PChar; index:Word; var fa:LongInt):Boolean; assembler;
asm
end;
function SetFileAttr(fname:PChar; index:Word; fa:LongInt):Boolean; assembler;
asm
end;
function GetFileAttributes; assembler;
asm end;
function SetFileAttributes; assembler;
asm end;
function MoveFile(src,dst:PChar):Boolean; assembler;
{$IFDEF Windows}
var
OemBuf: TLfnBuf;
{$ENDIF}
asm les di,[dst]
{$IFDEF Windows}
lea bx,OemBuf
push ss
push bx
push es
push di
push ss
push bx
call AnsiToOem
pop di
pop es
{$ENDIF}
mov ax,7156h
lea dx,src
call CallDOS_DSDX
end;
procedure EndSearch; assembler;
asm jc @@e
mov [ExtraInfo],cx
{$IFDEF Windows}
lea bx,TWin32FindData[di].cFileName
push es
call OemAnsi
pop es
lea bx,TWin32FindData[di].cAlternateFileName
call OemAnsi
{$ENDIF}
@@e:
end;
function FindFirstFile; assembler;
asm mov cx,[FindFirst_Attr]
lea dx,filter
mov si,[DateFormat]
les di,[fd]
mov ax,714Eh
call CallDOS_DSDX
xchg dx,ax
call EndSearch
end;
function FindNextFile; assembler;
asm mov bx,[h]
mov si,[DateFormat]
les di,[fd]
stc
mov ax,714Fh
int 21h
call SetDosError
call EndSearch
end;
function FindClose; assembler;
asm mov bx,[h]
stc
mov ax,71A1h
int 21h
call SetDosError
end;
function TranslateName; assembler;
asm xor bx,bx
mov cx,[how]
xchg bl,cl
lea si,fname
les di,[tname]
mov ax,7160h
call CallDOS_DSSI
{$IFDEF Windows}
jc @@e
mov bx,di
call OemAnsi
@@e:
{$ENDIF}
end;
function FileCreate(fname:PChar; attr,creat,share:Word):Word; assembler;
asm mov bx,[creat]
mov cx,[attr]
mov dx,[share]
lea si,fname
mov di,[AliasHint]
mov ax,716Ch
call CallDOS_DSSI
xchg dx,ax
jc @@e
mov [ExtraInfo],cx
@@e:
end;
function CreateFile; assembler;
asm end;
function GetVolumeInformation(fname:PChar; var vi:TVolumeInformation):Boolean; assembler;
asm mov cx,16
lea dx,fname
les di,[vi]
mov ax,71A0h
call CallDOS_DSDX
jc @@e
mov es:TVolumeInformation[di].max_path,dx
mov es:TVolumeInformation[di].max_file,cx
mov es:TVolumeInformation[di].fs_flags,bx
@@e:
end;
function DosDateTimeToFileTime(Date,Time:Word;
var t:TFileTime):Boolean; assembler;
asm end;
function FileTimeToDosDateTime(const t:TFileTime;
var Date,Time:Word):Boolean; assembler;
asm end;
end.
| Detected encoding: OEM (CP437) | 1
|
|
|