[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]

program soupdir;  {do a directory, listing SOUP files}

{
Russell_Schulz@alpha3.ersys.edmonton.ab.ca (950904)

Copyright 1995 Russell Schulz

this code is not in the Public Domain

permission is granted to use these routines in any application regardless
of commercial status as long as the author of these routines assumes no
liability for any damages whatsoever for any reason.  have fun.
}

uses dos,genericf;

type
  nodep=^node;
  node=record
      filename: string;
      description: string;
      next: nodep;
    end;

var
  head: nodep;

procedure die(s: string);

begin
  writeln(s);
  halt(1);
end;

procedure usage;

begin
  writeln('usage: SOUPDIR');
  halt(2);
end;

procedure lfreadln(var lff: text; var astring: string);

var
  done: boolean;
  c: char;

begin
  astring := '';

  done := false;
  while not done do
    begin
      if eof(lff) then
        done := true
      else if length(astring)>=255 then
        done := true
      else
        begin
          read(lff,c);
          if c=#10 then
            done := true
          else if c<>#13 then
            astring := astring+c;
        end;
    end;
end;

procedure initialize;

var
  areasf: text;
  tempstring: string;
  tempnodep: nodep;

begin
  if paramcount<>0 then
    usage;

  head := nil;

  assign(areasf,'AREAS');
{$I-}
  reset(areasf);
{$I+}
  if ioresult<>0 then
    die('could not open AREAS file');

  while not eof(areasf) do
    begin
      lfreadln(areasf,tempstring);
      new(tempnodep);

      tempnodep^.filename := chopfirstw(tempstring)+'.msg';
      tempnodep^.description := chopfirstw(tempstring);

      tempnodep^.next := head;
      head := tempnodep;
    end;

  close(areasf);
end;

procedure process;

var
  fileinfo: searchrec;
  filename: string;
  tempnodep: nodep;

begin
  findfirst('*.MSG',archive,fileinfo);
  while doserror=0 do
    begin
      filename := lower(fileinfo.name);

{assume no packet will be bigger than a meg}
      write(leftjustify(filename,12,' '),' ',fileinfo.size:6,' ');
      tempnodep := head;
      while tempnodep<>nil do
        begin
          if tempnodep^.filename=filename then
            begin
              write(copy(tempnodep^.description,1,50));
              tempnodep := nil;
            end
          else
            tempnodep := tempnodep^.next;
        end;
      writeln;
      findnext(fileinfo);
    end;
end;

procedure shutdown;

begin
end;

begin
  initialize;
  process;
  shutdown;
end.
-- 

[Back to DIRS SWAG index]  [Back to Main SWAG index]  [Original]