Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Kleine Helferlein

Testsuite Compiler

Lizenz:Erster Autor:Letzte Bearbeitung:
WTFPLRedakteurMOD 26.01.2014

Angelehnt an meinen Code zum rekursiven Durchsuchen von Dateien, habe ich hier ein kleines Programm gebastelt, das alle FreeBASIC-Codes eines angegebenen Ordners und dessen Unterordner durch einen oder mehrere FreeBASIC-Compiler compilieren lässt. Nach Bedarf können die erstellten Programme dann noch gestartet und auch anschließend gelöscht werden.

Der Code eignet sich also vor allem für Testsuites, bei denen eine Menge Codes als Testdateien definiert sind.

#Include Once "dir.bi"

#Ifndef FALSE
    #Define FALSE 0
    #Define TRUE (Not FALSE)
#EndIf

Type Compiler
    Declare Constructor (fbc As String, compileOptions As String, activated As Integer)

    As String fbc
    As String compileOptions
    As Integer activated
End Type
Constructor Compiler(fbc As String, compileOptions As String, activated As Integer)
    This.fbc = fbc
    This.compileOptions = compileOptions
    This.activated = activated
End Constructor

Declare Sub compileDirectory(fbc As String, compileOptions As String, startDir As String, attribute As Integer, runAfterCompilation As Integer = FALSE, deleteExeAfterwards As Integer = FALSE)


'#####################################################
' Configure here
'#####################################################
Dim As String compileOptions = "-g -exx"
Dim As Compiler fbc(0 To ...) = { Type<Compiler>("fbc", compileOptions, TRUE), _ 'default fbc
                                  Type<Compiler>("""\0.91_x86\fbc.exe""", compileOptions, TRUE), _ 'current x86 build
                                  Type<Compiler>("""\0.91_x64\fbc.exe""", compileOptions, TRUE) }  'current x64 build

Dim As String  startDir      = "test\"
Dim As Integer attribute     = fbDirectory Or fbNormal
Dim As Integer runExe        = TRUE
Dim As Integer deleteExe     = TRUE
'#####################################################


'Output
Print "-------------------------------------------------------------------------------"
Print "| Starting...                                                                 |"
Print "-------------------------------------------------------------------------------"
For i As Integer = 0 To UBound(fbc)
    If fbc(i).activated Then
        Print "Using " & fbc(i).fbc
        Print String(Len(fbc(i).fbc) + Len("Using "), "-")
        compileDirectory(fbc(i).fbc, fbc(i).compileOptions, startDir, attribute, runExe, deleteExe)
        Print "-------------------------------------------------------------------------------"
    EndIf
Next
Print "-------------------------------------------------------------------------------"
Print "| Finished!                                                                   |"
Print "-------------------------------------------------------------------------------"

While Len(InKey) : Wend
Print "Press any key..."
Sleep

Sub compileDirectory(fbc As String, compileOptions As String, startDir As String, attribute As Integer, runAfterCompilation As Integer = FALSE, deleteExeAfterwards As Integer = FALSE)
    Dim As String currName, temp
    Dim As Integer lines, FF, attributeRet

    currName = Dir(startDir & "*", attribute, @attributeRet)

    While currName <> ""
        Select Case attributeRet
            Case fbDirectory
                If currName <> "." AndAlso currName <> ".." Then
                    compileDirectory(fbc, compileOptions, startDir & currName & "\", attribute, runAfterCompilation, deleteExeAfterwards)
                    'reset dir - may cost time in huge folders but will do the trick in most cases
                    Dim As String tempName = Dir(startDir & "*", attribute, @attributeRet)
                    While tempName <> currName
                        tempName = Dir("", attribute, @attributeRet)
                    Wend
                EndIf
            Case Else
                Dim As String fileNameWithoutExtension = Left(currName, Len(currName) - 4)
                Dim As String fileExtension = Mid(currName, InStrRev(currName, "."))
                Dim As String fileNameExe
                #If Defined(__FB_LINUX__)
                    fileNameExe = fileNameWithoutExtension
                #ElseIf Defined(__FB_WIN32__)
                    fileNameExe = fileNameWithoutExtension & ".exe"
                #EndIf
                If fileExtension = ".bas" Then
                    Print "Compiling " & startDir & currName & "..."
                    Dim As String temp, fbcMessages
                    lines = 0
                    FF = FreeFile
                    Open Pipe fbc & " " & compileOptions & " " & startDir & currName & " 2>&1" For Input As #FF
                        While Not Eof( FF )
                            Line Input #FF, temp
                            fbcMessages &= temp
                        Wend
                        If Len(fbcMessages) Then
                            Print "Compilation failed:"
                            Print fbcMessages
                            Print
                        EndIf
                    Close #FF

                    If runAfterCompilation AndAlso Len(fbcMessages) = 0 Then
                        Print "Running " & fileNameExe & ":"
                        Print String(Len(fileNameExe) + Len("Running ") + 1, "-")
                        Exec(startDir & fileNameExe, "")
                        Print String(Len(fileNameExe) + Len("Running ") + 1, "-")
                    EndIf

                    If deleteExeAfterwards AndAlso Len(fbcMessages) = 0 Then
                        Print "Deleting " & fileNameExe & "..."
                        Select Case Kill(startDir & fileNameExe)
                            Case 1
                                Print "Deleting failed: file does not exist: " & startDir & fileNameExe
                            Case 2
                                Print "Deleting failed: " & startDir & fileNameExe
                        End Select
                    EndIf
                EndIf
        End Select

        currName = Dir("", attribute, @attributeRet)
    Wend
End Sub

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 19.01.2014 von RedakteurMOD angelegt.
  • Die aktuellste Version wurde am 26.01.2014 von RedakteurMOD gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen