Microsoft KB Archive/36333

From BetaArchive Wiki
< Microsoft KB Archive
Revision as of 13:14, 21 July 2020 by X010 (talk | contribs) (Text replacement - "&" to "&")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Knowledge Base


How to Compile a Batch of Files with Macintosh QuickBasic

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