Code:
'-------------------------------------------------------------------------------
'
' Unit: dosenv.pbl
' Zweck: Lesen und Ändern der Umgebung des zuletzt geladenen COMMAND.COM,
' verbesserte Version (optimierte, kompatible Nachfolgeversion
' von environ4 mit einigen Erweiterungen und Bugfixes).
' Version: 1.00
' Stand: 20.03.2000
' Sprache: PowerBASIC 3.5
' Autor: (C) M.Hoffmann, Wedeler Landstr.139, 22559 Hamburg.
' Historie:
'
'-------------------------------------------------------------------------------
' c: environ4.pbu 5534 5.04.98 14:42 (Vorgänger)
' c: dosenv .pbu 5660 20.03.00 15:32 v1.00
'-------------------------------------------------------------------------------
' Die hier beschriebene Methode zur Bestimmung der Umgebungsadresse
' lief bislang überall zuverlässig (auch unter Win 9x). Zwei weitere
' Methoden, um die Umgebung des ZUERST geladenen Kommandoprozessores zu bestim-
' men (MCB-Kette, Einstieg über Funktion 52h; INT 2Eh als Pointer auf COMMAND)
' funktionieren entweder nicht in der OS/2 1.3 DOS-Box oder nicht mit anderen
' Kommandoprozessoren (INT 2Eh zeigt nicht auf den NDOS-Prozessor).
' die maximale Größe einer Umgebung etwas weniger als 32k (32750), ACHTUNG:
' die Einstellung $STRING im Hauptprogramm ist entsprechend zu setzen!
' Lesefunktionen beziehen sich auf die möglicherweise bereits veränderte Kopie
' der Umgebung, nicht mehr auf die Originaltabelle!
'-------------------------------------------------------------------------------
' Anmerkungen zur Verwendung eines Pointers zur direkten Änderung der Umgebung:
' Durch Definition von @envBuf als String Ptr*32750 würde beim Löschen
' oder Einfügen von Variablen der Bereich hinter dem tatsächlichen Ende der
' Umgebungsvariablen hin- und hergeschoben, also korrumpiert !!! Ein korrektes
' Definieren via 'dim envBuf as string ptr*<envLen>' ist aber nicht möglich,
' weil für die Stringlänge eine Konstante angegeben werden muss!!
'-------------------------------------------------------------------------------
'
' ┌───────────────────┬────γ 2;─────────────────────────	 472;─────────────────────────& #9488;
' │ envBlock() │ Komletten Umgebungsblock zurückgeben │
' │ envClear() │ Löscht eine Variable aus dem Umgebungsblock │
' │ envCount() │ Liefert Anzahl der Variablen im Umgebungsblock zurück │
' │ envEntries() NEU │ Liefert ALLE Einträge zurück │
' │ envEntry() │ Liefert gesamten Eintrag anhand des Varnamens zurück │
' │ envEnum() │ Liefert Eintrag Nr. n aus der Umgebungstabelle zurück │
' │ envFree() │ Größe des noch freien Umgebungsspeichers zurückgeben │
' │ envInfo │ Adresse und Länge des letzten Umgebunsblocks bestimmen │
' │ envLen() │ Länge des Umgebungsblocks zurückgeben │
' │ envLoad() │ Initialisieren der Umgebungsfunktionen │
' │ envName() NEU │ Formatiert den Variablennamen gemäß envStyle() │
' │ envSave() │ Schreibt den Umgebungsblock in den Speicher zurück │
' │ envSet() │ Fügt einen neuen Eintrag in den Umgebungsblock ein │
' │ envStyle() ERW │ Bestimmt oder setzt Bearbeitungsmodus DOS oder INTERN │
' │ envUsed() │ Größe des belegten Umgebungsspeichers zurückgeben │
' │ envValue() │ Liefert Inhalt anhand eines Variablennamens zurück │
' └───────────────────┴────γ 2;─────────────────────────	 472;─────────────────────────& #9496;
'---Compiler--------------------------------------------------------------------
$compile unit
$cpu 80386
$debug map-,pbdebug-,path-,unit-
$dim all
$error all-
$event off
$float emulate
$lib all-
$optimize size
$static
$option gosub-,signed-
$string 32 ' -> im Hauptprogramm erforderlich!
defint a-z
'===============================================================================
' SHARED-Vars in dieser Unit
'
dim envPtr as shared string ptr*32750 ' Zeiger erspart def seg/peek/poke
dim envBuf as shared flex ' Kopie der Umgebungstabelle
dim envLn as shared word ' Länge des GESAMTEN Blocks
dim eLeft as shared integer ' Anzahl Bytes VOR einer bestimmten Var
dim eRight as shared integer ' Byteposition NACH einer bestimmten Var
dim eStyle as shared integer ' Bestimmt Formatierung des Varnamens
'===============================================================================
' Bestimmung der Umgebung DES ZULETZT GELADENEN COMMAND.COM (Adresse, Länge).
' COMMAND.COM ist dann gefunden, wenn die Adresse des 'Calling_PSP' gleich der
' eigenen, aktuellen PSP-Adresse ist.
' Es gibt keine Fehlerprüfung - wenn auf diese Weise COMMAND.COM nicht gefunden
' wird, läuft die Routine unweigerlich ins Nirwana. Eine effiziente Abfrage
' Dieser beiden Parameter ist nur zusammen möglich, daher keine Funktionen.
' Normalerweise wird die Routine nur intern verwendet, sie ist aber dennoch
' PUBLIC definiert.
' => Aus Gründen der Kompatibilität weiterhin nur Segmentadresse liefern!
'
sub envInfo (eSeg as word,eLen as word) local public
! mov ax,&h6200 ;
! int &h21 ;
! jc envInfoX ; bei INT-Fehler sofort abbrechen (neu in v5)
envInfo1: '
! mov es,bx ; BX enthält nach INT21,62 Adresse des aktiven PSP
! mov bx,es:[&h16] ; Dort steht an Offset 16h Adresse des AufruferPSP
! mov ax,es ; In BX steht jetzt Aufrufer-PSP, in AX vorheriges
! cmp bx,ax ; Sind diese beiden gleich, ist COMMAND gefunden!
! jne envInfo1 ; (Achtung: Endlosschleife möglich)
! mov ax,es:[&h2c] ; Offset &h2c enthält Adresse des Umgebungsblocks
! les bx,eSeg ;
! mov es:[bx],ax ; Adresse in eSeg zurückliefern
! dec ax ;
! mov es,ax ;
! mov ax,es:[3] ; Im MCB davor steht Größe des Bereichs in Paragraphen
! mov cl,4 ;
! shl ax,cl ; * 16 = Bytes
! les bx,eLen ;
! mov es:[bx],ax ; Bytes in eLen zurückliefern
envInfoX: '
end sub
'===============================================================================
' Laden des Umgebungsblocks zur weiteren Bearbeitung durch die Unit,
' -1 = Fehler, 0 = Ok (Vorgabe).
'
function envLoad() local public as integer
dim envSeg as local word
envInfo envSeg, envLn
' spart 5 Byte ggü. MIN (MIN% wegen Overflow nicht anwendbar)
incr envLn
if envLn > fre(-4) or envLn > fre(-1) or envLn = 0 then
function = -1
exit function
end if
! mov ax,envSeg
! mov envPtr[2],ax
map envBuf*envLn
decr envLn
envBuf=chr$(0)+left$(@envPtr,envLn)
end function
'===============================================================================
' Automatische Ausführung von envLoad() bei Bedarf (neu in v5)
function envCheck () local private as integer
if len(envBuf) = 0 then ' Pointer noch nicht gesetzt
function = envLoad() ' -> Pointer setzen, ggf. Fehler zurück
end if
' Vereinfacht in allen Routinen folgende Konstrukte:
' if envBuf = 0 then
' if envLoad() then
' exit function
' end if
' end if
' zu:
' if envCheck() then
' exit function
' end if
end function
'===============================================================================
' Liefert den gesamten aktuellen Umgebungsblock zurück, "" (vermutlich) Fehler
'
function EnvBlock() local public as string
if envCheck() then
exit function
end if
function = mid$(envBuf,2)
end function
'===============================================================================
' Kapselungsfunktion: liefert Länge der Umgebungstabelle zurück (-1=Fehler).
'
function EnvLen() local public as integer
if envCheck() then
function = -1
exit function
end if
function = envLn
end function
'===============================================================================
' Bestimmt, wieviel Platz in der Umgebungstabelle belegt ist, -1 = Fehler.
' ACHTUNG: Abschließende (2.) NULL zählt mit!
'
function EnvUsed() local public as integer
if envCheck() then
function = -1
exit function
end if
function = instr(envBuf,chr$(0,0)) ' wg. NULL zu Beginn entfällt +1
end function
'===============================================================================
' Bestimmt, wieviel Platz in der Umgebungstabelle frei ist. Fehler: <= 0
' (macht Sinn, damit ein Programm dann nicht dort herumfuhrwerkt).
'
function EnvFree() local public as integer
' Hinweis: Funktion envLen() statt globaler Var envLn benutzen, damit
' ggf. envLoad() zunächst ausgeführt wird!
function = envLen()-envUsed()
end function
'===============================================================================
' Steuert Formatierung des Variablennamens (Auswertung in envName()).
' Setzt einen neuen Style (newStyle => 0) oder fragt den aktuellen Style
' lediglich ab (newStyle = -1). Bei Veränderungen wird VORHERIGER Style zurück-
' gegeben. Style kann folgende Werte annehmen:
' 0 (Vorgabe): führende und nachfolgende Leerstellen entfernen & UCASE
' 1 (MSDOS) : nur führende Leerstellen entfernen & UCASE
' * (Win 9x) : keine Änderung (siehe 'windir' und 'winbootdir')
'
function envStyle (byval newStyle as integer) local public as integer
function = eStyle
if newStyle => 0 then
eStyle = newStyle
end if
end function
'===============================================================================
' Formatiert den übergebenen Variablennamen gemäß Einstellung envStyle().
'
function envName (inName as string) local public as string
select case eStyle
case 0 : function = ucase$( trim$(inName))
case 1 : function = ucase$(ltrim$(inName))
case else: function = inName
end select
end function
'===============================================================================
' Liefert Inhalt einer Umgebungsvariablen zurück, "" = Var nicht vorhanden
' oder Fehler (hier nicht unterscheidbar). ACHTUNG: Variablennamen werden
' immer in GROSSBUCHSTABEN erwartet!
' => envClear() ruft envValue und greift dann auf eLeft und eRight zurück!
'
function envValue (VarName as string) local public as string
dim tmp as local integer
if envCheck() then
exit function
end if
eLeft = instr(envBuf,chr$(0)+envName(VarName)+"=")
if eLeft then
tmp = eLeft+Len(VarName)+2
eRight = instr(tmp,envBuf,chr$(0)) ' +1 (Fehler environ4?) ?
function = mid$(envBuf,tmp,eRight-tmp)
incr eRight
end if
end function
'===============================================================================
' Liefert einen bestimmte Umgebungseintrag zurück, "" = Var nicht vorhanden
' oder Fehler (hier nicht unterscheidbar). ACHTUNG: Variablennamen werden
' immer in GROSSBUCHSTABEN erwartet!
'
function envEntry (VarName as string) local public as string
dim tmp as local integer
if envCheck() then
exit function
end if
tmp = instr(envBuf,chr$(0)+envName(VarName)+"=")
if tmp then
function = extract$(mid$(envBuf,tmp+1),chr$(0))
end if
end function
'===============================================================================
' Liefert ALLE Umgebungseinträge zurück, jeder Eintrag wird durch NULL
' abgeschlossen (ohne abschließende zweite NULL) "" -> (vermutlich) Fehler
'
function envEntries () local public as string
if envCheck() then
exit function
end if
function = mid$(extract$(envBuf,chr$(0,0))+chr$(0),2)
end function
'===============================================================================
' Löscht eine Variable aus der Umgebung. -1 = Fehler, -2 = Var nicht vorhanden.
' ACHTUNG: Variablennamen werden immer in GROSSBUCHSTABEN erwartet!
' => greift auf eLeft und eRight aus envValue() zurück!
'
function EnvClear (VarName as string) local public as integer
if envCheck() then
function = -1
exit function
end if
if len(envValue(VarName)) then ' dadurch wurden eLeft, eRight gesetzt!
envBuf = left$(envBuf,eLeft)+mid$(envBuf,eRight)
else
function = -2
end if
end function
'===============================================================================
' Liefert die Anzahl von Einträgen in der Umgebungstabelle, -1 = Fehler.
'
function EnvCount() local public as integer
if envCheck() then
function = -1
exit function
end if
function = tally(extract$(envBuf,chr$(0,0)),chr$(0))
' stimmt so wegen zusätzlicher NULL am Anfang!
end function
'===============================================================================
' Liefert den xten Umgebungseintrag als 'name=var', "" -> keine weiteren Vars
' oder Fehler (hier nicht unterscheidbar). idx beginnt bei 1.
'
function EnvEnum (byval idx as integer) local public as string
dim i as local integer
dim j as local integer
if envCheck() then
exit function
end if
for j=1 to idx
i = instr(i+1,envBuf,chr$(0))
incr i
if ascii(envBuf,i) = 0 then
exit function
end if
next
function = extract$(mid$(envBuf,i),chr$(0))
end function
'===============================================================================
' Fügt einen neuen Eintrag in die Umgebungstabelle ein, -1 = Fehler, -3 = zu
' wenig freier Platz, -2 = ungültige Zeichen in VarName/-Value oder Name leer.
' ACHTUNG: Neue Variablen werden immer AM ENDE der Tabelle eingefügt.
'
function envSet (byval VarName as string, VarValue as string) local public as integer
dim newEntry as local string
dim oldLen as local integer
if envCheck() then
function = -1
exit function
end if
if instr(VarName+VarValue,any chr$(0,61))>0 or len(VarName)=0 then
' ungültige Zeichen abweisen (ACHTUNG: was prüft DOS?
'=' ist hier auch in VarValue verboten!
function = -2
exit function
end if
newEntry = envName(VarName)+"="+VarValue
OldLen = len(envEntry(VarName)) ' falls schon vorhanden
if envFree()+OldLen-len(newEntry) < 0 then
function = -3
exit function
end if
if OldLen then
envClear VarName
end if
mid$(envBuf,envUsed()+1) = newEntry+chr$(0,0)
end function
'===============================================================================
' Schreibt den angegebenen oder gepufferten String in den Umgebungsblock,
' -2 = Ungültiger Umgebungsblock*. Mit EnvSave(chr$(0,0)) kann der
' komplette Umgebungsblock gelöscht werden!
' *Folgendes wird NICHT geprüft: Variablennamen in Großbuchstaben, führende
' Leerzeichen vor VarNamen. Schreibt das Programm auf eigene Regie einen
' Umgebungsblock, muß dieser VORHER entsprechend geprüft werden!
' Neu: wenn kein Block geladen wurde, wird nichts geschrieben und auch
' kein Fehler zurückgeliefert (logisch richtig).
'
function EnvSave (newEnv as string) local public as integer
if len(newEnv) then
if len(newEnv) <= EnvLen() and instr(newEnv,chr$(0,0)) > 0 then
envBuf = chr$(0)+ltrim$(newEnv,chr$(0))
else
function = -2
end if
end if
' nur belegten Bereich zurückschreiben (egal, ob verändert)
if len(envBuf) then
mid$(@envPtr,1) = mid$(envBuf,2,envUsed())
end if
end function
'****Ende der Unit**************************************************************
------------------