Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB21.ZIP/DYNADIR.SRC

Text File | 1985-10-31 | 8.2 KB | 211 lines

{->>>>DynaDIR<<<<----------------------------------------------}
{                                                              }
{ Filename: DYNADIR.SRC -- Last modified 10/31/85              }
{                                                              }
{ This routine returns a pointer to a linked list of type      }
{ DIRRec, which must have been previously defined this way,    }
{ along with pointer type DIRPtr to point to it:               }
{                                                              }
{ DIRPtr = ^DIRRec;                                            }
{ DIRRec = RECORD                                              }
{            FileName  : String15;                             }
{            Attrib    : Byte;                                 }
{            FileSize  : Real;                                 }
{            TimeStamp : TimeRec;                              }
{            DateStamp : DateRec;                              }
{            Next      : DIRPtr;                               }
{          END;                                                }
{                                                              }
{ The linked list will contain a record for every file in the  }
{ current directory.  Since the linked list is out in heap,    }
{ your directory data takes up NO space in your data segment.  }
{ If there are no files in the current directory, the pointer  }
{ returned is equal to NIL.                                    }
{                                                              }
{ The types TimeRec and DateRec must also have been defined    }
{ in your program prior to using DynaDIR.  They are defined    }
{ this way:                                                    }
{                                                              }
{ TimeRec = Record                                             }
{             TimeComp   : Integer;                            }
{             TimeString : String80;                           }
{             Hours,Minutes,Seconds,Hundredths : Integer       }
{           End;                                               }
{ DateRec = Record                                             }
{             DateComp       : Integer;                        }
{             DateString     : String80;                       }
{             Year,Month,Day : Integer;                        }
{             DayOfWeek      : Integer                         }
{           End;                                               }
{                                                              }
{--------------------------------------------------------------}


FUNCTION DynaDIR(Filespec : String80) : DIRPtr;

TYPE
  String9 = String[9];
  Reg     = RECORD
              CASE Boolean OF
                False : (Word : Integer);
                True  : (LoByte,HiByte : Byte)
            END;

  Regpack = RECORD
              AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Reg
            END;

  DWord   = RECORD
              LoInteger,HiInteger : Integer
            END;


VAR
  I         : Integer;
  Registers : RegPack;
  Root      : DIRPtr;
  Current   : DIRPtr;
  Prior     : DIRPtr;
  ASCIIZ    : ARRAY[1..81] OF Char;


