home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
d
/
drcpas10.zip
/
PARAMTRS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-11-17
|
4KB
|
170 lines
{$A+,B-,D-,F-,I-,L-,N-,O-,R-,S+,V-}
unit Paramtrs;
(* by David R. Conrad, for Turbo Pascal 5.5
This code is not copyrighted, you may use it freely.
There are no guarantees, either expressed or implied,
as to either merchantability or fitness for a particular
purpose. The author's liability is limited to the amount
you paid for it.
David R. Conrad, 17 Nov 92
David_Conrad@mts.cc.wayne.edu
dave@michigan.com
*)
interface
(* paramcount and paramstr, as usual, except:
program one two"three \"four\" five" -q\" \"six\"
is parsed as 'one', 'two', 'three "four" five', '-q"', '"six"'
In other words, quotes surround parameters which may contain spaces,
and backslashes escape quotes, but backslashes do not escape other
backslashes, so it isn't possible to get the literal sequence \" in
a parameter.
*)
function ParamCount : word;
function ParamStr(index : word) : string;
implementation
uses dos, tools;
type
paramstring = string[128];
var
prmstrptr : ^paramstring;
prmstr : paramstring;
function ParamCount : word;
var
i, p : integer;
begin
p := 0;
i := 1;
while (i <= length(prmstr)) do
begin
case prmstr[i] of
' ' : ;
'"' : if (prmstr[i-1] <> '\') then
begin
inc (p);
repeat
inc (i);
until (i >= length(prmstr)) or
((prmstr[i] = '"') and (prmstr[i-1] <> '\'));
end;
else
if (prmstr[i-1] = ' ') or
((prmstr[i-1] = '"') and (prmstr[i-2] <> '\')) then
inc (p);
end;
inc (i);
end;
ParamCount := p;
end;
function GetNameFromEnv : string;
var
c : ^char;
w : ^word;
last : char;
name : string;
extra : word;
begin
w := ptr(prefixseg,$2C);
c := ptr(w^,0);
repeat
last := c^;
IncPtr (pointer(c));
until (last = #0) and (c^ = #0);
IncPtr (pointer(c));
extra := ord(c^); (* lsb *)
IncPtr (pointer(c));
extra := extra + (ord(c^) SHL 8); (* msb *)
if (extra = 0) then (* if no extra strings in environment *)
begin
GetNameFromEnv := '';
exit;
end;
IncPtr (pointer(c));
name := '';
while (c^ <> #0) do
begin
name := name + c^;
IncPtr (pointer(c));
end;
GetNameFromEnv := name;
end;
function ParamStr(index : word) : string;
var
i, p : integer;
param : string;
begin
if (index = 0) then (* handle ParamStr(0) *)
begin
if lo(dosversion) < 3 then
ParamStr := ''
else
ParamStr := GetNameFromEnv;
exit;
end;
p := 0;
i := 1;
while (i <= length(prmstr)) and (p < index) do
begin
case prmstr[i] of
' ' : ;
'"' : if (prmstr[i-1] <> '\') then
begin
inc (p);
inc (i);
param := '';
while (i <= length(prmstr)) and
((prmstr[i] <> '"') or (prmstr[i-1] = '\')) do
begin
if (prmstr[i] = '"') then
param[length(param)] := prmstr[i]
else
param := param + prmstr[i];
inc (i);
end;
end;
else
if (prmstr[i-1] = ' ') or (prmstr[i-1] = '"') then
begin
inc (p);
param := '';
while (i <= length(prmstr)) and (prmstr[i] <> ' ') and
((prmstr[i] <> '"') or (prmstr[i-1] = '\')) do
begin
if prmstr[i] = '"' then
param[length(param)] := prmstr[i]
else
param := param + prmstr[i];
inc (i);
end;
if (i <= length(prmstr)) and
((prmstr[i] = '"') and (prmstr[i-1] <> '\')) then
dec (i);
end;
end;
inc (i);
end;
if (p = index) then
ParamStr := param
else
ParamStr := '';
end;
begin
prmstrptr := ptr(prefixseg,$80);
prmstr := prmstrptr^;
end.