Im Artikel "VB mit PowerBASIC erweitern" wurde gezeigt, warum es manchmal wünschenswert und manchmal sogar unumgänglich ist, die "schützende Hülle" von VB zu verlassen und eigene Programme mit DLLs zu erweitern, die in einer systemnäheren Sprache geschrieben sind. Es wurde beschrieben, wie dies in PowerBASIC bewerkstelligt werden kann.

Auch wenn PowerBASIC sehr effizient und äusserst preiswert ist, handelt es sich doch um Closed-Source-Software, und damit haben wir VB.Classic-Entwickler ja nun nicht gerade die besten Erfahrungen gemacht. Interessant wäre daher, ob es Open-Source-Alternativen gibt, die für unseren Einsatzzweck in Frage kommen.

Gibt es, und zwar ebenfalls als BASIC-Dialekt. Das Projekt nennt sich FreeBASIC. Der Compiler hat 2014 das Beta-Stadium hinter sich gelassen und ist sehr leistungsfähig und zuverlässig. Der folgende Code zeigt, dass alles, was wir im. o.g. Artikel mit PowerBASIC umgesetzt haben, auch mit FreeBASIC möglich ist.


FreeBASIC-Code:

            
'OPTION EXPLICIT -> Standard ab FreeBASIC v0.17

'Kompilieren: fbc.exe -dll -export "D:\FreeBASIC\VBDLL\fbtest1.bas"
'Getestet mit FreeBASIC Compiler - Version 0.20.0 (08-10-2008) for win32 (target:win32)

#include once "windows.bi"
#include once "win/ole2.bi"
'*****************************************************
EXTERN "windows-ms"
'*****************************************************
FUNCTION AddOne (BYVAL l AS INTEGER) AS INTEGER EXPORT
'Übergebenen Wert + 1 zurückgeben
'32bit-Ganzzahlen heissen INTEGER in FreeBASIC!
  RETURN l + 1
END FUNCTION
'*****************************************************
SUB AddOneInPlace(BYREF l AS INTEGER) EXPORT
'Wert um 1 erhöht zurückgeben
  l += 1
END SUB
'*****************************************************
FUNCTION UpperCase _
  (BYVAL arg AS ZSTRING PTR) AS BSTR EXPORT
'Argument in Grossbuchstaben übersetzen
'  Hinweis: Es gibt in FreeBASIC zwar auch eine UCASE$-Funktion, diese kann aber
'  derzeit nur mit Standard-ASCII-Zeichen umgehen; damit es auch mit den Umlauten
'  klappt, greifen wir auf die Funktion CharUpperBuff() aus der user32.dll zurück.
CharUpperBuff arg, len(*arg)
RETURN SysAllocStringByteLen(arg, LEN(*arg))
END FUNCTION
'*****************************************************
FUNCTION IsZero(BYVAL l AS INTEGER) AS SHORT EXPORT
'prüfen, ob 0
  IF l = 0 THEN
    FUNCTION = -1  'True
    'oder auch: RETURN -1
  ELSE
    FUNCTION = 0
    'diese Zuweisung ist eigentlich nicht notwendig, da
    'Funktionen und Variablen wie in VB mit 0 bzw. ""
    'vorbelegt werden
  END IF

'oder einfach so:
'  RETURN l = 0

