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 >
Wrap
Pascal/Delphi Source File
|
1992-01-10
|
5KB
|
173 lines
Program SampleDirProgramViaModem; {Don't ask me why, just couldn't find
anything better to make!}
(********************************************************************
This is just a small sample program that will help you see how easy
this unit is to use.
The most important variable to initialize is ONLINE. You can decide
if the person is online, or it's local dependent on what the commandline
options are or whatever method you use, but this variable HAS to be
set correctly, or nothing will work!!
Usage: BBSDIR Path Port Baud Ansi
Path - use *0 for RA in optional data
Port - use *P for RA in optional data
Baud - use *B for RA in optional data, 0 indicates local login.
Ansi - use *G for RA in optional data, 0-ascii,1-ansi.
********************************************************************)
uses COMUNIT,Dos;
var Path: string; {Hold the path we want a dir of}
TotalSize: Longint; {Total Size of all files in directory}
TotalNum: word; {Total number of files in directory}
Procedure GetCommand;
{ See above for explanation of parameters}
var d: searchrec;
Baud : word;
Code : integer;
Ans : byte;
Procedure Help;
begin
writeln('Usage: BBSDIR Path Port Baud Ansi');
writeln;
writeln('Path - use *0 for RA in optional data');
writeln('Port - use *P for RA in optional data');
writeln('Baud - use *B for RA in optional data, 0 indicates local login.');
writeln('Ansi - use *G for RA in optional data, 0-ascii,1-ansi');
halt;
end;
begin
if Paramcount < 4 then Help;
Path := Paramstr(1);
Val(Paramstr(2),Port,Code);
if Code <> 0 then Help;
Dec(Port); {RA returns 1-4, so dec by 1}
Val(Paramstr(3),Baud,Code);
if Code <> 0 then Help;
Online := Baud > 0;
Val(Paramstr(4),Ans,Code);
if Code <> 0 then Help;
Ansi := Ans = 1;
findfirst(path,$3f,d); {Let's check if they enter a path other than file...}
if DosError <> 0 then Help;
if D.attr = $10 then Path := Path+'\*.*';
end;
Procedure GetDirectory;
{We initialized the line counter, so after 24 lines, the user
will be prompted for more...therefore our loop will say:
while (doserror = 0) and (not stop) do
begin etc...
STOP is a boolean that is false until user says NO to more prompt}
var d: searchrec;
Function FormatTime(Time: longint): string;
var dt: datetime;
begin
unpacktime(Time,dt);
with Dt do
FormatTime := lz(month)+'-'+lz(day)+'-'+ms(year mod 100)+' '+lz(hour)+':'+lz(min);
{year mod 100 will return the last 2 digits...just what we want!}
end;
begin
TotalSize := 0;
TotalNum := 0;
findfirst(path,$3f,D);
while (doserror = 0) and (Not Stop) do
begin
inc(TotalNum);
Send(D.name+Rep(#32,13-length(D.name)));
if D.attr = $10
then Send('<DIR> ')
else Send(Rep(#32,9-length(Ms(D.size)))+ms(D.size));
Sendln(' '+FormatTime(D.Time));
inc(TotalSize,D.Size);
Findnext(D);
end;
end;
Procedure DisplayCredits;
begin
PortColor(14);
Sendln('BBSDIR, The first directory program for ONLINE!');
Sendln('Copyright (c) 1991-1992 HSE Delft, all rights reserved.');
Sendln('');
Send('Directory of: ');
PortColor(15);
Sendln(UprCase(Path));
Sendln('');
end;
Procedure DisplayTrailingStuff;
{The line counter initializes STOP to TRUE if the person said NO, so
"more y/n", so and it might occur in this proc depending on the
number of file names, and if STOP = true, then we want it to stop
right??}
begin
PortColor(14);
if not Stop then Sendln('');
if not Stop then Send(Rep(#32,8-length(ms(Totalnum)))+ms(Totalnum)+' file(s)');
if not Stop then Sendln(Rep(#32,11-length(ms(Totalsize)))+ms(TotalSize)+' bytes');
end;
Procedure WaitEnter;
var ch: char;
begin
PortColor(11);
Send('Press RETURN to continue...');
ch := WaitChar([#13]);
end;
begin
Online := False;
Ansi := True; {These are default values that will be changed later}
Port := 0;
ResetCounter(24,7); {reset the line counter to trigger after
24 lines, and use prompt color 7}
DisplayCredits;
GetCommand;
GetDirectory;
DisplayTrailingStuff;
WaitEnter;
end.