Article ID: 36333
Article Last Modified on 1/8/2003
APPLIES TO
- Microsoft QuickBasic Compiler for 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
Additional query words: MQuickB
Keywords: KB36333