QB / QB64 Discussion Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

 


  << Previous Topic | Next Topic >>Return to Index  

Programlist Keven

September 27 2007 at 4:18 PM
  (no login)

 

 
 Respond to this message   
AuthorReply

(no login)

Set Command$

September 27 2007, 4:20 PM 

DEFINT A-Z
'$INCLUDE: 'qb.bi'
DECLARE SUB SetCommand (NewCommand$)

' SetCommand [setcmd.bas]
' Written by Keven Coots

' Change COMMAND$ from within Quick Basic
' useful for passing options to CHAINed programs
' http://justbasic.i8.com
' released into the public domain
' works in the IDE but qb chops the first 2 charactures
' so you need to add 2 leading spaces in the IDE
' run QB.EXE with /L

CLS
PRINT
PRINT
PRINT
PRINT "Original COMMAND$ was - "; COMMAND$
SetCommand " This is a new command tail"
PRINT
PRINT "New COMMAND$ is - "; COMMAND$


SUB SetCommand (NewCommand$)
DIM reg AS RegType
IF LEN(NewCommand$) > 125 THEN
tmp$ = CHR$(32) + MID$(NewCommand$, 1, 125) + CHR$(13) ' need room for
ELSE 'leading spaces
tmp$ = CHR$(32) + NewCommand$ + CHR$(13) ' and trailing CR
END IF
reg.ax = &H5100 ' Get PSP of current proccess
INTERRUPT &H21, reg, reg
PSPSeg = reg.bx 'segment returend in BX
Offset = &H80 'offset in psp of command line
DEF SEG = PSPSeg 'set defualt segment to PSP seg
Offset = &H80
POKE Offset, LEN(tmp$) 'store length of new command line
FOR n = 1 TO LEN(tmp$) 'now store the new command line in the PSP
Offset = Offset + 1
POKE Offset, ASC(MID$(tmp$, n, 1))
NEXT
DEF SEG

END SUB


 
 Respond to this message   

(no login)

Command$ actual case

September 27 2007, 4:35 PM 

DECLARE FUNCTION CheckForFiles% (FileName$)
DECLARE SUB CheckForPatch ()
DECLARE FUNCTION DIR$ (FileSpec AS STRING, Mask AS INTEGER, Switch AS INTEGER)
'$INCLUDE: 'qb.bi'

' This code is kinda slopy but it works.
' all it does is insert a NOP in the files to replace the XOR al,20
' the xor al,20 is what makes the character UPPERCASE.


CONST FALSE = 0, TRUE = NOT FALSE
CONST Dos = &H21
CONST SetDTA = &H1A00, FindFirst = &H4E00, FindNext = &H4F00

DIM SHARED reg AS RegType
DIM SHARED RegX AS RegTypeX
DIM SHARED BCOM45%, QB%, BRUN45%
ChangeAttr$ = "attrib -h -s -r "
Nuller$ = " >nul"
QB$ = "QB.EXE"
BRUN45$ = "BRUN45.EXE"
BCOM45$ = "BCOM45.LIB"

CLS
PRINT
PRINT
PRINT "QB45 Command$ Patch (c) 1999 by Keven Coots"
PRINT "WWW: http://justbasic.i8.com"
PRINT
PRINT "For QuickBasic Version 4.5 and PDS 7.1"
PRINT "This program will patch the files QB.EXE, BCOM45.LIB and BRUN45.EXE"
PRINT "to allow QuickBasic to return actual case that was passed on the"
PRINT "command line in COMMAND$"
PRINT
PRINT "Original files will be backed up as QB.BAK, BCOM45.BAK and BRUN45.BAK"
PRINT
PRINT "QB.EXE, BCOM45.EXE and BRUN45.EXE must be in the current directory"
PRINT "Press ESC to quit, ENTER to Continue"

DO
DO
a$ = INKEY$
LOOP UNTIL LEN(a$)
IF a$ = CHR$(27) THEN
PRINT
PRINT
PRINT "User Cancel"
SYSTEM
END IF
IF a$ = CHR$(13) THEN EXIT DO
LOOP
PRINT
PRINT "Installing Patch...."
ON ERROR GOTO ErrHand


CheckForPatch
NewOp$ = SPACE$(2)
NewOp$ = CHR$(&H90) + CHR$(&H90) 'Value for NOP Op-Code

CurrentFile$ = QB$
IF NOT QB% THEN
PRINT "Patching - "; CurrentFile$
SHELL "copy QB.EXE QB.BAK >nul"
OPEN CurrentFile$ FOR BINARY AS #1
PUT #1, 155068, NewOp$ 'offset for QB.EXE
CLOSE #1
ELSE
IF QB% = -1 THEN PRINT "Patching - "; CurrentFile$; " Allready Patched"
IF QB% = -2 THEN PRINT "Patching - "; CurrentFile$; " File Not Found"
END IF

