home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / dos / qbdos / qbtmod.bas < prev    next >
Encoding:
BASIC Source File  |  1987-10-14  |  5.0 KB  |  192 lines
  1. '*****************************************************************************
  2.  
  3. 'Copyright (c) 1987 Marcel Madonna
  4. '
  5. '       This program will change the maximum memory required field on
  6. '       the header of an EXE file.
  7.  
  8.  
  9.  
  10. '       Execute with the following:
  11. '
  12. '               QBTMOD XXXXXXXX /MAX 99999
  13.  
  14. '       XXXXXXXX is the name of the program
  15. '       99999 is the number of paragraphs representing the maximum amount
  16. '               of memory that the EXE will require when executed.
  17. '               The minimum value is 2000 and the maximum value is 65535.
  18.  
  19. '       I purposely excluded any QBWARE/1 from this program so that it
  20. '       could be easily modified by non-registered users.  I also wrote it
  21. '       to be compatible with QB V2.00.
  22. '*****************************************************************************
  23.  
  24. ' This is a useful little routine that strips leading and trailing blanks
  25. ' from a string
  26.  
  27. Def FnCompress$(Text$)
  28.  
  29.     Static x%
  30.  
  31.     x% = 1
  32.     While  x% <= Len(Text$) and Mid$(Text$, x%, 1) = " "
  33.         x% = x%+1
  34.     Wend
  35.  
  36.     Text$ = Mid$(Text$, x%)
  37.  
  38.     x% = Len(Text$)
  39.     If x% = 0 then
  40.         FnCompress$ = ""
  41.         Exit Def
  42.     End if
  43.     While x% <> 0 and Mid$(Text$, x%, 1) = " "
  44.         x% = x% -1
  45.     Wend
  46.  
  47.     Text$ = Left$(Text$, x%)
  48.  
  49.     FnCompress$ = Text$
  50.  
  51. End Def
  52.  
  53. ' Start of program
  54.  
  55.  
  56.     Text.in$ = Command$             'Get Command line
  57.     Gosub Parse.Data                'Get file name
  58.  
  59.     Target.File$ = First.Field$
  60.     If Len(Target.File$) = 0 then
  61.         Goto Invalid.Parameter
  62.     End if
  63.  
  64. ' If no file extension is present, then add default of .EXE
  65. ' If file extension is present, then it must be.EXE
  66.  
  67.     x% = Instr(Target.File$,".")
  68.     If  x% = 0 then
  69.         Target.File$ = Target.File$ + ".EXE"
  70.     Else
  71.         If Right$(Target.File$, Len(Target.File$) - x%) <> "EXE" then
  72.             Goto Invalid.Parameter
  73.         End if
  74.     End if
  75.  
  76. ' If no parameters were passed in the command line, then we can assume
  77. ' a default of 16000 paragraphs (256K) will be used to update the EXE
  78. ' header
  79.  
  80.     If Parse.Done% then
  81.         New.Paragraph% = 16000
  82.         Paragraph.size = 16000
  83.     Else
  84.         Gosub Parse.Data
  85.         First.Blnk% = Instr(First.Field$, " ")
  86.         If First.Blnk% = 0 then
  87.             Goto Invalid.Parameter
  88.         End if
  89.  
  90. ' Check to see if the new paragraph size is acceptable
  91. ' (Between 2000 and 65535)
  92.  
  93.         Paragraph.Size = Val(Right$(First.Field$, Len(First.Field$)-First.Blnk%))
  94.  
  95.         If Paragraph.Size < 2000 or Paragraph.Size > 65535 then
  96.             Goto Invalid.Parameter
  97.         End if
  98.  
  99. ' We need to make paragraph size an integer, but QB accepts integers only up 32767
  100. ' so we need a little fancy footwork
  101.  
  102.         If Paragraph.Size > 32767 then
  103.             New.Paragraph% = (65536-Paragraph.Size)*-1
  104.         Else
  105.             New.Paragraph% = Paragraph.Size
  106.         End if
  107.     End if
  108.  
  109. ' We need an ASCIIZ string to open the file
  110.  
  111.     Target.File$ = Target.File$ + Chr$(0)
  112.     Filenum% = 1                    'Just to show you a neat trick
  113.     Reclen%  = 26                   'We only the first few bytes
  114.     Open Target.File$ Access READ WRITE as #Filenum% Len = Reclen%
  115.  
  116.     Field #Filenum%, _
  117.         1   as          ExeSig1$,  _  'First part of EXE signature - 4Dh
  118.         1   as          ExeSig2$,  _  'Second part - 5Ah
  119.         2   as          FileLen$,  _  'File size - (MOD 512)
  120.         2   as          FileSiz$,  _  'File size in 512 byte pages
  121.         2   as          RelCnt$,   _  'Number of relocation table items
  122.         2   as          HeadSiz$,  _  'Size of header - in paragraphs
  123.         2   as          MinSiz$,   _  'Minimum memory req's
  124.         2   as          MaxSiz$,   _  'Maximum size req's
  125.         12  as          Filler$       'The rest is unimportant for now
  126.  
  127. ' If the file has no length, assume that it was just created by the previous
  128. ' and it was really not on the disk and should be deleted
  129.  
  130.     If Lof(Filenum%) = 0 then
  131.         Close #Filenum%
  132.         Kill Target.File$
  133.         Goto Invalid.Parameter
  134.     End if
  135.  
  136.     Get #Filenum%,1         'Get the first record
  137.  
  138. ' Check signature to insure that we have a valid EXE file
  139.  
  140.     If ExeSig1$ <> Chr$(77) and ExeSig2$ <> Chr$(90) then
  141.         Close #Filenum%
  142.         Goto Invalid.Parameter
  143.     End if
  144.  
  145.     MaxSiz%         = Cvi(MaxSiz$)
  146.     MaxSiz          = MaxSiz%
  147.     If MaxSiz < 0 then
  148.         MaxSiz = 65536 + MaxSiz
  149.     End if
  150.  
  151.     Lset MaxSiz$ = Mki$(New.Paragraph%)
  152.  
  153.     Put #Filenum%,1         'Put the record back
  154.     Close #Filenum%
  155.  
  156. ' Let you know it worked
  157.  
  158.     Cls
  159.     Locate 1,1
  160.     Print "File: " + Target.File$
  161.     Print "Max Memory requirements changed from "; Maxsiz; " to ";Paragraph.Size
  162.  
  163.     End                     'That's all folks
  164.  
  165. Parse.Data:
  166.  
  167.     First.Dlm%    = Instr(Text.In$,"/")      'Find first delimeter
  168.  
  169.     If First.Dlm% = 0 then                   'If no more delimeters
  170.         First.Field$ = FnCompress$(Text.In$)
  171.         Parse.Done%  = -1                'Indicate parse complete
  172.         Return
  173.     End if
  174.  
  175.     First.Field$  = Left$(Text.In$,First.Dlm%-1)  'Remove first field
  176.  
  177. ' This function willremove all leading al trailing blanks
  178.  
  179.     First.Field$ = FnCompress$(First.Field$)
  180.  
  181. ' Strip first field from th command line
  182.  
  183.     Text.In$ = Right$(Text.In$, Len(Text.In$) - First.Dlm%)
  184.     Return
  185.  
  186. Invalid.Parameter:
  187.  
  188.     Cls
  189.     Locate 1,1
  190.     Print "Invalid parameter " + Command$
  191.     End
  192.