'******************************************************************************
'*                                                                            *
'*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