Category : Modula II Source Code
Archive   : HISTRPT.ZIP
Filename : GOODIES.MOD

 
Output of file : GOODIES.MOD contained in archive : HISTRPT.ZIP
IMPLEMENTATION MODULE GOODIES;
IMPORT SYSTEM;
IMPORT Lib;
IMPORT Str;
IMPORT Storage;
(*FROM Str IMPORT Caps;*)
VAR
ch : CHAR;

PROCEDURE GetTime(VAR Hrs,Mins,Secs,Hsecs : CARDINAL);
(*
RETURNS THE TIME AS RETURNED BY DOS
HOUR : 0..23 MINS : 0..59 SECS : 0..59 HSECS : 0..99
*)
VAR
R : SYSTEM.Registers;

BEGIN
WITH R DO
AH := 2CH;
Lib.Dos(R);
Hrs := CARDINAL(CH);
Mins := CARDINAL(CL);
Secs := CARDINAL(DH);
Hsecs := CARDINAL(DL);
END;
END GetTime;

PROCEDURE GetDate ( VAR Year,Month,Day : CARDINAL;
VAR DayOfWeek : CARDINAL );
(*
Returns the date as returned by DOS
YEAR : 1980..2099 MONTH : 1..12 DAY : 1..31
*)
VAR
R : SYSTEM.Registers;
BEGIN
WITH R DO
AH := 2AH;
Lib.Dos(R);
Year := CARDINAL(CX);
Month := CARDINAL(DH);
Day := CARDINAL(DL);
DayOfWeek := CARDINAL(AL);
END;
END GetDate;

PROCEDURE Exec( command : ARRAY OF CHAR;
params : ARRAY OF CHAR );
(*
Executes a named program, using all free heap memory to do so.
All momory allocation/deallocation is automatic.
The program name should include the extension and full path names.

Exec('\COM\ED.EXE','AFILE');
The string params will be passed to the program as the
'command line'.
*)
VAR
memptr : ADDRESS;
memsize : CARDINAL;
reply : CARDINAL;
BEGIN
memsize := Storage.HeapAvail ( Storage.MainHeap) -8;
Storage.HeapAllocate(Storage.MainHeap,memptr,memsize);
reply := Lib.Execute(command,params,memptr,memsize);
Storage.HeapDeallocate(Storage.MainHeap,memptr,memsize);
IF reply <> 0 THEN
Lib.FatalError('Failed to eecute program');
END;
END Exec;

PROCEDURE EnvironmentFind ( name : ARRAY OF CHAR;
VAR result : ARRAY OF CHAR );
(*
Find a string in the DOS environment
*)
VAR
n : CARDINAL;
pi : ARRAY[0..14] OF CHAR;
es : ARRAY[0..80] OF CHAR;
pp : Lib.CommandType;
BEGIN
n := 0;
LOOP
pp := Lib.Environment(n);
Str.Copy(es,pp^);
IF es[0] = CHR(0) THEN
result[0] := CHR(0);
RETURN;
END;
Str.ItemS(pi,es,' =',0);
IF Str.Match(pi,name) THEN
Str.ItemS(result,es,' =',1);
RETURN;
END;
INC(n);
END;
END EnvironmentFind;

PROCEDURE ExecCmd( command : ARRAY OF CHAR);
(*
Similar to Exec except the command is executed under a
copy of COMMAND.COM, the DOS command interpreter. This means
that the command can be exactly as typed from the normal DOS
prompt, and may include 'built in' commands such as DIR, COPY etc.
Again all memory de/allocation is automatic.
examples:
ExecCmd('dir /w'); (* do a 'wide' DOS directory *)
ExecCmd('ed afile'); (* same as Exec example above *)
ExecCmd is generally perferred over exec for general use
although it has two disadvantages
1) There is slightly less memory available to run the command,
2) COMMAND.COM must be re-loades which is slightly slower.
*)
VAR
path : ARRAY[0..63] OF CHAR;
cline : ARRAY[0..128] OF CHAR;

BEGIN
EnvironmentFind('COMSPEC',path);
Str.Concat(cline,'/C ',command);
Exec(path,cline);
END ExecCmd;

