Category : BASIC Source Code
Archive   : QBDOS.ZIP
Filename : QBTMOD.BAS

'*****************************************************************************

'Copyright (c) 1987 Marcel Madonna
'
' This program will change the maximum memory required field on
' the header of an EXE file.



' Execute with the following:
'
' QBTMOD XXXXXXXX /MAX 99999

' XXXXXXXX is the name of the program
' 99999 is the number of paragraphs representing the maximum amount
' of memory that the EXE will require when executed.
' The minimum value is 2000 and the maximum value is 65535.

' I purposely excluded any QBWARE/1 from this program so that it
' could be easily modified by non-registered users. I also wrote it
' to be compatible with QB V2.00.
'*****************************************************************************

' This is a useful little routine that strips leading and trailing blanks
' from a string

Def FnCompress$(Text$)

Static x%

x% = 1
While x% <= Len(Text$) and Mid$(Text$, x%, 1) = " "
x% = x%+1
Wend

Text$ = Mid$(Text$, x%)

x% = Len(Text$)
If x% = 0 then
FnCompress$ = ""
Exit Def
End if
While x% <> 0 and Mid$(Text$, x%, 1) = " "
x% = x% -1
Wend

Text$ = Left$(Text$, x%)

FnCompress$ = Text$

End Def

' Start of program


Text.in$ = Command$ 'Get Command line
Gosub Parse.Data 'Get file name

Target.File$ = First.Field$
If Len(Target.File$) = 0 then
Goto Invalid.Parameter
End if

' If no file extension is present, then add default of .EXE
' If file extension is present, then it must be.EXE

x% = Instr(Target.File$,".")
If x% = 0 then
Target.File$ = Target.File$ + ".EXE"
Else
If Right$(Target.File$, Len(Target.File$) - x%) <> "EXE" then
Goto Invalid.Parameter
End if
End if

' If no parameters were passed in the command line, then we can assume
' a default of 16000 paragraphs (256K) will be used to update the EXE
' header

If Parse.Done% then
New.Paragraph% = 16000
Paragraph.size = 16000
Else
Gosub Parse.Data
First.Blnk% = Instr(First.Field$, " ")
If First.Blnk% = 0 then
Goto Invalid.Parameter
End if

' Check to see if the new paragraph size is acceptable
' (Between 2000 and 65535)

Paragraph.Size = Val(Right$(First.Field$, Len(First.Field$)-First.Blnk%))

If Paragraph.Size < 2000 or Paragraph.Size > 65535 then
Goto Invalid.Parameter
End if

' We need to make paragraph size an integer, but QB accepts integers only up 32767
' so we need a little fancy footwork

If Paragraph.Size > 32767 then
New.Paragraph% = (65536-Paragraph.Size)*-1
Else
New.Paragraph% = Paragraph.Size
End if
End if

' We need an ASCIIZ string to open the file

Target.File$ = Target.File$ + Chr$(0)
Filenum% = 1 'Just to show you a neat trick
Reclen% = 26 'We only the first few bytes
Open Target.File$ Access READ WRITE as #Filenum% Len = Reclen%

Field #Filenum%, _
1 as ExeSig1$, _ 'First part of EXE signature - 4Dh
1 as ExeSig2$, _ 'Second part - 5Ah
2 as FileLen$, _ 'File size - (MOD 512)
2 as FileSiz$, _ 'File size in 512 byte pages
2 as RelCnt$, _ 'Number of relocation table items
2 as HeadSiz$, _ 'Size of header - in paragraphs
2 as MinSiz$, _ 'Minimum memory req's
2 as MaxSiz$, _ 'Maximum size req's
12 as Filler$ 'The rest is unimportant for now

' If the file has no length, assume that it was just created by the previous
' and it was really not on the disk and should be deleted

If Lof(Filenum%) = 0 then
Close #Filenum%
Kill Target.File$
Goto Invalid.Parameter
End if

Get #Filenum%,1 'Get the first record

' Check signature to insure that we have a valid EXE file

If ExeSig1$ <> Chr$(77) and ExeSig2$ <> Chr$(90) then
Close #Filenum%
Goto Invalid.Parameter
End if

MaxSiz% = Cvi(MaxSiz$)
MaxSiz = MaxSiz%
If MaxSiz < 0 then
MaxSiz = 65536 + MaxSiz
End if

Lset MaxSiz$ = Mki$(New.Paragraph%)

Put #Filenum%,1 'Put the record back
Close #Filenum%

' Let you know it worked

Cls
Locate 1,1
Print "File: " + Target.File$
Print "Max Memory requirements changed from "; Maxsiz; " to ";Paragraph.Size

End 'That's all folks

Parse.Data:

First.Dlm% = Instr(Text.In$,"/") 'Find first delimeter

If First.Dlm% = 0 then 'If no more delimeters
First.Field$ = FnCompress$(Text.In$)
Parse.Done% = -1 'Indicate parse complete
Return
End if

First.Field$ = Left$(Text.In$,First.Dlm%-1) 'Remove first field

' This function willremove all leading al trailing blanks

First.Field$ = FnCompress$(First.Field$)

' Strip first field from th command line

Text.In$ = Right$(Text.In$, Len(Text.In$) - First.Dlm%)
Return

Invalid.Parameter:

Cls
Locate 1,1
Print "Invalid parameter " + Command$
End