'oder spasseshalber in Assembler:
'ASM
'  MOV eax, [l]
'  XOR bx, bx
'  CMP eax, 0
'  JNE isnot0
'  DEC bx
'  isnot0:
'  MOV [FUNCTION], bx
'END ASM
END FUNCTION
'*****************************************************
SUB SwapLongs (BYREF l1 AS INTEGER, BYREF l2 AS INTEGER) EXPORT
'zwei Long-Werte vertauschen
SWAP l1, l2
END SUB
'*****************************************************
SUB SwapStrings (BYVAL s1 AS ZSTRING PTR, BYVAL s2 AS ZSTRING PTR) EXPORT
'zwei Strings vertauschen
SWAP *s1, *s2
END SUB
'*****************************************************
FUNCTION SystemDirectory() AS BSTR EXPORT
'Systemverzeichnis ermitteln
DIM AS UINTEGER l
DIM b AS BYTE PTR
DIM r AS BSTR
l = GetSystemDirectory(BYVAL 0&, 0)
b = ALLOCATE(l)
l = GetSystemDirectory(b, l)
r = SysAllocStringByteLen(b, l)
DEALLOCATE b
RETURN r
END FUNCTION
'*****************************************************
FUNCTION ShiftRight(BYVAL l AS INTEGER, BYVAL offs AS INTEGER) AS INTEGER EXPORT
'shift right
l SHR = offs
RETURN l
END FUNCTION
'*****************************************************
FUNCTION GetInstalledRamSize() AS INTEGER EXPORT
'Grösse des installierten Hauptspeichers ermitteln
DIM AS HMODULE hModule
hModule = DYLIBLOAD("KERNEL32.DLL")
  IF hModule THEN
  'Das Laden der KERNEL32.DLL war schon mal erfolgreich; alles andere wäre
  'allerdings auch eine Katastrophe ... ;-)
  'Spannend wird's jetzt:
  DIM pGlobalMemoryStatusEx AS FUNCTION(BYREF lpBuffer AS MEMORYSTATUSEX) AS INTEGER
  'pGlobalMemoryStatusEx ist nur innerhalb des IF-Blocks gültig; die Variable
  'stellt einen typisierten Funktionszeiger dar, mit dem wir dem Compiler mit-
  'teilen, mit welchen Parametern die Funktion aufgerufen wird.
  pGlobalMemoryStatusEx = DYLIBSYMBOL(hModule, "GlobalMemoryStatusEx")
    IF pGlobalMemoryStatusEx THEN
    'Die vorliegende Kernel-Version enthält die Funktion GlobalMemoryStatusEx();
    'um sie zu nutzen, deklarieren wir zunächst eine weitere Variable, die wiederum
    'nur im innersten IF-Block gültig ist.
    DIM mInfoEx AS MEMORYSTATUSEX
    mInfoEx.dwLength = SIZEOF(mInfoEx)
    'Aufruf von GlobalMemoryStatusEx()
      IF pGlobalMemoryStatusEx(mInfoEx) THEN
      'Aufruf war erfolgreich
      FUNCTION = mInfoEx.ullTotalPhys SHR 10 '= \ 1024 (in Kilobyte umrechnen)
      DYLIBFREE hModule 'Modul-Handle freigeben
      EXIT FUNCTION     'Funktion verlassen
      END IF
    END IF
  DYLIBFREE hModule
  END IF
'Notausgang: Aufruf der alten Methode
SCOPE 'definiert Gütigkeitsbereich für mInfo
  DIM mInfo AS MEMORYSTATUS
  mInfo.dwLength = SIZEOF(mInfo)
  GlobalMemoryStatus VARPTR(mInfo)
  FUNCTION = mInfo.dwTotalPhys SHR 10 '= \ 1024 (in Kilobyte umrechnen)
END SCOPE
END FUNCTION
'*****************************************************
END EXTERN
            

Und hier der VB-Code:

Option Explicit

'Deklaration der DLL-Funktionen
Declare Function AddOne Lib "fbtest1.dll" (ByVal l As Long) As Long
Declare Sub AddOneInPlace Lib "fbtest1.dll" (ByRef l As Long)
Declare Function UpperCase Lib "fbtest1.dll" (ByVal s As String) As String
Declare Function IsZero Lib "fbtest1.dll" (ByVal l As Long) As Boolean
Declare Sub SwapLongs Lib "fbtest1.dll" (ByRef l1 As Long, ByRef l2 As Long)
Declare Sub SwapStrings Lib "fbtest1.dll" (ByRef s1 As String, ByRef s2 As String)
Declare Function SystemDirectory Lib "fbtest1.dll" () As String
Declare Function GetInstalledRamSize Lib "fbtest1.dll" () As Long
Declare Function ShiftRight Lib "fbtest1.dll" (ByVal zahl As Long, ByVal offset As Long) As Long

'Test der DLL-Funktionen
Sub Main()
Dim l1 As Long, l2 As Long
Dim s1 As String, s2 As String
l1 = AddOne(41)
Debug.Assert l1 = 42
AddOneInPlace l1
Debug.Assert l1 = 43
s1 = UpperCase("hällo wörld")
Debug.Assert s1 = "HÄLLO WÖRLD"
Debug.Assert IsZero(l2) = True
l2 = 55
Debug.Assert IsZero(l2) = False
SwapLongs l1, l2
Debug.Assert l1 = 55
Debug.Assert l2 = 43
s2 = CStr(l1)
SwapStrings s1, s2
Debug.Assert s1 = "55"
Debug.Assert s2 = "HÄLLO WÖRLD"
Debug.Assert ShiftRight(16, 1) = 8
Debug.Print "Systemverzeichnis: " & SystemDirectory()
Debug.Print "Installierter Hauptspeicher: " & GetInstalledRamSize() & " KB"
End Sub
            

Test bestanden! ;-)

Der vom Compiler erzeugte Code ist echter Maschinencode und von keinerlei Laufzeitkomponenten abhängig.

Auch hier der Hinweis: Mit FreeBASIC verlassen wir in vielerlei Hinsicht die "schützende Hülle" von VB; Sie sollten ihren FB-Code daher besonders ausführlich testen.