Category : Pascal Source Code
Archive   : SUNCOM.ZIP
Filename : MYDOS.PAS

UNIT MyDos;

INTERFACE

USES Dos,Crt,Windows;

FUNCTION Drive_Number(Path : String) : Integer;
FUNCTION DiskVolumeID(Path : String) : String;
PROCEDURE Directory(Foreground1,
Foreground2,
BackGround,
FrameType : Byte);
PROCEDURE FILECOPIER(Source,
Destination : String;
IOError : Byte);

IMPLEMENTATION
(*****************************************************************************)

FUNCTION Drive_Number;
begin
Drive_Number := -1;
case Path[1] of
'A','a' : Drive_Number := 1;
'B','b' : Drive_Number := 2;
'C','c' : Drive_Number := 3;
'D','d' : Drive_Number := 4;
'E','e' : Drive_Number := 5;
'F','f' : Drive_Number := 6;
'G','g' : Drive_Number := 7;
end;
end;

(*****************************************************************************)

FUNCTION DiskVolumeID;
VAR FileInfo : SearchRec;
DiskVolID : String;
LCV : Integer;
begin
FindFirst('*.*',VolumeID,FileInfo);
DiskVolID := FileInfo.Name;
for LCV := 1 to length(DiskVolID) do
if DiskVolID[LCV] = '.'
then delete(DiskVolID,LCV,1);
for LCV := 1 to length(DiskVolID) do
if not (DiskVolID[LCV] in [' '..'z'])
then DiskVolID := 'No Label';
end;

(*****************************************************************************)

PROCEDURE Directory;
VAR FileInfo : SearchRec;
TimeNow : DateTime;
FileTimeStamp,
NumFiles,
NumDirectories : LongInt;
FileReference : File of Byte;
Question,
AmPm : Char;
DirPattern,
DirPath,
DirPattern2 : String;
Counter : Integer;
LABEL Beginning;

FUNCTION STR2(Number : Integer) : String;
VAR NewString : String;
begin
Str(Number,NewString);
if Length(NewString) = 1 then Insert('0',NewString,1);
if Length(NewString) = 4 then Delete(NewString,1,2);
STR2 := NewString;
end;

BEGIN
window(1,1,80,25);
NumFiles := 0;
NumDirectories := 0;
Beginning:
{$i-}
WINDOWIN(Foreground1,Background,FrameType,10,10,70,13,CursorCol,CursorRow,WindowPtr);
textcolor(ForeGround1);
write('Directory Pattern: ');
textcolor(ForeGround2);
readln(DirPattern);
textcolor(ForeGround1);
write('Directory Path: ');
textcolor(ForeGround2);
readln(DirPath);
ChDir(DirPath);
if (IOresult <> 0) or (length(DirPattern) < 3) or (length(DirPath) < 2)
then begin
{$i+}
DirPattern := '*.*';
end;
{$i+}
if length(DirPath) >=3
then begin
DirPattern2 := DirPath+'\'+DirPattern;
{$i-}
ChDir(DirPath);
DirPattern2 := DirPattern;
if (IOresult <> 0) or (length(DirPattern) < 3) or (length(DirPath) < 2)
then begin
{$i+}
WINDOWOUT(CursorCol,CursorRow,WindowPtr);
exit;
end;
{$i+}
end
else begin
{$i-}
ChDir(DirPath+'\');
DirPattern2 := DirPattern;
if (IOresult <> 0) or (length(DirPattern) < 3) or (length(DirPath) < 2)
then begin
{$i+}
WINDOWOUT(CursorCol,CursorRow,WindowPtr);
exit;
end;
{$i+}
end;
OFFCURSOR;
window(1,1,80,25);
clrscr;
MAKEWINDOW(black,white,4,0,15,1,65,5);
write(' Disk Volume ID: ');
textcolor(red);
writeln(DiskVolumeID(DirPattern2));
textcolor(black);
write(' Directory of: ');
textcolor(red);
writeln(DirPath+'\'+DirPattern);
textcolor(black);
write(' Space Free: ');
textcolor(red);
write(DiskFree(Drive_Number(DirPath[1])),' Bytes');
MAKEWINDOW(black,white,4,0,15,7,65,23);
Counter := 0;
FindFirst(DirPattern2,AnyFile,FileInfo);
while (DosError = 0) do
begin
Assign(FileReference,FileInfo.Name);
if (FileInfo.Attr = 32) or (FileInfo.Attr = 16)
then begin
if FileInfo.Attr = 32
then begin
Reset(FileReference);
NumFiles := NumFiles + 1;
GetFTime(FileReference,FileTimeStamp);
UnPackTime(FileTimeStamp,TimeNow);
write(FileInfo.Name:12,FileSize(FileReference):9);
with TimeNow do
begin
if Hour > 12
then begin
Hour := Hour - 12;
AmPm := 'p';
end
else AmPm := 'a';
write(' Bytes ',STR2(Month),'/',STR2(Day),'/',STR2(Year),' ');
writeln(STR2(Hour),':',STR2(Min)+AmPm);
end;
end
else begin
writeln(FileInfo.Name:12,' ':9);
NumDirectories := NumDirectories + 1;
end;
Counter := Counter + 1;
if Counter >= 14
then begin
Counter := 0;
textcolor(red);
write('Press Any Key...');
Question := readkey;
textcolor(black);
writeln;
end;
if FileInfo.Attr = 32 then Close(FileReference);
FindNext(FileInfo);
end
else FindNext(FileInfo);
end;
textcolor(black);
write('Number of Files: ');
textcolor(yellow);
writeln(NumFiles);
textcolor(black);
write('Number of Directories: ');
textcolor(yellow);
writeln(NumDirectories);
textcolor(red);
write('Press Any Key...');
Question := readkey;
WINDOWOUT(CursorCol,CursorRow,WindowPtr);
ONCURSOR;
end;

(*****************************************************************************)

PROCEDURE FILECOPIER;
VAR Buffer : Array[1..8192] of char;
NumberOfBytes,
NumberRead,
NumberWritten : word;
SourceFile,
DestFile : File;
BEGIN
NumberOfBytes := 1;
IOError := 0;
{$I-}
assign(SourceFile,Source);
reset(SourceFile,NumberOfBytes);
{$I+}
if IOResult <> 0 then
begin
IOError := 1;
exit;
end;
{$I-}
assign(DestFile,Destination);
rewrite(DestFile,NumberOfBytes);
{$I+}
if IOResult <> 0 then
begin
IOError := 2;
exit;
end;
repeat
BlockRead(SourceFile,Buffer,SizeOf(Buffer),NumberRead);
BlockWrite(DestFile,Buffer,NumberRead,NumberWritten);
until (NumberRead = 0) {or (NumberRead <> NumberWritten)};
close(SourceFile);
close(DestFile);
END;

end. {unit}