home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
p
/
psdir101.zip
/
DIRS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-12-24
|
7KB
|
243 lines
{
╔══════════════════╗
║ Directory ║
║ Procedures ║
║ Rev. 1.01 ║
╚══════════════════╝
}
{$F-} {$O-} {$A+} {$G-}
{$V-} {$B-} {$X-} {$N+} {$E+}
{$I FINAL.PAS}
{$IFDEF FINAL}
{$I-} {$R-}
{$D-} {$L-} {$S-}
{$ENDIF}
Unit Dirs;
Interface
Uses DOS;
Const
StdFile = Directory + ReadOnly + Archive;
Files = 1;
Time = 2;
Date = 4;
Size = 8;
Directories = 16;
Type
DirListInfo=^DirListing; {One File Information Element}
DirList=Record {List of Files}
Total:Word; {Total Number of Files}
Root :Pointer; {Root Pointer}
Info :DirListInfo; {Linked List}
End;
DirListing=Record {Information Record}
Attr:Byte;
Time,
Size:LongInt;
Name:String[12];
Next:Pointer;
End;
Function IsDir (FDir:String):Boolean;
Procedure GoDir (FDir:String);
Procedure DelSlash (StIn:String;Var StOut:String);
Procedure AddSlash (StIn:String;Var StOut:String);
Procedure InitDirList(Var Dir:DirList);
Procedure GotoDirList(Var Dir:DirList;Num:Word);
Procedure KillDirList(Var Dir:DirList);
Procedure LoadDirList(Var Dir:DirList;Mask:PathStr;Attr:Byte;IncDir:Byte);
Implementation
Function IsDir(FDir:String):Boolean;
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Checks if FDir is a valid directory or not. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
T :String[80]; {Old Drive and Directory}
Org:String[2]; {Original Drive}
Drv:Byte; {New Drive Code}
Begin
GetDir(0,T);
Org:=' :';
Org[1]:=T[1];
Drv:=0;
If Length(FDir)>1 Then
Begin
If FDir[2]=':' Then
Begin
Drv:=Ord(UpCase(FDir[1]));
Drv:=Drv-Ord('A')+1;
End;
End;
GetDir(Drv,T);
{$I-}
ChDir(FDir);
If IOResult<>0 Then
IsDir:=False
Else
IsDir:=True;
ChDir(T); {Go Back to Original Directory in New Drive}
ChDir(Org); {Go Back to Old Drive}
{$IFNDEF FINAL} {$I+} {$ENDIF}
If IOResult<>0 Then;
End;
Procedure GoDir(FDir:String);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Goes to the specified directory if it exists. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
Err:Word;
Begin
If (Length(FDir)>1) And (FDir[Length(FDir)]='\') Then
If (FDir[Length(FDir)-1]<>':') Then
Delete(FDir,Length(FDir),1);
{$I-}
ChDir(FDir);
{$IFNDEF FINAL} {$I+} {$ENDIF}
Err:=IOResult;
End;
Procedure DelSlash(StIn:String;Var StOut:String);
Begin
StOut:=StIn;
If (StOut[Length(StOut)]='\') Then
If (Length(StOut)>1) Then
Begin
If (StOut[Length(StOut)-1]<>':') Then
StOut[0]:=Chr(Length(StOut)-1);
End;
End;
Procedure AddSlash(StIn:String;Var StOut:String);
Begin
If StIn='' Then
StOut:=''
Else
If StIn[Length(StIn)]='\' Then
StOut:=StIn
Else
StOut:=StIn+'\';
End;
Procedure InitDirList(Var Dir:DirList);
Begin
Dir.Total:=0;
Dir.Root :=NIL;
Dir.Info :=NIL;
End;
Procedure GotoDirList(Var Dir:DirList;Num:Word);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Goes to the directory position Num, with the first directory entry ║ }
{ ║ being 1 and the last 65535 or Dir.Total. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
T:Word;
Begin
T:=1;
Dir.Info:=Dir.Root;
If Dir.Info=NIL Then Exit;
While (T<Num) And (Dir.Info^.Next<>NIL) do
Begin
Dir.Info:=Dir.Info^.Next;
Inc(T);
End;
End;
Procedure KillDirList(Var Dir:DirList);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Removes all the information in the linked list Dir from memory. ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
Next:Pointer;
Begin
Dir.Info:=Dir.Root;
While Dir.Info<>NIL do
Begin
Next:=Dir.Info^.Next;
Dispose(Dir.Info);
Dir.Info:=Next;
End;
Dir.Total:=0;
Dir.Root :=NIL;
End;
Procedure LoadDirList(Var Dir:DirList;Mask:PathStr;Attr,IncDir:Byte);
{ ╔════════════════════════════════════════════════════════════════════════╗ }
{ ║ Loads a directory, specified by mask, into memory. Only files with ║ }
{ ║ attributes Attr are included. Directories are also added to the list ║ }
{ ║ if IncDir >= Directory. If files are already listed in the list Dir,║ }
{ ║ the files found are added to the end of the list. ║ }
{ ║ ║ }
{ ║ Assumes: There is enough memory. ║ }
{ ║ There are less than 65535 files in the directory. ║ }
{ ║ ║ }
{ ║ 5 4 3 2 1 0 ║ }
{ ║ Attribute bits: A D V S H R ║ }
{ ╚════════════════════════════════════════════════════════════════════════╝ }
Var
P :DirListInfo;
DirSrch:SearchRec;
Begin
FindFirst(Mask,Attr,DirSrch);
While (DosError=0) do
Begin
If (((DirSrch.Attr And Directory)<>0) And ((IncDir And Directory)<>0))
Or (((DirSrch.Attr And Directory)=0) And ((IncDir And Files)<>0)) Then
Begin
New(P);
If Dir.Root=NIL Then
Begin
Dir.Total:=1;
Dir.Root :=P;
Dir.Info :=P;
End
Else
Begin
Inc(Dir.Total);
GotoDirList(Dir,65535);
Dir.Info^.Next:=P;
End;
P^.Next:=NIL;
P^.Attr:=DirSrch.Attr;
P^.Time:=DirSrch.Time;
P^.Size:=DirSrch.Size;
P^.Name:=DirSrch.Name;
End;
FindNext(DirSrch);
End;
End;
End.
{ Copyright 1993, Michael Gallias }