🚀 go-pugleaf

.HI..All.

Oto te dwie wspanialem procedurki (szczerze mowiac to sie chyba niczym nie
roznia):

===> BeGIn Of Longname.Pas <===
USES Strings;

type
  TSearchRec = record
    attr : longint;
    creation : comp;
    lastaccess : comp;
    lastmodification : comp;
    highfilesize : longint;
    lowfilesize : longint;
    reserved : comp;
    name : array[0..259] of char;
    shortname : array[0..13] of char;
    handle : word;
  end;

const
  faReadOnly      =  $01;
  faHidden        =  $02;
  faSysFile       =  $04;
  faVolumeID      =  $08;
  faDirectory     =  $10;
  faArchive       =  $20;
  faAnyFile       =  $3F;

function findfirst(filespec:string;attr:word;var S:TSearchRec):integer;
begin
  filespec := filespec + #0;
  S.attr := attr;
  asm
    push ds
    push ss
    pop ds
    lea dx,filespec+1
    les di,S
    mov ax,$714e
    mov cx,attr
    mov si,0
    int $21
    les di,S
    mov word ptr es:[di+TSearchRec.handle], ax
    jc @1
    xor ax,ax
  @1:
    mov @result,ax
    pop ds
  end;
end;


function FindNext(var S:TSearchRec):integer;
begin
  asm
    mov ax,$714f
    mov si,0
    les di,S
    mov bx,word ptr es:[di+TSearchRec.Handle]
    int $21
    jc @1
    xor ax,ax
  @1:
    mov @result,ax
  end;
end;

function FindClose(var S:TSearchRec):integer;
begin
  asm
    mov ax,$71a1
    les di,S
    mov bx,word ptr es:[di+TSearchRec.Handle]
    int $21
    jc @1
    xor ax,ax
  @1:
    mov @result,ax
  end;
end;

procedure ShowLongNames(const path:string);
var
  S : TSearchRec;
  Res : Integer;
begin
  Res := findfirst(path+'\*.*',faAnyFile-faVolumeID,S);
  while Res = 0 do
  begin
    with S do
    begin
      if (S.Attr and faDirectory) <> 0 then
      begin
        if (StrComp(Name,'.') <> 0) and (StrComp(Name,'..') <> 0) then
        begin
          if ShortName[0] <> #0 then
            ShowLongNames(path+'\'+StrPas(ShortName))
          else
            ShowLongNames(path+'\'+StrPas(Name));
        end;
      end;
      if ShortName[0] <> #0 then
        writeln('ren ',path+'\'+StrPas(ShortName),' "',name,'"');
    end;
    Res := FindNext(S);
  end;
  FindClose(S);
end;

var
  x : integer;
begin
  showlongnames('C:');
end.
===>  EnD oF Longname.Pas  <===

===> BeGIn Of Longnw95.Pas <===
� [7] PASCAL (2:480/54.35) �������������������������������������������� PASCAL
�
 Msg  : 298 of 300 
 From : Christoph Jaeger                    2:240/5490.25   Fri 17 May 96 14:50

 To   : *.* 
 Subj : Longfilenames under WIN95 
�������������������������������������������������������������������������������
�
Hallo *.*!


This is a short UNIT for uses with WIN95 longfilenames.


>>> [Longname.PAS] <<<

{ 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;

function LFindClose(var SRec:TLSearchRec):word; assembler;
{ Free search handle }
asm
 mov ax,714fh
 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.
=== LDOS.PAS end of part 2/2


=== 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.


CIAO,
           Christoph

===>  EnD oF Longnw95.Pas  <===
.CUL8R..All.... UI120:ONJKBHESBATDFFDJCAEFAHDNLCMBAHCGDGGUHJCACIH

E-MAIL: ce...@plearn.edu.pl (frozen)  UNHOLY: 101:1000/6.3
PGP FP: 38 A5 70 CE 0A CF B2 0E  4B E7 C8 04 B4 33 D6 E2