PROCEDURE Today(format : CARDINAL): Tdaystr;
(*
Today will return the system time from DOS in one of 4 formats:

1 : Saturday 10/09/1989
2 : 10/09/1989
3 : 10/09/89
4 : January 09, 1989

***************** OTHER FORMATS UNDER DEVELOPMENT *****************
*)
VAR
y,m,d,dow : CARDINAL;
y1,m1,d1 : LONGCARD;
month : ARRAY[0..8] OF CHAR;
yr : ARRAY[0..3] OF CHAR;
mo,da : ARRAY[0..1] OF CHAR;
DayOfWeek : ARRAY[0..8] OF CHAR;
done : BOOLEAN;
temp : Tdaystr;
BEGIN
GetDate(y,m,d,dow);
y1 := VAL(LONGCARD,y);
m1 := VAL(LONGCARD,m);
d1 := VAL(LONGCARD,d);
Str.CardToStr(y1,yr,10,done);
Str.CardToStr(m1,mo,10,done);
Str.CardToStr(d1,da,10,done);
IF m < 10 THEN
Str.Concat(mo,'0',mo);
END;
IF d < 10 THEN
Str.Concat(da,'0',da);
END;
CASE dow OF
0 : DayOfWeek := 'Sunday'|
1 : DayOfWeek := 'Monday'|
2 : DayOfWeek := 'Tuesday' |
3 : DayOfWeek := 'Wednesday'|
4 : DayOfWeek := 'Thursday'|
5 : DayOfWeek := 'Friday'|
6 : DayOfWeek := 'Saturday'
END;
CASE format OF
1 : Str.Concat(temp,DayOfWeek,' ');
Str.Concat(temp,temp,mo);
Str.Concat(temp,temp,'/');
Str.Concat(temp,temp,da);
Str.Concat(temp,temp,'/');
Str.Concat(temp,temp,yr)|
2 : Str.Concat(temp,mo,'/');
Str.Concat(temp,temp,da);
Str.Concat(temp,temp,'/');
Str.Concat(temp,temp,yr) |
3 : Str.Concat(temp,mo,'/');
Str.Concat(temp,temp,da);
Str.Concat(temp,temp,'/');
Str.Slice(yr,yr,2,2);
Str.Concat(temp,temp,yr) |
4 : CASE m OF
1 : month := 'January'|
2 : month := 'February'|
3 : month := 'March'|
4 : month := 'April'|
5 : month := 'May'|
6 : month := 'June'|
7 : month := 'July'|
8 : month := 'August'|
9 : month := 'September'|
10 : month := 'October'|
11 : month := 'November'|
12 : month := 'December'
END;
Str.Concat(temp,month,' ');
Str.Concat(temp,temp,da);
Str.Concat(temp,temp,',');
Str.Concat(temp,temp,yr)|
END;
RETURN temp;
END Today;

PROCEDURE Now(format:CARDINAL):Tmstr;
(*
Now will return a string containing the current system time from DOS
in one of 6 formats.

1 : HH:MM:SS:ss (* ss IS HUNDRETHS OF A SECOND *)
2 : HH:MM:SS (* 24 HOUR FORMAT *)
3 : HH:MM:SS (* 12 HOUR FORMAT *)
4 : HH:MM (* 24 HOUR FORMAT *)
5 : HH:MM (* 12 HOUR FORMAT *)
6 : HH:MMA/P (* 12 HOUR FORMAT WITH A OR P *)
*)

VAR
hr,min,sec,sec100 : CARDINAL;
h1,m1,s1,s2 : LONGCARD;
h,m,s,s0 : ARRAY[0..1] OF CHAR;
temp : Tmstr;
p,done : BOOLEAN;

BEGIN
GetTime(hr,min,sec,sec100);
IF (format = 3) OR (format = 5) OR (format = 6) THEN
IF hr > 12 THEN
p := TRUE;
DEC(hr,12);
END;
END;
h1 := VAL(LONGCARD,hr);
m1 := VAL(LONGCARD,min);
s1 := VAL(LONGCARD,sec);
s2 := VAL(LONGCARD,sec100);
Str.CardToStr(h1,h,10,done);
Str.CardToStr(m1,m,10,done);
Str.CardToStr(s1,s,10,done);
Str.CardToStr(s2,s0,10,done);
CASE format OF
1 : Str.Concat(temp,h,':');
Str.Concat(temp,temp,m);
Str.Concat(temp,temp,':');
Str.Concat(temp,temp,s);
Str.Concat(temp,temp,':');
Str.Concat(temp,temp,s0)|
2 : Str.Concat(temp,h,':');
Str.Concat(temp,temp,m);
Str.Concat(temp,temp,':');
Str.Concat(temp,temp,s)|
3 : Str.Concat(temp,h,':');
Str.Concat(temp,temp,m);
Str.Concat(temp,temp,':');
Str.Concat(temp,temp,s)|
4 : Str.Concat(temp,h,':');
Str.Concat(temp,temp,m)|
5 : Str.Concat(temp,h,':');
Str.Concat(temp,temp,m)|
6 : Str.Concat(temp,h,':');
Str.Concat(temp,temp,m);
IF p THEN
Str.Concat(temp,temp,'P');
ELSE
Str.Concat(temp,temp,'A');
END|
END;
RETURN temp;
END Now;

PROCEDURE IsAlpha(ch : CHAR) : BOOLEAN;
BEGIN
Str.Caps(ch);
RETURN(ch >= 'A') AND (ch <= 'Z');
END IsAlpha;
PROCEDURE IsDigit(ch : CHAR) : BOOLEAN;
BEGIN
Str.Caps(ch);
RETURN(ch >= '0') AND (ch <= '9');
END IsDigit;
PROCEDURE IsWhite(ch : CHAR) : BOOLEAN;
BEGIN
RETURN(ch = ' ') OR (ch = CHR(9)) OR (ch = CHR(13));
END IsWhite;





END GOODIES.

  3 Responses to “Category : Modula II Source Code
Archive   : HISTRPT.ZIP
Filename : GOODIES.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/