ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/MISCPAS.ZIP/PASTOOLS.PAS

Pascal/Delphi Source File | 1992-06-23 | 5.0 KB | 189 lines

20-Mar-84 20:48:17-PST,5273;000000000001
Return-Path: <b-davis@utah-cs>
Received: FROM utah-cs BY USC-ISIB.ARPA WITH TCP ; 20 Mar 84 20:46:17 PST
Received: by utah-cs.ARPA (4.19/3.33.3)
    id AA24179; Tue, 20 Mar 84 21:40:08 mst
Date: Tue, 20 Mar 84 21:40:08 mst
From: b-davis@utah-cs (Brad Davis)
Message-Id: <[e-mail]>
To: info-ibmpc@usc-isib
Subject: New Tools for MS-Pascal


I have three routines that the readers might be interested in.

    ENV (const s1: lstring; var s2: lstring);
        Returns the value of s1 from the current
        enviroment.  See the SET command.  If
        s1 were COMSPEC then s2 probably would be
        C:\COMMAND.COM for an XT.

    ARGC : integer;
        Returns the count of the parameters on the
        command line.  Counts the program name as
        one of the parameters, e.g.  C>FOO BAR  would
        return 2.

    ARGV (i: integer; var s: lstring);
        I is the position of the parameter to return.
        In the example above ARGV(1,s) would return
        BAR in s.  Since MS-DOS doesn't give the
        program name like UNIX, ARGV(0,s) would give
        the null string in s.


ARGC and ARGV match the Berkely Pascal conventions for the same
named pre-declared routines.  They also match the C conventions
for the parameters to main().

All you need to do to use them is to declare them external in
your program and link them to your program.  If you have any
questions just write.


                Brad Davis

P.S.  Sorry if the code is cryptic.  I usually don't spend time
      commenting my hacks.  I will answer any questions anyone
      might have.


------------------------------------------------------------------------
{$DEBUG-}
INTERFACE;
UNIT
    command_line(argc,argv,env);

    function argc: integer;
    procedure argv(num: integer; var s: lstring);
    procedure env(var inps,outs: lstring);

END;
IMPLEMENTATION OF command_line;
CONST
    CR = chr(13);
    PARAM = #80;
    ENVOFF = #2C;
TYPE
    smallstring = lstring(40);
    alphaarray = super array[0..*] of smallstring;
VAR
    doparse: boolean;
    doenv: boolean;
    parsecnt: integer;
    envcnt: integer;
    arguments: ^alphaarray;
    environment: ^alphaarray;
    CESXQQ [EXTERN]: WORD;
VALUE
    doparse := true;
    doenv:= true;

    procedure parsecommand;
    var
        i,j,k: integer;
        doskip: boolean;
        a: ads of lstring(255);
    begin
        doparse := false;
        a.s := CESXQQ;
        a.r := PARAM;
        parsecnt := 1;
        i := 1;
        while i <= (ord(a^.len)) do begin
            while a^[i] = ' ' do i := i + 1;
            parsecnt := parsecnt + 1;
            while (a^[i] <> ' ') and (a^[i] <> CR) do i := i + 1;
        end;
        new(arguments,parsecnt-1);
        i := 1;
        arguments^[0] := null;  { MS-DOS doesn't give us the program name }
        j := 0;
        while i <= (ord(a^.len)) do begin
            while a^[i] = ' ' do i := i + 1;
            j := j + 1;
            k := 1;
            while (a^[i] <> ' ') and (a^[i] <> CR) do begin
                arguments^[j][k] := a^[i];
                i := i + 1;
                k := k + 1;
            end;
            arguments^[j].len := wrd(k-1);
        end;
    end;

    procedure getenvironment;
    var
        i,j,k: integer;
        a: adsmem;
        offset: ads of word;
    begin
        doenv := false;
        offset.s := CESXQQ;
        offset.r := ENVOFF;
        a.s := offset^;
        a.r := 0;
        i := 0;
        envcnt := 0;
        while a^[wrd(i)] <> 0 do begin
            envcnt := envcnt + 1;
            while a^[wrd(i)] <> 0 do i := i + 1;
            i := i + 1;
        end;
        new(environment,envcnt);
        i := 0;
        j := 0;
        while a^[wrd(i)] <> 0 do begin
            k := 1;
            while a^[wrd(i)] <> 0 do begin
                environment^[j][k] := chr(a^[wrd(i)]);
                i := i + 1;
                k := k + 1;
            end;
            environment^[j].len := wrd(k-1);
            j := j + 1;
            i := i + 1;
        end;
    end;

    function argc{: integer};
    begin
        if doparse then parsecommand;
        argc := parsecnt;
    end;

    procedure argv{num: integer; var s: lstring};
    begin
        if doparse then parsecommand;
        if num < parsecnt then
            movel(adr arguments^[num],adr s,arguments^[num].len+1)
        else
            s.len := 0;
    end;

    procedure env{var inps,outs: lstring};
    var
        i,j: integer;
        s1,s2: lstring(255);
    begin
        if doenv then getenvironment;
        for i := 1 to ord(inps.len) do
            if (inps[i] >= 'a') and (inps[i] <= 'z') then
                s1[i] := chr(ord(inps[i]) - ord('a') + ord('A'))
            else
                s1[i] := inps[i];
        s1.len := inps.len;
        outs.len := 0;
        for i := 0 to envcnt-1 do begin
            s2 := environment^[i];
            j := positn('=',s2,1);
            delete(s2,j,ord(s2.len)-j+1);
            if s2 = s1 then begin
                movel(adr environment^[i],adr outs,environment^[i].len+1);
                delete(outs,1,j);
            end;
        end;
    end;

END.