Im Beitrag “API-Funktionen finden und speichern” haben wir gezeigt, wie Sie alle API-Deklarationen eines VBA-Projekts finden und sowohl die Daten der API-Funktion als auch die der Parameter in zwei Tabellen speichern. Zu API-Deklarationen gehören jedoch auch einige Konstanten und Typen, die beim Aufruf der API-Funktionen verwendet werden oder als Parameter der Funktionen dienen. Im Sinne des Schaffens einer Möglichkeit zum Migrieren von API-Deklarationen von 32-Bit zu 64-Bit wollen wir auch diese Elemente zunächst in entsprechenden Tabellen speichern, um diese dann per Code anzupassen und in der 64-Bit-Version auszugeben.
Vorarbeiten
Im Beitrag API-Funktionen finden und speichern (www.access-im-unternehmen.de/1312) haben wir bereits eine Prozedur angelegt, die alle Module einer Datenbank durchläuft und die enthaltenen API-Deklarationen ausliest. Dieser fügen wir einen weiteren Aufruf hinzu, und zwar für eine Prozedur namens FindAPITypes:
Public Sub FindAPIDeclares() Dim objVBProject As VBProject Dim objVBComponent As VBComponent Set objVBProject = GetCurrentVBProject For Each objVBComponent In objVBProject.VBComponents FindAPIDeclaresInModule objVBComponent FindAPITypes objVBComponent Next objVBComponent End Sub
Die Prozedur FindAPITypes und die von dieser Prozedur aufgerufenen Routinen sehen wir uns im vorliegenden Beitrag an.
Wie sind Type-Konstrukte aufgebaut
Bevor wir Code programmieren können, mit denen wir Type-Elemente einlesen, müssen wir uns erst einmal ansehen, wie diese Elemente aufgebaut sind. Ein Type-Element besteht immer mindetens aus dem Type-Schlüsselwort und dem Namen des Types in der ersten Zeile, einem Element, das aus dem Elementnamen, dem Schlüsselwort As und dem Variablentyp besteht, und dem Abschluss mit der Zeile End Type:
Type bla
blub As String
End Type
Das Type-Element kann in der ersten Zeile auch noch ein Schlüsselwort enthalten, das die Gültigkeit bezeichnet, also Private oder Public.
Eines der im Type-Konstrukt enthaltenen Elemente mit dem Datentyp String kann auch noch die Angabe einer festen Zeichenanzahl enthalten, zum Beispiel mit der Zeichenanzahl 50:
blub As String * 50
Ein praktisches Beispiel ist das folgende:
Private Type shellBrowseInfo hwndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As String ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type
Typen in VBA-Modulen finden
In der oben vorgestellten Prozedur namens FindAPIDeclares durchlaufen wir alle VBComponent-Objekte, also alle Module des aktuellen VBA-Projekts. Für jedes Modul rufen wir einmal die Prozedur FindAPITypes auf und übergeben dieser einen Verweis auf das jeweilige Modul:
FindAPITypes objVBComponent
Die Prozedur FindAPITypes finden Sie in Listing 1. Die Prozedur nimmt das VBComponent-Objekt mit dem Parameter objVBComponent entgegen und füllt die Variable objCodeModule mit dem Objekt aus der Eigenschaft CodeModule der VBA-Komponente aus objVBComponent.
Public Sub FindAPITypes(objVBComponent As VBComponent) Dim objCodeModule As CodeModule Dim lngLine As Long Dim strLine As String Dim strType As String Set objCodeModule = objVBComponent.CodeModule For lngLine = 1 To objCodeModule.CountOfDeclarationLines strLine = Trim(objCodeModule.Lines(lngLine, 1)) strLine = ReplaceMultipleSpaces(strLine) If Left(strLine, 5) = "Type " Or Left(strLine, 13) = "Private Type " Or Left(strLine, 12) = "Public Type " Then strType = strLine & vbCrLf Do While Not Left(strLine, 8) = "End Type" lngLine = lngLine + 1 strLine = Trim(objCodeModule.Lines(lngLine, 1)) strLine = ReplaceMultipleSpaces(strLine) strType = strType & strLine & vbCrLf Loop SaveAPIType strType, objVBComponent.Name End If Next lngLine End Sub
Listing 1: Prozedur zum Finden der API-Type-Strukturen
Dann durchlaufen wir alle Zeilen des Deklarationsbereichs des jeweils aktuellen Moduls aus objCodeModule in einer For Next-Schleife von der Zeile 1 bis zu der mit CountOfDeclaration ermittelten letzten Zeile des Deklarationsbereichs. Hier übertragen wir die aktuelle Zeile, von der wir mit der Trim-Funktion überschüssige Leerzeichen vorn und hinten entfernen, in die Variable strLine. Diese schicken wir dann durch die Funktion ReplaceMultipleSpaces. Damit wollen wir überschüssige Leerzeichen aus der aktuellen Zeile entfernen, sodass aus der Zeile
Private Type Beispiel
die folgende Zeile wird:
Private Type Beispiel
Die dazu verwendete Funktion ReplaceMultipleSpaces sieht wie folgt aus und durchläuft solange eine Do While-Schleife, bis keine doppelten Leerzeichen mehr in der mit dem Parameter strLine übergebenen Zeichenkette enthalten sind. Innerhalb der Do While-Schleife ersetzt die Funktion jeweils ein doppeltes Leerzeichen durch ein einfaches Leerzeichen. Anschließend gibt sie die Zeichenkette aus strLine als Rückgabewert der Funktion zurück:
Public Function ReplaceMultipleSpaces( ByVal strLine As String) As String Do While Not InStr(1, strLine, " ") = 0 strLine = VBA.Replace(strLine, " ", " ") Loop ReplaceMultipleSpaces = strLine End Function
Die so behandelte Zeile landet in der aufrufenden Prozedur wieder in der Variablen strLine. Nachdem diese nun keine führenden oder folgenden Leerzeichen mehr aufweist, können wir die aktuelle Zeile dahingehend überprüfen, ob diese die erste Zeile eines Type-Konstrukts ist.
Dafür testen wir, ob die ersten fünf Zeichen der Zeichenkette “Type “, die ersten dreizehn Zeichen der Zeichenkette “Private Type ” oder die ersten zwölf Zeichen der Zeichenkette “Public Sub ” lauten. Ist das der Fall, fügen wir der Variablen strType die erste Zeile des Type-Konstrukts inklusive eines Zeilenumbruchs hinzu.
Danach durchlaufen wir solange eine Do While-Schleife, bis wir auf eine Zeile stoßen, die mit der Zeichenfolge End Type beginnt – also bis zur letzten Zeile des Type-Konstrukts. Dabei erhöhen wir die Zählervariable lngLine jeweils um 1 und lesen die jeweilige Zeile aus objCodeModule.Lines(lngLine, 1) in die Variable strLine ein.
In dieser Zeile entfernen wir wieder mit der Funktion ReplaceMultipleSpaces überflüssige Leerzeichen. Den Grund dafür erfahren Sie übrigens weiter unten. Danach fügen wir die bereinigte aktuelle Zeile als neue Zeile an die Zeichenkette strType an und hängen noch ein vbCrLf hinten an.
Dies alles geschieht, wie oben bereits beschrieben, bis wir in strLine den Ausdruck End Type finden. Damit ist das Type-Konstrukt komplett in die Variable strType eingelesen. Dieses übergeben wir dann nebst dem Namen der VBA-Komponente an eine weitere Prozedur namens SaveAPIType.
Tabelle zum Speichern der Type-Elemente anlegen
Um die Type-Konstrukte beziehungsweise deren Informationen zu speichern, verwenden wir zwei Tabellen. Die Erste heißt tblAPITypes und sieht in der Entwurfsansicht wie in Bild 1 aus. Die Felder speichern die folgenden Informationen:
Bild 1: Entwurf der Tabelle tblAPITypes
- APITypeID: Primärschlüsselfeld der Tabelle
- APITypeName: Name des Type-Konstrukts, also der in der ersten Zeile angegebene Bezeichner
- Module: Modul, in dem sich die Definition des Type-Elements befindet
- Visibility: Sichtbarkeit, als entweder Private oder Public
- APIType: Text des kompletten Typs inklusive der darin definierten Elemente
Speichern des Type-Konstrukts
Das Speichern erledigt die Prozedur SaveAPIType. Sie erwartet mit dem ersten Parameter den kompletten Text des Type-Konstrukts und mit dem zweiten den Namen des Moduls, in dem sich der Type befindet (siehe Listing 2).
Public Sub SaveAPIType(ByVal strAPIType As String, ByVal strModule As String) Dim strLines() As String Dim strLine As String Dim db As dao.Database Dim rstTypes As dao.Recordset Dim strVisibility As String Dim strTypeElements() As String Dim lngTypeID As Long Dim strAPITypeName As String Set db = CurrentDb Set rstTypes = db.OpenRecordset("SELECT * FROM tblAPITypes", dbOpenDynaset) If Right(strAPIType, 2) = vbCrLf Then strAPIType = Left(strAPIType, Len(strAPIType) - 2) End If strLines = Split(strAPIType, vbCrLf) strLine = strLines(0) strTypeElements = Split(strLine, " ") Select Case UBound(strTypeElements) - LBound(strTypeElements) + 1 Case 2 strVisibility = "Public" strAPITypeName = Split(strLine, " ")(1) Case 3 strVisibility = Split(strLine, " ")(0) strAPITypeName = Split(strLine, " ")(2) End Select With rstTypes .AddNew !APITypeName = strAPITypeName !Module = strModule !Visibility = strVisibility !APIType = strAPIType lngTypeID = !APITypeID .Update End With SaveAPITypeElements db, strLines, lngTypeID End Sub