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