{$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,P+,Q-,R-,S-,T-,V-,X-,Y-}

Unit LFN;

{   Unit: LFN Version 1.0, 7.11.1998            }
{   Size: 140 Lines, 225 byte Code, 6 byte Data }
{  Usage: Long File Names Support for Pascal    }
{ Author: Antivivisektion@t-online.de           }
{                                               }
{    Just include LFN in USES - that's all!     }
{   Now you can use RESET/REWRITE with LFNs...  }
{                                               }
{ FREEWARE W/O ANY WARANTEE, plz read disclamer }
{                                               }
{ Limitation: Path+Name has to be < 80 chars.   }

Interface
Const LFNSupport: Boolean = False;

Implementation

Procedure Old21; Assembler; asm dd 0; end;

Procedure New21; Assembler;
asm
    cmp  ah,3Dh  { Pascal-Request: RESET   = CY = DL=01 (Action) }
    stc
    je   @Entry
    cmp  ah,3Ch  { Pascal-Request: REWRITE = NC = DL=12 (Action) }
    clc
    je   @Entry
    jmp  dword ptr cs:[Old21]
@Entry:
    push bx
    push cx
    push dx
    push bp
    push si
    push di
    push ds
    push es

    mov  si,dx   { DS:SI = Filename ASCIIZ      }
    mov  bl,al   { Copy FILEMODE to BL          }
    mov  dl,01h  { CY = Pascal-Request: RESET   }
    jc   @A
    mov  dl,12h  { NC = Pascal-Request: REWRITE }

@A: mov  ax,716Ch
    xor  bh,bh
    xor  cx,cx
    xor  dh,dh
    xor  di,di
    pushf
    call dword ptr cs:[Old21]
    pop  es
    pop  ds
    pop  di
    pop  si
    pop  bp
    pop  dx
    pop  cx
    pop  bx
    sti
    retf 2
end;

Var OldExit: Pointer;

Procedure MyExit; Far;
Begin
  ExitProc := OldExit;
  asm
    mov  ax,2521h
    push ds
    lds  dx,dword ptr cs:[Old21]
    int  21h
    pop  ds
  End;
End;

Begin
  asm
    { Check if DOS 7+ *and* WIN 4+ }
    mov  ah,30h
    int  21h
    cmp  al, 7
    jb   @E

    mov  ax,160Ah
    int  2Fh
    or   ax,ax { Win running? }
    jne  @E
    cmp  bh, 4 { Win 4+? }
    jb   @E

    { Install new exit-handler }
    les  di,[ExitProc]
    mov  word ptr [OldExit],di
    mov  word ptr [OldExit+2],es
    mov  word ptr [ExitProc], offset MyExit;
    mov  word ptr [ExitProc+2], cs
    { Install LFN-support }
    mov  ax,3521h
    int  21h
    mov  word ptr cs:[Old21],bx
    mov  word ptr cs:[Old21+2],es
    mov  ax,2521h
    mov  dx, offset New21
    push ds
    push cs
    pop  ds
    int  21h
    pop  ds
    { Change status }
    mov  [LFNSupport],True
    jmp  @E
    db   "LFN-support by Antivivisektion@t-online.de"
@E:
  End;
End.

{   DISCLAIMER
    ----------
    WE DO NOT WARANTEE ANYTHING CONCERNING ANY OF THE SOURCES OR FILES
    WHICH MAKE UP THIS LFN PACKAGE. WE ACCEPT NO RESPONSIBILITY FOR
    ANY LOSS OR DAMAGE OF ANY KIND, INCLUDING, BUT NOT LIMITED TO, LOSSES
    OF A PHYSICAL, MENTAL, SOCIAL, FINANCIAL, MARITAL, OR OF WHATEVER
    NATURE, RESULTING FROM THE USE, OR THE PURPORTED USE, OF THIS LFN
    PACKAGE OR ANY OF THE FILES IN THE PACKAGE, FOR ANY PURPOSE WHATSOEVER.
    WE DO NOT EVEN WARANTEE THAT THE FILES WILL NOT KILL YOU.

    YOU USE THIS LFN PACKAGE ENTIRELY AT YOUR OWN RISK, AND YOU SUPPLY
    IT TO YOUR CUSTOMERS, FRIENDS, FAMILY, ACQUAINTANCES, OR ENEMIES,
    ENTIRELY AT YOUR OWN RISK.

    IF THESE TERMS ARE NOT ACCEPTABLE TO YOU, THEN PLEASE DELETE ALL
    THE FILES FROM YOUR DISKS IMMEDIATELY AND PERMANENTLY.

    In this disclaimer, "WE" refers to: Antivivisektion@t-online.de

    (Disclaimer written by The-African-Chief <laa12@cc.keele.ac.uk>) }