(**********************************************************************)
(*                                                                    *)
(* Ph”niX SoftCrew  Turbo Pascal Programme                            *)
(* most (c) by PSC Software Development Lippstadt/Warendorf           *)
(*                                                                    *)
(* Ph”niX SoftCrew          ####   ####  ####                         *)
(* c/o Carsten Strotmann    #   # ##    ##                            *)
(* An der Kreutzbrede 20    ####   ###  ##     Software Development   *)
(*                          #        ## ##                            *)
(* 4410 Warendorf 1         #     ####   ####                         *)
(*                                                                    *)
(**********************************************************************)

(*

  Programmname   :ATARI Dir Version 2
  Filename       :ADIR.PAS
  von            :CARSTEN STROTMANN
  letzte Žnderung:06.02.90
  Bemerkung      :

*)

PROGRAM ADIR;

USES CRT, A_UNIT;

VAR
  u, p : BYTE;
  s : STRING;
  drive,
  drivetype : BYTE;
  search,
  drivestr  : STRING;

  FUNCTION UpString (str : STRING) : STRING;

  VAR
    u : BYTE;

  BEGIN
    FOR u := 1 TO Length (str) DO
      str[u]:=UpCase(str[u]);

    UpString := str;
  END;

BEGIN
  drivestr := '';
  search := '*.*';
  WriteLn;
  s := UpString(ParamStr(1));

  p := Pos (':',s);
  IF p > 0 THEN
  BEGIN
    drivestr := Copy(s,1,p);
    search   := Copy(s,p+1,Length(s)-p);
  END;

  IF drivestr = '' THEN
    search := s;

  IF search = '' THEN
    search := '*.*';

  IF Paramcount > 0 THEN
    WriteLn ('Directory Disk ',s);
  WriteLn;

  IF drivestr = 'D2:' THEN
  BEGIN
    drive := 1;
    drivetype := 1;
  END
  ELSE
  BEGIN
    drive := 0;
    drivetype := 2;
  END;

  IF DiskStatus > 0 THEN
    DiskReset;
  SetDrive (drive,drivetype);
  SetNewDriveTab (secprotrk, secsize);

  Read_Dir (drive);
  Read_VTOC (drive);

  SetOldDriveTab;

  REPEAT
    u := A_FindNext (search);

    IF u > 0 THEN
    BEGIN
      IF (a_dir[u].flag AND $20 > 0)  THEN
        Write ('* ')
      ELSE
        Write ('  ');

      WriteLn (a_dir[u].name, a_dir[u].ext,' ',a_dir[u].length :3);
    END;
  UNTIL u = 0;

  WriteLn;
  WriteLn (a_vtoc.freesec,' Freie Sektoren. ');

  WriteLn;
  WriteLn;

END.