home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBBS / DEMOS / DEMODOOR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  4.5 KB  |  163 lines
  1. (*
  2.  
  3.   The most important variable to initialize is ONLINE. You can decide
  4.   if the person is online, or it's local dependent on what the commandline
  5.   options are or whatever method you use, but this variable HAS to be
  6.   set correctly, or nothing will work!!
  7.  
  8.   Usage: DEMODOOR Path Port Baud Ansi
  9.  
  10.   Path - use *0 for RA in optional data
  11.   Port - use *P for RA in optional data
  12.   Baud - use *B for RA in optional data, 0 indicates local login.
  13.   Ansi - use *G for RA in optional data, 0-ascii,1-ansi.
  14.  
  15. *)
  16.  
  17.  
  18. uses
  19.   dos,
  20.   eco_door, eco_lib
  21.  
  22.   ;
  23.  
  24.  
  25.  
  26. var
  27.    path      :  string;     { hold the path we want a dir of       }
  28.    totalsize : longint;     { total size of all files in directory }
  29.    totalnum  :    word;     { total number of files in directory   }
  30.  
  31.   procedure getcommand;  { see above for explanation of parameters}
  32.   var
  33.     d     : searchrec;
  34.     baud  :      word;
  35.     code  :   integer;
  36.     ans   :      byte;
  37.  
  38.     procedure help;
  39.     begin
  40.       writeln('Usage: ', __progname, ' Path Port Baud Ansi');
  41.       writeln;
  42.       writeln('Path - use *0 for RA in optional data');
  43.       writeln('Port - use *P for RA in optional data');
  44.       writeln('Baud - use *B for RA in optional data, 0 indicates local login.');
  45.       writeln('Ansi - use *G for RA in optional data, 0-ascii,1-ansi');
  46.       halt;
  47.     end;
  48.  
  49.   begin
  50.     if paramcount < 4 then help;
  51.     path := paramstr(1);
  52.     val(paramstr(2),port,code);
  53.     if code <> 0 then help;
  54.     dec(port);                          {ra returns 1-4, so dec by 1}
  55.     val(paramstr(3),baud,code);
  56.     if code <> 0 then help;
  57.     online := baud > 0;
  58.     val(paramstr(4),ans,code);
  59.     if code <> 0 then help;
  60.     user.ansi := ans = 1;
  61.     if path[length(path)]  = '\' then delete(path,length(path),1);
  62.     findfirst(path,$3f,d);              {let's check if they enter a path other than file...}
  63.     if doserror <> 0 then help;
  64.     if d.attr = $10 then path := path+'\*.*';
  65.   end;
  66.  
  67.  
  68.   
  69.   procedure getdirectory;
  70.     {
  71.       We initialized the line counter, so after 24 lines, the user
  72.       will be prompted for more...therefore our loop will say:
  73.       while (doserror = 0) and (not stop) do
  74.       begin etc...
  75.       stop is a boolean that is false until user says no to more prompt
  76.     }
  77.   var d: searchrec;
  78.  
  79.     function formattime(time: longint): string;
  80.     var dt: datetime;
  81.     begin
  82.       unpacktime(time,dt);
  83.       with dt do formattime := 
  84.         lz(month)+'-'+lz(day)+'-'+ms(year mod 100)+'  '+lz(hour)+':'+lz(min);
  85.         {year mod 100 will return the last 2 digits...just what we want!}
  86.     end;
  87.  
  88.   begin
  89.     totalsize := 0;
  90.     totalnum  := 0;
  91.  
  92.     findfirst(path,$3f,d);
  93.     while (doserror = 0) and (not stop) do begin
  94.       inc(totalnum);
  95.       send(d.name+rep(#32,13-length(d.name)));
  96.       if d.attr = $10 then send('<DIR>    ') else send(
  97.         rep(#32,9-length(ms(d.size)))+ms(d.size)
  98.       );
  99.       sendln(' '+formattime(d.time));
  100.       inc(totalsize,d.size);
  101.       findnext(d);
  102.     end;
  103.   end;
  104.  
  105.  
  106.   
  107.   procedure displaycredits;
  108.   begin
  109.     clrportscr;                 {first let's clear screen, so it's not a mess!}
  110.     portcolor(14);
  111.     sendln(__progname + ', The first directory program for ONLINE!');
  112.     sendln('(C) MCMXCIII by UltiHouse Software, All Rights Reserved.');
  113.     sendln('');
  114.     send('Directory of: ');
  115.     portcolor(15);
  116.     sendln(uprcase(path));
  117.     sendln('');
  118.   end;
  119.  
  120.  
  121.   
  122.   procedure displaytrailingstuff;
  123.   {
  124.     The line counter initializes STOP to TRUE if the person said NO, so
  125.     "more y/n", so and it might occur in this proc depending on the
  126.     number of file names, and if STOP = true, then we want it to stop
  127.     right??
  128.   }
  129.  
  130.   begin
  131.     portcolor(14);
  132.     if not stop then sendln('');
  133.     if not stop then send(rep(#32,8-length(ms(totalnum)))+ms(totalnum)+' file(s)');
  134.     if not stop then sendln(rep(#32,11-length(ms(totalsize)))+ms(totalsize)+' bytes');
  135.     if not stop then sendln(rep(#32,27-length(ms(diskfree(0))))+ms(diskfree(0))+' bytes free');
  136.   end;
  137.  
  138.  
  139.   
  140.   procedure waitenter;
  141.   var ch: char;
  142.   begin
  143.     portcolor(11);
  144.     send('Press RETURN to continue...');
  145.     ch := waitchar([#13]);
  146.   end;
  147.  
  148.  
  149. begin
  150.   online    := false;
  151.   user.ansi := true;    {these are default values that will be changed later}
  152.   port      := 0;
  153.  
  154.   resetcounter(24,7);    
  155.   { reset the line counter to trigger after 24 lines, and use prompt color 7 }
  156.   getcommand;
  157.   displaycredits;
  158.   getcommand;
  159.   getdirectory;
  160.   displaytrailingstuff;
  161.   waitenter;
  162. end.
  163.