Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PSDIR101.ZIP/DIRS.PAS

Pascal/Delphi Source File | 1992-12-24 | 6.5 KB | 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 }