{->>>>DTAtoDIR<<<<---------------------------------------------}
{                                                              }
{ Local to DYNADIR.SRC -- Last modified 10/31/85               }
{                                                              }
{ This routine is local to DynaDIR and should not be extracted }
{ for other purposes.  It converts data as returned by DOS     }
{ calls $4E & $4F in the Disk Transfer Area (DTA) to a more    }
{ tractable form as defined by my own record type DIRRec.      }
{ This involves converting the time from a two byte integer to }
{ a TimeRec, and the date from an integer to a DateRec.        }
{                                                              }
{ As of 10/31/85, this routine is incomplete.  It still cannot }
{ calculate the day-of-the-week correctly given the date.  I   }
{ am researching Zeller's Congruence and will add it when I    }
{ get it to work.                                              }
{--------------------------------------------------------------}



PROCEDURE DTAtoDIR(VAR OutRec : DIRRec);

CONST
  MonthTags : ARRAY [1..12] of String9 =
    ('January','February','March','April','May','June','July',
     'August','September','October','November','December');
  DayTags   : ARRAY [1..7] OF String9 =
    ('Sunday','Monday','Tuesday','Wednesday',
     'Thursday','Friday','Saturday');

TYPE
  String5 = String[5];
  Dword   = RECORD
              LoInteger,HiInteger : Integer
            END;
  DTAPtr  = ^DTARec;
  DTARec  = RECORD
              Reserved : ARRAY[0..20] OF Byte;
              Attrib   : Byte;
              TimeComp : Integer;
              DateComp : Integer;
              FileSize : DWord;
              FileName : ARRAY[1..13] OF Char
            END;

VAR
  I           : Integer;
  Temp1,Temp2 : String5;
  AMPM        : Char;
  InRec       : DTARec;
  Registers   : Regpack;
  CurrentDTA  : DTAPtr;

BEGIN
  Registers.AX.Word := $2F00; { Find current location of DTA }
  MSDOS(Registers);
  WITH Registers DO CurrentDTA := Ptr(ES.Word,BX.Word);
  InRec := CurrentDTA^;
  WITH OutRec DO              { Now extract and reformat data }
    BEGIN
      I := 1;                 { Extract the file name field }
      WHILE InRec.FileName[I] <> Chr(0) DO
        BEGIN
          FileName[I] := InRec.FileName[I];
          I := Succ(I)
        END;
      FileName[0] := CHR(I-1);
      Attrib := InRec.Attrib; { Extract the attribute field }
      WITH TimeStamp DO
        BEGIN
          TimeComp := InRec.TimeComp;
          Hours := TimeComp SHR 11;
          Minutes := (TimeComp AND $07E0) SHR 5;
          Seconds := (TimeComp AND $1F) SHL 1;
          Hundredths := 0;
          I := Hours;
          IF HOURS = 0 THEN I := 12;  { 0 hrs = 12 AM }
          IF Hours >= 12 THEN         { 13 hrs = 1 PM etc }
            BEGIN
              IF Hours > 12 THEN I := Hours - 12;
              AMPM := 'p'
            END
          ELSE AMPM := 'a';
          Str(I:2,Temp1); Str(Minutes,Temp2);
          IF Length(Temp2) < 2 THEN Temp2 := '0' + Temp2;
          TimeString := Temp1 + ':' + Temp2 + AMPM
        END;
      WITH DateStamp DO
        BEGIN
          DateComp := InRec.DateComp;
          Day := DateComp AND $1F;
          Month := (DateComp AND $01FF) SHR 5;
          Year  := (DateComp SHR 9) + 1980;
          DayOfWeek := 1;  { Fudge!  Needs Zeller's Congruence! }
          DateString := DayTags[DayOfWeek] + ', ';
          Str(Day,Temp1);
          DateString := DateString +
            MonthTags[Month] + ' ' + Temp1 + ', ';
          Str(Year,Temp1);
          DateString := DateString + Temp1;
        END;
      WITH InRec.FileSize DO  { Convert 4-byte filesize to real }
        FileSize := (HiInteger*65536.0)+LoInteger;
      Next := NIL;            { Initialize the "next" pointer }
    END
END;


BEGIN
  {First step is to convert Filespec string to ASCIIZ:}
  Filespec := Filespec + CHR(0);  { Append binary zero to Filespec }
  Move(Filespec[1],ASCIIZ,Sizeof(Filespec));
  WITH Registers DO
    BEGIN
      AX.Word := $4E00;       { $4E = Find First }
      DS.Word := Seg(ASCIIZ); { Put address of ASCIIZ }
      DX.Word := Ofs(ASCIIZ); { in DS : DX }
    END;
  MSDOS(Registers);           { Make FIND FIRST DOS call... }
  IF Registers.AX.Word = 2 THEN DynaDIR := NIL
    ELSE
      BEGIN
        New(Root);            { Convert first find to DIR format }
        DTAtoDIR(Root^);
        Prior := Root;
        IF Registers.AX.Word <> 18 THEN
          REPEAT
            Registers.AX.Word := $4F00;
            MSDOS(Registers);   { Make FIND NEXT DOS call... }
            IF Registers.AX.Word <> 18 THEN
              BEGIN
                New(Current);
                DTAtoDIR(Current^);  { Convert additional finds }
                Prior^.Next := Current;  { to DIRRec format }
                Prior := Prior^.Next
              END
          UNTIL Registers.AX.Word = 18;
        DynaDIR := Root;
      END
END;  {DynaDIR}