Category : Batch File Utilities - mostly for DOS
Archive   : BATUTIL.ZIP
Filename : UTILITY.MOD

IMPLEMENTATION MODULE Utility;

(*
Title: UTILITY.MOD

Author: Randall A. Maddox
12209 M Peach Crest Drive
Germantown, MD 20874
(301) 428-9581

System: LOGITECH MODULA-2, MS/PCDOS, Version 3.03, December 1987

Description: This module contains the implementations of the procedures
defined in UTILITY.DEF. Some are MS/PCDOS-specific
procedures and those require DOS 2.0 or higher.
NOTE:
GetEnvVar, GetCmdParm and GetCmdLn depend upon the
initialization carried out by the module body. If any
other module body is executed prior to this that resets
the DTA, then all of these procedures may fail to operate
properly.

The following procedures are found in this module:

CapStr - returns string in uppercase
TrimLT - trims off leading/trailing spaces
TrimOne - trims all multiple spaces to single spaces
TrimAll - trims out all spaces
GetDate - returns date formatted as Day Mon dd, yyyy
GetTime - returns time formatted as hh:mm:ss _M
GetEnvVar - returns value of environment variable
ParmCnt - returns number of command line parameters
GetCmdParm - returns single command line parameter
GetCmdLn - returns command-line as string

Update History:
Originally written: 10/6/87
Revamped to work under DOS 2.X or better: 7/1/88
Modified GetEnvVar, added GetCmdLn: 7/2/88
Added TrimLT and TrimAll: 7/3/88
Added GetCmdParm, ParmCnt, TrimOne: 7/4/88
Added CapStr: 7/5/88
Minor optimizations, made ParmCnt a function: 7/6/88
*)

FROM ASCII IMPORT
nul;

FROM Strings IMPORT
CompareStr, Delete, Length;

FROM SYSTEM IMPORT
(* data types *)
WORD,ADDRESS,
(* procedures *)
SETREG,GETREG,SWI,CODE,
(* registers *)
AX,BX,CX,DX,ES;

TYPE
CharPtr = POINTER TO CHAR;

VAR
EnvAddr : ADDRESS; (* address of our environment space *)
CmdAddr : ADDRESS;
CmdPtr : CharPtr;
CmdLn : ARRAY[0..127] OF CHAR;
I,J,Parms : CARDINAL;
AXwd, BXwd, ESwd : WORD; (* used to load registers *)


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

PROCEDURE CapStr(VAR Str : ARRAY OF CHAR);

(* This procedure returns Str with all lowercase letters converted
to uppercase.
*)

BEGIN
I := Length(Str);
IF (I > 0) THEN
DEC(I); (* index of last character in Str *)
FOR J := 0 TO I DO
Str[J] := CAP(Str[J])
END (* for *)
END (* if *)
END CapStr;

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

PROCEDURE TrimLT(VAR Str : ARRAY OF CHAR);

(* This procedure trims off any leading or trailing spaces from
Str.
*)

VAR
LeadingDone, TrailingDone : BOOLEAN;

BEGIN
LeadingDone := FALSE;
TrailingDone := FALSE;
I := Length(Str); (* number of chars in Str *)
IF (I > 0) THEN
REPEAT
IF (Str[0] = ' ') THEN
DEC(I);
Delete(Str,0,1)
ELSE
LeadingDone := TRUE
END; (* if *)
IF (I > 0) AND (Str[I - 1] = ' ') THEN
DEC(I);
Delete(Str,I,1)
ELSE
TrailingDone := TRUE
END (* if *)
UNTIL LeadingDone AND TrailingDone
END (* if *)
END TrimLT;

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

PROCEDURE TrimOne(VAR Str : ARRAY OF CHAR);

(* This procedure trims all occurrences of multiple consecutive
spaces in Str to single spaces.
*)

BEGIN
I := Length(Str);
IF (I > 1) THEN
J := 0; (* index into Str *)
DEC(I); (* index of last character in Str *)
REPEAT
IF (Str[J] = ' ') AND (Str[J + 1] = ' ') THEN
DEC(I);
Delete(Str,J,1)
ELSE
INC(J)
END (* if *)
UNTIL (J = I)
END
END TrimOne;

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

PROCEDURE TrimAll(VAR Str : ARRAY OF CHAR);

(* This procedure removes all spaces from Str.
*)

BEGIN
I := Length(Str);
IF (I > 0) THEN
DEC(I); (* index of last character in Str *)
J := 0; (* index into Str *)
REPEAT
IF (Str[J] = ' ') THEN
DEC(I);
Delete(Str,J,1)
ELSE
INC(J)
END (* if *)
UNTIL (J > I)
END (* if *)
END TrimAll;

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