CurrentFile$ = BCOM45$
IF NOT BCOM45% THEN
PRINT "Patching - "; CurrentFile$
SHELL "copy BCOM45.LIB BCOM45.BAK >nul"
OPEN CurrentFile$ FOR BINARY AS #1
PUT #1, 32593, NewOp$ 'offset for BCOM45.LIB
CLOSE #1
ELSE
IF BCOM45% = -1 THEN PRINT "Patching - "; CurrentFile$; " Allready Patched"
IF BCOM45% = -2 THEN PRINT "Patching - "; CurrentFile$; " File Not Found"
END IF

CurrentFile$ = BRUN45$
IF NOT BRUN45% THEN
PRINT "Patching - "; CurrentFile$
SHELL "copy BRUN45.EXE BRUN45.BAK >nul"
OPEN CurrentFile$ FOR BINARY AS #1
PUT #1, 29446, NewOp$ 'offset for BRUN45.EXE
CLOSE #1
ELSE
IF BRUN45% = -1 THEN PRINT "Patching - "; CurrentFile$; " Allready Patched"
IF BRUN45% = -2 THEN PRINT "Patching - "; CurrentFile$; " File Not Found"
END IF
PRINT
PRINT "Patch Installed!"
PRINT "Use QuickBasic as you normaly would you don't have to load"
PRINT "any special librarys"
PRINT "Happy programming!"
SYSTEM

ErrHand:
IF ERR = 255 THEN
PRINT
PRINT "Patch allready Installed"
SYSTEM
END IF
IF ERR = 254 THEN
PRINT
PRINT "The Files QB.EXE, BCOM45.LIB and BRUN45.EXE could not be found "
PRINT "in the current directory."
PRINT "Exiting..."
SYSTEM
END IF

PRINT "There was an error while attempting to write to "; CurrentFile$
PRINT "Make sure the file does not have the ReadOnly attribute set"
SYSTEM

FUNCTION CheckForFiles% (FileName$)
CheckForFiles% = 0
IF DIR$(FileName$, &HFF, 0) <> "" THEN CheckForFiles% = -1

END FUNCTION

SUB CheckForPatch
TestByte$ = CHR$(&H90) + CHR$(&H90)
NewOp$ = SPACE$(2)
CurrentFile$ = "QB.EXE"
IF CheckForFiles%(CurrentFile$) THEN
OPEN CurrentFile$ FOR BINARY AS #1
GET #1, 155068, NewOp$ 'offset for QB.EXE
IF NewOp$ = TestByte$ THEN QB% = -1
CLOSE #1
ELSE
QB% = -2
END IF

CurrentFile$ = "BCOM45.LIB"
IF CheckForFiles%(CurrentFile$) THEN
OPEN CurrentFile$ FOR BINARY AS #1
GET #1, 32593, NewOp$ 'offset for BCOM45.LIB
IF NewOp$ = TestByte$ THEN BCOM45% = -1
CLOSE #1
ELSE
BCOM45% = -2
END IF

CurrentFile$ = "BRUN45.EXE"
IF CheckForFiles%(CurrentFile$) THEN
OPEN CurrentFile$ FOR BINARY AS #1
GET #1, 29446, NewOp$ 'offset for BRUN45.EXE
IF NewOp$ = TestByte$ THEN BRUN45% = -1
CLOSE #1
ELSE
BRUN45% = -2
END IF

IF BRUN45% = -1 AND QB% = -1 AND BCOM45% = -1 THEN ERROR 255
IF BRUN45% = -2 AND QB% = -2 AND BCOM45% = -2 THEN ERROR 254
END SUB

DEFINT A-Z
FUNCTION DIR$ (FileSpec$, Mask%, Switch%) STATIC


DIM DTA AS STRING * 44
Null$ = CHR$(0)
RegX.ax = SetDTA
RegX.dx = VARPTR(DTA)
RegX.ds = -1
INTERRUPTX Dos, RegX, RegX


IF LEN(FileSpec$) THEN
FileSpecZ$ = FileSpec$ + Null$
RegX.ax = FindFirst
RegX.cx = Mask%
RegX.dx = SADD(FileSpecZ$)
RegX.ds = -1
ELSE
RegX.ax = FindNext
END IF

INTERRUPTX Dos, RegX, RegX


IF RegX.flags AND 1 THEN
DIR$ = ""
ELSE

SELECT CASE Switch%
CASE 1
Null = INSTR(31, DTA, Null$)
DIR$ = DTA
CASE ELSE
Null = INSTR(31, DTA, Null$)
DIR$ = MID$(DTA, 31, Null - 30)
END SELECT
END IF

END FUNCTION


 
 Respond to this message   
Current Topic - Programlist Keven
  << Previous Topic | Next Topic >>Return to Index  
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement