home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frozen Fish 1: Amiga
/
FrozenFish-Apr94.iso
/
bbs
/
alib
/
d9xx
/
d923
/
setenv39.lha
/
SetEnv39
/
SetEnv.mod
< prev
next >
Wrap
Text File
|
1993-10-07
|
4KB
|
122 lines
(* ------------------------------------------------------------------------
:Program. SetEnv.mod
:Contents. SetEnv clone, supports dos V39 SAVE_to_envarc: feature.
:Contents. (use SAVE option) If you specify a var name without a
:Contents. string, SetEnv deletes the var (aka UnSetEnv)
:Author. Franz Schwarz
:Copyright. Freeware (freely distributable, copyrighted software)
:Language. Oberon-2
:Translator. Amiga Oberon 3.00
:History. v39.0 fSchwarz
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
:Remark. As of Amiga Oberon Release 3.00: possible odd pointers to
:Remark. array of char/byte: _don't_ compile with OddChk
:Usage. SetEnv NAME,SAVE/S,STRING/F
------------------------------------------------------------------------ *)
MODULE SetEnv;
IMPORT d: Dos, e: Exec, i: Intuition, y: SYSTEM, o: OberonLib (* , NoGuru *) ;
CONST versionStr = "\000$VER: Oberon-SetEnv 39.0 (8.5.93)";
CONST saveVar = 12; (* V39+ Dos: Affect ENVARC: as well as ENV: *)
CONST templ = "NAME,SAVE/S,STRING/F";
TYPE
ArgT = STRUCT
name : e.STRPTR;
save : LONGINT;
string: e.STRPTR;
END;
VAR Rda: d.RDArgsPtr;
Args: ArgT;
Err: LONGINT;
Flags: LONGSET;
Eac: d.ExAllControlPtr;
Buf: ARRAY 1000 OF y.BYTE;
EARes: BOOLEAN;
Ead: d.ExAllDataPtr;
k: LONGINT;
lock: d.FileLockPtr;
dos : d.DosLibraryPtr;
break: BOOLEAN;
PROCEDURE ExAllEnd *{dos,-990}(lock{1} : d.FileLockPtr; (* V39 Dos *)
buffer{2} : ARRAY OF y.BYTE;
size{3} : LONGINT;
data{4} : LONGINT;
ctrl{5} : d.ExAllControlPtr);
BEGIN
break := FALSE;
dos := d.base;
y.SETREG(0, y.ADR(versionStr));
Flags:=LONGSET{d.globalOnly};
o.Result:=20;
IF d.dos.lib.version<37 THEN
IF d.Output()#NIL THEN
y.SETREG(0, d.Write(d.Output(), "Need AmigaOS 2.04 or higher!\n", 29));
ELSE
e.Alert(e.recovery+e.openLib+e.dosLib+e.anUnknown);
END;
HALT(20);
END;
IF o.wbStarted THEN
i.DisplayBeep(NIL);
HALT(20);
END;
Rda:=d.ReadArgs(templ, Args, NIL);
IF Rda#NIL THEN
o.Result := 10;
IF Args.save # 0 THEN INCL (Flags, saveVar); END;
IF Args.name # NIL THEN
IF Args.string = NIL THEN
y.SETREG (0, d.DeleteVar(Args.name^, Flags)); o.Result := 0;
ELSE
IF d.SetVar(Args.name^, Args.string^, -1, Flags) THEN o.Result := 0; END;
END;
ELSE (* Args.name # NIL *)
IF Args.save = 0 THEN lock := d.Lock ("ENV:", d.accessRead);
ELSE lock := d.Lock ("ENVARC:", d.accessRead); END;
IF lock # NIL THEN
Eac := d.AllocDosObject (d.exAllControl, NIL);
IF Eac # NIL THEN
Eac.lastKey := 0; Eac.matchString := NIL; Eac.matchFunc := NIL;
LOOP
EARes := d.ExAll(lock, Buf, SIZE(Buf), d.type, Eac);
IF ~EARes THEN IF d.IoErr() # d.noMoreEntries THEN EXIT; END; END;
Ead := y.ADR (Buf);
IF ~break THEN
FOR k := 1 TO Eac.entries DO
IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
break := TRUE;
d.PrintF ("*** Aborted\n");
IF dos.lib.version >= 39 THEN
ExAllEnd (lock, Buf, SIZE(Buf), d.type, Eac);
o.Result := 5;
EXIT;
END;
END; (* d.ctrlC IN .. *)
IF (Ead.type < 0) & ~break THEN d.PrintF ("%s\n", Ead.name); END;
Ead := Ead.next;
END; (* FOR *)
END; (* ~break *)
IF ~EARes THEN
IF break THEN o.Result := 5; ELSE o.Result := 0; END;
EXIT;
END;
END; (* LOOP *)
d.FreeDosObject (d.exAllControl, Eac);
END; (* Eac # NIL *)
d.UnLock (lock);
END; (* lock # NIL *)
END; (* Args.name # NIL *)
d.FreeArgs (Rda);
END; (* Rda # NIL *)
END SetEnv.