PROCEDURE GetDate(VAR DateStr : Date);

(* This procedure gets the current system date and returns it in the
form: Day Mon dd, yyyy in the variable DateStr.
*)

VAR
Yr,Mo,Day,DOW : CARDINAL;
Temp : ARRAY[0..2] OF CHAR;

BEGIN
AXwd := WORD(2A00H); (* calling function 2AH, get system date *)
SETREG(AX,AXwd);
CODE(PushBP); (* push BP *)
SWI(Dos); (* transfer to MSDOS *)
CODE(PopBP,PushDX,PushCX); (* pop BP *)
GETREG(AX,DOW); (* AL = day of week, 0 = Sun, 1 = Mon, etc. *)
CODE(PopCX);
GETREG(CX,Yr); (* year, 1980 thru 2099 *)
CODE(PopDX);
GETREG(DX,Mo); (* DH = month, 1 thru 12; DL = day, 1 thru 31 *)
(* got the info, now separate it out *)
Day := CARDINAL(BITSET(Mo) * BITSET(00FFH)); (* DL *)
Mo := CARDINAL(BITSET(Mo) * BITSET(0FF00H)) DIV 100H; (* DH *)
DOW := CARDINAL(BITSET(DOW) * BITSET(00FFH)); (* AL *)
(* then put it into DateStr *)
DateStr[16] := nul; (* string terminator *)
DateStr[15] := CHR((Yr MOD 10) + 30H); (* 4th digit of year *)
Yr := Yr DIV 10;
DateStr[14] := CHR((Yr MOD 10) + 30H); (* 3rd digit of year *)
Yr := Yr DIV 10;
DateStr[13] := CHR((Yr MOD 10) + 30H); (* 2nd digit of year *)
Yr := Yr DIV 10;
DateStr[12] := CHR(Yr + 30H); (* 1st digit of year *)
DateStr[11] := ' ';
DateStr[10] := ',';
DateStr[9] := CHR((Day MOD 10) + 30H); (* 2nd digit of day *)
Day := Day DIV 10;
DateStr[8] := CHR(Day + 30H); (* 1st digit of day *)
DateStr[7] := ' ';
CASE Mo OF
1 : Temp := 'Jan' |
2 : Temp := 'Feb' |
3 : Temp := 'Mar' |
4 : Temp := 'Apr' |
5 : Temp := 'May' |
6 : Temp := 'Jun' |
7 : Temp := 'Jul' |
8 : Temp := 'Aug' |
9 : Temp := 'Sep' |
10 : Temp := 'Oct' |
11 : Temp := 'Nov'
ELSE
Temp := 'Dec'
END; (* case *)
DateStr[6] := Temp[2];
DateStr[5] := Temp[1];
DateStr[4] := Temp[0];
DateStr[3] := ' ';
CASE DOW OF
0 : Temp := 'Sun' |
1 : Temp := 'Mon' |
2 : Temp := 'Tue' |
3 : Temp := 'Wed' |
4 : Temp := 'Thu' |
5 : Temp := 'Fri'
ELSE
Temp := 'Sat'
END; (* case *)
DateStr[2] := Temp[2];
DateStr[1] := Temp[1];
DateStr[0] := Temp[0]
END GetDate; (* end of procedure *)

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

PROCEDURE GetTime(VAR TimeStr : Time);

(* This procedure gets the current system time and returns it in the
form: hh:mm:ss _M in the variable TimeStr.
*)

VAR
Hr,Min,Sec : CARDINAL;

