home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / CUNIT_20 / BBSDIR.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-10  |  5KB  |  173 lines
  1. Program SampleDirProgramViaModem;  {Don't ask me why, just couldn't find
  2.                                     anything better to make!}
  3.  
  4. (********************************************************************
  5.  
  6.   This is just a small sample program that will help you see how easy
  7.   this unit is to use.
  8.  
  9.  
  10.   The most important variable to initialize is ONLINE. You can decide
  11.   if the person is online, or it's local dependent on what the commandline
  12.   options are or whatever method you use, but this variable HAS to be
  13.   set correctly, or nothing will work!!
  14.  
  15.   Usage: BBSDIR Path Port Baud Ansi
  16.  
  17.   Path - use *0 for RA in optional data
  18.   Port - use *P for RA in optional data
  19.   Baud - use *B for RA in optional data, 0 indicates local login.
  20.   Ansi - use *G for RA in optional data, 0-ascii,1-ansi.
  21.  
  22.  ********************************************************************)
  23.  
  24.  
  25. uses COMUNIT,Dos;
  26.  
  27. var 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;
  32.  
  33.   { See above for explanation of parameters}
  34.  
  35.   var d: searchrec;
  36.  
  37.       Baud  : word;
  38.       Code  : integer;
  39.       Ans   : byte;
  40.  
  41.       Procedure Help;
  42.  
  43.         begin
  44.           writeln('Usage: BBSDIR Path Port Baud Ansi');
  45.           writeln;
  46.           writeln('Path - use *0 for RA in optional data');
  47.           writeln('Port - use *P for RA in optional data');
  48.           writeln('Baud - use *B for RA in optional data, 0 indicates local login.');
  49.           writeln('Ansi - use *G for RA in optional data, 0-ascii,1-ansi');
  50.           halt;
  51.         end;
  52.  
  53.  
  54.  
  55.   begin
  56.     if Paramcount < 4 then Help;
  57.  
  58.     Path := Paramstr(1);
  59.  
  60.     Val(Paramstr(2),Port,Code);
  61.     if Code <> 0 then Help;
  62.     Dec(Port);                          {RA returns 1-4, so dec by 1}
  63.  
  64.     Val(Paramstr(3),Baud,Code);
  65.     if Code <> 0 then Help;
  66.     Online := Baud > 0;
  67.  
  68.     Val(Paramstr(4),Ans,Code);
  69.     if Code <> 0 then Help;
  70.     Ansi := Ans = 1;
  71.  
  72.     findfirst(path,$3f,d);              {Let's check if they enter a path other than file...}
  73.     if DosError <> 0 then Help;
  74.     if D.attr = $10 then Path := Path+'\*.*';
  75.  
  76.   end;
  77.  
  78. Procedure GetDirectory;
  79.  
  80.   {We initialized the line counter, so after 24 lines, the user
  81.    will be prompted for more...therefore our loop will say:
  82.    while (doserror = 0) and (not stop) do
  83.    begin etc...
  84.    STOP is a boolean that is false until user says NO to more prompt}
  85.  
  86.   var d: searchrec;
  87.  
  88.       Function FormatTime(Time: longint): string;
  89.  
  90.         var dt: datetime;
  91.  
  92.         begin
  93.           unpacktime(Time,dt);
  94.           with Dt do
  95.             FormatTime := lz(month)+'-'+lz(day)+'-'+ms(year mod 100)+'  '+lz(hour)+':'+lz(min);
  96.  
  97.              {year mod 100 will return the last 2 digits...just what we want!}
  98.  
  99.         end;
  100.  
  101.   begin
  102.     TotalSize := 0;
  103.     TotalNum  := 0;
  104.  
  105.     findfirst(path,$3f,D);
  106.     while (doserror = 0) and (Not Stop) do
  107.     begin
  108.       inc(TotalNum);
  109.  
  110.       Send(D.name+Rep(#32,13-length(D.name)));
  111.       if D.attr = $10
  112.         then Send('<DIR>    ')
  113.         else Send(Rep(#32,9-length(Ms(D.size)))+ms(D.size));
  114.       Sendln(' '+FormatTime(D.Time));
  115.  
  116.       inc(TotalSize,D.Size);
  117.  
  118.       Findnext(D);
  119.     end;
  120.   end;
  121.  
  122. Procedure DisplayCredits;
  123.  
  124.   begin
  125.     PortColor(14);
  126.     Sendln('BBSDIR, The first directory program for ONLINE!');
  127.     Sendln('Copyright (c) 1991-1992 HSE Delft, all rights reserved.');
  128.     Sendln('');
  129.     Send('Directory of: ');
  130.     PortColor(15);
  131.     Sendln(UprCase(Path));
  132.     Sendln('');
  133.   end;
  134.  
  135. Procedure DisplayTrailingStuff;
  136.  
  137.   {The line counter initializes STOP to TRUE if the person said NO, so
  138.    "more y/n", so and it might occur in this proc depending on the
  139.    number of file names, and if STOP = true, then we want it to stop
  140.    right??}
  141.  
  142.   begin
  143.     PortColor(14);
  144.     if not Stop then Sendln('');
  145.     if not Stop then Send(Rep(#32,8-length(ms(Totalnum)))+ms(Totalnum)+' file(s)');
  146.     if not Stop then Sendln(Rep(#32,11-length(ms(Totalsize)))+ms(TotalSize)+' bytes');
  147.   end;
  148.  
  149. Procedure WaitEnter;
  150.  
  151.   var ch: char;
  152.  
  153.   begin
  154.     PortColor(11);
  155.     Send('Press RETURN to continue...');
  156.     ch := WaitChar([#13]);
  157.   end;
  158.  
  159.  
  160. begin
  161.   Online := False;
  162.   Ansi   := True;    {These are default values that will be changed later}
  163.   Port   := 0;
  164.  
  165.   ResetCounter(24,7);        {reset the line counter to trigger after
  166.                               24 lines, and use prompt color 7}
  167.  
  168.   DisplayCredits;
  169.   GetCommand;
  170.   GetDirectory;
  171.   DisplayTrailingStuff;
  172.   WaitEnter;
  173. end.