123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740 |
- '******************************************************************************
- '* *
- '*KATALOG INHALT.MAC
- '* *
- '* Dieser Makro erstellt einen Speicherauszug des Katalogs *
- '*"vertriebauf" in eine Textdatei. *
- '* Aufgenommen werden die Kataloginformationen, Datenbankinformationen, *
- '*Datenbankstruktur, Katalogordner, Tabellenverbindungen und *
- '*Benutzerklasseninformationen. *
- '******************************************************************************
- OPTION EXPLICIT
- 'Funktionen und Prozeduren deklarieren
- Declare Sub TableInfo(DB As Object)
- Declare Sub TraverseFolder(fold As object, level as integer)
- Declare Sub UserClassInfo(class as object, level as integer)
- Declare Sub TraverseUserClass(class As object, level as integer)
- Declare Sub GetParentItem(item as object)
- Declare Function DecodeDataType(DataType as integer) As String
- Declare Function DecodeJoinType(JoinType as integer) As String
- Declare Function DecodeProcessingType(ProcessingType as integer) As String
- Declare Function DecodePermissionType(PermissionType as integer) As String
- Declare Function DecodeDataItem(ItemType as integer) As String
- Declare Function FolderItemType(objExpression as object) As String
- Declare Function Indent(level as integer) As String
- 'Registrierungs-Funktion-Prototypen
- Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
- (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
- ByVal samDesired As Long, phkResult As Long) As Long
- Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
- (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
- ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
-
- Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
- 'Funktion zum Abrufen von Registrierungswerten
- Declare Function GetInfo(lngClassKey As Long, strSectionKey As String, _
- lngReserved As Long, lngSecurity As Long, strValueName As String) As Variant
- 'Spezifische Zugangsberechtigungen zur Registrierung
- Const SYNCHRONIZE = &H100000
- Const KEY_NOTIFY = &H10
- Const KEY_ENUMERATE_SUB_KEYS = &H8
- Const KEY_QUERY_VALUE = &H1
- Const STANDARD_RIGHTS_ALL = &H1F0000
- Const READ_CONTROL = &H20000
- Const STARDARD_RIGHTS_READ = (READ_CONTROL)
- Const KEY_READ = ((STARDARD_RIGHTS_READ or KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS or KEY_NOTIFY) and (Not SYNCHRONIZE))
- 'Wichtigkeits-Codes definieren
- Const ERROR_SUCCESS = 0&
- 'Vordefinierte Registrierungs-Klassen-Konstante
- Const HKEY_LOCAL_MACHINE = &H80000002
- 'Vordefinierte Typen von Registrierungswerten
- Const REG_SZ = (1) 'Unicode Null beendete die Zeichenkette
- 'globale Variablen deklarieren
- Global g_ImpApp As Object, g_ImpCat As Object
- Global g_LineEnd As String, g_tab As String, g_ItemPath As String
- Global g_filenumber As Integer
- 'Hauptteil des Programms
- '------------------------------------------------------------------------------
- Sub Main()
- 'Variablen der Prozedurebene deklarieren
- 'declare procedure level variables
- Dim Database As Object
- Dim Tablelink as Object
- Dim counter_1 As Integer
- Dim counter_2 As Integer
- Dim ans As Integer
- Dim ImpPath As String
- Dim filename As String
- Dim directory As String
- Dim flag As String
- Dim intPosition As Integer
- Dim lngClassKey As Long
- Dim strSectionKey As String
- Dim lngReserved As Long
- Dim lngSecurity As Long
- Dim strValueName As String
-
- 'On Error GoTo ErrorHandler
- On Error Resume Next
- 'benötigt zum Durchsuchen der Registrierung
- lngClassKey = HKEY_LOCAL_MACHINE
- strSectionKey = "SOFTWARE\Cognos\cer5\Rendition Locations"
- lngReserved = 0
- lngSecurity = KEY_READ
- strValueName = "Samples"
-
- 'Pfad für Impromptu Beispiele
-
- ImpPath = GetField(Command, 1, ",")
- filename = GetField(Command, 2, ",")
- 'Meldung für den Benutzer anzeigen, was der Makro bewirkt und ihm die Option
- 'gibt, abzubrechen
-
- 'Impromptu und den AUFUmsatz-Beispielkatalog öffnen
- Set g_ImpApp = CreateObject("CognosImpromptu.Application")
- g_ImpApp.OpenCatalog imppath & "\" & filename & ".cat", "Ersteller", "", "gaps", "Gcbs12ma"
- 'den aktiven Katalog und die Datenbank auf Objektvariablen einrichten
- Set g_ImpCat = g_ImpApp.ActiveCatalog
- Set Database = g_ImpCat.Databases(1)
- g_LineEnd = Chr$(13) + Chr$(10) 'Wagenrücklauf (CR)
- g_tab = Chr$(9) 'Tabulatur
-
- 'Datei zum Speichern der Kataloginformationen öffnen
- g_filenumber = Freefile
- Open ImpPath & "\" & filename & ".icr" For Output As #g_filenumber
- '-----------------------------
- 'Abschnitt Kataloginformationen
- '-----------------------------
- 'den Katalog-Dateinamen und die Beschreibung zur Datei hinzufügen
- Print #g_filenumber, "Kataloginformationen" + g_LineEnd + g_tab + _
- "Katalog-Dateiname: " + g_ImpCat.Filename + g_LineEnd + g_tab + _
- "Beschreibung: " + g_ImpCat.Description + g_LineEnd
- 'Hinweis: Automatisierung für das Katalog-Erstellungsdatum noch nicht
- ' implementiert
- '-----------------------------
- 'Abschnitt Datenbankinformationen
- '-----------------------------
- 'den Datenbanknamen und die Verbindungszeichenkette zur Datei hinzufügen
- Print #g_filenumber, "Datenbankinformationen" + g_LineEnd + _
- g_tab + "Datenbankname: " + Database.Name + g_LineEnd + g_tab + _
- "Verbindungszeichenkette: " + _
- g_ImpApp.DatabaseDefinitions(Database.Name).Definition + g_LineEnd
- '---------------------------------------
- 'Datenbankstruktur, Tabellen und Spalten
- '---------------------------------------
- 'die Tabellen und Spalten zur Datei hinzufügen
- Print #g_filenumber, "Datenbankstruktur" + g_LineEnd
-
- 'Da Datenbanken Qualifizierungsebenen haben, müssen alle Ebenen auf Tabellen
- 'überprüft werden. Wenn es diese Ebenen gibt, das Objekt
- 'Datenbankqualifizierungsebene an die Sub-Routine TabellenInfo weitergeben, durch
- 'die die Tabellen und Spalten aller Ebenen zur globalen Variable g_KatInfo
- 'hinzugefügt werden. Gibt es dagegen keine Qualifizierungsebenen, wird einfach
- 'die Datenbank weitergegeben.
-
- If Not (Database.CatalogLevels Is Nothing) Then 'es gibt Katalogebenen
- 'alle Katalogebenen auf Schemaebenen überprüfen
- For counter_1 = 1 to Database.CatalogLevels.Count
- 'die Katalogebene hat Schemaebenen
- If Not (Database.CatalogLevels(counter_1).SchemaLevels Is Nothing) Then
- For counter_2 = 1 To Database.CatalogLevels(counter_1).SchemaLevels.Count
- Call TableInfo(Database.CatalogLevels(counter_1).SchemaLevels(counter_2))
- Next counter_2
- Else 'no schema levels
- 'die Katalogebene an die Sub-Routine TabellenInfo weitergeben
- If Not Database.CatalogLevels(counter_1).Tables Is Nothing Then
- Call TableInfo(Database.CatalogLevels(counter_1))
- End If
- End If
- Next counter_1
- 'es gibt keine Katalogebenen, auf Schemaebenen überprüfen
- ElseIf Not (Database.SchemaLevels Is Nothing) Then
- For counter_2 = 1 To Database.SchemaLevels.Count
- 'Schemaebene an die Sub-Routine TabellenInfo weitergeben
- Call TableInfo(Database.SchemaLevels(counter_2))
- Next counter_2
- Else 'es gibt weder Katalog- noch Schemaebenen
- Call TableInfo(Database) 'die aktive Datenbank an die Sub-Routine
- ' TabellenInfo weitergeben
- End If
- '---------------------------------------
- 'Abschnitt Katalogordner
- '---------------------------------------
- 'die Ordner und Ordnerelemente zur Datei hinzufügen
- Print #g_filenumber, g_LineEnd + "Katalogordner" + g_LineEnd
- 'die Ordner-Zusammenstellung zusammen mit der Ordnerebene 1 (höchste Stufe)
- ' and die Prozedur TraverserOrdner weitergeben
- Call TraverseFolder(g_ImpCat.Folders, 1)
- '---------------------------------------
- 'Abschnitt Verbindungen
- '---------------------------------------
- 'die Verbindungsinformationen zur Datei hinzufügen
- Print #g_filenumber, g_LineEnd + "Tabellenverbindungen: " + g_LineEnd
- set Tablelink = g_ImpCat.Tablelinks
- counter_1 = 1
- 'für jede Verbindung des Katalogs den Tabellennamen und den Verbindungstyp
- 'in die Datei stellen, die Funktion DekodiereVerbndgTyp zum Ändern des Typs von
- 'numerisch auf Text verwenden
-
- For counter_1 = 1 to Tablelink.count
- Print #g_filenumber, g_tab & Tablelink(counter_1).lefttable.Name & _
- " - " & tablelink(counter_1).RightTable.Name & ": " & _
- DecodeJoinType(tablelink(counter_1).type) & g_LineEnd & g_tab & _
- tablelink(counter_1).Condition.Formula & g_LineEnd
- Next counter_1
- '---------------------------------------
- 'Benutzerklasseninformationen
- '---------------------------------------
- 'die Benutzerklasseninformationen zur Datei hinzufügen
- 'Die Funktion BenutzerKlassenInfo wird aufgerufen, um die Eigenschaften der aktiven
- 'Benutzerklasse (der "Ersteller"-Benutzerklasse beim ersten Aufruf) abzufragen.
- 'Die Funktion wird auf dieselbe Weise für die restliche benutzerklassenstruktur
- 'verwendet, bis sie für alle Benutzerklassen unterhalb von "Ersteller" aufgerufen
- 'wurde. Die Funktion TraverseBenutzerKlasse wird ebenfalls aufgerufen und alle
- 'Benutzerklassenebenen durchgangen, solange bis alle gefunden wurden.
-
- Print #g_filenumber, "'Benutzerklasseninformationen" + g_LineEnd
- Call UserClassInfo(g_ImpCat.ActiveUserClass, 1)
- counter_1 = 1
- For counter_1 = 1 To g_ImpCat.ActiveUserClass.UserClasses.Count
- Call UserClassInfo(g_ImpCat.ActiveUserClass.UserClasses(counter_1), 2)
- Call TraverseUserClass(g_ImpCat.ActiveUserClass.UserClasses(counter_1),2)
- Next counter_1
- 'Datei schließen
- Close #g_filenumber
- g_ImpCat.Close
- Set Tablelink = Nothing
- Set Database = Nothing
- Set g_ImpCat = Nothing
- Set g_ImpApp = Nothing
-
- done:
- Exit Sub
- ErrorHandler:
- MsgBox "Fehlernr.: " & Err & " " & Error
- Resume done
-
- End Sub
- 'Diese Prozedur wird vom Abschnitt Datenbankstruktur des Hauptteils des
- 'Programms aufgerufen.
- 'Sub-Routine TabellenInfo für den Auszug der Datenbankinformationen (Tabellen und Spalten)
- Sub TableInfo(database As Object) 'das Datenbankobjekt wurde weitergegeben
- 'die Variablen der Prozedurebene deklarieren
- Dim TableIndexNo As Integer
- Dim ColumnIndexNo As Integer
- 'alle Tabellen mit den dazugehörigen Spalten in der Datei speichern
- 'die Tabellen- und Spaltennamen abrufen, sowie den Spaltentyp und
- 'ob die Spalte ein Schlüssel ist
- 'den numerischen Datentyp an die Funktion DekodiereDatenTyp weitergeben, um ihn
- 'in Zeichenkette zu konvertieren und ihn zurückgeben
- For TableIndexNo = 1 To Database.Tables.Count
- Print #g_filenumber, g_tab + "Table: " + _
- database.Tables(TableIndexNo).name
- For ColumnIndexNo = 1 To Database.tables(TableIndexNo).columns.count
- Print #g_filenumber, g_tab + g_tab + "Spalte: " + _
- database.Tables(TableIndexNo).Columns(ColumnIndexNo).name + _
- " (" + (DecodeDataType(database.Tables(TableIndexNo).Columns _
- (ColumnIndexNo).Type)) + ")"
- Next ColumnIndexNo
- Next TableIndexNo
- End Sub
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'Diese Prozedur wird vom Abschnitt Katalogordner des Haupteils des
- 'Programms aufgerufen.
- Sub TraverseFolder(Folders as Object, level as Integer)
- 'die Variablen der Prozedurebene deklarieren
- Dim counter As integer
- Dim item as object
-
- 'Beim erstmaligen Aufruf ist die Ebene 1, daher wird Element = Ordner verwendet und
- 'alle Ordner der höchsten Ebene werden durchsucht. Sowie sich alle Ordner der
- 'höchsten Ebene und die dazugehörigen Spalten in der Datei befinden, wird die Funktion
- 'wieder aufgerufen und die Ordner der nächsten Ebene gespeichert, bis sich alle Ordner
- 'und Elemente in der Datei befinden.
- If Level <> 1 Then 'kein Ordner der höchsten Ebene
- Set item = Folders.Items
- 'alle Elemente der Ordner-Zusammenstellung durchsuchen
- For counter = 1 to item.count
- If item(counter).Value Is Nothing Then
- Print #g_filenumber, indent(level) & "Ordner: " & _
- item(counter).Name
- Call TraverseFolder(item(counter), level + 1)
- Else
- Print #g_filenumber, indent(level) & _
- FolderItemType(item(counter)) & ": " & _
- item(counter).Name & " (" & item(counter).Value.Formula & _
- ", " & DecodeDataItem(item(counter).ResultType) & ")"
- End If
- Next counter
- Else 'Ordner der höchsten Ebene
- Set item = Folders
- 'alle Elemente der Ordner-Zusammenstellung durchsuchen
- For counter = 1 to Item.Count
- If item(counter).Value Is Nothing Then
- Print #g_filenumber, Indent(level) & "Ordner: " & item(counter).Name
- Call TraverseFolder(item(counter), level + 1)
- Else
- Print #g_filenumber, Indent(level) & _
- FolderItemType(item(counter)) & ": " & _
- item(counter).Name & " (" & item(counter).Value.Formula & _
- ", " & DecodeDataItem(item(counter).ResultType) & ")"
- End If
- Next counter
- End if
- set item = nothing
- End Sub
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'Diese Prozedur wird vom Abschnitt Benutzerklasseninformationen des Hauptteils
- 'des Programms aufgerufen. Das gilt auch für die Prozedur TraverseBenutzerKlasse.
- 'Die aktive Benutzerklasse und die Ebene der Benutzerklasse wurden weitergegeben.
- 'Beachten Sie, daß 1 die Ebene der Benutzerklasse "Ersteller" ist.
- Sub UserClassInfo(PassedClass As Object, level As Integer)
- 'die Variablen der Prozedurebene deklarieren
- Dim counter As Integer
- Dim TextBlobLimit As Integer
- With PassedClass
- Print #g_filenumber, Indent(level) + "Benutzerklasse: " + .Name
- Print #g_filenumber, Indent(level + 1) + "Client/Server-Informationen"
- Print #g_filenumber, Indent(level + 2) + "Abfrageverarbeitung: " + _
- DecodeProcessingType(.QueryProcessing)
- Print #g_filenumber, Indent(level + 2) + "Verbindungsdauer minimieren: " + _
- Format$(.MinimizeConnectTime, "True/False") + g_LineEnd
- Print #g_filenumber, Indent(level + 1) + "Gouverneur-Informationen"
- Print #g_filenumber, Indent(level + 2) + "Neue Berichte erstellen: " + _
- Format$(.CanCreateNewReports, "True/False")
- Print #g_filenumber, Indent(level + 2) + "Ordner hinzufügen/ändern: " + _
- Format$(.CanAddOrModifyFolders, "True/False")
- Print #g_filenumber, Indent(level + 2) +"Benutzerklassen hinzufügen/ändern: "+ _
- Format$(.CanAddOrModifyUserClasses, "True/False")
- Print #g_filenumber, Indent(level + 2) + "SQL-Direkteingabe: " + _
- Format$(.CanDirectEnterSQL, "True/False")
- Print #g_filenumber, Indent(level + 2) + "'Über-Kreuz'-Produktabfragen: " + _
- DecodePermissionType(.CrossProductPermission)
- Print #g_filenumber, Indent(level + 2) + "Offene Verbindungen zulassen: " + _
- DecodePermissionType(.OuterJoinPermission)
- Print #g_filenumber, Indent(level + 2) + "Sortieren an nicht-indizierten " + _
- "Spalten: " + DecodePermissionType(.NonIndexSortingPermission)
- Print #g_filenumber, Indent(level + 2) +"'Select Distinct' zulassen: "+ _
- DecodePermissionType(.SelectDistinctPermission)
- Print #g_filenumber, Indent(level + 2) + "Abruf der Zeilen aus der Datenbank " + _
- "beschränken"
- Print #g_filenumber, Indent(level + 3) + "Warnen bei: " + _
- Format$(.RowsRetrievedWarnAfter)
- Print #g_filenumber, Indent(level + 3) + "Stoppen bei: " + _
- Format$(.MaxRowsRetrieved)
- Print #g_filenumber, Indent(level + 2) + "Abfrageausführungs-Zeitlimits"
- Print #g_filenumber, Indent(level + 3) + "Warnen bei: " + _
- Format$(.QueryExecutionTimeWarnAfter)
- Print #g_filenumber, Indent(level + 3) + "Stoppen bei: " + _
- Format$(.MaxQueryExecutionTime)
- Print #g_filenumber, Indent(level + 2) + "Tabellen-Limit je Bericht"
- Print #g_filenumber, Indent(level + 3) + "Warnen bei: " + _
- Format$(.TablesPerReportWarnAfter)
- Print #g_filenumber, Indent(level + 3) + "Stoppen bei: " _
- + Format$(.MaxTablesPerReport)
- Print #g_filenumber, Indent(level + 2) + "Text-Blob-Limit: " + _
- Format$(.HasTextBlobLimit, "True/False")
-
- TextBlobLimit = .HasTextBlobLimit
- If TextBlobLimit = 0 Then
- Print #g_filenumber, Indent(level + 2) + _
- "Max. Text-Blob-Zeichen: nv" + g_LineEnd
- Else
- Print #g_filenumber, Indent(level + 2) + _
- "Max. Text-Blob-Zeichen: " + _
- Format$(.MaxTextBlobCharacters) + g_LineEnd
- End If
-
- If .DeniedFolderItems.Count > 0 Then
- Print #g_filenumber, Indent(level + 1) + "Ordner und Elemente verweigert"
- for counter = 1 to .DeniedFolderItems.count
- g_ItemPath = ""
- Call GetParentItem(.DeniedFolderItems(counter))
- Print #g_filenumber, Indent(level + 2) + g_ItemPath + _
- .DeniedFolderItems(counter).name
- Next counter
- Print #g_filenumber,
- End If
- If .DeniedTables.Count > 0 Then
- Print #g_filenumber, Indent(level + 1) + "Tabellen verweigert"
- For counter = 1 To .DeniedTables.Count
- Print #g_filenumber, Indent(level + 2) + .DeniedTables(counter).Name
- Next counter
- Print #g_filenumber,
- End If
-
- If .DeniedColumns.Count > 0 Then
- Print #g_filenumber, Indent(level + 1) + "Spalten verweigert"
- For counter = 1 To .DeniedColumns.Count
- Print #g_filenumber, Indent(level + 2) + _
- .DeniedColumns(counter).Parent.Name + "." + _
- .DeniedColumns(counter).Name
- Next counter
- Print #g_filenumber,
- End If
-
- If .FilteredTables.Count > 0 Then
- Print #g_filenumber, Indent(level + 1) + "Tabellenfilter"
- For counter = 1 To .FilteredTables.Count
- Print #g_filenumber, Indent(level + 2) + "Tabelle: " + _
- .FilteredTables(counter).Name + " Filter: " + _
- .GetFilterFor(.FilteredTables(counter)).Formula
- Next counter
- Print #g_filenumber,
- End If
- 'Hinweis: die Datenbank hat keine Katalog- oder Schema-Qualifizierungsebenen,
- 'daher steht der Code hier als Kommentarzeile.
- 'If .DeniedSchemalevels.Count > 0 Then
- ' Print #g_filenumber, Indent(level + 1) + "Schemaebenen verweigert"
- ' For counter = 1 To .DeniedSchemalevels.Count
- ' Print #g_filenumber, Indent(level + 2) + _
- ' .DeniedSchemalevels(counter).Name
- ' Next counter
- 'End If
- 'If .DeniedCataloglevels.Count > 0 Then
- ' Print #g_filenumber, Indent(level + 1) + "Katalogebenen verweigert"
- ' For counter = 1 To .DeniedCataloglevels.Count
- ' Print #g_filenumber, Indent(level + 2) + _
- ' .DeniedCataloglevels(counter).Name
- ' Next counter
- 'End If
-
- End With
- End Sub
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'Diese Prozedur wird vom Abschnitt Benutzerklasseninformationen des Hauptteils
- 'des Programms sowie von sich selbst aufgerufen. Die aktive Benutzerklasse und
- 'die Ebene der Benutzerklasse wurden weitergegeben. Beachten Sie, daß 1 die
- 'Ebene der Benutzerklasse "Ersteller" ist.
- Sub TraverseUserClass(PassedClass As Object, level As Integer)
- 'die Variablen der Prozedurebene deklarieren
- Dim UserClass As Object
- Dim counter as Integer
- Set UserClass = PassedClass.UserClasses
- For counter = 1 To UserClass.Count
- Call UserClassInfo(UserClass(counter), level + 1)
- Call TraverseUserClass(UserClass(counter), level + 1)
- Next counter
- End Sub
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- Sub GetParentItem(PassedItem As Object)
- If Not (passeditem.Parent Is g_ImpCat) Then
- g_ItemPath = PassedItem.Parent.Name + "\" + g_ItemPath
- Call GetParentItem(PassedItem.parent)
- Else
- g_ItemPath = "\" + g_ItemPath
- End If
- End Sub
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'Funktion DekodiereDatenTyp für die Konvertierung des Spaltentyps von numerisch zu
- 'Zeichenkette.
- 'diese Funktion wird von der Sub-Routine TabellenInfo aufgerufen, diese gibt eine
- 'Ganzzahl weiter, die den Datentyp der Spalten darstellt. Die Funktion gibt
- 'den Namen des Typs zurück.
- Function DecodeDataType(DataTypeNo As Integer) As String
- Select Case DataTypeNo
- Case 0
- DecodeDataType = "Unkannt"
- Case 1
- DecodeDataType = "char"
- Case 2
- DecodeDataType = "varchar"
- Case 3
- DecodeDataType = "text"
- Case 4
- DecodeDataType = "tinyint"
- Case 5
- DecodeDataType = "int"
- Case 6
- DecodeDataType = "decimal"
- Case 7
- DecodeDataType = "float"
- Case 8
- DecodeDataType = "double"
- Case 9
- DecodeDataType = "binary"
- Case 10
- DecodeDataType = "Unterschiedliche Binäre"
- Case 11
- DecodeDataType = "longint"
- Case 12
- DecodeDataType = "date"
- Case 13
- DecodeDataType = "time"
- Case 14
- DecodeDataType = "datetime"
- Case 15
- DecodeDataType = "Intervall"
- Case 16
- DecodeDataType = "Datenbankschlüssel"
- Case 17
- DecodeDataType = "Blob"
- Case 18
- DecodeDataType = "Text"
- Case 19
- DecodeDataType = "Blob-Reihe"
- Case Else 'andere Werte
- DecodeDataType = "Unbekannt"
- End Select
-
- End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'DekodiereDatenElement Funktion zum Konvertieren der numerischen Anzeige für OrdnerElemente
- 'zu Textanzeige.
- 'diese Funktion wird von dem TraverseFolder Sub aufgerufen, sub gibt eine
- 'Ganzzahl weiter, die den Datentyp eines Ordnerelements repräsentiert, und diese Funktion
- 'liefert einen Namen für den Typ
- Function DecodeDataItem(DataTypeNo As Integer) As String
- Select Case DataTypeNo
- Case 0
- DecodeDataItem = "Unbekannt"
- Case 1
- DecodeDataItem = "Boolesch"
- Case 2
- DecodeDataItem = "Zahl"
- Case 3
- DecodeDataItem = "Zeichenkette"
- Case 4
- DecodeDataItem = "Datum"
- Case 5
- DecodeDataItem = "Uhrzeit"
- Case 6
- DecodeDataItem = "Datum/Uhrzeit"
- Case 7
- DecodeDataItem = "Intervall"
- Case 8
- DecodeDataItem = "Blob"
- Case Else 'andere Werte
- DecodeDataItem = "Unbekannt"
- End Select
-
- End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- ' Funktion DekodiereVerbndgTyp für die Konvertierung des Spaltentyps von numerisch zu
- 'Zeichenkette.
- 'Diese Funktion wird vom Abschnitt Verbindungen des Hauptteils aufgerufen.
- 'Sie gibt den Verbindungstyp als Zeichenkette zur Speicherung in der Datei zurück.
- Function DecodeJoinType(JoinType As Integer) As String
- Select Case JoinType
- Case 0
- DecodeJoinType = "Geschlossene Verbindung"
- Case 1
- DecodeJoinType = "Linke offene Verbindung"
- Case 2
- DecodeJoinType = "Rechte offene Verbindung"
- Case 3
- DecodeJoinType = "Volle offene Verbindung"
- Case Else
- DecodeJoinType = "Unbekannter Verbindungstyp"
- End Select
- End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'diese Prozedur wird von der Funktion BenutzerKlassenInfo aufgerufen, um den
- 'Verabeitungstyp von numerisch zu Zeichenkette zu konvertieren.
- 'Funktion DekodiereVerarbtngTyp zur Konvertierung des Verarbeitungstyps von
- 'numerisch zu Zeichenkette.
- Function DecodeProcessingType(ProcessingType AS Integer) As String
- Select Case ProcessingType
- Case 1
- DecodeProcessingType = "Nur Datenbank"
- Case 2
- DecodeProcessingType = "Beschränkte lokale Verarbeitung"
- Case 3
- DecodeProcessingType = "Flexible Verarbeitung"
- Case Else
- DecodeProcessingType = "Unbekannter Verarbeitungstyp"
- End Select
- End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'diese Prozedur wird von der Funktion BenutzerKlassenInfo aufgerufen, um den Privilegientyp
- 'von numerisch zu Zeichenkette zu konvertieren.
- 'Funktion DekodierePrivilegTyp zur Konvertierung des Privilegientyps von numerisch
- 'zu Zeichenkette.
- Function DecodePermissionType(PermissionType as integer) As String
- Select Case PermissionType
- Case 0
- DecodePermissionType = "Zulassen"
- Case 1
- DecodePermissionType = "Warnen"
- Case 2
- DecodePermissionType = "Verhindern"
- Case Else
- DecodePermissionType = "Unbekannt"
- End Select
- End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'Je nach weitergegebener Ebene rückt diese Funktion entsprechend ein.
- Function Indent(level as integer) as string
- 'die Variablen der Prozedurebene deklarieren
- Dim Indentstring As string
- Dim count As integer
-
- Indentstring = ""
- For count = 1 to level
- Indentstring = Indentstring + g_tab
- Next count
- Indent = IndentString
- End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'Function LokalisiereSchlssl(DigitSchlssl as integer) as string
- ' If DigitSchlssl = 0 Then
- ' LokalisiereSchlssl = "Falsch"
- ' Else
- ' LokalisiereSchlssl = "Wahr"
- ' End If
- 'End Function
- '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- 'diese Funktion bestimmt den Typ des Ordnerelements
- Function FolderItemType(objExpression as object) As String
- Dim strFormula As String
- If objExpression.ResultType = 1 Then
- 'dies ist ein Bedingungs-Ordner-Element (weil der resultierende Typ "Boolesch" ist)
- FolderItemType = "Filter"
- Else
- strFormula = objExpression.Value.Formula
- If Left(strFormula, 2) = "[?" Then
- 'dies ist ein Eingabeaufforderungs-Ordnerelement(enthält Eingabeaufforderungs-Definition)
- FolderItemType = "Eingabeaufforderung"
- Else
- 'nach Leerzeichen innerhalb der Formel suchen. Was keine Berechnung ist, hat keine Leerzeichen
- If Instr(strFormula, " ") Then
- FolderItemType = "Berechnung"
- Else
- FolderItemType = "Spalte"
- End If
- End If
- End If
- End Function
- Function GetInfo(lngClassKey As Long, strSectionKey As String, _
- lngReserved As Long, lngSecurity As Long, strValueName As String) As Variant
- Dim lngResult As Long
- Dim lngOpen As Long
- Dim lngQuery As Long
- Dim lngClose As Long
- Dim lngBuffer As Long
- Dim strValueData As String
- Dim vntValue, NullChar
-
- '-den Teilschlüssel öffnen --
- lngOpen = RegOpenKeyEx(lngClassKey, strSectionKey, lngReserved, _
- lngSecurity, lngResult)
-
- '-Pufferspeicher einstellen --
- strValueData = String$(255, 0)
- lngBuffer = Len(strValueData)
- '-den Wert lesen --
- lngQuery = RegQueryValueExStr(lngResult, strValueName, lngReserved, _
- REG_SZ, strValueData, lngBuffer)
- If lngQuery = ERROR_SUCCESS Then
- vntValue = strValueData
- NullChar = InStr(vntValue, Chr(0))
- If NullChar > 0 Then
- vntValue = Left(vntValue, NullChar - 1)
- End If
- End If
-
- '-Schlüssel schließen --
- lngClose = RegCloseKey(lngResult)
-
- '-Zeichenkettenwert von RegistrierungAbfrageWertExtrahierteZeichenkette zurückgeben --
- GetInfo = Left$(vntValue, lngBuffer)
-
- End Function
|