Many new Qbasic programmmers are frustrated when they attempt to record data in environment variables so it can be used by other programs. It seems senseless to set a variable with [tt]ENVIRON[/tt] when that information is certain to disappear the moment the program terminates. The example I am posting below shows a way to alter the environment data for the parent process of your program (probably COMMAND.COM). With a few minor modifications, you should be able to make more permanent changes to environment variables that will last after your program is finished.
The following code (sorry about it's length!) doesn't actually change the value of an environment variable... it changes the variable name (you shouldn't have any difficulty altering the code to change values). Have you ever noticed that most of the environment variable names viewed in a COMMAND shell are upper case? For instance: TEMP=C:\WINDOWS\TEMP. Two notable exceptions are the windir and winbootdir variables you will find on a Win9x system. These are tamper-resistant variables... if you enter SET winbootdir= at the command prompt and then enter SET to view the environment table, you will notice that you have failed to delete the winbootdir variable (Microsoft doesn't want you to do that). The following code will give you a taste of that magic.
Try the following:
1) Start QB with the following command line (to allow use of the DOS interrupts):
QB.EXE /AH /L QB.QLB
2) Compile my posted code into an EXE.
3) Exit to the command prompt.
4) Enter SET XXX-TIPS=Good Information
5) Enter SET so you can view all of the environment variables.
6) Run your compiled program.
7) Enter SET to view the environment variables again. You will notice that XXX-TIPS has been changed to Tek-Tips (with mixed upper and lower case letters).
8) Enter SET Tek-Tips= to try to delete the Tek-Tips variable.
9) Hmmm... why can't that variable be deleted or changed?
Welcome to Microsoft's world of magic.
You should have a bit of fun trying to baffle your friends and coworkers. You should also be able to find some fun in the helper functions I've included in the following example. The MemToString and StringToMem functions will allow you to perform quick search-and-replace operations on substantial blocks of memory (how long have you been looking for an easy way to do that?) Please note that I haven't used a single PEEK, POKE, FOR/NEXT or DO/LOOP.... Why fiddle with memory one byte at a time when you can do it with blocks several kilobytes in size?
[tt]
' $DYNAMIC
DEFINT A-Z
TYPE RegTypeX
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
DS AS INTEGER
Es AS INTEGER
END TYPE
TYPE ProgramSegmentPrefix
Int20Hinstruction AS STRING * 2
SegmentAfterAllocatedMEM AS INTEGER
UnusedFiller AS STRING * 1
FarJumpTo000C0h AS STRING * 1
SizeOfFirstCOMsegment AS INTEGER
RemainderOfFarJumpTo000C0h AS STRING * 2
Int22HterminationAddress AS LONG
Int23HctrlBreakAddress AS LONG
Int24HcriticalErrorAddress AS LONG
ParentPSPsegment AS INTEGER
JobFileTable AS STRING * 20
EnvironmentBlockSegment AS INTEGER
SSSPtoLastInt21Hcall AS LONG
JobFileTableEntries AS INTEGER
PointerToJobFileTable AS LONG
PointerToPreviousPSP AS LONG
Unknown AS STRING * 4
VersionReturnToInt21Hfun30H AS STRING * 2
MoreUnknown AS STRING * 14
Int21HretfInstructions AS STRING * 3
MoreUnknowns AS STRING * 9
FirstDefaultFCB AS STRING * 16
SecondDefaultFCB AS STRING * 16
MoreUnusedFiller AS STRING * 4
CommandLine AS STRING * 128
END TYPE
DECLARE SUB GetPSP (PSPseg AS INTEGER, PSP AS ProgramSegmentPrefix)
'This sub just gets the contents of the specified PSP and
'places it in the PSP user defined type....
DECLARE FUNCTION MemToString$ (MemSeg, MemOffset, NumBytes)
'Copies a chunk of memory into a string.
'There are no similar functions in Qbasic.
DECLARE SUB StringToMem (PassVar$, MemSeg, MemOffset)
'Copies the contents of a string into a location
'in memory. This performs the opposite function of the
'MemToString function. There are no similar functions in Qbasic.
DECLARE FUNCTION OpenTempFile (PathToTempFile$)
'This asks DOS to create a temporary file (in this case,
'in the TEMP folder specified by the TEMP environment variable)
'and open it for READ WRITE access.
'The name of the file is returned in PathToTempFile$ and the file handle
'is returned in OpenTempFile. The actual name of the file will be
'something like "AJDDDLBF" or "AIDFCNDB" but we don't have to concern ourselves
'with that. We just use the file handle to perform operations on it (making
'certain we use KillFile PathToTempFile$ to delete it when we are done).
DECLARE FUNCTION KillFile (PathToDeadFile$)
'Similar to Qbasic KILL PathToDeadFile$
DECLARE FUNCTION FilePut (fHandle, NumBytes, MemSeg, MemOffset)
'Looks into memory at the specified segment and offset,
'gets the number of bytes specified by NumBytes
'and writes the data to the current position of the open file
'specified by fHandle.
'Similar to Qbasic PUT #fHandle, , FileBuffer$ except it writes a
'range of memory (rather than a variable) to the current position of
'an open file.
DECLARE SUB FileSeekStart (fHandle)
'Simply seeks the beginning of the open file referenced by fHandle.
'Similar to Qbasic SEEK #fHandle, 1
DECLARE FUNCTION GetFile (fHandle, FileBuffer$)
'Similar to Qbasic GET #fHandle, , FileBuffer$
DECLARE FUNCTION GetFileToMem (fHandle, NumBytes, MemSeg, MemOffset)
'Similar to Qbasic GET #fHandle, , FileBuffer$
'except it reads the specified number of bytes directly into a memory address.
DECLARE SUB CloseFile (fHandle)
'This just closes the file referenced by fHandle.
'(Similar to Qbasic CLOSE #FileNumber)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
DIM PSP AS ProgramSegmentPrefix
'MAIN PROGRAM ----------------------------------
SearchEnvVar$ = "XXX-TIPS"
ReplaceEnvVar$ = "Tek-Tips"
'Interrupt 21h, function 62h just gets the
'segment of the Program Segment Prefix for
'the current process....
InRegs.AX = &H6200
CALL InterruptX(&H21, InRegs, OutRegs)
PSPseg = OutRegs.BX
GetPSP PSPseg, PSP
'We don't know the size of the environment for the
'given process, so let's grab 4096 bytes (should be big enough)
'and place it in a string so we can search through it...
EnvSeg = PSP.EnvironmentBlockSegment
EnvBlock$ = MemToString$(EnvSeg, 0, 4096)
'The environment table is terminated with two nul characters,
'so we'll use them to cut off the string returned in MemToString$....
EnvBlock$ = LEFT$(EnvBlock$, INSTR(EnvBlock$, STRING$(2, 0)) - 1)
Srch = INSTR(EnvBlock$, SearchEnvVar$)
IF Srch > 0 THEN
'Make the replacement in the string.
MID$(EnvBlock$, Srch, LEN(SearchEnvVar$)) = ReplaceEnvVar$
'Write the string back into the environment.
PSPenvSeg = PSP.EnvironmentBlockSegment
CALL StringToMem(EnvBlock$, PSPenvSeg, 0)
END IF
'Repeat the operation with the parent of the current process
'(this is probably COMMAND.COM).
PSPseg = PSP.ParentPSPsegment
GetPSP PSPseg, PSP
EnvSeg = PSP.EnvironmentBlockSegment
EnvBlock$ = MemToString$(EnvSeg, 0, 4096)
EnvBlock$ = LEFT$(EnvBlock$, INSTR(EnvBlock$, STRING$(2, 0)) - 1)
Srch = INSTR(EnvBlock$, SearchEnvVar$)
IF Srch > 0 THEN
MID$(EnvBlock$, Srch, LEN(SearchEnvVar$)) = ReplaceEnvVar$
PSPenvSeg = PSP.EnvironmentBlockSegment
CALL StringToMem(EnvBlock$, PSPenvSeg, 0)
END IF
'HELPER FUNCTIONS ----------------------------------
SUB CloseFile (fHandle)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3E00
InRegs.BX = fHandle
CALL InterruptX(&H21, InRegs, OutRegs)
END SUB
FUNCTION FilePut (fHandle, NumBytes, MemSeg, MemOffset)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4000
InRegs.BX = fHandle
InRegs.CX = NumBytes
InRegs.DS = MemSeg
InRegs.DX = MemOffset
CALL InterruptX(&H21, InRegs, OutRegs)
FilePut = OutRegs.AX
END FUNCTION
SUB FileSeekStart (fHandle)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4200
InRegs.BX = fHandle
InRegs.CX = 0
InRegs.DX = 0
CALL InterruptX(&H21, InRegs, OutRegs)
END SUB
FUNCTION GetFile (fHandle, FileBuffer$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3F00
InRegs.BX = fHandle
InRegs.CX = LEN(FileBuffer$)
InRegs.DS = VARSEG(FileBuffer$)
InRegs.DX = SADD(FileBuffer$)
CALL InterruptX(&H21, InRegs, OutRegs)
END FUNCTION
FUNCTION GetFileToMem (fHandle, NumBytes, MemSeg, MemOffset)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3F00
InRegs.BX = fHandle
InRegs.CX = NumBytes
InRegs.DS = MemSeg
InRegs.DX = MemOffset
CALL InterruptX(&H21, InRegs, OutRegs)
END FUNCTION
SUB GetPSP (PSPseg AS INTEGER, PSP AS ProgramSegmentPrefix)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
hFile = OpenTempFile(PathToTempFile$)
retval = FilePut(hFile, LEN(PSP), PSPseg, 0)
FileSeekStart hFile
retval = GetFileToMem(hFile, LEN(PSP), VARSEG(PSP), VARPTR(PSP))
CloseFile hFile
retval = KillFile(PathToTempFile$)
END SUB
FUNCTION KillFile (PathToDeadFile$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4100
InRegs.DS = VARSEG(PathToDeadFile$)
InRegs.DX = SADD(PathToDeadFile$)
CALL InterruptX(&H21, InRegs, OutRegs) 'Create an empty file
KillFile = OutRegs.AX
END FUNCTION
FUNCTION MemToString$ (MemSeg, MemOffset, NumBytes)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
hFile = OpenTempFile(PathToTempFile$)
retval = FilePut(hFile, NumBytes, MemSeg, MemOffset)
FileSeekStart hFile
FileBuffer$ = STRING$(NumBytes, 0)
retval = GetFile(hFile, FileBuffer$)
CloseFile hFile
retval = KillFile(PathToTempFile$)
MemToString$ = FileBuffer$
END FUNCTION
FUNCTION OpenTempFile (PathToTempFile$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
PathToTempFile$ = ENVIRON$("TEMP"
+ STRING$(13, 0)
InRegs.AX = &H5A00
InRegs.CX = &H20
InRegs.DS = VARSEG(PathToTempFile$)
InRegs.DX = SADD(PathToTempFile$)
CALL InterruptX(&H21, InRegs, OutRegs) 'Create an empty file
OpenTempFile = OutRegs.AX
END FUNCTION
SUB StringToMem (PassVar$, MemSeg, MemOffset)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
hFile = OpenTempFile(PathToTempFile$)
NumBytes = LEN(PassVar$)
MemorySegment = VARSEG(PassVar$)
MemoryOffset = SADD(PassVar$)
retval = FilePut(hFile, NumBytes, MemorySegment, MemoryOffset)
FileSeekStart hFile
retval = GetFileToMem(hFile, NumBytes, MemSeg, MemOffset)
CloseFile hFile
retval = KillFile(PathToTempFile$)
END SUB
[/tt]
The following code (sorry about it's length!) doesn't actually change the value of an environment variable... it changes the variable name (you shouldn't have any difficulty altering the code to change values). Have you ever noticed that most of the environment variable names viewed in a COMMAND shell are upper case? For instance: TEMP=C:\WINDOWS\TEMP. Two notable exceptions are the windir and winbootdir variables you will find on a Win9x system. These are tamper-resistant variables... if you enter SET winbootdir= at the command prompt and then enter SET to view the environment table, you will notice that you have failed to delete the winbootdir variable (Microsoft doesn't want you to do that). The following code will give you a taste of that magic.
Try the following:
1) Start QB with the following command line (to allow use of the DOS interrupts):
QB.EXE /AH /L QB.QLB
2) Compile my posted code into an EXE.
3) Exit to the command prompt.
4) Enter SET XXX-TIPS=Good Information
5) Enter SET so you can view all of the environment variables.
6) Run your compiled program.
7) Enter SET to view the environment variables again. You will notice that XXX-TIPS has been changed to Tek-Tips (with mixed upper and lower case letters).
8) Enter SET Tek-Tips= to try to delete the Tek-Tips variable.
9) Hmmm... why can't that variable be deleted or changed?
Welcome to Microsoft's world of magic.
You should have a bit of fun trying to baffle your friends and coworkers. You should also be able to find some fun in the helper functions I've included in the following example. The MemToString and StringToMem functions will allow you to perform quick search-and-replace operations on substantial blocks of memory (how long have you been looking for an easy way to do that?) Please note that I haven't used a single PEEK, POKE, FOR/NEXT or DO/LOOP.... Why fiddle with memory one byte at a time when you can do it with blocks several kilobytes in size?
[tt]
' $DYNAMIC
DEFINT A-Z
TYPE RegTypeX
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
DS AS INTEGER
Es AS INTEGER
END TYPE
TYPE ProgramSegmentPrefix
Int20Hinstruction AS STRING * 2
SegmentAfterAllocatedMEM AS INTEGER
UnusedFiller AS STRING * 1
FarJumpTo000C0h AS STRING * 1
SizeOfFirstCOMsegment AS INTEGER
RemainderOfFarJumpTo000C0h AS STRING * 2
Int22HterminationAddress AS LONG
Int23HctrlBreakAddress AS LONG
Int24HcriticalErrorAddress AS LONG
ParentPSPsegment AS INTEGER
JobFileTable AS STRING * 20
EnvironmentBlockSegment AS INTEGER
SSSPtoLastInt21Hcall AS LONG
JobFileTableEntries AS INTEGER
PointerToJobFileTable AS LONG
PointerToPreviousPSP AS LONG
Unknown AS STRING * 4
VersionReturnToInt21Hfun30H AS STRING * 2
MoreUnknown AS STRING * 14
Int21HretfInstructions AS STRING * 3
MoreUnknowns AS STRING * 9
FirstDefaultFCB AS STRING * 16
SecondDefaultFCB AS STRING * 16
MoreUnusedFiller AS STRING * 4
CommandLine AS STRING * 128
END TYPE
DECLARE SUB GetPSP (PSPseg AS INTEGER, PSP AS ProgramSegmentPrefix)
'This sub just gets the contents of the specified PSP and
'places it in the PSP user defined type....
DECLARE FUNCTION MemToString$ (MemSeg, MemOffset, NumBytes)
'Copies a chunk of memory into a string.
'There are no similar functions in Qbasic.
DECLARE SUB StringToMem (PassVar$, MemSeg, MemOffset)
'Copies the contents of a string into a location
'in memory. This performs the opposite function of the
'MemToString function. There are no similar functions in Qbasic.
DECLARE FUNCTION OpenTempFile (PathToTempFile$)
'This asks DOS to create a temporary file (in this case,
'in the TEMP folder specified by the TEMP environment variable)
'and open it for READ WRITE access.
'The name of the file is returned in PathToTempFile$ and the file handle
'is returned in OpenTempFile. The actual name of the file will be
'something like "AJDDDLBF" or "AIDFCNDB" but we don't have to concern ourselves
'with that. We just use the file handle to perform operations on it (making
'certain we use KillFile PathToTempFile$ to delete it when we are done).
DECLARE FUNCTION KillFile (PathToDeadFile$)
'Similar to Qbasic KILL PathToDeadFile$
DECLARE FUNCTION FilePut (fHandle, NumBytes, MemSeg, MemOffset)
'Looks into memory at the specified segment and offset,
'gets the number of bytes specified by NumBytes
'and writes the data to the current position of the open file
'specified by fHandle.
'Similar to Qbasic PUT #fHandle, , FileBuffer$ except it writes a
'range of memory (rather than a variable) to the current position of
'an open file.
DECLARE SUB FileSeekStart (fHandle)
'Simply seeks the beginning of the open file referenced by fHandle.
'Similar to Qbasic SEEK #fHandle, 1
DECLARE FUNCTION GetFile (fHandle, FileBuffer$)
'Similar to Qbasic GET #fHandle, , FileBuffer$
DECLARE FUNCTION GetFileToMem (fHandle, NumBytes, MemSeg, MemOffset)
'Similar to Qbasic GET #fHandle, , FileBuffer$
'except it reads the specified number of bytes directly into a memory address.
DECLARE SUB CloseFile (fHandle)
'This just closes the file referenced by fHandle.
'(Similar to Qbasic CLOSE #FileNumber)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
DIM PSP AS ProgramSegmentPrefix
'MAIN PROGRAM ----------------------------------
SearchEnvVar$ = "XXX-TIPS"
ReplaceEnvVar$ = "Tek-Tips"
'Interrupt 21h, function 62h just gets the
'segment of the Program Segment Prefix for
'the current process....
InRegs.AX = &H6200
CALL InterruptX(&H21, InRegs, OutRegs)
PSPseg = OutRegs.BX
GetPSP PSPseg, PSP
'We don't know the size of the environment for the
'given process, so let's grab 4096 bytes (should be big enough)
'and place it in a string so we can search through it...
EnvSeg = PSP.EnvironmentBlockSegment
EnvBlock$ = MemToString$(EnvSeg, 0, 4096)
'The environment table is terminated with two nul characters,
'so we'll use them to cut off the string returned in MemToString$....
EnvBlock$ = LEFT$(EnvBlock$, INSTR(EnvBlock$, STRING$(2, 0)) - 1)
Srch = INSTR(EnvBlock$, SearchEnvVar$)
IF Srch > 0 THEN
'Make the replacement in the string.
MID$(EnvBlock$, Srch, LEN(SearchEnvVar$)) = ReplaceEnvVar$
'Write the string back into the environment.
PSPenvSeg = PSP.EnvironmentBlockSegment
CALL StringToMem(EnvBlock$, PSPenvSeg, 0)
END IF
'Repeat the operation with the parent of the current process
'(this is probably COMMAND.COM).
PSPseg = PSP.ParentPSPsegment
GetPSP PSPseg, PSP
EnvSeg = PSP.EnvironmentBlockSegment
EnvBlock$ = MemToString$(EnvSeg, 0, 4096)
EnvBlock$ = LEFT$(EnvBlock$, INSTR(EnvBlock$, STRING$(2, 0)) - 1)
Srch = INSTR(EnvBlock$, SearchEnvVar$)
IF Srch > 0 THEN
MID$(EnvBlock$, Srch, LEN(SearchEnvVar$)) = ReplaceEnvVar$
PSPenvSeg = PSP.EnvironmentBlockSegment
CALL StringToMem(EnvBlock$, PSPenvSeg, 0)
END IF
'HELPER FUNCTIONS ----------------------------------
SUB CloseFile (fHandle)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3E00
InRegs.BX = fHandle
CALL InterruptX(&H21, InRegs, OutRegs)
END SUB
FUNCTION FilePut (fHandle, NumBytes, MemSeg, MemOffset)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4000
InRegs.BX = fHandle
InRegs.CX = NumBytes
InRegs.DS = MemSeg
InRegs.DX = MemOffset
CALL InterruptX(&H21, InRegs, OutRegs)
FilePut = OutRegs.AX
END FUNCTION
SUB FileSeekStart (fHandle)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4200
InRegs.BX = fHandle
InRegs.CX = 0
InRegs.DX = 0
CALL InterruptX(&H21, InRegs, OutRegs)
END SUB
FUNCTION GetFile (fHandle, FileBuffer$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3F00
InRegs.BX = fHandle
InRegs.CX = LEN(FileBuffer$)
InRegs.DS = VARSEG(FileBuffer$)
InRegs.DX = SADD(FileBuffer$)
CALL InterruptX(&H21, InRegs, OutRegs)
END FUNCTION
FUNCTION GetFileToMem (fHandle, NumBytes, MemSeg, MemOffset)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H3F00
InRegs.BX = fHandle
InRegs.CX = NumBytes
InRegs.DS = MemSeg
InRegs.DX = MemOffset
CALL InterruptX(&H21, InRegs, OutRegs)
END FUNCTION
SUB GetPSP (PSPseg AS INTEGER, PSP AS ProgramSegmentPrefix)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
hFile = OpenTempFile(PathToTempFile$)
retval = FilePut(hFile, LEN(PSP), PSPseg, 0)
FileSeekStart hFile
retval = GetFileToMem(hFile, LEN(PSP), VARSEG(PSP), VARPTR(PSP))
CloseFile hFile
retval = KillFile(PathToTempFile$)
END SUB
FUNCTION KillFile (PathToDeadFile$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
InRegs.AX = &H4100
InRegs.DS = VARSEG(PathToDeadFile$)
InRegs.DX = SADD(PathToDeadFile$)
CALL InterruptX(&H21, InRegs, OutRegs) 'Create an empty file
KillFile = OutRegs.AX
END FUNCTION
FUNCTION MemToString$ (MemSeg, MemOffset, NumBytes)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
hFile = OpenTempFile(PathToTempFile$)
retval = FilePut(hFile, NumBytes, MemSeg, MemOffset)
FileSeekStart hFile
FileBuffer$ = STRING$(NumBytes, 0)
retval = GetFile(hFile, FileBuffer$)
CloseFile hFile
retval = KillFile(PathToTempFile$)
MemToString$ = FileBuffer$
END FUNCTION
FUNCTION OpenTempFile (PathToTempFile$)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
PathToTempFile$ = ENVIRON$("TEMP"
+ STRING$(13, 0)InRegs.AX = &H5A00
InRegs.CX = &H20
InRegs.DS = VARSEG(PathToTempFile$)
InRegs.DX = SADD(PathToTempFile$)
CALL InterruptX(&H21, InRegs, OutRegs) 'Create an empty file
OpenTempFile = OutRegs.AX
END FUNCTION
SUB StringToMem (PassVar$, MemSeg, MemOffset)
DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
hFile = OpenTempFile(PathToTempFile$)
NumBytes = LEN(PassVar$)
MemorySegment = VARSEG(PassVar$)
MemoryOffset = SADD(PassVar$)
retval = FilePut(hFile, NumBytes, MemorySegment, MemoryOffset)
FileSeekStart hFile
retval = GetFileToMem(hFile, NumBytes, MemSeg, MemOffset)
CloseFile hFile
retval = KillFile(PathToTempFile$)
END SUB
[/tt]
Real men don't use Interrupt 21h.