content-report.mac 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740
  1. '******************************************************************************
  2. '* *
  3. '*KATALOG INHALT.MAC
  4. '* *
  5. '* Dieser Makro erstellt einen Speicherauszug des Katalogs *
  6. '*"vertriebauf" in eine Textdatei. *
  7. '* Aufgenommen werden die Kataloginformationen, Datenbankinformationen, *
  8. '*Datenbankstruktur, Katalogordner, Tabellenverbindungen und *
  9. '*Benutzerklasseninformationen. *
  10. '******************************************************************************
  11. OPTION EXPLICIT
  12. 'Funktionen und Prozeduren deklarieren
  13. Declare Sub TableInfo(DB As Object)
  14. Declare Sub TraverseFolder(fold As object, level as integer)
  15. Declare Sub UserClassInfo(class as object, level as integer)
  16. Declare Sub TraverseUserClass(class As object, level as integer)
  17. Declare Sub GetParentItem(item as object)
  18. Declare Function DecodeDataType(DataType as integer) As String
  19. Declare Function DecodeJoinType(JoinType as integer) As String
  20. Declare Function DecodeProcessingType(ProcessingType as integer) As String
  21. Declare Function DecodePermissionType(PermissionType as integer) As String
  22. Declare Function DecodeDataItem(ItemType as integer) As String
  23. Declare Function FolderItemType(objExpression as object) As String
  24. Declare Function Indent(level as integer) As String
  25. 'Registrierungs-Funktion-Prototypen
  26. Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
  27. (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  28. ByVal samDesired As Long, phkResult As Long) As Long
  29. Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
  30. (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  31. ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
  32. Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  33. 'Funktion zum Abrufen von Registrierungswerten
  34. Declare Function GetInfo(lngClassKey As Long, strSectionKey As String, _
  35. lngReserved As Long, lngSecurity As Long, strValueName As String) As Variant
  36. 'Spezifische Zugangsberechtigungen zur Registrierung
  37. Const SYNCHRONIZE = &H100000
  38. Const KEY_NOTIFY = &H10
  39. Const KEY_ENUMERATE_SUB_KEYS = &H8
  40. Const KEY_QUERY_VALUE = &H1
  41. Const STANDARD_RIGHTS_ALL = &H1F0000
  42. Const READ_CONTROL = &H20000
  43. Const STARDARD_RIGHTS_READ = (READ_CONTROL)
  44. Const KEY_READ = ((STARDARD_RIGHTS_READ or KEY_QUERY_VALUE or KEY_ENUMERATE_SUB_KEYS or KEY_NOTIFY) and (Not SYNCHRONIZE))
  45. 'Wichtigkeits-Codes definieren
  46. Const ERROR_SUCCESS = 0&
  47. 'Vordefinierte Registrierungs-Klassen-Konstante
  48. Const HKEY_LOCAL_MACHINE = &H80000002
  49. 'Vordefinierte Typen von Registrierungswerten
  50. Const REG_SZ = (1) 'Unicode Null beendete die Zeichenkette
  51. 'globale Variablen deklarieren
  52. Global g_ImpApp As Object, g_ImpCat As Object
  53. Global g_LineEnd As String, g_tab As String, g_ItemPath As String
  54. Global g_filenumber As Integer
  55. 'Hauptteil des Programms
  56. '------------------------------------------------------------------------------
  57. Sub Main()
  58. 'Variablen der Prozedurebene deklarieren
  59. 'declare procedure level variables
  60. Dim Database As Object
  61. Dim Tablelink as Object
  62. Dim counter_1 As Integer
  63. Dim counter_2 As Integer
  64. Dim ans As Integer
  65. Dim ImpPath As String
  66. Dim filename As String
  67. Dim directory As String
  68. Dim flag As String
  69. Dim intPosition As Integer
  70. Dim lngClassKey As Long
  71. Dim strSectionKey As String
  72. Dim lngReserved As Long
  73. Dim lngSecurity As Long
  74. Dim strValueName As String
  75. 'On Error GoTo ErrorHandler
  76. On Error Resume Next
  77. 'benötigt zum Durchsuchen der Registrierung
  78. lngClassKey = HKEY_LOCAL_MACHINE
  79. strSectionKey = "SOFTWARE\Cognos\cer5\Rendition Locations"
  80. lngReserved = 0
  81. lngSecurity = KEY_READ
  82. strValueName = "Samples"
  83. 'Pfad für Impromptu Beispiele
  84. ImpPath = GetField(Command, 1, ",")
  85. filename = GetField(Command, 2, ",")
  86. 'Meldung für den Benutzer anzeigen, was der Makro bewirkt und ihm die Option
  87. 'gibt, abzubrechen
  88. 'Impromptu und den AUFUmsatz-Beispielkatalog öffnen
  89. Set g_ImpApp = CreateObject("CognosImpromptu.Application")
  90. g_ImpApp.OpenCatalog imppath & "\" & filename & ".cat", "Ersteller", "", "gaps", "Gcbs12ma"
  91. 'den aktiven Katalog und die Datenbank auf Objektvariablen einrichten
  92. Set g_ImpCat = g_ImpApp.ActiveCatalog
  93. Set Database = g_ImpCat.Databases(1)
  94. g_LineEnd = Chr$(13) + Chr$(10) 'Wagenrücklauf (CR)
  95. g_tab = Chr$(9) 'Tabulatur
  96. 'Datei zum Speichern der Kataloginformationen öffnen
  97. g_filenumber = Freefile
  98. Open ImpPath & "\" & filename & ".icr" For Output As #g_filenumber
  99. '-----------------------------
  100. 'Abschnitt Kataloginformationen
  101. '-----------------------------
  102. 'den Katalog-Dateinamen und die Beschreibung zur Datei hinzufügen
  103. Print #g_filenumber, "Kataloginformationen" + g_LineEnd + g_tab + _
  104. "Katalog-Dateiname: " + g_ImpCat.Filename + g_LineEnd + g_tab + _
  105. "Beschreibung: " + g_ImpCat.Description + g_LineEnd
  106. 'Hinweis: Automatisierung für das Katalog-Erstellungsdatum noch nicht
  107. ' implementiert
  108. '-----------------------------
  109. 'Abschnitt Datenbankinformationen
  110. '-----------------------------
  111. 'den Datenbanknamen und die Verbindungszeichenkette zur Datei hinzufügen
  112. Print #g_filenumber, "Datenbankinformationen" + g_LineEnd + _
  113. g_tab + "Datenbankname: " + Database.Name + g_LineEnd + g_tab + _
  114. "Verbindungszeichenkette: " + _
  115. g_ImpApp.DatabaseDefinitions(Database.Name).Definition + g_LineEnd
  116. '---------------------------------------
  117. 'Datenbankstruktur, Tabellen und Spalten
  118. '---------------------------------------
  119. 'die Tabellen und Spalten zur Datei hinzufügen
  120. Print #g_filenumber, "Datenbankstruktur" + g_LineEnd
  121. 'Da Datenbanken Qualifizierungsebenen haben, müssen alle Ebenen auf Tabellen
  122. 'überprüft werden. Wenn es diese Ebenen gibt, das Objekt
  123. 'Datenbankqualifizierungsebene an die Sub-Routine TabellenInfo weitergeben, durch
  124. 'die die Tabellen und Spalten aller Ebenen zur globalen Variable g_KatInfo
  125. 'hinzugefügt werden. Gibt es dagegen keine Qualifizierungsebenen, wird einfach
  126. 'die Datenbank weitergegeben.
  127. If Not (Database.CatalogLevels Is Nothing) Then 'es gibt Katalogebenen
  128. 'alle Katalogebenen auf Schemaebenen überprüfen
  129. For counter_1 = 1 to Database.CatalogLevels.Count
  130. 'die Katalogebene hat Schemaebenen
  131. If Not (Database.CatalogLevels(counter_1).SchemaLevels Is Nothing) Then
  132. For counter_2 = 1 To Database.CatalogLevels(counter_1).SchemaLevels.Count
  133. Call TableInfo(Database.CatalogLevels(counter_1).SchemaLevels(counter_2))
  134. Next counter_2
  135. Else 'no schema levels
  136. 'die Katalogebene an die Sub-Routine TabellenInfo weitergeben
  137. If Not Database.CatalogLevels(counter_1).Tables Is Nothing Then
  138. Call TableInfo(Database.CatalogLevels(counter_1))
  139. End If
  140. End If
  141. Next counter_1
  142. 'es gibt keine Katalogebenen, auf Schemaebenen überprüfen
  143. ElseIf Not (Database.SchemaLevels Is Nothing) Then
  144. For counter_2 = 1 To Database.SchemaLevels.Count
  145. 'Schemaebene an die Sub-Routine TabellenInfo weitergeben
  146. Call TableInfo(Database.SchemaLevels(counter_2))
  147. Next counter_2
  148. Else 'es gibt weder Katalog- noch Schemaebenen
  149. Call TableInfo(Database) 'die aktive Datenbank an die Sub-Routine
  150. ' TabellenInfo weitergeben
  151. End If
  152. '---------------------------------------
  153. 'Abschnitt Katalogordner
  154. '---------------------------------------
  155. 'die Ordner und Ordnerelemente zur Datei hinzufügen
  156. Print #g_filenumber, g_LineEnd + "Katalogordner" + g_LineEnd
  157. 'die Ordner-Zusammenstellung zusammen mit der Ordnerebene 1 (höchste Stufe)
  158. ' and die Prozedur TraverserOrdner weitergeben
  159. Call TraverseFolder(g_ImpCat.Folders, 1)
  160. '---------------------------------------
  161. 'Abschnitt Verbindungen
  162. '---------------------------------------
  163. 'die Verbindungsinformationen zur Datei hinzufügen
  164. Print #g_filenumber, g_LineEnd + "Tabellenverbindungen: " + g_LineEnd
  165. set Tablelink = g_ImpCat.Tablelinks
  166. counter_1 = 1
  167. 'für jede Verbindung des Katalogs den Tabellennamen und den Verbindungstyp
  168. 'in die Datei stellen, die Funktion DekodiereVerbndgTyp zum Ändern des Typs von
  169. 'numerisch auf Text verwenden
  170. For counter_1 = 1 to Tablelink.count
  171. Print #g_filenumber, g_tab & Tablelink(counter_1).lefttable.Name & _
  172. " - " & tablelink(counter_1).RightTable.Name & ": " & _
  173. DecodeJoinType(tablelink(counter_1).type) & g_LineEnd & g_tab & _
  174. tablelink(counter_1).Condition.Formula & g_LineEnd
  175. Next counter_1
  176. '---------------------------------------
  177. 'Benutzerklasseninformationen
  178. '---------------------------------------
  179. 'die Benutzerklasseninformationen zur Datei hinzufügen
  180. 'Die Funktion BenutzerKlassenInfo wird aufgerufen, um die Eigenschaften der aktiven
  181. 'Benutzerklasse (der "Ersteller"-Benutzerklasse beim ersten Aufruf) abzufragen.
  182. 'Die Funktion wird auf dieselbe Weise für die restliche benutzerklassenstruktur
  183. 'verwendet, bis sie für alle Benutzerklassen unterhalb von "Ersteller" aufgerufen
  184. 'wurde. Die Funktion TraverseBenutzerKlasse wird ebenfalls aufgerufen und alle
  185. 'Benutzerklassenebenen durchgangen, solange bis alle gefunden wurden.
  186. Print #g_filenumber, "'Benutzerklasseninformationen" + g_LineEnd
  187. Call UserClassInfo(g_ImpCat.ActiveUserClass, 1)
  188. counter_1 = 1
  189. For counter_1 = 1 To g_ImpCat.ActiveUserClass.UserClasses.Count
  190. Call UserClassInfo(g_ImpCat.ActiveUserClass.UserClasses(counter_1), 2)
  191. Call TraverseUserClass(g_ImpCat.ActiveUserClass.UserClasses(counter_1),2)
  192. Next counter_1
  193. 'Datei schließen
  194. Close #g_filenumber
  195. g_ImpCat.Close
  196. Set Tablelink = Nothing
  197. Set Database = Nothing
  198. Set g_ImpCat = Nothing
  199. Set g_ImpApp = Nothing
  200. done:
  201. Exit Sub
  202. ErrorHandler:
  203. MsgBox "Fehlernr.: " & Err & " " & Error
  204. Resume done
  205. End Sub
  206. 'Diese Prozedur wird vom Abschnitt Datenbankstruktur des Hauptteils des
  207. 'Programms aufgerufen.
  208. 'Sub-Routine TabellenInfo für den Auszug der Datenbankinformationen (Tabellen und Spalten)
  209. Sub TableInfo(database As Object) 'das Datenbankobjekt wurde weitergegeben
  210. 'die Variablen der Prozedurebene deklarieren
  211. Dim TableIndexNo As Integer
  212. Dim ColumnIndexNo As Integer
  213. 'alle Tabellen mit den dazugehörigen Spalten in der Datei speichern
  214. 'die Tabellen- und Spaltennamen abrufen, sowie den Spaltentyp und
  215. 'ob die Spalte ein Schlüssel ist
  216. 'den numerischen Datentyp an die Funktion DekodiereDatenTyp weitergeben, um ihn
  217. 'in Zeichenkette zu konvertieren und ihn zurückgeben
  218. For TableIndexNo = 1 To Database.Tables.Count
  219. Print #g_filenumber, g_tab + "Table: " + _
  220. database.Tables(TableIndexNo).name
  221. For ColumnIndexNo = 1 To Database.tables(TableIndexNo).columns.count
  222. Print #g_filenumber, g_tab + g_tab + "Spalte: " + _
  223. database.Tables(TableIndexNo).Columns(ColumnIndexNo).name + _
  224. " (" + (DecodeDataType(database.Tables(TableIndexNo).Columns _
  225. (ColumnIndexNo).Type)) + ")"
  226. Next ColumnIndexNo
  227. Next TableIndexNo
  228. End Sub
  229. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  230. 'Diese Prozedur wird vom Abschnitt Katalogordner des Haupteils des
  231. 'Programms aufgerufen.
  232. Sub TraverseFolder(Folders as Object, level as Integer)
  233. 'die Variablen der Prozedurebene deklarieren
  234. Dim counter As integer
  235. Dim item as object
  236. 'Beim erstmaligen Aufruf ist die Ebene 1, daher wird Element = Ordner verwendet und
  237. 'alle Ordner der höchsten Ebene werden durchsucht. Sowie sich alle Ordner der
  238. 'höchsten Ebene und die dazugehörigen Spalten in der Datei befinden, wird die Funktion
  239. 'wieder aufgerufen und die Ordner der nächsten Ebene gespeichert, bis sich alle Ordner
  240. 'und Elemente in der Datei befinden.
  241. If Level <> 1 Then 'kein Ordner der höchsten Ebene
  242. Set item = Folders.Items
  243. 'alle Elemente der Ordner-Zusammenstellung durchsuchen
  244. For counter = 1 to item.count
  245. If item(counter).Value Is Nothing Then
  246. Print #g_filenumber, indent(level) & "Ordner: " & _
  247. item(counter).Name
  248. Call TraverseFolder(item(counter), level + 1)
  249. Else
  250. Print #g_filenumber, indent(level) & _
  251. FolderItemType(item(counter)) & ": " & _
  252. item(counter).Name & " (" & item(counter).Value.Formula & _
  253. ", " & DecodeDataItem(item(counter).ResultType) & ")"
  254. End If
  255. Next counter
  256. Else 'Ordner der höchsten Ebene
  257. Set item = Folders
  258. 'alle Elemente der Ordner-Zusammenstellung durchsuchen
  259. For counter = 1 to Item.Count
  260. If item(counter).Value Is Nothing Then
  261. Print #g_filenumber, Indent(level) & "Ordner: " & item(counter).Name
  262. Call TraverseFolder(item(counter), level + 1)
  263. Else
  264. Print #g_filenumber, Indent(level) & _
  265. FolderItemType(item(counter)) & ": " & _
  266. item(counter).Name & " (" & item(counter).Value.Formula & _
  267. ", " & DecodeDataItem(item(counter).ResultType) & ")"
  268. End If
  269. Next counter
  270. End if
  271. set item = nothing
  272. End Sub
  273. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  274. 'Diese Prozedur wird vom Abschnitt Benutzerklasseninformationen des Hauptteils
  275. 'des Programms aufgerufen. Das gilt auch für die Prozedur TraverseBenutzerKlasse.
  276. 'Die aktive Benutzerklasse und die Ebene der Benutzerklasse wurden weitergegeben.
  277. 'Beachten Sie, daß 1 die Ebene der Benutzerklasse "Ersteller" ist.
  278. Sub UserClassInfo(PassedClass As Object, level As Integer)
  279. 'die Variablen der Prozedurebene deklarieren
  280. Dim counter As Integer
  281. Dim TextBlobLimit As Integer
  282. With PassedClass
  283. Print #g_filenumber, Indent(level) + "Benutzerklasse: " + .Name
  284. Print #g_filenumber, Indent(level + 1) + "Client/Server-Informationen"
  285. Print #g_filenumber, Indent(level + 2) + "Abfrageverarbeitung: " + _
  286. DecodeProcessingType(.QueryProcessing)
  287. Print #g_filenumber, Indent(level + 2) + "Verbindungsdauer minimieren: " + _
  288. Format$(.MinimizeConnectTime, "True/False") + g_LineEnd
  289. Print #g_filenumber, Indent(level + 1) + "Gouverneur-Informationen"
  290. Print #g_filenumber, Indent(level + 2) + "Neue Berichte erstellen: " + _
  291. Format$(.CanCreateNewReports, "True/False")
  292. Print #g_filenumber, Indent(level + 2) + "Ordner hinzufügen/ändern: " + _
  293. Format$(.CanAddOrModifyFolders, "True/False")
  294. Print #g_filenumber, Indent(level + 2) +"Benutzerklassen hinzufügen/ändern: "+ _
  295. Format$(.CanAddOrModifyUserClasses, "True/False")
  296. Print #g_filenumber, Indent(level + 2) + "SQL-Direkteingabe: " + _
  297. Format$(.CanDirectEnterSQL, "True/False")
  298. Print #g_filenumber, Indent(level + 2) + "'Über-Kreuz'-Produktabfragen: " + _
  299. DecodePermissionType(.CrossProductPermission)
  300. Print #g_filenumber, Indent(level + 2) + "Offene Verbindungen zulassen: " + _
  301. DecodePermissionType(.OuterJoinPermission)
  302. Print #g_filenumber, Indent(level + 2) + "Sortieren an nicht-indizierten " + _
  303. "Spalten: " + DecodePermissionType(.NonIndexSortingPermission)
  304. Print #g_filenumber, Indent(level + 2) +"'Select Distinct' zulassen: "+ _
  305. DecodePermissionType(.SelectDistinctPermission)
  306. Print #g_filenumber, Indent(level + 2) + "Abruf der Zeilen aus der Datenbank " + _
  307. "beschränken"
  308. Print #g_filenumber, Indent(level + 3) + "Warnen bei: " + _
  309. Format$(.RowsRetrievedWarnAfter)
  310. Print #g_filenumber, Indent(level + 3) + "Stoppen bei: " + _
  311. Format$(.MaxRowsRetrieved)
  312. Print #g_filenumber, Indent(level + 2) + "Abfrageausführungs-Zeitlimits"
  313. Print #g_filenumber, Indent(level + 3) + "Warnen bei: " + _
  314. Format$(.QueryExecutionTimeWarnAfter)
  315. Print #g_filenumber, Indent(level + 3) + "Stoppen bei: " + _
  316. Format$(.MaxQueryExecutionTime)
  317. Print #g_filenumber, Indent(level + 2) + "Tabellen-Limit je Bericht"
  318. Print #g_filenumber, Indent(level + 3) + "Warnen bei: " + _
  319. Format$(.TablesPerReportWarnAfter)
  320. Print #g_filenumber, Indent(level + 3) + "Stoppen bei: " _
  321. + Format$(.MaxTablesPerReport)
  322. Print #g_filenumber, Indent(level + 2) + "Text-Blob-Limit: " + _
  323. Format$(.HasTextBlobLimit, "True/False")
  324. TextBlobLimit = .HasTextBlobLimit
  325. If TextBlobLimit = 0 Then
  326. Print #g_filenumber, Indent(level + 2) + _
  327. "Max. Text-Blob-Zeichen: nv" + g_LineEnd
  328. Else
  329. Print #g_filenumber, Indent(level + 2) + _
  330. "Max. Text-Blob-Zeichen: " + _
  331. Format$(.MaxTextBlobCharacters) + g_LineEnd
  332. End If
  333. If .DeniedFolderItems.Count > 0 Then
  334. Print #g_filenumber, Indent(level + 1) + "Ordner und Elemente verweigert"
  335. for counter = 1 to .DeniedFolderItems.count
  336. g_ItemPath = ""
  337. Call GetParentItem(.DeniedFolderItems(counter))
  338. Print #g_filenumber, Indent(level + 2) + g_ItemPath + _
  339. .DeniedFolderItems(counter).name
  340. Next counter
  341. Print #g_filenumber,
  342. End If
  343. If .DeniedTables.Count > 0 Then
  344. Print #g_filenumber, Indent(level + 1) + "Tabellen verweigert"
  345. For counter = 1 To .DeniedTables.Count
  346. Print #g_filenumber, Indent(level + 2) + .DeniedTables(counter).Name
  347. Next counter
  348. Print #g_filenumber,
  349. End If
  350. If .DeniedColumns.Count > 0 Then
  351. Print #g_filenumber, Indent(level + 1) + "Spalten verweigert"
  352. For counter = 1 To .DeniedColumns.Count
  353. Print #g_filenumber, Indent(level + 2) + _
  354. .DeniedColumns(counter).Parent.Name + "." + _
  355. .DeniedColumns(counter).Name
  356. Next counter
  357. Print #g_filenumber,
  358. End If
  359. If .FilteredTables.Count > 0 Then
  360. Print #g_filenumber, Indent(level + 1) + "Tabellenfilter"
  361. For counter = 1 To .FilteredTables.Count
  362. Print #g_filenumber, Indent(level + 2) + "Tabelle: " + _
  363. .FilteredTables(counter).Name + " Filter: " + _
  364. .GetFilterFor(.FilteredTables(counter)).Formula
  365. Next counter
  366. Print #g_filenumber,
  367. End If
  368. 'Hinweis: die Datenbank hat keine Katalog- oder Schema-Qualifizierungsebenen,
  369. 'daher steht der Code hier als Kommentarzeile.
  370. 'If .DeniedSchemalevels.Count > 0 Then
  371. ' Print #g_filenumber, Indent(level + 1) + "Schemaebenen verweigert"
  372. ' For counter = 1 To .DeniedSchemalevels.Count
  373. ' Print #g_filenumber, Indent(level + 2) + _
  374. ' .DeniedSchemalevels(counter).Name
  375. ' Next counter
  376. 'End If
  377. 'If .DeniedCataloglevels.Count > 0 Then
  378. ' Print #g_filenumber, Indent(level + 1) + "Katalogebenen verweigert"
  379. ' For counter = 1 To .DeniedCataloglevels.Count
  380. ' Print #g_filenumber, Indent(level + 2) + _
  381. ' .DeniedCataloglevels(counter).Name
  382. ' Next counter
  383. 'End If
  384. End With
  385. End Sub
  386. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  387. 'Diese Prozedur wird vom Abschnitt Benutzerklasseninformationen des Hauptteils
  388. 'des Programms sowie von sich selbst aufgerufen. Die aktive Benutzerklasse und
  389. 'die Ebene der Benutzerklasse wurden weitergegeben. Beachten Sie, daß 1 die
  390. 'Ebene der Benutzerklasse "Ersteller" ist.
  391. Sub TraverseUserClass(PassedClass As Object, level As Integer)
  392. 'die Variablen der Prozedurebene deklarieren
  393. Dim UserClass As Object
  394. Dim counter as Integer
  395. Set UserClass = PassedClass.UserClasses
  396. For counter = 1 To UserClass.Count
  397. Call UserClassInfo(UserClass(counter), level + 1)
  398. Call TraverseUserClass(UserClass(counter), level + 1)
  399. Next counter
  400. End Sub
  401. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  402. Sub GetParentItem(PassedItem As Object)
  403. If Not (passeditem.Parent Is g_ImpCat) Then
  404. g_ItemPath = PassedItem.Parent.Name + "\" + g_ItemPath
  405. Call GetParentItem(PassedItem.parent)
  406. Else
  407. g_ItemPath = "\" + g_ItemPath
  408. End If
  409. End Sub
  410. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  411. 'Funktion DekodiereDatenTyp für die Konvertierung des Spaltentyps von numerisch zu
  412. 'Zeichenkette.
  413. 'diese Funktion wird von der Sub-Routine TabellenInfo aufgerufen, diese gibt eine
  414. 'Ganzzahl weiter, die den Datentyp der Spalten darstellt. Die Funktion gibt
  415. 'den Namen des Typs zurück.
  416. Function DecodeDataType(DataTypeNo As Integer) As String
  417. Select Case DataTypeNo
  418. Case 0
  419. DecodeDataType = "Unkannt"
  420. Case 1
  421. DecodeDataType = "char"
  422. Case 2
  423. DecodeDataType = "varchar"
  424. Case 3
  425. DecodeDataType = "text"
  426. Case 4
  427. DecodeDataType = "tinyint"
  428. Case 5
  429. DecodeDataType = "int"
  430. Case 6
  431. DecodeDataType = "decimal"
  432. Case 7
  433. DecodeDataType = "float"
  434. Case 8
  435. DecodeDataType = "double"
  436. Case 9
  437. DecodeDataType = "binary"
  438. Case 10
  439. DecodeDataType = "Unterschiedliche Binäre"
  440. Case 11
  441. DecodeDataType = "longint"
  442. Case 12
  443. DecodeDataType = "date"
  444. Case 13
  445. DecodeDataType = "time"
  446. Case 14
  447. DecodeDataType = "datetime"
  448. Case 15
  449. DecodeDataType = "Intervall"
  450. Case 16
  451. DecodeDataType = "Datenbankschlüssel"
  452. Case 17
  453. DecodeDataType = "Blob"
  454. Case 18
  455. DecodeDataType = "Text"
  456. Case 19
  457. DecodeDataType = "Blob-Reihe"
  458. Case Else 'andere Werte
  459. DecodeDataType = "Unbekannt"
  460. End Select
  461. End Function
  462. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  463. 'DekodiereDatenElement Funktion zum Konvertieren der numerischen Anzeige für OrdnerElemente
  464. 'zu Textanzeige.
  465. 'diese Funktion wird von dem TraverseFolder Sub aufgerufen, sub gibt eine
  466. 'Ganzzahl weiter, die den Datentyp eines Ordnerelements repräsentiert, und diese Funktion
  467. 'liefert einen Namen für den Typ
  468. Function DecodeDataItem(DataTypeNo As Integer) As String
  469. Select Case DataTypeNo
  470. Case 0
  471. DecodeDataItem = "Unbekannt"
  472. Case 1
  473. DecodeDataItem = "Boolesch"
  474. Case 2
  475. DecodeDataItem = "Zahl"
  476. Case 3
  477. DecodeDataItem = "Zeichenkette"
  478. Case 4
  479. DecodeDataItem = "Datum"
  480. Case 5
  481. DecodeDataItem = "Uhrzeit"
  482. Case 6
  483. DecodeDataItem = "Datum/Uhrzeit"
  484. Case 7
  485. DecodeDataItem = "Intervall"
  486. Case 8
  487. DecodeDataItem = "Blob"
  488. Case Else 'andere Werte
  489. DecodeDataItem = "Unbekannt"
  490. End Select
  491. End Function
  492. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  493. ' Funktion DekodiereVerbndgTyp für die Konvertierung des Spaltentyps von numerisch zu
  494. 'Zeichenkette.
  495. 'Diese Funktion wird vom Abschnitt Verbindungen des Hauptteils aufgerufen.
  496. 'Sie gibt den Verbindungstyp als Zeichenkette zur Speicherung in der Datei zurück.
  497. Function DecodeJoinType(JoinType As Integer) As String
  498. Select Case JoinType
  499. Case 0
  500. DecodeJoinType = "Geschlossene Verbindung"
  501. Case 1
  502. DecodeJoinType = "Linke offene Verbindung"
  503. Case 2
  504. DecodeJoinType = "Rechte offene Verbindung"
  505. Case 3
  506. DecodeJoinType = "Volle offene Verbindung"
  507. Case Else
  508. DecodeJoinType = "Unbekannter Verbindungstyp"
  509. End Select
  510. End Function
  511. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  512. 'diese Prozedur wird von der Funktion BenutzerKlassenInfo aufgerufen, um den
  513. 'Verabeitungstyp von numerisch zu Zeichenkette zu konvertieren.
  514. 'Funktion DekodiereVerarbtngTyp zur Konvertierung des Verarbeitungstyps von
  515. 'numerisch zu Zeichenkette.
  516. Function DecodeProcessingType(ProcessingType AS Integer) As String
  517. Select Case ProcessingType
  518. Case 1
  519. DecodeProcessingType = "Nur Datenbank"
  520. Case 2
  521. DecodeProcessingType = "Beschränkte lokale Verarbeitung"
  522. Case 3
  523. DecodeProcessingType = "Flexible Verarbeitung"
  524. Case Else
  525. DecodeProcessingType = "Unbekannter Verarbeitungstyp"
  526. End Select
  527. End Function
  528. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  529. 'diese Prozedur wird von der Funktion BenutzerKlassenInfo aufgerufen, um den Privilegientyp
  530. 'von numerisch zu Zeichenkette zu konvertieren.
  531. 'Funktion DekodierePrivilegTyp zur Konvertierung des Privilegientyps von numerisch
  532. 'zu Zeichenkette.
  533. Function DecodePermissionType(PermissionType as integer) As String
  534. Select Case PermissionType
  535. Case 0
  536. DecodePermissionType = "Zulassen"
  537. Case 1
  538. DecodePermissionType = "Warnen"
  539. Case 2
  540. DecodePermissionType = "Verhindern"
  541. Case Else
  542. DecodePermissionType = "Unbekannt"
  543. End Select
  544. End Function
  545. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  546. 'Je nach weitergegebener Ebene rückt diese Funktion entsprechend ein.
  547. Function Indent(level as integer) as string
  548. 'die Variablen der Prozedurebene deklarieren
  549. Dim Indentstring As string
  550. Dim count As integer
  551. Indentstring = ""
  552. For count = 1 to level
  553. Indentstring = Indentstring + g_tab
  554. Next count
  555. Indent = IndentString
  556. End Function
  557. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  558. 'Function LokalisiereSchlssl(DigitSchlssl as integer) as string
  559. ' If DigitSchlssl = 0 Then
  560. ' LokalisiereSchlssl = "Falsch"
  561. ' Else
  562. ' LokalisiereSchlssl = "Wahr"
  563. ' End If
  564. 'End Function
  565. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  566. 'diese Funktion bestimmt den Typ des Ordnerelements
  567. Function FolderItemType(objExpression as object) As String
  568. Dim strFormula As String
  569. If objExpression.ResultType = 1 Then
  570. 'dies ist ein Bedingungs-Ordner-Element (weil der resultierende Typ "Boolesch" ist)
  571. FolderItemType = "Filter"
  572. Else
  573. strFormula = objExpression.Value.Formula
  574. If Left(strFormula, 2) = "[?" Then
  575. 'dies ist ein Eingabeaufforderungs-Ordnerelement(enthält Eingabeaufforderungs-Definition)
  576. FolderItemType = "Eingabeaufforderung"
  577. Else
  578. 'nach Leerzeichen innerhalb der Formel suchen. Was keine Berechnung ist, hat keine Leerzeichen
  579. If Instr(strFormula, " ") Then
  580. FolderItemType = "Berechnung"
  581. Else
  582. FolderItemType = "Spalte"
  583. End If
  584. End If
  585. End If
  586. End Function
  587. Function GetInfo(lngClassKey As Long, strSectionKey As String, _
  588. lngReserved As Long, lngSecurity As Long, strValueName As String) As Variant
  589. Dim lngResult As Long
  590. Dim lngOpen As Long
  591. Dim lngQuery As Long
  592. Dim lngClose As Long
  593. Dim lngBuffer As Long
  594. Dim strValueData As String
  595. Dim vntValue, NullChar
  596. '-den Teilschlüssel öffnen --
  597. lngOpen = RegOpenKeyEx(lngClassKey, strSectionKey, lngReserved, _
  598. lngSecurity, lngResult)
  599. '-Pufferspeicher einstellen --
  600. strValueData = String$(255, 0)
  601. lngBuffer = Len(strValueData)
  602. '-den Wert lesen --
  603. lngQuery = RegQueryValueExStr(lngResult, strValueName, lngReserved, _
  604. REG_SZ, strValueData, lngBuffer)
  605. If lngQuery = ERROR_SUCCESS Then
  606. vntValue = strValueData
  607. NullChar = InStr(vntValue, Chr(0))
  608. If NullChar > 0 Then
  609. vntValue = Left(vntValue, NullChar - 1)
  610. End If
  611. End If
  612. '-Schlüssel schließen --
  613. lngClose = RegCloseKey(lngResult)
  614. '-Zeichenkettenwert von RegistrierungAbfrageWertExtrahierteZeichenkette zurückgeben --
  615. GetInfo = Left$(vntValue, lngBuffer)
  616. End Function