How to Compile a Batch of Files with Macintosh QuickBasic (36333)
The information in this article applies to:
- Microsoft QuickBASIC Compiler for the Apple Macintosh 1.0
This article was previously published under Q36333 SUMMARY
This program demonstrates how to compile more than one file at a time
with Macintosh QuickBasic. It also demonstrates how to save window
positions between invocations of a program.
MORE INFORMATION
'----------------------------------------------------------------
' Batch Compile
' Copyright 1988 Microsoft Corp.
' Written in QuickBasic 1.00 for the Apple Macintosh
'
' This program is for demonstration purposes. Microsoft does
' not make any warranty or claims for the performance of this
' program.
'
' This program is for personal use only. It may not be
' redistributed in any form, electronic or mechanical, for any
' purpose, without the written permission of Microsoft Corp.
'
'----------------------------------------------------------------
' Batch Compile reads a list of file names and sublaunches
' QuickBasic so QB will compile each file.
'
' This uses a default name for the compiled application:
'
' sourceName + " apl"
'
' It does not use a name that was set in the Compile As...
' dialog. If you want this program to use whatever was set
' instead of the default, you should change the "SetAplName"
' subprogram.
'
' This program does not handle switch specifications, so it
' is not 100% compatible with the program list files used by
' Microsoft Basic Compiler 1.00. This program could be
' modified to parse out the switches.
' Code to parse switch information would be inserted in the
' "DoNextFile" subprogram.
'
'----------------------------------------------------------------
' STR 1000 = Name of QuickBasic
' STR 1001 = Name of program list file
' BCFG 1000 = configuration info
'
'----------------------------------------------------------------
WINDOW 1,"",(0,0)-(1,1),3
' Global variables
DIM SHARED QBName$, programList$
' config%(0 to 3) = window coordinates
' config%(4) =
' 2 = deleting apl files before compile,
' 1 = not deleting
' config%(5) =
' -1 = not currently compiling a list
' else current line index into program list
DIM SHARED config%(5)
' dirty flags:
' 0 = config%() changed
' 1 = QBName$ changed
' 2 = programList$ changed
DIM SHARED dirty%(2)
'scratch variables
DIM SHARED r1%(3),r2%(3),r3%(3),x%
' list of resource handles to delete
DIM SHARED zList&(10)
' Get resources
ON ERROR GOTO BadRes
me% = SYSTEM(7)
LoadString me%, 1000, QBName$
LoadString me%, 1001, programList$
LoadArray me%, 1000, config%(0), "BCFG"
ON ERROR GOTO 0
' range check value of apl deletion
IF config%(4)<1 OR config%(4)>2 THEN config%(4)=2
' make sure saved window will be visible
mBar% = PEEKW(&HBAA)
h% = config%(2)-config%(0)
w% = (config%(3)-config%(1))/2
SetRect r1%(0),w%,mBar%+h%+19,CINT(SYSTEM(5)-w%),CINT(SYSTEM(6)-h%)
' do rectangles intersect ?
SectRect r1%(0),config%(0),r1%(0),x%
IF x% = 0 THEN CALL DefaultWindow : dirty%(0) = -1
t$ = "QB Batch Compile"
WINDOW 1,t$,(config%(1),config%(0))-(config%(3),config%(2)),6
WHILE 1
IF config%(5) <= 0 THEN 'starting new compilation
ui
ELSE 'in compilation sequence
DoNextFile
END IF
WEND
'----------------------------------------------------------------
' BadRes
' Configuration resource loading error handler.
'
' Something is wrong with the resource fork: probably missing
' a resource. This will happen the first time the program is
' run after compiling.
' This code is paranoid: it deletes all existing resources
' of the types we're concerned with (if any). It assumes that
' there may be duplicates of any given resource, which is a very
' abnormal condition. This can usually happen only while
' debugging, but we'll leave in the protective code to be sure.
'
BadRes:
h& = 0 : id% = 0 : t$ = "" : n$ = ""
me% = SYSTEM(7)
' make list of existing special string resources
c% = 0 : tref% = me%
i% = 1 : k% = 0
CountRes "STR ",c%
WHILE i% <= c% AND tref% = me%
GetIndRes "STR ",i%,h&
GetResInfo h&,id%,t$,n$
HomeResFile h&,tref%
IF tref% = me% AND (id% = 1000 OR id% = 1001) THEN
zList&(k%) = h& : k% = k% + 1
ELSE
ReleaseRes h&
END IF
i% = i% + 1
WEND
' make list of existing configuration resource(s)
i% = 1 : tref% = me%
CountRes "BCFG",c%
WHILE i% <= c% AND tref% = me%
GetIndRes "BCFG",i%,h&
GetResInfo h&,id%,t$,n$
HomeResFile h&,tref%
IF tref% = me% AND (id% =1000) THEN
zList&(k%) = h& : k% = k% + 1
ELSE
ReleaseRes h&
END IF
i% = i% + 1
WEND
' delete all resources in the list
FOR i% = 0 TO k% -1 : RemoveRes me%,zList&(i%) : NEXT
UpdateResFile me%
FOR i% = 0 TO k% -1 : ReleaseRes zList&(i%) : NEXT
' Save default configuration
DefaultWindow
config%(4) = 2 'Delete before compile enabled
config%(5) = -1 'Not compiling a list
SaveArray me%, config%(0), 12, 1000, "Config Info", "BCFG"
' Save default names (all null)
QBName$ = "" : programList$ = ""
SaveString me%,1000,"","QuickBasic"
SaveString me%,1001,"","Program List"
UpdateResFile me%
RESUME NEXT
'----------------------------------------------------------------
' Quit
' Clean up and terminate this program
'
SUB Quit STATIC
SaveInfo
END
END SUB
'----------------------------------------------------------------
' DefaultWindow
' Initialize the default window configuration
'
SUB DefaultWindow STATIC
h%=120 : w%=400
t% = (SYSTEM(6)-h%)\3 : l% = (SYSTEM(5)-w%)\2
SetRect config%(0),l%,t%,l%+w%,t%+h%
END SUB
'----------------------------------------------------------------
' ui
' The user interface for this program
'
SUB ui STATIC
CLS
SetRect r1%(0),110,10,390,40 : SetRect r2%(0),110,50,390,80
BUTTON 1,1,"QB Name",(8,9)-(100,34),1
BUTTON 2,1,"Program List",(8,50)-(100,75),1
BUTTON 3,1,"Quit",(150,90)-(250,110),1
BUTTON 4,0,"Compile",(280,90)-(380,110),1
BUTTON 5,config%(4),"Delete apl first",(10,90)-(130,105),2
d%=0
WHILE d%<>4
d%=DIALOG(0)
SELECT CASE d%
CASE 1
SELECT CASE DIALOG(1)
CASE 1 'QB Name
GetFile z$,"APPL","Please find QuickBasic."
IF LEN(z$) > 250 THEN 'path too long
BEEP
ELSEIF z$ <> "" THEN
QBName$ = z$ : dirty%(0) = -1
config%(5) = -1 : dirty%(1) = -1
END IF
CASE 2
GetFile z$,"TEXT","Program List file?"
IF LEN(z$) > 250 THEN 'path too long
BEEP
ELSEIF z$ <> "" THEN
programList$ = z$ : dirty%(0) = -1
config%(5) = -1 : dirty%(2) = -1
END IF
CASE 3 : Quit
CASE 4 'compile
config%(5) = 0 : dirty%(0) = -1
BUTTON CLOSE 0 : CLS
DoNextFile
CASE 5 'toggle 'delete apls' switch
BUTTON 5,(BUTTON(5) = 2) + 2
config%(4) = BUTTON(5) : dirty%(0) = -1
END SELECT
CASE 4 : Quit 'close box on window clicked
CASE 5 : WHILE DIALOG(0)=5:WEND : GOSUB redraw
CASE ELSE 'ignore anything else
END SELECT
IF QBName$<>"" AND programList$<>"" THEN
BUTTON 4,1
ELSE
BUTTON 4,0
END IF
WEND
Quit
redraw: 'window refresh routine
TEXTFONT 4
TextBox QBName$,r1%(0),1
TextBox programList$,r2%(0),1
PENPAT PEEKL(&H904)-28
InsetRect r1%(0),-2,-2 : FRAMERECT VARPTR(r1%(0))
InsetRect r1%(0), 2, 2
InsetRect r2%(0),-2,-2 : FRAMERECT VARPTR(r2%(0))
InsetRect r2%(0), 2, 2
PENNORMAL
RETURN
END SUB
'----------------------------------------------------------------
' DoNextFile
' Compile the next file in the list
'
' List file may contain blank and comment lines.
' A line with a semicolon as the first nonblank is a comment line.
'
SUB DoNextFile STATIC
w% = WINDOW(2) : h% = WINDOW(3)
SetRect r1%(0),2,2,w%-2,h%-2
f$ = programList$
Parse f$,plPath$
CHDIR plPath$
Exists programList$,x%
IF x% THEN
OPEN programList$ FOR INPUT AS #1
' synchronize with last offset
i% = 0
WHILE NOT EOF(1) AND i% < config%(5)
LINE INPUT #1, l$ : i% = i% + 1
WEND
WHILE config%(5) > -1
' look for next file in list
found% = 0
WHILE NOT EOF(1) AND NOT found%
LINE INPUT #1, l$ : i% = i% + 1
Ltrim l$
' skip blank lines and comments
' 59 = ASC(";")
' l$ may be null (illegal for ASC) so we PEEK
IF l$ <> "" AND PEEK(SADD(l$)) <> 59 THEN found% = -1
' extension: parse switch info here
WEND
IF found% THEN
config%(5) = i% : dirty%(0) = -1
fullName$ = plPath$+l$
Exists fullName$,x%
IF x% THEN
' Set MBAN to default name
SetAplName fullName$, fullName$ + " apl"
IF config%(4) = 2 THEN
Exists fullName$ + " apl", x%
IF x% THEN KILL fullName$ + " apl"
END IF
SaveInfo 'Remember where we were
' echo name of file we're about to compile
m$ = "Compiling"+CHR$(13)+plPath$+":"+CHR$(13)+l$
TextBox m$,r1%(0),1
SubLaunch QBName$, fullName$, 256 'compile file
' here if SubLaunch failed: stop processing
config%(5) = -1 : dirty%(0) = -1
BEEP : EXIT SUB
ELSE 'file not found
m$ = plPath$+":"+CHR$(13)+l$+CHR$(13)+"not found"
BEEP : TextBox m$,r1%(0),1
END IF
ELSE 'no more files to compile
m$ = "Done"
TEXTFONT 0 : TextBox m$, r1%(0), 1
config%(5) = -1 : dirty%(0) = -1 'stop processing
END IF
WEND
CLOSE #1
SaveInfo
ELSE 'program list not found
m$ = plPath$+":"+CHR$(13)+f$+CHR$(13)+"not found"
BEEP : TEXTFONT 0 : TextBox m$,r1%(0),1
END IF
END SUB
'----------------------------------------------------------------
' SetAplName
' Make sure there's a valid MBAN resource. Remove any existing
' MBAN(s), and use a default.
'
' n$ = name of source file
' cn$ = compiled application name
'
'----------------------------------------------------------------
' This could be changed to use an existing MBAN as follows:
' IF no MBAN (count for this file = 0) THEN
' use default
' ELSEIF 1 MBAN (count for this file = 1) THEN
' use MBAN
' ELSE (more than 1: file is damaged) THEN
' either delete all and use default, or have user select.
' Always remove the extras: there should only be 1 MBAN.
'
SUB SetAplName( n$, cn$ ) STATIC
c% = 0 : fr% = 0 : h1& = 0
' delete all existing MBANs
CountRes "MBAN",c%
OpenResFile n$, fr% : UpdateResFile fr%
CountRes "MBAN",x%
x% = x% - c%
FOR k% = 1 TO x%
GetIndRes "MBAN",k%,h1&
RemoveRes fr%,h1&
ReleaseRes h1&
NEXT
UpdateResFile fr%
' save our default MBAN
StringToHandle cn$,h1&
AddRes fr%, h1&, "MBAN", 0
CloseResFile fr%
ReleaseRes h1&
END SUB
'----------------------------------------------------------------
' SaveInfo
' Flush information to the resource fork if it's been changed.
'
' dirty%() contains a list of changed resources:
' 0 = config%() changed
' 1 = QBName$ changed
' 2 = programList$ changed
'
SUB SaveInfo STATIC
me% = SYSTEM(7)
' delete changed resources
FOR i% = 0 TO 2 : zList&(i%)= 0 : NEXT
IF dirty%(0) THEN GetRes me%,"BCFG",1000,zList&(0)
IF dirty%(1) THEN GetRes me%,"STR ",1000,zList&(1)
IF dirty%(2) THEN GetRes me%,"STR ",1001,zList&(2)
FOR i% = 0 TO 2
IF dirty%(i%) THEN RemoveRes me%, zList&(i%)
NEXT
UpdateResFile me%
' Save new resources
IF dirty%(0) THEN
SetRect config%(0),0,0,400,120
LocalToGlobal config%(0) :LocalToGlobal config%(2)
SaveArray me%,config%(0),12,1000,"Config Info","BCFG"
END IF
IF dirty%(1) THEN SaveString me%,1000,QBName$,"QuickBasic"
IF dirty%(2) THEN SaveString me%,1001,programList$,"Program List"
UpdateResFile me%
END SUB
'-------------------------------------------------------------------
' UTILITIES
'-------------------------------------------------------------------
'-------------------------------------------------------------------
' StringToHandle
' Convert Basic string to Pascal string in a handle.
'
SUB StringToHandle(a$,h&) STATIC
x$ = ""
ReleaseRes h& :h& = 0 'make sure handle is empty
B2PStr a$,x$
size& = ASC(x$)+1 'string length + length byte
NewHandle size&,h&
BlockMove SADD(x$),PEEKL(h&),size&
x$ = ""
END SUB
'---------------------------------------------------------------
' GetFile
' Display a message above the standard file dialog.
' m$ = message to display
' t$ = types displayed
' f$ = result from FILES$()
'
SUB GetFile(f$,t$,m$) STATIC
TEXTFONT 0
w%=300 : x% = WIDTH(m$)
IF x% > w%-10 THEN w% = x% + 10
mBar%=PEEKW(&HBAA) :l%=(SYSTEM(5)-w%)\2
WINDOW 10,"",(l%,mBar%+11)-(l%+w%,mBar%+30),2
SetRect r3%(0),2,2,CINT(WINDOW(2)-2),CINT(WINDOW(3)-2)
TEXTFONT 0 :TEXTSIZE 12
TextBox m$,r3%(0),1
f$=FILES$(1,t$)
WINDOW CLOSE 10
TEXTFONT 4
END SUB
'----------------------------------------------------------------
' Parse
' Separate filename from path
'
SUB Parse(f$,p$) STATIC
i%=1 : WHILE i% : l%=i% : i%=INSTR(i%+1,f$,":") : WEND
IF l%=1 THEN p$="" ELSE p$=LEFT$(f$,l%) : f$=RIGHT$(f$,LEN(f$)-l%)
END SUB
'----------------------------------------------------------------
' Ltrim
' Remove leading spaces and control characters from string
'
SUB Ltrim(s$) STATIC
IF s$ <> "" THEN
i% = 1
a& = SADD(s$)
WHILE PEEK(a&+i%-1) <= 32 AND i% <= LEN(s$)
i% = i%+1
WEND
s$ = RIGHT$(s$,LEN(s$)-i%+1)
END IF
END SUB
| Modification Type: | Minor | Last Reviewed: | 1/8/2003 |
|---|
| Keywords: | KB36333 |
|---|
|