BEGIN
AXwd := WORD(2C00H); (* calling function 2CH, get system time *)
SETREG(AX,AXwd);
CODE(PushBP); (* push BP *)
SWI(Dos); (* transfer to MSDOS *)
CODE(PopBP,PushDX); (* pop BP *)
GETREG(CX,Hr); (* CH = hour, 0 thru 23; CL = minutes, 0 thru 59 *)
CODE(PopDX);
GETREG(DX,Sec); (* DH = seconds, 0 thru 59; DL = hundreths of seconds *)
(* got the info, now separate it out *)
Min := CARDINAL(BITSET(Hr) * BITSET(00FFH)); (* CL *)
Hr := CARDINAL(BITSET(Hr) * BITSET(0FF00H)) DIV 100H; (* CH *)
Sec := CARDINAL(BITSET(Sec) * BITSET(0FF00H)) DIV 100H; (* DH *)
(* then put it into TimeStr *)
TimeStr[11] := nul; (* string terminator *)
TimeStr[10] := 'M';
IF (Hr > 12) THEN
Hr := Hr - 12;
TimeStr[9] := 'P'
ELSE
TimeStr[9] := 'A'
END;
TimeStr[8] := ' ';
TimeStr[7] := CHR((Sec MOD 10) + 30H); (* 2nd digit of seconds *)
Sec := Sec DIV 10;
TimeStr[6] := CHR(Sec + 30H); (* 1st digit of seconds *)
TimeStr[5] := ':';
TimeStr[4] := CHR((Min MOD 10) + 30H); (* 2nd digit of minutes *)
Min := Min DIV 10;
TimeStr[3] := CHR(Min + 30H); (* 1st digit of minutes *)
TimeStr[2] := ':';
TimeStr[1] := CHR((Hr MOD 10) + 30H); (* 2nd digit of hours *)
Hr := Hr DIV 10;
TimeStr[0] := CHR(Hr + 30H) (* 1st digit of hours *)
END GetTime; (* end of procedure *)

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

PROCEDURE GetEnvVar(VarName : ARRAY OF CHAR;
VAR VarValue : ARRAY OF CHAR);

(* This procedure searches the current environment variables for the one
specified in VarName. If that variable is found, then its value is
returned in VarValue. If VarValue is not long enough to hold the entire
value of VarName, then the truncated value is returned with no error
indicated. If the variable specified in VarName is NOT found, then
VarValue is returned with VarValue[0] = nul.

Procedure assumes that at least one environment variable is present,
and this should be a safe assumption since DOS will at least set
COMSPEC even if the user sets nothing else.
*)

TYPE
Cptr = POINTER TO CHAR;

VAR
addr : ADDRESS;
Chptr : Cptr;
name : ARRAY[0..127] OF CHAR;
K : CARDINAL;

BEGIN (* GetEnvironVar *)
VarValue[0] := nul; (* reset this if we do find it *)
addr := EnvAddr; (* point to our environment *)
(* The environment block is always paragraph aligned and consists of
a series of ASCIIZ strings of the form name=parameter. The end of
the environment block is indicated by an additional 00H byte.
*)
LOOP (* loop through names in environment block *)
(* read an environment variable name into name *)
I := 0;
K := HIGH(name);
WHILE (I <= K) DO
(* get one character *)
Chptr := addr;
IF (Chptr^ = '=') THEN (* end of name *)
name[I] := nul;
I := K + 1
ELSE (* not end of name *)
name[I] := Chptr^; (* store the character *)
INC(I); (* increment our index *)
(* and increment our pointer *)
IF (addr.OFFSET < 0FFFEH) THEN
INC(addr.OFFSET)
ELSE
addr.OFFSET := 0;
INC(addr.SEGMENT,0FFFH)
END (* if *)
END (* IF *)
END; (* WHILE *)
IF (CompareStr(name,VarName) <> 0) THEN (* didn't get a match *)
(* skip ahead to next string *)
REPEAT
Chptr := addr;
INC(addr)
UNTIL (Chptr^ = nul);
(* that's end of string, test for end of environment *)
Chptr := addr;
IF (Chptr^ = nul) THEN EXIT END (* exit on end of environment *)
ELSE (* we got a match *)
I := 0;
J := HIGH(VarValue);
REPEAT (* read the value into VarValue *)
INC(addr);
Chptr := addr;
VarValue[I] := Chptr^;
INC(I)
UNTIL (Chptr^ = nul) OR (I > J);
EXIT (* and get out of here *)
END (* IF *)
END (* LOOP *)
END GetEnvVar; (* end of procedure *)

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

PROCEDURE ParmCnt() : CARDINAL;

(* This procedure returns the number of command line parameters
present.
*)

BEGIN
RETURN Parms
END ParmCnt; (* procedure *)

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

PROCEDURE GetCmdParm(N : CARDINAL;
VAR Str : ARRAY OF CHAR);

(* This procedure returns the command line parameter number N in
the variable Str. Parameters start with 1 as the first. If
Str is not long enough to contain the requested parameter,
then the truncated part that does fit is returned. If parameter
N does not exist, then Str is returned with Str[0] = nul.
*)

VAR
K : CARDINAL;

BEGIN
Str[0] := nul; (* reset this if we do find it *)
IF (N <= Parms) AND (N > 0) THEN (* it's there *)
J := 1; (* N is parameter we want, J is parameter we are on *)
K := 0; (* character index into CmdLn string *)
IF (J < N) THEN (* skip ahead to N'th parameter *)
REPEAT
IF (CmdLn[K] = ' ') THEN
INC(J)
END;
INC(K)
UNTIL (J = N)
END; (* if *)
(* copy this parameter to str *)
J := I - K; (* characters left in CmdLn *)
IF (J > HIGH(Str)) THEN
J := HIGH(Str) (* don't overrun Str *)
END; (* if *)
I := 0; (* index into Str, K is index into CmdLn *)
WHILE (I <= J) AND (CmdLn[K] <> ' ') DO
Str[I] := CmdLn[K];
INC(I);
INC(K)
END; (* while *)
IF (I <= HIGH(Str)) THEN (* need to terminate Str *)
Str[I] := nul
END (* if *)
END (* if *)
END GetCmdParm;

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

PROCEDURE GetCmdLn(VAR CmdStr : ARRAY OF CHAR);

(* This procedure returns the command-line found at offset 81H in
the PSP in the variable CmdStr. CmdStr[0] will be set to ASCII
nul if no command line present. If CmdStr is not long enough
to hold the entire command line, then only the truncated portion
that fits is returned. The command line is returned with all
leading and trailing spaces removed and each parameter separated
from the others by a single space. Any parsing of the command
line contents is the responsibility of the calling program.
*)

BEGIN
I := HIGH(CmdLn);
J := HIGH(CmdStr);
IF (I < J) THEN J := I END;
FOR I := 0 TO J DO
CmdStr[I] := CmdLn[I]
END (* for *)
END GetCmdLn;

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

BEGIN (* module body *)

(* first, find out where our environment is and initialize EnvAddr *)
AXwd := WORD(2F00H); (* calling function 2FH, get DTA address *)
SETREG(AX,AXwd); (* AH = 2FH *)
CODE(PushBP); (* push BP *)
SWI(Dos); (* transfer to MSDOS *)
CODE(PopBP,PushES); (* pop BP *)
GETREG(BX,BXwd); (* offset of DTA *)
CODE(PopES);
GETREG(ES,ESwd); (* segment of DTA *)
EnvAddr.OFFSET := CARDINAL(BXwd);
EnvAddr.SEGMENT := CARDINAL(ESwd);
CmdAddr := EnvAddr; (* address of command tail also *)
(* DTA address is initially at offset 80H in PSP, while address of
segment address of environment is at offset 2CH in PSP, i.e.,
the address we really want is found 54H bytes back from the
address we now have *)
WHILE (EnvAddr.OFFSET < 54H) DO (* make sure no cardinal overflow *)
DEC(EnvAddr.SEGMENT);
INC(EnvAddr.OFFSET,10H)
END; (* while *)
DEC(EnvAddr.OFFSET,54H); (* points to address of address we want *)
EnvAddr.SEGMENT := CARDINAL(EnvAddr^); (* segment of environment block *)
EnvAddr.OFFSET := 0; (* offset of environment block *)
(* environment block is always paragraph aligned *)

(* next save our command line and parameter count for later *)
Parms := 0; (* initialize count of command line parametrs *)
CmdPtr := CmdAddr;
I := ORD(CmdPtr^); (* length of command tail *)
IF (I = 0) THEN (* no command line *)
CmdLn[0] := nul
ELSE (* copy command line to CmdLn and set Parms *)
CmdLn[I] := nul; (* terminate string *)
FOR J := 0 TO (I - 1) DO
(* increment our pointer *)
IF (CmdAddr.OFFSET < 0FFFEH) THEN
INC(CmdAddr.OFFSET)
ELSE
CmdAddr.OFFSET := 0;
INC(CmdAddr.SEGMENT,0FFFH)
END; (* if *)
CmdPtr := CmdAddr;
CmdLn[J] := CmdPtr^ (* store the character *)
END; (* for *)
TrimLT(CmdLn); (* trim off leading/trailing spaces *)
TrimOne(CmdLn); (* trim internal spaces to 1 each *)
(* set parameter count *)
I := Length(CmdLn); (* see how many characters left *)
IF (I > 0) THEN (* at least one left *)
J := 0; (* index into CmdLn *)
Parms := 1; (* know we have at least one *)
REPEAT (* now count spaces separating parameters *)
IF (CmdLn[J] = ' ') THEN
INC(Parms)
END; (* if *)
INC(J)
UNTIL (J = I) (* repeat *)
END (* if *)
END; (* if *)

END Utility.

(* end of this file *)