Component File /DocBuilderClass.vb (VB.NET)
1: Option Strict Off
2: Option Explicit On
3: Friend Class DocBuilderClass
4: Public DatabaseStoreConnectionString As String
5: Public DataStore As New DataStoreClass
6: Public DocParseID As Integer
7: Public DocFolderPath As String
8: Public FilesCreated As New Collection
9: Public HTMLHelpIndexContents As New Collection
10: Public MakeRTFFile As Boolean
11: Public MakeTextFile As Boolean
12: Public MakeHTMLHelp As Boolean
13: Public UseColourCoding As Boolean
14: Private Structure STARTUPINFO
15: Dim cb As Integer
16: Dim lpReserved As String
17: Dim lpDesktop As String
18: Dim lpTitle As String
19: Dim dwX As Integer
20: Dim dwY As Integer
21: Dim dwXSize As Integer
22: Dim dwYSize As Integer
23: Dim dwXCountChars As Integer
24: Dim dwYCountChars As Integer
25: Dim dwFillAttribute As Integer
26: Dim dwFlags As Integer
27: Dim wShowWindow As Short
28: Dim cbReserved2 As Short
29: Dim lpReserved2 As Integer
30: Dim hStdInput As Integer
31: Dim hStdOutput As Integer
32: Dim hStdError As Integer
33: End Structure
34:
35: Private Structure PROCESS_INFORMATION
36: Dim hProcess As Integer
37: Dim hThread As Integer
38: Dim dwProcessID As Integer
39: Dim dwThreadID As Integer
40: End Structure
41:
42: Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Integer, ByVal dwMilliseconds As Integer) As Integer
43:
44: 'UPGRADE_WARNING: Structure PROCESS_INFORMATION may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
45: 'UPGRADE_WARNING: Structure STARTUPINFO may require marshalling attributes to be passed as an argument in this Declare statement. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1050"'
46: Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Integer, ByVal lpThreadAttributes As Integer, ByVal bInheritHandles As Integer, ByVal dwCreationFlags As Integer, ByVal lpEnvironment As Integer, ByVal lpCurrentDirectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Integer
47:
48: Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Integer) As Integer
49:
50: Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Integer, ByRef lpExitCode As Integer) As Integer
51:
52: Private Const NORMAL_PRIORITY_CLASS As Integer = &H20
53: Private Const INFINITE As Short = -1
54:
55: Public Function ExecCmd(ByRef cmdline As String) As Object
56: Dim ret As Integer
57: Dim proc As PROCESS_INFORMATION
58: Dim start As STARTUPINFO
59:
60: ' Initialize the STARTUPINFO structure:
61: start.cb = Len(start)
62:
63: ' Start the shelled application:
64: ret = CreateProcessA(vbNullString, cmdline, 0, 0, 1, NORMAL_PRIORITY_CLASS, 0, vbNullString, start, proc)
65:
66: ' Wait for the shelled application to finish:
67: ret = WaitForSingleObject(proc.hProcess, INFINITE)
68: Call GetExitCodeProcess(proc.hProcess, ret)
69: Call CloseHandle(proc.hThread)
70: Call CloseHandle(proc.hProcess)
71: 'UPGRADE_WARNING: Couldn't resolve default property of object ExecCmd. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
72: ExecCmd = ret
73: End Function
74:
75: Public Sub SetDataStoreConnectionString(ByRef ConnectionString As String)
76:
77: DatabaseStoreConnectionString = ConnectionString
78:
79: End Sub
80:
81:
82: Public Function BuildDocumentation(ByRef ParseID As Integer, ByRef FolderPath As String, ByRef BuildHTMLDocumentation As Boolean, ByRef BuildHTMLHelpDocumentation As Boolean, ByRef BuildTextDocumentation As Boolean, ByRef BuildRTFDocumentation As Boolean, ByRef ColourCodeSource As Boolean) As Boolean
83: Dim FileName As Object
84:
85: Dim PageBody As String
86: Dim PageTitle As String
87: Dim FileBody As String
88: Dim CommandText As String
89: Dim Result As Double
90: Dim RTFText As String
91: 'Dim DataStore As New DataStoreClass
92: DataStore.SetConnectionString((DatabaseStoreConnectionString))
93: 'Dim
94: DocParseID = ParseID
95: DocFolderPath = FolderPath
96:
97: MakeRTFFile = False
98: MakeHTMLHelp = False
99: MakeTextFile = False
100: UseColourCoding = False
101:
102: If BuildRTFDocumentation = True Then MakeRTFFile = True
103: If BuildTextDocumentation = True Then MakeTextFile = True
104: If BuildHTMLHelpDocumentation = True Then MakeHTMLHelp = True
105: If ColourCodeSource = True Then UseColourCoding = True
106:
107:
108: FormMain.DefInstance.UpdateStatus(("Building documentation for database " & CurrentDatabaseName))
109: Call FormMain.DefInstance.UpdateCurrentItem("")
110: Call AppendToLogFile(CurrentLogFileName, "Building documentation for project " & CurrentProjectName & vbCrLf)
111:
112: 'Build start of RTF file
113: If MakeRTFFile Then
114:
115: 'RTFText = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033\deflangfe1033{\fonttbl{\f0\fswiss\fprq2\fcharset0 Arial;}{\f1\froman\fprq2\fcharset0 Times New Roman;}}" & vbCrLf
116: 'RTFText = RTFText & "{\stylesheet{ Normal;}{\s1 heading 1;}{\s2 heading 2;}}" & vbCrLf
117:
118: RTFText = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033\deflangfe1033{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{\f1\fswiss\fprq2\fcharset0 Arial;}}" & vbCrLf
119: RTFText = RTFText & "{\stylesheet{ Normal;}{\s1 heading 1;}{\s2 heading 2;}}" & vbCrLf
120: RTFText = RTFText & "\viewkind4\uc1\pard\keepn\s1\sb240\sa60\lang2057\kerning32\b\f0\fs32 SQL Server Documentation for project " & CurrentProjectName & "\par" & vbCrLf
121:
122: Call CreateFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
123:
124: End If
125:
126: 'Build Default Page
127: PageTitle = "Database Documentation"
128: 'UPGRADE_WARNING: Couldn't resolve default property of object GetDefaultPageHTML(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
129: PageBody = GetDefaultPageHTML()
130: Call CreatePage("Documentation", DocFolderPath, "Default.htm", PageTitle, PageBody, False)
131:
132: 'Build Database List Page
133: PageTitle = "Databases"
134: 'UPGRADE_WARNING: Couldn't resolve default property of object GetDatabaseListPageHTML(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
135: PageBody = GetDatabaseListPageHTML()
136: Call CreatePage("Databases", DocFolderPath, "Databases.htm", PageTitle, PageBody, True)
137:
138: 'Build page for each database
139: FormMain.DefInstance.UpdateStatus(("Building databases documentation"))
140: Call AppendToLogFile(CurrentLogFileName, "Building databases documentation" & vbCrLf)
141: Call CreateDatabasePages()
142:
143: 'Build Tables list and table pages
144: FormMain.DefInstance.UpdateStatus(("Building tables documentation"))
145: Call AppendToLogFile(CurrentLogFileName, "Building tables documentation" & vbCrLf)
146: Call CreateTablesListAndTablesPages()
147:
148: 'Build View list and table pages
149: FormMain.DefInstance.UpdateStatus(("Building views documentation"))
150: Call AppendToLogFile(CurrentLogFileName, "Building views documentation" & vbCrLf)
151: Call CreateViewsListAndTablesPages()
152:
153: 'Build Stored Procedure list and table pages
154: FormMain.DefInstance.UpdateStatus(("Building stored procedure documentation"))
155: Call AppendToLogFile(CurrentLogFileName, "Building stored procedure documentation" & vbCrLf)
156: Call CreateStoredProceduresListAndTablesPages()
157:
158: 'Build Triggers list and table pages
159: FormMain.DefInstance.UpdateStatus(("Building triggers documentation"))
160: Call AppendToLogFile(CurrentLogFileName, "Building triggers documentation" & vbCrLf)
161: Call CreateTriggersListAndTablesPages()
162:
163: 'Build indexes list and table pages
164: FormMain.DefInstance.UpdateStatus(("Building indexes documentation"))
165: Call AppendToLogFile(CurrentLogFileName, "Building indexes documentation" & vbCrLf)
166: Call CreateIndexesListAndTablesPages()
167:
168: 'Build full text catalog list and table pages
169: FormMain.DefInstance.UpdateStatus(("Building full-text catalogs documentation"))
170: Call AppendToLogFile(CurrentLogFileName, "Building full-text catalogs documentation" & vbCrLf)
171: Call CreateFullTextCatalogsListAndTablesPages()
172:
173: 'Build DTS package documentation
174: If CurrentProjectDocumentDTSPackages Then
175: FormMain.DefInstance.UpdateStatus(("Building DTS package documentation"))
176: Call AppendToLogFile(CurrentLogFileName, "Building DTS package documentation" & vbCrLf)
177: Call CreateDTSPackagePages()
178: End If
179:
180: 'Build Jobs documentation
181: If CurrentProjectDocumentJobs Then
182: FormMain.DefInstance.UpdateStatus(("Building Jobs documentation"))
183: Call AppendToLogFile(CurrentLogFileName, "Building Jobs documentation" & vbCrLf)
184: Call CreateJobsPages()
185: End If
186:
187: Call FormMain.DefInstance.UpdateCurrentItem("")
188:
189: 'Build end of RTF file
190: If MakeRTFFile Then
191:
192: RTFText = "}" & vbCrLf
193: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
194:
195: End If
196:
197: 'Optionally build the HTML Help documentation
198: Dim retval As Integer
199: If BuildHTMLHelpDocumentation Then
200:
201: FormMain.DefInstance.UpdateStatus(("Building project HTML Help documentation"))
202: Call AppendToLogFile(CurrentLogFileName, "Building project HTML Help documentation" & vbCrLf)
203:
204: 'Call CreateHTMLHelpProjectFile
205: FormMain.DefInstance.UpdateStatus(("Building content for HTML Help project file " & CurrentProjectName & ".hhp"))
206: Call AppendToLogFile(CurrentLogFileName, "Building content for HTML Help project file " & CurrentProjectName & ".hhp" & vbCrLf)
207: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLHelpProjectFile. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
208: FileBody = GetHTMLHelpProjectFile
209: Call CreateFile(DocFolderPath, CurrentProjectName & ".hhp", FileBody)
210:
211: FormMain.DefInstance.UpdateStatus(("Building content for HTML Help index file " & CurrentProjectName & ".hhk"))
212: Call AppendToLogFile(CurrentLogFileName, "Building content for HTML Help index file " & CurrentProjectName & ".hhk" & vbCrLf)
213: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLHelpIndexFile. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
214: FileBody = GetHTMLHelpIndexFile
215: Call CreateFile(DocFolderPath, CurrentProjectName & ".hhk", FileBody)
216:
217: FormMain.DefInstance.UpdateStatus(("Building content for HTML Help table of contents file " & CurrentProjectName & ".hhc"))
218: Call AppendToLogFile(CurrentLogFileName, "Building content for HTML Help table of contents file " & CurrentProjectName & ".hhc" & vbCrLf)
219: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLHelpTableOfContentsFile. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
220: FileBody = GetHTMLHelpTableOfContentsFile
221: Call CreateFile(DocFolderPath, CurrentProjectName & ".hhc", FileBody)
222:
223: 'Call HHC to build the documentation
224: FormMain.DefInstance.UpdateStatus(("Compiling project HTML Help documentation"))
225: CommandText = VB6.GetPath & "\hhc.exe """ & DocFolderPath & "\" & CurrentProjectName & ".hhp"""
226: Call AppendToLogFile(CurrentLogFileName, "Compiling project HTML Help documentation. Command used: " & CommandText & vbCrLf)
227:
228: 'Result = Shell(CommandText, vbNormalFocus)
229:
230: 'UPGRADE_WARNING: Couldn't resolve default property of object ExecCmd(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
231: retval = ExecCmd(CommandText)
232:
233: End If 'End of HTML Help documentation
234:
235:
236:
237: 'If HTML output not required then remove the HTML files
238: '??? Can't get this to work syncronously
239: BuildHTMLDocumentation = True
240: Dim FileSystemObject As New Scripting.FileSystemObject
241: If BuildHTMLDocumentation = False Then
242:
243: FormMain.DefInstance.UpdateStatus(("Removing temporary HTML files"))
244: Call AppendToLogFile(CurrentLogFileName, "Removing temporary HTML files" & vbCrLf)
245:
246:
247: For Each FileName In FilesCreated
248:
249: 'Debug.Print (FileName)
250:
251: 'Ensure output folder exists
252: 'UPGRADE_WARNING: Couldn't resolve default property of object FileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
253: If Not FileSystemObject.FileExists(DocFolderPath & "\" & FileName) Then
254:
255: 'UPGRADE_WARNING: Couldn't resolve default property of object FileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
256: FileSystemObject.DeleteFile(DocFolderPath & "\" & FileName, True)
257:
258: End If
259:
260: Next FileName
261:
262: End If
263:
264: Call AppendToLogFile(CurrentLogFileName, "**Documentation generation completed for project '" & CurrentProjectName & "'**" & vbCrLf)
265: BuildDocumentation = True
266:
267: End Function
268:
269:
270: Private Sub CreatePage(ByRef PageTitle As String, ByRef FolderName As String, ByRef FileName As String, ByRef HTMLTitle As String, ByRef HTMLBody As String, ByRef AddBodyTags As Boolean)
271: Dim TextFile As Object
272:
273: Call AppendToLogFile(CurrentLogFileName, "Creating file " & FolderName & "/" & FileName & " (" & HTMLTitle & ")" & vbCrLf)
274: FilesCreated.Add((FileName))
275: Dim HTML As String
276: Randomize()
277: Dim RandomNumber As Short
278: RandomNumber = Int((10 - 0 + 1) * Rnd() + 0)
279:
280: HTML = "<html>" & vbCrLf
281: HTML = HTML & "<head>" & vbCrLf
282: HTML = HTML & "<title>" & PageTitle & "</title>" & vbCrLf
283: HTML = HTML & "</head>" & vbCrLf
284: If AddBodyTags = True Then
285:
286: If ApplicationIsEvaluationVersion Then
287: If RandomNumber > 5 Then
288: HTML = HTML & "<BODY onLoad=""javascript:oOo();"">" & vbCrLf
289: HTML = HTML & "<script language=""JavaScript"">function oOo() {alert('Upgrade to the full version of the SQL Documentation Tool at " & ApplicationURL & "');}</script>" & vbCrLf
290: Else
291: HTML = HTML & "<body>" & vbCrLf
292: End If
293: Else
294: HTML = HTML & "<body>" & vbCrLf
295: End If
296:
297: HTML = HTML & "<h1>" & HTMLTitle & "</h1>" & vbCrLf
298: End If
299: HTML = HTML & "" & HTMLBody & "" & vbCrLf
300: If AddBodyTags = True Then
301: HTML = HTML & "</body>" & vbCrLf
302: End If
303: HTML = HTML & "</html>" & vbCrLf
304:
305: Dim FileSystemObject As New Scripting.FileSystemObject
306:
307: TextFile = FileSystemObject.CreateTextFile(FolderName & "/" & FileName, True, False)
308:
309: 'UPGRADE_WARNING: Couldn't resolve default property of object TextFile.Write. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
310: TextFile.Write(HTML)
311: 'UPGRADE_WARNING: Couldn't resolve default property of object TextFile.Close. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
312: TextFile.Close()
313:
314: 'UPGRADE_NOTE: Object FileSystemObject may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
315: FileSystemObject = Nothing
316:
317: End Sub
318: Private Sub CreateFile(ByRef FolderName As String, ByRef FileName As String, ByRef FileBody As String)
319: Dim TextFile As Object
320:
321: Err.Clear()
322: On Error Resume Next
323:
324: Dim FileSystemObject As New Scripting.FileSystemObject
325:
326: TextFile = FileSystemObject.CreateTextFile(FolderName & "/" & FileName, True, False)
327:
328: 'UPGRADE_WARNING: Couldn't resolve default property of object TextFile.Write. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
329: TextFile.Write(FileBody)
330: 'UPGRADE_WARNING: Couldn't resolve default property of object TextFile.Close. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
331: TextFile.Close()
332:
333: 'UPGRADE_NOTE: Object FileSystemObject may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
334: FileSystemObject = Nothing
335:
336: If Err.Number > 0 Then
337: FormMain.DefInstance.UpdateStatus(("Problem creating file " & FolderName & "/" & FileName))
338: Call AppendToLogFile(CurrentLogFileName, "ERROR: Problem creating the file: " & FolderName & "/" & FileName & vbCrLf)
339: Call AppendToLogFile(CurrentLogFileName, vbTab & "Details: (" & Err.Number & ") " & Err.Description & vbCrLf)
340: End If
341:
342: End Sub
343: Private Sub AppendFile(ByRef FolderName As String, ByRef FileName As String, ByRef FileBody As String)
344: Dim TextFile As Object
345:
346: Err.Clear()
347: On Error Resume Next
348:
349: Dim FileSystemObject As New Scripting.FileSystemObject
350:
351: TextFile = FileSystemObject.OpenTextFile(FolderName & "/" & FileName, Scripting.IOMode.ForAppending, False)
352:
353: 'UPGRADE_WARNING: Couldn't resolve default property of object TextFile.Write. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
354: TextFile.Write(FileBody)
355: 'UPGRADE_WARNING: Couldn't resolve default property of object TextFile.Close. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
356: TextFile.Close()
357:
358: 'UPGRADE_NOTE: Object FileSystemObject may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
359: FileSystemObject = Nothing
360:
361: If Err.Number > 0 Then
362: 'FormMain.UpdateStatus ("Problem appending file " & FolderName & "/" & FileName)
363: Call AppendToLogFile(CurrentLogFileName, "ERROR: Problem appending the file: " & FolderName & "/" & FileName & vbCrLf)
364: Call AppendToLogFile(CurrentLogFileName, vbTab & "Details: (" & Err.Number & ") " & Err.Description & vbCrLf)
365: End If
366:
367: End Sub
368: Private Function GetDefaultPageHTML() As Object
369:
370: Dim HTML As String
371: HTML = ""
372:
373: HTML = HTML & "<frameset cols=""200,*"">" & vbCrLf
374: HTML = HTML & "<frame name=""functionsFrame"" target=""main"" src=""Databases.htm"">" & vbCrLf
375: HTML = HTML & "<frame name=""mainFrame"" src=""Introduction.htm"">" & vbCrLf
376: HTML = HTML & "<noframes>" & vbCrLf
377: HTML = HTML & "<body>" & vbCrLf
378: HTML = HTML & "<p><a href=""Databases.htm"" title=""Databases"">Databases</a></p>" & vbCrLf
379: HTML = HTML & "</body>" & vbCrLf
380: HTML = HTML & "</noframes>" & vbCrLf
381: HTML = HTML & "</frameset>" & vbCrLf
382:
383: 'UPGRADE_WARNING: Couldn't resolve default property of object GetDefaultPageHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
384: GetDefaultPageHTML = HTML
385:
386: End Function
387: 'Builds the left hand frame
388: Private Function GetDatabaseListPageHTML() As Object
389:
390: Dim HTML As String
391: HTML = ""
392:
393: Dim RS As New ADODB.Recordset
394: Dim DataConnection As New ADODB.Connection
395: Dim SQL As String
396: Dim ConnectionID As Integer
397: Dim DatabaseID As Integer
398: Dim DatabaseName As String
399: Dim DatabaseServer As String
400: Dim TextReportsLinks As String
401: Dim PreviousDatabaseServer As String
402: Dim IsFirstDatabase As Boolean
403: Dim DTSLink As String
404: Dim JobLink As String
405:
406: SQL = "SELECT t_Databases.*, t_Connections.ConnectionID, t_Connections.DatabaseServer "
407: SQL = SQL & "FROM (t_Parses "
408: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID) "
409: SQL = SQL & "INNER JOIN t_Connections on t_Databases.fk_ConnectionID = t_Connections.ConnectionID "
410: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID & " "
411: SQL = SQL & "ORDER BY t_Connections.DatabaseServer"
412:
413: RS = DataStore.GetRecordSet(SQL)
414:
415: HTML = "" 'HTML & "<h2>Database Documentation Summary</h2>" & vbCrLf
416: TextReportsLinks = "Text Reports:<br>"
417: PreviousDatabaseServer = ""
418: IsFirstDatabase = True
419:
420: Do While Not RS.EOF
421:
422: DatabaseID = RS.Fields("DatabaseID").Value
423: ConnectionID = RS.Fields("ConnectionID").Value
424: DatabaseName = RS.Fields("DatabaseName").Value
425: DatabaseServer = RS.Fields("DatabaseServer").Value
426:
427: If DatabaseServer <> PreviousDatabaseServer Then
428: If IsFirstDatabase = False Then
429: HTML = HTML & DTSLink
430: HTML = HTML & JobLink
431: HTML = HTML & "</p>" & vbCrLf
432: End If
433:
434: HTML = HTML & "<p>" & DatabaseServer & "<br>" & vbCrLf
435: Else
436: HTML = HTML & "<br>" & vbCrLf
437: End If
438:
439: HTML = HTML & " <a href=""Database_" & DatabaseID & ".htm"" target=""mainFrame"">" & vbCrLf
440: HTML = HTML & DatabaseName & "</a><br>" & vbCrLf
441:
442: HTML = HTML & " <a href=""Database_" & DatabaseID & "_Tables.htm"" target=""mainFrame"">" & vbCrLf
443: HTML = HTML & "Tables</a><br>" & vbCrLf
444:
445: HTML = HTML & " <a href=""Database_" & DatabaseID & "_Views.htm"" target=""mainFrame"">" & vbCrLf
446: HTML = HTML & "Views</a><br>" & vbCrLf
447:
448: HTML = HTML & " <a href=""Database_" & DatabaseID & "_StoredProcedures.htm"" target=""mainFrame"">" & vbCrLf
449: HTML = HTML & "Stored Procedures</a><br>" & vbCrLf
450:
451: HTML = HTML & " <a href=""Database_" & DatabaseID & "_Triggers.htm"" target=""mainFrame"">" & vbCrLf
452: HTML = HTML & "Triggers</a><br>" & vbCrLf
453:
454: HTML = HTML & " <a href=""Database_" & DatabaseID & "_Indexes.htm"" target=""mainFrame"">" & vbCrLf
455: HTML = HTML & "Indexes</a><br>" & vbCrLf
456:
457: HTML = HTML & " <a href=""Database_" & DatabaseID & "_FullTextCatalogs.htm"" target=""mainFrame"">" & vbCrLf
458: HTML = HTML & "Full-Text Catalogs</a><br>" & vbCrLf
459:
460: If CurrentProjectDocumentDTSPackages Then
461: DTSLink = "<br> <a href=""Connection_" & ConnectionID & "_DTSPackages.htm"" target=""mainFrame"">" & vbCrLf
462: DTSLink = DTSLink & "DTS Packages</a><br>" & vbCrLf
463: End If
464:
465: If CurrentProjectDocumentJobs Then
466: JobLink = " <a href=""Connection_" & ConnectionID & "_Jobs.htm"" target=""mainFrame"">" & vbCrLf
467: JobLink = JobLink & "Jobs</a><br>" & vbCrLf
468: End If
469:
470: 'If DatabaseServer <> PreviousDatabaseServer Then
471: 'HTML = HTML & DTSLink
472: 'End If
473:
474: 'HTML = HTML & "</p>" & vbCrLf
475:
476: 'Build start of text file for each database
477: If MakeTextFile Then
478:
479: Call CreateFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", UCase("Database " & DatabaseName) & vbCrLf & vbCrLf)
480:
481: TextReportsLinks = TextReportsLinks & " <a href=""" & CurrentProjectName & "_" & DatabaseName & ".txt"" title=""Text Report for Project " & CurrentProjectName & " database " & DatabaseName & """ target=""mainFrame"">"
482: TextReportsLinks = TextReportsLinks & DatabaseName
483: TextReportsLinks = TextReportsLinks & "</a>"
484: TextReportsLinks = TextReportsLinks & "<br>" & vbCrLf
485:
486: End If
487:
488: PreviousDatabaseServer = DatabaseServer
489: IsFirstDatabase = False
490:
491: 'If DatabaseServer <> PreviousDatabaseServer Or RS.EOF Then
492: ' HTML = HTML & DTSLink
493: 'End If
494:
495: RS.MoveNext()
496: Loop
497:
498: HTML = HTML & DTSLink
499: HTML = HTML & JobLink
500:
501: HTML = HTML & "<h2>Reports</h2>" & vbCrLf
502:
503: HTML = HTML & "<p>"
504:
505: HTML = HTML & "<a href=""Introduction.htm"" title=""HTML Report for Project " & CurrentProjectName & """ target=""mainFrame"">"
506: HTML = HTML & "HTML Report"
507: HTML = HTML & "</a>"
508: HTML = HTML & "<br>" & vbCrLf
509:
510: 'Link to HTML Help report if it was created
511: If MakeHTMLHelp Then
512: HTML = HTML & "<a href=""" & CurrentProjectName & ".chm"" title=""HTML Help Report for Project " & CurrentProjectName & """>"
513: HTML = HTML & "HTML Help Report"
514: HTML = HTML & "</a>"
515: HTML = HTML & "<br>" & vbCrLf
516: End If
517:
518: 'Link to RTF report if it was created
519: If MakeRTFFile Then
520: HTML = HTML & "<a href=""" & CurrentProjectName & ".rtf"" title=""RTF (Word compatible) Report for Project " & CurrentProjectName & """ target=""_blank"">"
521: HTML = HTML & "RTF (Word compatible) Report"
522: HTML = HTML & "</a>"
523: HTML = HTML & "<br>" & vbCrLf
524:
525: End If
526:
527: 'Link to text reports if they were created
528: If MakeTextFile Then
529:
530: HTML = HTML & TextReportsLinks
531: 'HTML = HTML & "<br>" & vbCrLf
532:
533:
534: End If
535:
536: HTML = HTML & "</p>" & vbCrLf
537:
538: 'Link to us
539: HTML = HTML & "<p><small>"
540: HTML = HTML & "Documentation generated by the "
541: HTML = HTML & "<a href=""" & ApplicationURL & "?V=" & ApplicationVersion & """ title=""" & ApplicationName & """ target=""_blank"">"
542: HTML = HTML & ApplicationName
543: HTML = HTML & "</a>"
544: HTML = HTML & "</small></p>" & vbCrLf
545:
546: 'UPGRADE_WARNING: Couldn't resolve default property of object GetDatabaseListPageHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
547: GetDatabaseListPageHTML = HTML
548:
549: End Function
550: 'Note that this also builds the introduction page
551: Public Sub CreateDatabasePages()
552: Dim FullTextCatalogName As Object
553: Dim FullTextCatalogID As Object
554: Dim IndexName As Object
555: Dim IndexID As Object
556: Dim TriggerName As Object
557: Dim TriggerID As Object
558: Dim RSTriggers As Object
559: Dim StoredProcedureName As Object
560: Dim StoredProcedureID As Object
561: Dim ViewName As Object
562: Dim ViewID As Object
563: Dim RSViews As Object
564: Dim TableName As Object
565: Dim TableID As Object
566: Dim RSTables As Object
567:
568: Dim TablesHTML As String
569: TablesHTML = ""
570: Dim ViewsHTML As String
571: ViewsHTML = ""
572: Dim StoredProceduresHTML As String
573: StoredProceduresHTML = ""
574: Dim TriggersHTML As String
575: TriggersHTML = ""
576: Dim IndexesHTML As String
577: IndexesHTML = ""
578: Dim NumberOfTables As Integer
579: Dim NumberOfViews As Integer
580: Dim NumberOfStoredProcedures As Integer
581: Dim NumberOfTriggers As Integer
582: Dim NumberOfIndexes As Integer
583: Dim FullTextCatalogsHTML As String
584: Dim NumberOfFullTextCatalogs As Integer
585:
586: Dim RSDatabases As New ADODB.Recordset
587: Dim RSStoredProcedures As New ADODB.Recordset
588: Dim RSStoredProcedureColumns As New ADODB.Recordset
589: Dim RSFullTextCatalogs As New ADODB.Recordset
590: Dim RSIndexes As New ADODB.Recordset
591: Dim DataConnection As New ADODB.Connection
592: Dim SQL As String
593: Dim DatabaseID As Integer
594: Dim DatabaseName As String
595: Dim PageBody As String
596: Dim PageTitle As String
597:
598: Dim IntroductionPageBody As String
599:
600: SQL = "SELECT t_Databases.* "
601: SQL = SQL & "FROM t_Parses "
602: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
603: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
604:
605: RSDatabases = DataStore.GetRecordSet(SQL)
606:
607: IntroductionPageBody = "<h2>Database Documentation Summary</h2>" & vbCrLf
608:
609: Do While Not RSDatabases.EOF
610:
611: DatabaseID = RSDatabases.Fields("DatabaseID").Value
612: DatabaseName = RSDatabases.Fields("DatabaseName").Value
613:
614: PageTitle = "Database " & DatabaseName
615: PageBody = ""
616:
617: IntroductionPageBody = IntroductionPageBody & "<h3>Database <a href=""Database_" & DatabaseID & ".htm"">" & DatabaseName & "</a></h3>" & vbCrLf
618:
619: 'Show list of tables in this database
620: If ApplicationIsEvaluationVersion Then
621: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_Tables.* "
622: Else
623: SQL = "SELECT t_Tables.* "
624: End If
625:
626: SQL = SQL & "FROM t_Tables "
627: SQL = SQL & "WHERE "
628: SQL = SQL & "fk_ParseID = " & DocParseID
629: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
630: RSTables = DataStore.GetRecordSet(SQL)
631:
632: TablesHTML = "<h2>Tables</h2>" & vbCrLf
633: NumberOfTables = 0
634:
635: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.EOF. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
636: Do While Not RSTables.EOF
637:
638: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
639: 'UPGRADE_WARNING: Couldn't resolve default property of object TableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
640: TableID = RSTables.Fields("TableID").Value
641: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
642: 'UPGRADE_WARNING: Couldn't resolve default property of object TableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
643: TableName = RSTables.Fields("TableName").Value
644: 'UPGRADE_WARNING: Couldn't resolve default property of object TableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
645: TablesHTML = TablesHTML & "<a href=""Database_" & DatabaseID & "_Table_" & TableID & ".htm"" target=""mainFrame"">" & vbCrLf
646: 'UPGRADE_WARNING: Couldn't resolve default property of object TableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
647: TablesHTML = TablesHTML & "" & TableName & "</a><br>" & vbCrLf
648:
649: NumberOfTables = NumberOfTables + 1
650:
651: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTables.MoveNext. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
652: RSTables.MoveNext()
653: Loop
654:
655: If NumberOfTables = 0 Then
656: TablesHTML = TablesHTML & "No tables were found."
657: IntroductionPageBody = IntroductionPageBody & "Number of Tables: " & NumberOfTables & "<br>" & vbCrLf
658: Else
659: IntroductionPageBody = IntroductionPageBody & "Number of Tables: " & NumberOfTables & " [ <a href=""Database_" & DatabaseID & "_Tables.htm"">View Tables</a> ]<br>" & vbCrLf
660: End If
661:
662:
663:
664: PageBody = PageBody & TablesHTML
665:
666: 'Show a list of views in this database
667: If ApplicationIsEvaluationVersion Then
668: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_Views.* "
669: Else
670: SQL = "SELECT t_Views.* "
671: End If
672:
673: SQL = SQL & "FROM t_Views "
674: SQL = SQL & "WHERE "
675: SQL = SQL & "fk_ParseID = " & DocParseID
676: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
677: RSViews = DataStore.GetRecordSet(SQL)
678:
679: ViewsHTML = "<h2>Views</h2>" & vbCrLf
680: NumberOfViews = 0
681:
682: 'UPGRADE_WARNING: Couldn't resolve default property of object RSViews.EOF. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
683: Do While Not RSViews.EOF
684:
685: 'UPGRADE_WARNING: Couldn't resolve default property of object RSViews.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
686: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
687: ViewID = RSViews.Fields("ViewID").Value
688: 'UPGRADE_WARNING: Couldn't resolve default property of object RSViews.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
689: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
690: ViewName = RSViews.Fields("ViewName").Value
691:
692: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
693: ViewsHTML = ViewsHTML & "<a href=""Database_" & DatabaseID & "_View_" & ViewID & ".htm"" target=""mainFrame"">" & vbCrLf
694: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
695: ViewsHTML = ViewsHTML & "" & ViewName & "</a><br>" & vbCrLf
696:
697: NumberOfViews = NumberOfViews + 1
698:
699: 'UPGRADE_WARNING: Couldn't resolve default property of object RSViews.MoveNext. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
700: RSViews.MoveNext()
701: Loop
702:
703: If NumberOfViews = 0 Then
704: ViewsHTML = ViewsHTML & "No views were found."
705: IntroductionPageBody = IntroductionPageBody & "Number of Views: " & NumberOfViews & "<br>" & vbCrLf
706: Else
707: IntroductionPageBody = IntroductionPageBody & "Number of Views: " & NumberOfViews & " [ <a href=""Database_" & DatabaseID & "_Views.htm"">View Views</a> ]<br>" & vbCrLf
708: End If
709:
710:
711:
712: PageBody = PageBody & ViewsHTML
713:
714: 'Show a list of stored procedures in the database
715: If ApplicationIsEvaluationVersion Then
716: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_StoredProcedures.* "
717: Else
718: SQL = "SELECT t_StoredProcedures.* "
719: End If
720:
721: SQL = SQL & "FROM t_StoredProcedures "
722: SQL = SQL & "WHERE "
723: SQL = SQL & "fk_ParseID = " & DocParseID
724: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
725: RSStoredProcedures = DataStore.GetRecordSet(SQL)
726:
727: StoredProceduresHTML = "<h2>Stored Procedures</h2>" & vbCrLf
728: NumberOfStoredProcedures = 0
729:
730: Do While Not RSStoredProcedures.EOF
731:
732: 'UPGRADE_WARNING: Couldn't resolve default property of object StoredProcedureID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
733: StoredProcedureID = RSStoredProcedures.Fields("StoredProcedureID").Value
734: 'UPGRADE_WARNING: Couldn't resolve default property of object StoredProcedureName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
735: StoredProcedureName = RSStoredProcedures.Fields("StoredProcedureName").Value
736:
737: 'UPGRADE_WARNING: Couldn't resolve default property of object StoredProcedureID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
738: StoredProceduresHTML = StoredProceduresHTML & "<a href=""Database_" & DatabaseID & "_StoredProcedure_" & StoredProcedureID & ".htm"" target=""mainFrame"">" & vbCrLf
739: 'UPGRADE_WARNING: Couldn't resolve default property of object StoredProcedureName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
740: StoredProceduresHTML = StoredProceduresHTML & "" & StoredProcedureName & "</a><br>" & vbCrLf
741:
742: NumberOfStoredProcedures = NumberOfStoredProcedures + 1
743:
744: RSStoredProcedures.MoveNext()
745: Loop
746:
747: If NumberOfStoredProcedures = 0 Then
748: StoredProceduresHTML = StoredProceduresHTML & "No stored procedures were found."
749: IntroductionPageBody = IntroductionPageBody & "Number of Stored Procedures: " & NumberOfStoredProcedures & "<br>" & vbCrLf
750: Else
751: IntroductionPageBody = IntroductionPageBody & "Number of Stored Procedures: " & NumberOfStoredProcedures & " [ <a href=""Database_" & DatabaseID & "_StoredProcedures.htm"">View Stored Procedures</a> ]<br>" & vbCrLf
752: End If
753:
754: PageBody = PageBody & StoredProceduresHTML
755:
756: 'Show a list of triggers in the database
757: If ApplicationIsEvaluationVersion Then
758: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_Triggers.*, t_Tables.* "
759: Else
760: SQL = "SELECT t_Triggers.*, t_Tables.* "
761: End If
762:
763: SQL = SQL & "FROM t_Triggers "
764: SQL = SQL & "INNER JOIN t_Tables ON t_Tables.TableID = t_Triggers.fk_TableID "
765: SQL = SQL & "WHERE "
766: SQL = SQL & "t_Tables.fk_ParseID = " & DocParseID
767: SQL = SQL & " AND t_Tables.fk_DatabaseID = " & DatabaseID
768: RSTriggers = DataStore.GetRecordSet(SQL)
769:
770: TriggersHTML = "<h2>Triggers</h2>" & vbCrLf
771: NumberOfTriggers = 0
772:
773: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTriggers.EOF. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
774: Do While Not RSTriggers.EOF
775:
776: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTriggers.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
777: 'UPGRADE_WARNING: Couldn't resolve default property of object TriggerID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
778: TriggerID = RSTriggers.Fields("TriggerID").Value
779: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTriggers.Fields. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
780: 'UPGRADE_WARNING: Couldn't resolve default property of object TriggerName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
781: TriggerName = RSTriggers.Fields("TriggerName").Value
782:
783: 'UPGRADE_WARNING: Couldn't resolve default property of object TriggerID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
784: TriggersHTML = TriggersHTML & "<a href=""Database_" & DatabaseID & "_Trigger_" & TriggerID & ".htm"" target=""mainFrame"">" & vbCrLf
785: 'UPGRADE_WARNING: Couldn't resolve default property of object TriggerName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
786: TriggersHTML = TriggersHTML & "" & TriggerName & "</a><br>" & vbCrLf
787:
788: NumberOfTriggers = NumberOfTriggers + 1
789:
790: 'UPGRADE_WARNING: Couldn't resolve default property of object RSTriggers.MoveNext. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
791: RSTriggers.MoveNext()
792: Loop
793:
794: If NumberOfTriggers = 0 Then
795: TriggersHTML = TriggersHTML & "No triggers were found."
796: IntroductionPageBody = IntroductionPageBody & "Number of Triggers: " & NumberOfTriggers & "<br>" & vbCrLf
797: Else
798: IntroductionPageBody = IntroductionPageBody & "Number of Triggers: " & NumberOfTriggers & " [ <a href=""Database_" & DatabaseID & "_Triggers.htm"">View Triggers</a> ]<br>" & vbCrLf
799: End If
800:
801: PageBody = PageBody & TriggersHTML
802:
803: 'Show a list of indexes in the database
804: If ApplicationIsEvaluationVersion Then
805: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_TableIndexes.* "
806: Else
807: SQL = "SELECT t_TableIndexes.* "
808: End If
809:
810: SQL = SQL & "FROM t_TableIndexes "
811: SQL = SQL & "INNER JOIN t_Tables ON t_Tables.TableID = t_TableIndexes.fk_TableID "
812: SQL = SQL & "WHERE "
813: SQL = SQL & "t_Tables.fk_ParseID = " & DocParseID
814: SQL = SQL & " AND t_Tables.fk_DatabaseID = " & DatabaseID
815: RSIndexes = DataStore.GetRecordSet(SQL)
816:
817: IndexesHTML = "<h2>Indexes</h2>" & vbCrLf
818: NumberOfIndexes = 0
819:
820: Do While Not RSIndexes.EOF
821:
822: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
823: IndexID = RSIndexes.Fields("IndexID").Value
824: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
825: IndexName = RSIndexes.Fields("IndexName").Value
826:
827: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
828: IndexesHTML = IndexesHTML & "<a href=""Database_" & DatabaseID & "_Index_" & IndexID & ".htm"" target=""mainFrame"">" & vbCrLf
829: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
830: IndexesHTML = IndexesHTML & "" & IndexName & "</a><br>" & vbCrLf
831:
832: NumberOfIndexes = NumberOfIndexes + 1
833:
834: RSIndexes.MoveNext()
835: Loop
836:
837: If NumberOfIndexes = 0 Then
838: IndexesHTML = IndexesHTML & "No indexes were found."
839: IntroductionPageBody = IntroductionPageBody & "Number of Indexes: " & NumberOfIndexes & "<br>" & vbCrLf
840: Else
841: IntroductionPageBody = IntroductionPageBody & "Number of Indexes: " & NumberOfIndexes & " [ <a href=""Database_" & DatabaseID & "_Indexes.htm"">View Indexes</a> ]<br>" & vbCrLf
842: End If
843:
844: PageBody = PageBody & IndexesHTML
845:
846: 'Show a list of full-text catalogs in the database
847: SQL = "SELECT t_FullTextCatalogs.* "
848: SQL = SQL & "FROM t_FullTextCatalogs "
849: SQL = SQL & "WHERE "
850: SQL = SQL & "t_FullTextCatalogs.fk_ParseID = " & DocParseID
851: SQL = SQL & " AND t_FullTextCatalogs.fk_DatabaseID = " & DatabaseID
852: RSFullTextCatalogs = DataStore.GetRecordSet(SQL)
853:
854: FullTextCatalogsHTML = "<h2>Full-Text Catalogs</h2>" & vbCrLf
855: NumberOfFullTextCatalogs = 0
856:
857: Do While Not RSFullTextCatalogs.EOF
858:
859: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
860: FullTextCatalogID = RSFullTextCatalogs.Fields("FullTextCatalogID").Value
861: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
862: FullTextCatalogName = RSFullTextCatalogs.Fields("FullTextCatalogName").Value
863:
864: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
865: FullTextCatalogsHTML = FullTextCatalogsHTML & "<a href=""Database_" & DatabaseID & "_FullTextCatalog_" & FullTextCatalogID & ".htm"" target=""mainFrame"">" & vbCrLf
866: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
867: FullTextCatalogsHTML = FullTextCatalogsHTML & "" & FullTextCatalogName & "</a><br>" & vbCrLf
868:
869: NumberOfFullTextCatalogs = NumberOfFullTextCatalogs + 1
870:
871: RSFullTextCatalogs.MoveNext()
872: Loop
873:
874: If NumberOfFullTextCatalogs = 0 Then
875: FullTextCatalogsHTML = FullTextCatalogsHTML & "No full-text catalogs were found."
876: IntroductionPageBody = IntroductionPageBody & "Number of Full-Text Catalogs: " & NumberOfFullTextCatalogs & "<br>" & vbCrLf
877: Else
878: IntroductionPageBody = IntroductionPageBody & "Number of Full-Text Catalogs: " & NumberOfFullTextCatalogs & " [ <a href=""Database_" & DatabaseID & "_FullTextCatalogs.htm"">View Full-Text Catalogs</a> ]<br>" & vbCrLf
879: End If
880:
881: PageBody = PageBody & FullTextCatalogsHTML
882:
883: Call CreatePage("Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & ".htm", PageTitle, PageBody, True)
884:
885: RSDatabases.MoveNext()
886: Loop
887:
888: IntroductionPageBody = IntroductionPageBody & "<p>Documentation created by the <a href=""" & ApplicationURL & "?V=" & ApplicationVersion & """ target=""_blank"" title=""" & ApplicationName & " website "">" & ApplicationName & "</a>.</p>" & vbCrLf
889:
890: 'Build Introduction Page
891: Call CreatePage("Introduction", DocFolderPath, "Introduction.htm", "Introduction", IntroductionPageBody, True)
892:
893:
894: End Sub
895: Public Sub CreateTablesListAndTablesPages()
896: Dim RelationshipTitleTag As Object
897: Dim PrimaryKeyColumnName As Object
898: Dim PrimaryKeyTableName As Object
899: Dim PrimaryKeyTableID As Object
900: Dim ForeignKeyColumnName As Object
901: Dim ForeignKeyTableName As Object
902: Dim ForeignKeyTableID As Object
903: Dim ColumnIsIdentity As Object
904:
905: Dim ListHTML As String
906: ListHTML = ""
907:
908: Dim TableHTML As String
909: Dim NumberOfTables As Integer
910:
911: Dim RSDatabases As New ADODB.Recordset
912: Dim RSTables As New ADODB.Recordset
913: Dim RSColumns As New ADODB.Recordset
914: Dim RSColumnRelationships As ADODB.Recordset
915: Dim DataConnection As New ADODB.Connection
916: Dim SQL As String
917: Dim DatabaseID As Integer
918: Dim DatabaseName As String
919: Dim PageBody As String
920: Dim PageTitle As String
921: Dim TableID As Integer
922: Dim TableName As String
923: Dim TablePrimaryKeyName As String
924: Dim ColumnID As Integer
925: Dim ColumnName As String
926: Dim ColumnTypeName As String
927: Dim ColumnLength As String
928: Dim ColumnIsNullable As String
929: Dim ColumnIsPrimaryKey As String
930: Dim ColumnIsPrimaryKeyForHTML As String
931: Dim ColumnIsPrimaryKeyForRTF As String
932: Dim ColumnRelationships As String
933: Dim ColumnDescription As String
934: Dim ColumnDescriptionHTML As String
935: Dim PrimaryKeyName As String
936: Dim ForeignKeyName As String
937: Dim PrimaryKeyColumnID As Integer
938: Dim ForeignKeyColumnID As Integer
939: Dim RelationshipAltTag As String
940: Dim RTFText As String
941: Dim IsFirstDatabase As Boolean
942: Dim RSTriggers As New ADODB.Recordset
943: Dim TriggerID As Integer
944: Dim TriggerName As String
945: Dim TriggerIsUpdate As Boolean
946: Dim TriggerIsDelete As Boolean
947: Dim TriggerIsInsert As Boolean
948: 'Dim TriggerIsAfter As Boolean
949: 'Dim TriggerIsInsteadOf As Boolean
950: Dim TriggerText As String
951: Dim TriggerTypeText As String
952: Dim NumberOfTriggersOnTable As Integer
953: Dim TableTriggersHTML As String
954: Dim DatabaseTextFile As String
955: Dim NumberOfColumnsInPrimaryKey As Integer
956: Dim TableCompoundPrimaryKeyHTML As String
957: Dim RSCompoundPrimaryKeyColumns As New ADODB.Recordset
958: Dim CompoundPrimaryKeyColumnID As Integer
959: Dim CompoundPrimaryKeyColumnName As String
960:
961: SQL = "SELECT t_Databases.* "
962: SQL = SQL & "FROM t_Parses "
963: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
964: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
965:
966: RSDatabases = DataStore.GetRecordSet(SQL)
967:
968: IsFirstDatabase = True
969:
970: Do While Not RSDatabases.EOF
971:
972: DatabaseID = RSDatabases.Fields("DatabaseID").Value
973: DatabaseName = RSDatabases.Fields("DatabaseName").Value
974: DatabaseTextFile = "TABLES" & vbCrLf & vbCrLf
975:
976: ListHTML = ""
977: NumberOfTables = 0
978:
979: 'Build database title section in RTF file
980: If MakeRTFFile Then
981:
982: 'Put in a page break for the second and subsequent databases
983: If IsFirstDatabase = False Then
984: RTFText = "\page " & vbCrLf
985: Else
986: RTFText = ""
987: End If
988:
989: RTFText = RTFText & "\pard\keepn\s2\b\kerning0\fs24 " & vbCrLf
990: RTFText = RTFText & DatabaseName & " Tables \par" & vbCrLf
991: RTFText = RTFText & "\pard\b0\f0\par" & vbCrLf
992:
993: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
994:
995: End If
996:
997: If ApplicationIsEvaluationVersion Then
998: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_Tables.* "
999: Else
1000: SQL = "SELECT t_Tables.* "
1001: End If
1002: SQL = SQL & "FROM t_Tables "
1003: SQL = SQL & "WHERE "
1004: SQL = SQL & "fk_ParseID = " & DocParseID
1005: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
1006: RSTables = DataStore.GetRecordSet(SQL)
1007:
1008: Do While Not RSTables.EOF
1009:
1010: TableID = RSTables.Fields("TableID").Value
1011: TableName = RSTables.Fields("TableName").Value
1012: TablePrimaryKeyName = RSTables.Fields("PrimaryKeyName").Value
1013: TableHTML = ""
1014:
1015: NumberOfTriggersOnTable = 0
1016: TableTriggersHTML = ""
1017:
1018: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & TableName)
1019:
1020: ListHTML = ListHTML & "<a href=""Database_" & DatabaseID & "_Table_" & TableID & ".htm"">" & vbCrLf
1021: ListHTML = ListHTML & "" & TableName & "</a><br>" & vbCrLf
1022:
1023: DatabaseTextFile = DatabaseTextFile & TableName & vbCrLf
1024:
1025: 'Store this table
1026: Call StoreHTMLHelpIndexContent(TableName, "Table", "Database_" & DatabaseID & "_Table_" & TableID & ".htm", "", DatabaseID, TableID, 0)
1027:
1028: 'Get columns for this table
1029: SQL = "SELECT t_TableColumns.* "
1030: SQL = SQL & "FROM t_TableColumns "
1031: SQL = SQL & "WHERE "
1032: SQL = SQL & "fk_TableID = " & TableID
1033: RSColumns = DataStore.GetRecordSet(SQL)
1034:
1035: TableHTML = TableHTML & GetHTMLTableOpener
1036: TableHTML = TableHTML & GetHTMLTableRowOpener
1037:
1038: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1039: TableHTML = TableHTML & GetHTMLTableHeaderCell(" ")
1040: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1041: TableHTML = TableHTML & GetHTMLTableHeaderCell("Column Name")
1042: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1043: TableHTML = TableHTML & GetHTMLTableHeaderCell("Type")
1044: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1045: TableHTML = TableHTML & GetHTMLTableHeaderCell("Length")
1046: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1047: TableHTML = TableHTML & GetHTMLTableHeaderCell("Nullable")
1048: If CurrentProjectDocumentTableColumnDescriptions Then
1049: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1050: TableHTML = TableHTML & GetHTMLTableHeaderCell("Description")
1051: End If
1052: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1053: TableHTML = TableHTML & GetHTMLTableHeaderCell("Relationships")
1054:
1055: TableHTML = TableHTML & GetHTMLTableRowCloser
1056:
1057: 'Build table opening section in RTF file
1058: If MakeRTFFile Then
1059:
1060: RTFText = ""
1061: RTFText = RTFText & "\trowd\trautofit1\trgaph108\trleft-108\trbrdrt\brdrs\brdrw10 \trbrdrl\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx8452\pard\intbl\b " & TableName & "\b0\cell\row" & vbCrLf
1062: RTFText = RTFText & "\trowd\trgaph108\trleft-108\trbrdrt\brdrs\brdrw10 \trbrdrl\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx1527\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx3716\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx5381\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx7149\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx8452\pard\intbl \cell\i Column Name\i0\cell\i Type\i0\cell\i Length\i0\cell\i Nullable\i0\cell\row" & vbCrLf
1063:
1064:
1065: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1066:
1067: End If
1068:
1069: RTFText = ""
1070:
1071: Do While Not RSColumns.EOF
1072:
1073: ColumnID = RSColumns.Fields("ColumnID").Value
1074: ColumnName = RSColumns.Fields("ColumnName").Value
1075: ColumnTypeName = RSColumns.Fields("TypeName").Value
1076: ColumnLength = RSColumns.Fields("Length").Value
1077: ColumnIsNullable = RSColumns.Fields("IsNullable").Value
1078: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnIsIdentity. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1079: ColumnIsIdentity = RSColumns.Fields("IsIdentity").Value
1080: ColumnIsPrimaryKey = RSColumns.Fields("IsPrimaryKey").Value
1081: ColumnDescription = RSColumns.Fields("ColumnDescription").Value
1082: ColumnRelationships = ""
1083:
1084: ColumnDescriptionHTML = ColumnDescription
1085: If Len(ColumnDescriptionHTML) = 0 Then ColumnDescriptionHTML = " "
1086:
1087: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & TableName & "." & ColumnName)
1088:
1089: 'Store this table column
1090: Call StoreHTMLHelpIndexContent(ColumnName, "Column", "Database_" & DatabaseID & "_Table_" & TableID & ".htm", CStr(ColumnID), DatabaseID, TableID, 0)
1091:
1092:
1093: If UCase(ColumnIsNullable) = "TRUE" Then
1094: ColumnIsNullable = "Yes"
1095: End If
1096: If UCase(ColumnIsNullable) = "FALSE" Then
1097: ColumnIsNullable = "No"
1098: End If
1099:
1100: 'Identity columns
1101: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnIsIdentity. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1102: If UCase(ColumnIsIdentity) = "TRUE" Then
1103: ColumnIsPrimaryKeyForHTML = "Identity"
1104: ColumnIsPrimaryKeyForRTF = "Identity"
1105: End If
1106: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnIsIdentity. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1107: If UCase(ColumnIsIdentity) = "FALSE" Then
1108: ColumnIsPrimaryKeyForHTML = ""
1109: ColumnIsPrimaryKeyForRTF = ""
1110: End If
1111:
1112: '3.0: Primary key columns
1113: If UCase(ColumnIsPrimaryKey) = "TRUE" Then
1114: If ColumnIsPrimaryKeyForHTML = "Identity" Then
1115: ColumnIsPrimaryKeyForHTML = ColumnIsPrimaryKeyForHTML & ",<br>Primary Key"
1116: ColumnIsPrimaryKeyForRTF = ColumnIsPrimaryKeyForRTF & ", Primary Key"
1117: Else
1118: ColumnIsPrimaryKeyForHTML = ColumnIsPrimaryKeyForHTML & "Primary Key"
1119: ColumnIsPrimaryKeyForRTF = "Primary Key"
1120: End If
1121: End If
1122:
1123: If Len(ColumnIsPrimaryKeyForHTML) = 0 Then
1124: ColumnIsPrimaryKeyForHTML = " "
1125: End If
1126:
1127:
1128: 'Determine if this column is a primary key in relationships
1129: 'Get columns for this table
1130: SQL = "SELECT t_TableRelationships.* "
1131: SQL = SQL & "FROM t_TableRelationships "
1132: SQL = SQL & "WHERE "
1133: SQL = SQL & "fk_PrimaryKeyColumnID = " & ColumnID
1134: RSColumnRelationships = DataStore.GetRecordSet(SQL)
1135:
1136: Do While Not RSColumnRelationships.EOF
1137:
1138: PrimaryKeyName = RSColumnRelationships.Fields("PrimaryKeyName").Value
1139: ForeignKeyColumnID = RSColumnRelationships.Fields("fk_ForeignKeyColumnID").Value
1140: ForeignKeyName = RSColumnRelationships.Fields("ForeignKeyName").Value
1141:
1142: 'Get details of foreign key table
1143: SQL = "SELECT t_Tables.*, t_TableColumns.* "
1144: SQL = SQL & "FROM (t_TableRelationships "
1145: SQL = SQL & "INNER JOIN t_TableColumns ON t_TableRelationships.fk_ForeignKeyColumnID = t_TableColumns.ColumnID) "
1146: SQL = SQL & "INNER JOIN t_Tables ON t_TableColumns.fk_TableID = t_Tables.TableID "
1147: SQL = SQL & "WHERE t_TableRelationships.fk_ForeignKeyColumnID = " & ForeignKeyColumnID
1148: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1149: ForeignKeyTableID = DataStore.ExecuteSQLReturnSingleValue(SQL, "TableID")
1150: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1151: ForeignKeyTableName = DataStore.ExecuteSQLReturnSingleValue(SQL, "TableName")
1152: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1153: ForeignKeyColumnName = DataStore.ExecuteSQLReturnSingleValue(SQL, "ColumnName")
1154:
1155: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1156: PrimaryKeyTableID = TableID
1157: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1158: PrimaryKeyTableName = TableName
1159: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1160: PrimaryKeyColumnName = ColumnName
1161:
1162: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1163: RelationshipTitleTag = "Relationship " & ForeignKeyName & ": "
1164: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1165: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1166: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1167: RelationshipTitleTag = RelationshipTitleTag & PrimaryKeyTableName & "." & PrimaryKeyColumnName
1168: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1169: RelationshipTitleTag = RelationshipTitleTag & " is the primary key for "
1170: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1171: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1172: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1173: RelationshipTitleTag = RelationshipTitleTag & ForeignKeyTableName & "." & ForeignKeyColumnName
1174: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1175: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1176: ColumnRelationships = ColumnRelationships & "FK: <a href=""Database_" & DatabaseID & "_Table_" & ForeignKeyTableID & ".htm#" & ForeignKeyColumnID & """ title=""" & RelationshipTitleTag & """>" & ForeignKeyName & "</a><br>" & vbCrLf
1177:
1178: RSColumnRelationships.MoveNext()
1179: Loop 'End of primary key relationships
1180:
1181: 'Determine if this column is a foreign key in relationships
1182: 'Get columns for this table
1183: SQL = "SELECT t_TableRelationships.* "
1184: SQL = SQL & "FROM t_TableRelationships "
1185: SQL = SQL & "WHERE "
1186: SQL = SQL & "fk_ForeignKeyColumnID = " & ColumnID
1187: ColumnID = ColumnID
1188: RSColumnRelationships = DataStore.GetRecordSet(SQL)
1189:
1190: Do While Not RSColumnRelationships.EOF
1191:
1192: PrimaryKeyName = RSColumnRelationships.Fields("PrimaryKeyName").Value
1193: PrimaryKeyColumnID = RSColumnRelationships.Fields("fk_PrimaryKeyColumnID").Value
1194: ForeignKeyName = RSColumnRelationships.Fields("ForeignKeyName").Value
1195:
1196: 'Get details of foreign key table
1197: SQL = "SELECT t_Tables.*, t_TableColumns.* "
1198: SQL = SQL & "FROM (t_TableRelationships "
1199: SQL = SQL & "INNER JOIN t_TableColumns ON t_TableRelationships.fk_PrimaryKeyColumnID = t_TableColumns.ColumnID) "
1200: SQL = SQL & "INNER JOIN t_Tables ON t_TableColumns.fk_TableID = t_Tables.TableID "
1201: SQL = SQL & "WHERE t_TableRelationships.fk_PrimaryKeyColumnID = " & PrimaryKeyColumnID
1202: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1203: PrimaryKeyTableID = DataStore.ExecuteSQLReturnSingleValue(SQL, "TableID")
1204: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1205: PrimaryKeyTableName = DataStore.ExecuteSQLReturnSingleValue(SQL, "TableName")
1206: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1207: PrimaryKeyColumnName = DataStore.ExecuteSQLReturnSingleValue(SQL, "ColumnName")
1208:
1209: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1210: ForeignKeyTableID = TableID
1211: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1212: ForeignKeyTableName = TableName
1213: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1214: ForeignKeyColumnName = ColumnName
1215:
1216: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1217: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1218: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1219: RelationshipTitleTag = PrimaryKeyTableName & "." & PrimaryKeyColumnName
1220: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1221: RelationshipTitleTag = RelationshipTitleTag & " is the primary key for "
1222: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyColumnName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1223: 'UPGRADE_WARNING: Couldn't resolve default property of object ForeignKeyTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1224: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1225: RelationshipTitleTag = RelationshipTitleTag & ForeignKeyTableName & "." & ForeignKeyColumnName
1226: 'UPGRADE_WARNING: Couldn't resolve default property of object RelationshipTitleTag. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1227: 'UPGRADE_WARNING: Couldn't resolve default property of object PrimaryKeyTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1228: ColumnRelationships = ColumnRelationships & "PK: <a href=""Database_" & DatabaseID & "_Table_" & PrimaryKeyTableID & ".htm#" & PrimaryKeyColumnID & """ title=""" & RelationshipTitleTag & """>" & PrimaryKeyName & "</a><br>" & vbCrLf
1229:
1230: RSColumnRelationships.MoveNext()
1231: Loop 'End of foreign key relationships
1232:
1233: If ColumnRelationships = "" Then ColumnRelationships = " "
1234:
1235: TableHTML = TableHTML & GetHTMLTableRowOpener
1236: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1237: TableHTML = TableHTML & GetHTMLTableBodyCell(ColumnIsPrimaryKeyForHTML)
1238: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1239: TableHTML = TableHTML & GetHTMLTableBodyCell("<a name=""" & ColumnID & """>" & ColumnName & "</a>")
1240: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1241: TableHTML = TableHTML & GetHTMLTableBodyCell(ColumnTypeName)
1242: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1243: TableHTML = TableHTML & GetHTMLTableBodyCell(ColumnLength)
1244: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1245: TableHTML = TableHTML & GetHTMLTableBodyCell(ColumnIsNullable)
1246:
1247: If CurrentProjectDocumentTableColumnDescriptions Then
1248: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1249: TableHTML = TableHTML & GetHTMLTableBodyCell(ColumnDescriptionHTML)
1250: End If
1251:
1252: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1253: TableHTML = TableHTML & GetHTMLTableBodyCell("<small>" & ColumnRelationships & "</small>")
1254: TableHTML = TableHTML & GetHTMLTableRowCloser
1255:
1256: ' TableHTML = TableHTML & ColumnName & "<br>" & vbCrLf
1257:
1258: If MakeRTFFile Then
1259:
1260: RTFText = RTFText & "\intbl " & ColumnIsPrimaryKeyForRTF & "\cell " & ColumnName & "\cell " & ColumnTypeName & "\cell " & ColumnLength & "\cell " & ColumnIsNullable & "\cell\row" & vbCrLf
1261:
1262: End If
1263:
1264: RSColumns.MoveNext()
1265:
1266: Loop 'End of table columns
1267:
1268: TableHTML = TableHTML & GetHTMLTableCloser
1269:
1270: 'Show any triggers associated with this table
1271: SQL = "SELECT t_Triggers.* "
1272:
1273: SQL = SQL & "FROM t_Triggers "
1274: SQL = SQL & "WHERE "
1275: SQL = SQL & "t_Triggers.fk_TableID = " & TableID
1276: RSTriggers = DataStore.GetRecordSet(SQL)
1277:
1278: TableTriggersHTML = "<h2>Triggers on this table</h2>" & vbCrLf
1279:
1280: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableOpenerWithWidth(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1281: TableTriggersHTML = TableTriggersHTML & GetHTMLTableOpenerWithWidth(60)
1282: TableTriggersHTML = TableTriggersHTML & GetHTMLTableRowOpener
1283:
1284: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1285: TableTriggersHTML = TableTriggersHTML & GetHTMLTableHeaderCell(" ")
1286: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1287: TableTriggersHTML = TableTriggersHTML & GetHTMLTableHeaderCell("Trigger")
1288: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1289: TableTriggersHTML = TableTriggersHTML & GetHTMLTableHeaderCell("For")
1290:
1291: TableTriggersHTML = TableTriggersHTML & GetHTMLTableRowCloser
1292:
1293: Do While Not RSTriggers.EOF
1294:
1295: TriggerTypeText = ""
1296:
1297: TriggerID = RSTriggers.Fields("TriggerID").Value
1298: TriggerName = RSTriggers.Fields("TriggerName").Value
1299: 'TriggerText = RSTriggers.Fields("TriggerText").Value
1300: 'TriggerTableID = RSTriggers.Fields("TableID").Value
1301: 'TriggerTableName = RSTriggers.Fields("TableName").Value
1302:
1303: TriggerIsUpdate = RSTriggers.Fields("IsUpdate").Value
1304: TriggerIsDelete = RSTriggers.Fields("IsDelete").Value
1305: TriggerIsInsert = RSTriggers.Fields("IsInsert").Value
1306:
1307: If TriggerIsInsert = True Then
1308: TriggerTypeText = TriggerTypeText & "Insert, "
1309: End If
1310:
1311: If TriggerIsUpdate = True Then
1312: TriggerTypeText = TriggerTypeText & "Update, "
1313: End If
1314:
1315: If TriggerIsDelete = True Then
1316: TriggerTypeText = TriggerTypeText & "Delete, "
1317: End If
1318:
1319: If Right(TriggerTypeText, 2) = ", " Then
1320: TriggerTypeText = Left(TriggerTypeText, Len(TriggerTypeText) - 2)
1321: End If
1322:
1323: NumberOfTriggersOnTable = NumberOfTriggersOnTable + 1
1324:
1325: TableTriggersHTML = TableTriggersHTML & GetHTMLTableRowOpener
1326:
1327: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1328: TableTriggersHTML = TableTriggersHTML & GetHTMLTableBodyCell(" ")
1329: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1330: TableTriggersHTML = TableTriggersHTML & GetHTMLTableBodyCell("<a href=""Database_" & DatabaseID & "_Trigger_" & TriggerID & ".htm"">" & TriggerName & "</a>")
1331: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1332: TableTriggersHTML = TableTriggersHTML & GetHTMLTableBodyCell(TriggerTypeText)
1333:
1334: TableTriggersHTML = TableTriggersHTML & GetHTMLTableRowCloser
1335:
1336: RSTriggers.MoveNext()
1337:
1338:
1339: Loop
1340:
1341: TableTriggersHTML = TableTriggersHTML & GetHTMLTableCloser
1342:
1343: If NumberOfTriggersOnTable > 0 Then
1344: TableHTML = TableHTML & TableTriggersHTML
1345: End If
1346:
1347: '3.0: Compound Primary Keys
1348: SQL = "SELECT Count(ColumnID) as NumberOfColumns FROM t_TableColumns WHERE fk_TableID = " & TableID & " AND IsPrimaryKey = True "
1349: NumberOfColumnsInPrimaryKey = CInt(DataStore.ExecuteSQLReturnSingleValue(SQL, "NumberOfColumns"))
1350:
1351: If NumberOfColumnsInPrimaryKey > 1 Then
1352:
1353: TableCompoundPrimaryKeyHTML = "<a name=""" & TablePrimaryKeyName & """></a><h2>Table compound primary key " & TablePrimaryKeyName & "</h2>" & vbCrLf
1354:
1355: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & "<p>This table's primary key consists of more than one column. The columns used in the primary key are:</p>" & vbCrLf
1356:
1357: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableOpenerWithWidth(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1358: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableOpenerWithWidth(25)
1359: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableRowOpener
1360: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1361: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableHeaderCell("Column Name")
1362: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableRowCloser
1363:
1364: 'Store this table compound primary key
1365: Call StoreHTMLHelpIndexContent(TablePrimaryKeyName, "Compound Primary Key", "Database_" & DatabaseID & "_Table_" & TableID & ".htm", TablePrimaryKeyName, DatabaseID, TableID, 0)
1366:
1367: SQL = "SELECT * FROM t_TableColumns WHERE fk_TableID = " & TableID & " AND IsPrimaryKey = True ORDER BY PrimaryKeySequence"
1368: RSCompoundPrimaryKeyColumns = DataStore.GetRecordSet(SQL)
1369:
1370: Do While Not RSCompoundPrimaryKeyColumns.EOF
1371:
1372: CompoundPrimaryKeyColumnID = RSCompoundPrimaryKeyColumns.Fields("ColumnID").Value
1373: CompoundPrimaryKeyColumnName = RSCompoundPrimaryKeyColumns.Fields("ColumnName").Value
1374:
1375: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableRowOpener
1376:
1377: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1378: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableBodyCell(CompoundPrimaryKeyColumnName)
1379: 'TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableBodyCell("<a href=""Database_" & DatabaseID & "_Trigger_" & TriggerID & ".htm"">" & TriggerName & "</a>")
1380: 'TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableBodyCell(TriggerTypeText)
1381:
1382: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableRowCloser
1383:
1384: RSCompoundPrimaryKeyColumns.MoveNext()
1385: Loop
1386:
1387:
1388: TableCompoundPrimaryKeyHTML = TableCompoundPrimaryKeyHTML & GetHTMLTableCloser
1389: TableHTML = TableHTML & TableCompoundPrimaryKeyHTML
1390:
1391: End If
1392:
1393:
1394:
1395:
1396: 'Build table closing section in RTF file (appended to columns content made previously)
1397: If MakeRTFFile Then
1398:
1399: RTFText = RTFText & "\pard\par" & vbCrLf
1400:
1401: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1402:
1403: End If
1404:
1405: 'Build a tables list page for the particular database
1406: PageTitle = "Table " & DatabaseName & ".." & TableName
1407: PageBody = TableHTML
1408: Call CreatePage("Table " & DatabaseName & ".." & TableName, DocFolderPath, "Database_" & DatabaseID & "_Table_" & TableID & ".htm", PageTitle, PageBody, True)
1409:
1410: NumberOfTables = NumberOfTables + 1
1411:
1412: RSTables.MoveNext()
1413:
1414: Loop
1415:
1416: If NumberOfTables = 0 Then
1417: ListHTML = "<p>No tables were found.</p>"
1418: DatabaseTextFile = DatabaseTextFile & "No tables were found." & vbCrLf
1419:
1420: If MakeRTFFile Then
1421:
1422: RTFText = "\pard\keepn\s2\kerning0\fs24 " & vbCrLf
1423: RTFText = RTFText & "No tables were found. \par" & vbCrLf
1424: RTFText = RTFText & "\pard\f0\par" & vbCrLf
1425:
1426: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1427:
1428: End If
1429: End If
1430:
1431: 'Build a tables list page for the particular database
1432: PageTitle = "Tables in Database " & DatabaseName
1433: PageBody = ListHTML
1434: Call CreatePage("Tables in Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & "_Tables.htm", PageTitle, PageBody, True)
1435:
1436: 'Build database tables part of text file for each database
1437: If MakeTextFile Then
1438:
1439: Call AppendFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", DatabaseTextFile & vbCrLf)
1440:
1441: End If
1442:
1443: RSDatabases.MoveNext()
1444: IsFirstDatabase = False
1445:
1446: Loop
1447:
1448: End Sub
1449: Public Sub CreateViewsListAndTablesPages()
1450:
1451: Dim ListHTML As String
1452: ListHTML = ""
1453:
1454: Dim ViewHTML As String
1455: Dim NumberOfViews As Integer
1456:
1457: Dim RSDatabases As New ADODB.Recordset
1458: Dim RSViews As New ADODB.Recordset
1459: Dim RSColumns As New ADODB.Recordset
1460: Dim DataConnection As New ADODB.Connection
1461: Dim SQL As String
1462: Dim DatabaseID As Integer
1463: Dim DatabaseName As String
1464: Dim RTFText As String
1465: Dim IsFirstDatabase As Boolean
1466: Dim PageBody As String
1467: Dim PageTitle As String
1468: Dim ViewID As Integer
1469: Dim ViewName As String
1470: Dim ViewText As String
1471: Dim ColumnID As Integer
1472: Dim ColumnName As String
1473: Dim ColumnTypeName As String
1474: Dim ColumnLength As String
1475: Dim ColumnIsNullable As String
1476: Dim ColumnIsPrimaryKey As String
1477: Dim ColumnIsPrimaryKeyForRTF As String
1478: Dim DatabaseTextFile As String
1479:
1480: SQL = "SELECT t_Databases.* "
1481: SQL = SQL & "FROM t_Parses "
1482: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
1483: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
1484:
1485: RSDatabases = DataStore.GetRecordSet(SQL)
1486:
1487: IsFirstDatabase = True
1488:
1489: Do While Not RSDatabases.EOF
1490:
1491: DatabaseID = RSDatabases.Fields("DatabaseID").Value
1492: DatabaseName = RSDatabases.Fields("DatabaseName").Value
1493: DatabaseTextFile = "VIEWS" & vbCrLf & vbCrLf
1494:
1495: ListHTML = ""
1496: NumberOfViews = 0
1497:
1498: 'Build database title section in RTF file
1499: If MakeRTFFile Then
1500:
1501: 'Put in a page break for the second and subsequent databases
1502: If IsFirstDatabase = False Then
1503: RTFText = "\page " & vbCrLf
1504: Else
1505: RTFText = ""
1506: End If
1507:
1508: RTFText = RTFText & "\pard\keepn\s2\b\kerning0\fs24 " & vbCrLf
1509: RTFText = RTFText & DatabaseName & " Views \par" & vbCrLf
1510: RTFText = RTFText & "\pard\b0\f0\par" & vbCrLf
1511:
1512: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1513:
1514: End If
1515:
1516: If ApplicationIsEvaluationVersion Then
1517: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_Views.* "
1518: Else
1519: SQL = "SELECT t_Views.* "
1520: End If
1521:
1522: SQL = SQL & "FROM t_Views "
1523: SQL = SQL & "WHERE "
1524: SQL = SQL & "fk_ParseID = " & DocParseID
1525: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
1526: RSViews = DataStore.GetRecordSet(SQL)
1527:
1528: Do While Not RSViews.EOF
1529:
1530: ViewID = RSViews.Fields("ViewID").Value
1531: ViewName = RSViews.Fields("ViewName").Value
1532: ViewText = RSViews.Fields("ViewText").Value
1533: ViewHTML = ""
1534:
1535: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & ViewName)
1536:
1537: DatabaseTextFile = DatabaseTextFile & ViewName & vbCrLf
1538:
1539: 'Store this view
1540: Call StoreHTMLHelpIndexContent(ViewName, "View", "Database_" & DatabaseID & "_View_" & ViewID & ".htm", "", DatabaseID, 0, ViewID)
1541: 'ViewText = Replace(ViewText, vbCrLf, "<br>" & vbCrLf)
1542:
1543: ListHTML = ListHTML & "<a href=""Database_" & DatabaseID & "_View_" & ViewID & ".htm"">" & vbCrLf
1544: ListHTML = ListHTML & "" & ViewName & "</a><br>" & vbCrLf
1545:
1546: 'Get columns for this View
1547: SQL = "SELECT t_ViewColumns.* "
1548: SQL = SQL & "FROM t_ViewColumns "
1549: SQL = SQL & "WHERE "
1550: SQL = SQL & "fk_ViewID = " & ViewID
1551: RSColumns = DataStore.GetRecordSet(SQL)
1552:
1553: ViewHTML = ViewHTML & GetHTMLTableOpener
1554: ViewHTML = ViewHTML & GetHTMLTableRowOpener
1555:
1556: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1557: ViewHTML = ViewHTML & GetHTMLTableHeaderCell(" ")
1558: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1559: ViewHTML = ViewHTML & GetHTMLTableHeaderCell("Column Name")
1560: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1561: ViewHTML = ViewHTML & GetHTMLTableHeaderCell("Type")
1562: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1563: ViewHTML = ViewHTML & GetHTMLTableHeaderCell("Length")
1564: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1565: ViewHTML = ViewHTML & GetHTMLTableHeaderCell("Nullable")
1566:
1567: ViewHTML = ViewHTML & GetHTMLTableRowCloser
1568:
1569: 'Build table opening section in RTF file
1570: If MakeRTFFile Then
1571:
1572: RTFText = ""
1573: RTFText = RTFText & "\trowd\trgaph108\trleft-108\trbrdrt\brdrs\brdrw10 \trbrdrl\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx8452\pard\intbl\b " & ViewName & "\b0\cell\row" & vbCrLf
1574: RTFText = RTFText & "\trowd\trgaph108\trleft-108\trbrdrt\brdrs\brdrw10 \trbrdrl\brdrs\brdrw10 \trbrdrb\brdrs\brdrw10 \trbrdrr\brdrs\brdrw10 \clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx1527\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx3716\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx5381\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx7149\clbrdrt\brdrw15\brdrs\clbrdrl\brdrw15\brdrs\clbrdrb\brdrw15\brdrs\clbrdrr\brdrw15\brdrs \cellx8452\pard\intbl \cell\i Column Name\i0\cell\i Type\i0\cell\i Length\i0\cell\i Nullable\i0\cell\row" & vbCrLf
1575:
1576: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1577:
1578: End If
1579:
1580: RTFText = ""
1581:
1582: Do While Not RSColumns.EOF
1583:
1584: ColumnID = RSColumns.Fields("ColumnID").Value
1585: ColumnName = RSColumns.Fields("ColumnName").Value
1586: ColumnTypeName = RSColumns.Fields("TypeName").Value
1587: ColumnLength = RSColumns.Fields("Length").Value
1588: ColumnIsNullable = RSColumns.Fields("IsNullable").Value
1589: ColumnIsPrimaryKey = RSColumns.Fields("IsPrimaryKey").Value
1590:
1591: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & ViewName & "." & ColumnName)
1592:
1593: 'Store this view column
1594: Call StoreHTMLHelpIndexContent(ColumnName, "Column", "Database_" & DatabaseID & "_View_" & ViewID & ".htm", CStr(ColumnID), DatabaseID, 0, ViewID)
1595:
1596: If UCase(ColumnIsNullable) = "TRUE" Then
1597: ColumnIsNullable = "Yes"
1598: End If
1599: If UCase(ColumnIsNullable) = "FALSE" Then
1600: ColumnIsNullable = "No"
1601: End If
1602:
1603: If UCase(ColumnIsPrimaryKey) = "TRUE" Then
1604: ColumnIsPrimaryKey = "Primary Key"
1605: ColumnIsPrimaryKeyForRTF = "Primary Key"
1606: End If
1607: If UCase(ColumnIsPrimaryKey) = "FALSE" Then
1608: ColumnIsPrimaryKey = " "
1609: ColumnIsPrimaryKeyForRTF = ""
1610: End If
1611:
1612: ViewHTML = ViewHTML & GetHTMLTableRowOpener
1613: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1614: ViewHTML = ViewHTML & GetHTMLTableBodyCell(ColumnIsPrimaryKey)
1615: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1616: ViewHTML = ViewHTML & GetHTMLTableBodyCell("<a name=""" & ColumnID & """>" & ColumnName & "</a>")
1617: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1618: ViewHTML = ViewHTML & GetHTMLTableBodyCell(ColumnTypeName)
1619: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1620: ViewHTML = ViewHTML & GetHTMLTableBodyCell(ColumnLength)
1621: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1622: ViewHTML = ViewHTML & GetHTMLTableBodyCell(ColumnIsNullable)
1623: ViewHTML = ViewHTML & GetHTMLTableRowCloser
1624:
1625: If MakeRTFFile Then
1626:
1627: RTFText = RTFText & "\intbl " & ColumnIsPrimaryKeyForRTF & "\cell " & ColumnName & "\cell " & ColumnTypeName & "\cell " & ColumnLength & "\cell " & ColumnIsNullable & "\cell\row" & vbCrLf
1628:
1629: End If
1630:
1631: ' ViewHTML = ViewHTML & ColumnName & "<br>" & vbCrLf
1632:
1633: RSColumns.MoveNext()
1634:
1635: Loop
1636:
1637: ViewHTML = ViewHTML & GetHTMLTableCloser
1638:
1639: If UseColourCoding Then
1640: 'UPGRADE_WARNING: Couldn't resolve default property of object ColorCodeHTML(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1641: ViewHTML = ViewHTML & "<p>" & ColorCodeHTML(ViewText) & "</p>"
1642: Else
1643: 'UPGRADE_WARNING: Couldn't resolve default property of object CodeHTML(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1644: ViewHTML = ViewHTML & "<p>" & CodeHTML(ViewText) & "</p>"
1645: End If
1646:
1647: 'Add view text in textarea
1648: ViewHTML = ViewHTML & "<form name=""FormView"">" & vbCrLf
1649: ViewHTML = ViewHTML & "<hr>" & vbCrLf
1650: ViewHTML = ViewHTML & "Copy and Paste Version of View SQL:<br>" & vbCrLf
1651: ViewHTML = ViewHTML & "<textarea rows=""18"" cols=""70"">" & vbCrLf
1652: 'UPGRADE_WARNING: Couldn't resolve default property of object CodeHTMLBasic(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1653: ViewHTML = ViewHTML & CodeHTMLBasic(ViewText)
1654: ViewHTML = ViewHTML & "</textarea>" & vbCrLf
1655: ViewHTML = ViewHTML & "</form>" & vbCrLf
1656:
1657:
1658:
1659: 'Build table closing section in RTF file (appended to columns content made previously)
1660: If MakeRTFFile Then
1661:
1662: RTFText = RTFText & "\pard\par" & vbCrLf
1663:
1664: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1665:
1666: End If
1667:
1668: 'Build a Views list page for the particular database
1669: PageTitle = "View " & DatabaseName & ".." & ViewName
1670: PageBody = ViewHTML
1671: Call CreatePage("View " & DatabaseName & ".." & ViewName, DocFolderPath, "Database_" & DatabaseID & "_View_" & ViewID & ".htm", PageTitle, PageBody, True)
1672:
1673: NumberOfViews = NumberOfViews + 1
1674:
1675: RSViews.MoveNext()
1676:
1677: Loop
1678:
1679: If NumberOfViews = 0 Then
1680: ListHTML = "<p>No views were found.</p>"
1681: DatabaseTextFile = DatabaseTextFile & "No views were found." & vbCrLf
1682:
1683: If MakeRTFFile Then
1684:
1685: RTFText = "\pard\keepn\s2\kerning0\fs24 " & vbCrLf
1686: RTFText = RTFText & "No views were found. \par" & vbCrLf
1687: RTFText = RTFText & "\pard\f0\par" & vbCrLf
1688:
1689: Call AppendFile(DocFolderPath, CurrentProjectName & ".rtf", RTFText)
1690:
1691: End If
1692:
1693: End If
1694:
1695: 'Build a Views list page for the particular database
1696: PageTitle = "Views in Database " & DatabaseName
1697: PageBody = ListHTML
1698: Call CreatePage("Views in Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & "_Views.htm", PageTitle, PageBody, True)
1699:
1700: 'Build database views part of text file for each database
1701: If MakeTextFile Then
1702:
1703: Call AppendFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", DatabaseTextFile & vbCrLf)
1704:
1705: End If
1706:
1707: RSDatabases.MoveNext()
1708: IsFirstDatabase = False
1709:
1710: Loop
1711:
1712: End Sub
1713: Public Sub CreateStoredProceduresListAndTablesPages()
1714:
1715: Dim ListHTML As String
1716: ListHTML = ""
1717:
1718: 'Dim StoredProcedureHTML As String
1719: Dim NumberOfStoredProcedures As Integer
1720: Dim NumberOfItemsDocumented As Integer
1721:
1722: Dim RSDatabases As New ADODB.Recordset
1723: Dim RSStoredProcedures As New ADODB.Recordset
1724: Dim RSStoredProcedureColumns As New ADODB.Recordset
1725: Dim DataConnection As New ADODB.Connection
1726: Dim SQL As String
1727: Dim DatabaseID As Integer
1728: Dim DatabaseName As String
1729: Dim PageBody As String
1730: Dim PageTitle As String
1731: Dim StoredProcedureID As Integer
1732: Dim StoredProcedureName As String
1733: Dim StoredProcedureText As String
1734: Dim StoredProcedureColumnID As Integer
1735: Dim StoredProcedureColumnName As String
1736: Dim StoredProcedureColumnTypeName As String
1737: Dim StoredProcedureColumnLength As Integer
1738: Dim DatabaseTextFile As String
1739: 'Dim ColumnID As Long
1740: 'Dim ColumnName As String
1741: 'Dim ColumnTypeName As String
1742: 'Dim ColumnLength As String
1743: 'Dim ColumnIsNullable As String
1744: 'Dim ColumnIsPrimaryKey As String
1745:
1746: NumberOfItemsDocumented = 0
1747:
1748: SQL = "SELECT t_Databases.* "
1749: SQL = SQL & "FROM t_Parses "
1750: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
1751: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
1752:
1753: RSDatabases = DataStore.GetRecordSet(SQL)
1754:
1755: Dim CConCatStoredProcedure As New CConCat
1756: Do While Not RSDatabases.EOF
1757:
1758: DatabaseID = RSDatabases.Fields("DatabaseID").Value
1759: DatabaseName = RSDatabases.Fields("DatabaseName").Value
1760: DatabaseTextFile = "STORED PROCEDURES" & vbCrLf & vbCrLf
1761:
1762: ListHTML = ""
1763: NumberOfStoredProcedures = 0
1764:
1765: If ApplicationIsEvaluationVersion Then
1766: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_StoredProcedures.* "
1767: Else
1768: SQL = "SELECT t_StoredProcedures.* "
1769: End If
1770: SQL = SQL & "FROM t_StoredProcedures "
1771: SQL = SQL & "WHERE "
1772: SQL = SQL & "fk_ParseID = " & DocParseID
1773: SQL = SQL & " AND fk_DatabaseID = " & DatabaseID
1774: RSStoredProcedures = DataStore.GetRecordSet(SQL)
1775:
1776: Do While Not RSStoredProcedures.EOF
1777:
1778: StoredProcedureID = RSStoredProcedures.Fields("StoredProcedureID").Value
1779: StoredProcedureName = RSStoredProcedures.Fields("StoredProcedureName").Value
1780: StoredProcedureText = RSStoredProcedures.Fields("StoredProcedureText").Value
1781: 'StoredProcedureHTML = ""
1782:
1783:
1784: DatabaseTextFile = DatabaseTextFile & StoredProcedureName & vbCrLf
1785:
1786: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & StoredProcedureName)
1787:
1788: NumberOfItemsDocumented = NumberOfItemsDocumented + 1
1789:
1790: CConCatStoredProcedure.Cat((GetHTMLTableOpener))
1791: CConCatStoredProcedure.Cat((GetHTMLTableRowOpener))
1792:
1793: CConCatStoredProcedure.Cat((GetHTMLTableHeaderCell(" ")))
1794: CConCatStoredProcedure.Cat((GetHTMLTableHeaderCell("Column Name")))
1795: CConCatStoredProcedure.Cat((GetHTMLTableHeaderCell("Type")))
1796: CConCatStoredProcedure.Cat((GetHTMLTableHeaderCell("Length")))
1797:
1798: CConCatStoredProcedure.Cat((GetHTMLTableRowCloser))
1799:
1800: Call StoreHTMLHelpIndexContent(StoredProcedureName, "Stored Procedure", "Database_" & DatabaseID & "_StoredProcedure_" & StoredProcedureID & ".htm", "", DatabaseID, 0, 0)
1801:
1802: 'Stored procedure columns
1803: SQL = "SELECT t_StoredProcedureColumns.* "
1804: SQL = SQL & "FROM t_StoredProcedureColumns "
1805: SQL = SQL & "WHERE "
1806: SQL = SQL & "fk_StoredProcedureID = " & StoredProcedureID
1807: RSStoredProcedureColumns = DataStore.GetRecordSet(SQL)
1808:
1809: Do While Not RSStoredProcedureColumns.EOF
1810:
1811: StoredProcedureColumnID = RSStoredProcedureColumns.Fields("StoredProcedureColumnID").Value
1812: StoredProcedureColumnName = RSStoredProcedureColumns.Fields("StoredProcedureColumnName").Value
1813: StoredProcedureColumnTypeName = RSStoredProcedureColumns.Fields("StoredProcedureColumnTypeName").Value
1814: StoredProcedureColumnLength = RSStoredProcedureColumns.Fields("StoredProcedureColumnLength").Value
1815:
1816: CConCatStoredProcedure.Cat((GetHTMLTableRowOpener))
1817: CConCatStoredProcedure.Cat((GetHTMLTableBodyCell(" ")))
1818: CConCatStoredProcedure.Cat((GetHTMLTableBodyCell(StoredProcedureColumnName)))
1819: CConCatStoredProcedure.Cat((GetHTMLTableBodyCell(StoredProcedureColumnTypeName)))
1820: CConCatStoredProcedure.Cat((GetHTMLTableBodyCell(CStr(StoredProcedureColumnLength))))
1821: CConCatStoredProcedure.Cat((GetHTMLTableRowCloser))
1822:
1823: RSStoredProcedureColumns.MoveNext()
1824:
1825: Loop
1826:
1827:
1828: CConCatStoredProcedure.Cat((GetHTMLTableCloser))
1829:
1830: 'StoredProcedureText = Replace(StoredProcedureText, vbCrLf, "<br>" & vbCrLf)
1831:
1832: ListHTML = ListHTML & "<a href=""Database_" & DatabaseID & "_StoredProcedure_" & StoredProcedureID & ".htm"">" & vbCrLf
1833: ListHTML = ListHTML & "" & StoredProcedureName & "</a><br>" & vbCrLf
1834:
1835: If UseColourCoding Then
1836: CConCatStoredProcedure.Cat((ColorCodeHTML(StoredProcedureText)))
1837: Else
1838: CConCatStoredProcedure.Cat((CodeHTML(StoredProcedureText)))
1839: End If
1840:
1841: 'Add stored procedure text in textarea
1842: CConCatStoredProcedure.Cat(("<form name=""FormStoredProcedure"">" & vbCrLf))
1843: CConCatStoredProcedure.Cat(("<hr>" & vbCrLf))
1844: CConCatStoredProcedure.Cat(("Copy and Paste Version of Stored Procedure SQL:<br>" & vbCrLf))
1845: CConCatStoredProcedure.Cat(("<textarea rows=""18"" cols=""70"">" & vbCrLf))
1846: CConCatStoredProcedure.Cat((CodeHTMLBasic(StoredProcedureText)))
1847: CConCatStoredProcedure.Cat(("</textarea>" & vbCrLf))
1848: CConCatStoredProcedure.Cat(("</form>" & vbCrLf))
1849:
1850: 'Build a tables list page for the particular database
1851: PageTitle = "Stored Procedure " & DatabaseName & ".." & StoredProcedureName
1852: PageBody = CConCatStoredProcedure.Text
1853: Call CreatePage("Stored Procedure " & DatabaseName & ".." & StoredProcedureName, DocFolderPath, "Database_" & DatabaseID & "_StoredProcedure_" & StoredProcedureID & ".htm", PageTitle, PageBody, True)
1854:
1855: NumberOfStoredProcedures = NumberOfStoredProcedures + 1
1856:
1857: 'UPGRADE_NOTE: Object CConCatStoredProcedure may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
1858: CConCatStoredProcedure = Nothing
1859: RSStoredProcedures.MoveNext()
1860:
1861: Loop
1862:
1863: If NumberOfStoredProcedures = 0 Then
1864: ListHTML = "<p>No stored procedures were found.</p>"
1865: DatabaseTextFile = DatabaseTextFile & "No stored procedures were found." & vbCrLf
1866: End If
1867:
1868: 'Build a stored procedures list page for the particular database
1869: PageTitle = "Stored Procedures in Database " & DatabaseName
1870: PageBody = ListHTML
1871: Call CreatePage("Stored Procedures in Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & "_StoredProcedures.htm", PageTitle, PageBody, True)
1872:
1873: 'Build database stored procedures part of text file for each database
1874: If MakeTextFile Then
1875:
1876: Call AppendFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", DatabaseTextFile & vbCrLf)
1877:
1878: End If
1879:
1880:
1881: RSDatabases.MoveNext()
1882:
1883: Loop
1884:
1885: End Sub
1886: Public Sub CreateTriggersListAndTablesPages()
1887:
1888: Dim ListHTML As String
1889: ListHTML = ""
1890:
1891: Dim TriggerHTML As String
1892: Dim NumberOfTriggers As Integer
1893:
1894: Dim RSDatabases As New ADODB.Recordset
1895: Dim RSTriggers As New ADODB.Recordset
1896: Dim DataConnection As New ADODB.Connection
1897: Dim SQL As String
1898: Dim DatabaseID As Integer
1899: Dim DatabaseName As String
1900: Dim PageBody As String
1901: Dim PageTitle As String
1902: Dim TriggerID As Integer
1903: Dim TriggerName As String
1904: Dim TriggerIsUpdate As Boolean
1905: Dim TriggerIsDelete As Boolean
1906: Dim TriggerIsInsert As Boolean
1907: 'Dim TriggerIsAfter As Boolean
1908: 'Dim TriggerIsInsteadOf As Boolean
1909: Dim TriggerText As String
1910: Dim TriggerTypeText As String
1911: Dim TriggerTableID As Integer
1912: Dim TriggerTableName As String
1913: Dim DatabaseTextFile As String
1914:
1915: SQL = "SELECT t_Databases.* "
1916: SQL = SQL & "FROM t_Parses "
1917: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
1918: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
1919:
1920: RSDatabases = DataStore.GetRecordSet(SQL)
1921:
1922: Do While Not RSDatabases.EOF
1923:
1924: DatabaseID = RSDatabases.Fields("DatabaseID").Value
1925: DatabaseName = RSDatabases.Fields("DatabaseName").Value
1926: DatabaseTextFile = "TRIGGERS" & vbCrLf & vbCrLf
1927:
1928: ListHTML = ""
1929: NumberOfTriggers = 0
1930:
1931: If ApplicationIsEvaluationVersion Then
1932: SQL = "SELECT TOP " & ApplicationEvaluationVersionItemLimit & " t_Triggers.*, t_Tables.* "
1933: Else
1934: SQL = "SELECT t_Triggers.*, t_Tables.* "
1935: End If
1936:
1937: SQL = SQL & "FROM t_Triggers "
1938: SQL = SQL & "INNER JOIN t_Tables ON t_Tables.TableID = t_Triggers.fk_TableID "
1939: SQL = SQL & "WHERE "
1940: SQL = SQL & "t_Tables.fk_ParseID = " & DocParseID
1941: SQL = SQL & " AND t_Tables.fk_DatabaseID = " & DatabaseID
1942: RSTriggers = DataStore.GetRecordSet(SQL)
1943:
1944: Do While Not RSTriggers.EOF
1945:
1946: TriggerID = RSTriggers.Fields("TriggerID").Value
1947: TriggerName = RSTriggers.Fields("TriggerName").Value
1948: TriggerText = RSTriggers.Fields("TriggerText").Value
1949: TriggerTableID = RSTriggers.Fields("TableID").Value
1950: TriggerTableName = RSTriggers.Fields("TableName").Value
1951:
1952: TriggerIsUpdate = RSTriggers.Fields("IsUpdate").Value
1953: TriggerIsDelete = RSTriggers.Fields("IsDelete").Value
1954: TriggerIsInsert = RSTriggers.Fields("IsInsert").Value
1955:
1956: DatabaseTextFile = DatabaseTextFile & TriggerName & vbCrLf
1957:
1958: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & TriggerName)
1959:
1960: 'Store this trigger
1961: Call StoreHTMLHelpIndexContent(TriggerName, "Trigger", "Database_" & DatabaseID & "_Trigger_" & TriggerID & ".htm", "", DatabaseID, 0, 0)
1962:
1963: TriggerTypeText = ""
1964:
1965: If TriggerIsInsert = True Then
1966: TriggerTypeText = TriggerTypeText & "Insert, "
1967: End If
1968:
1969: If TriggerIsUpdate = True Then
1970: TriggerTypeText = TriggerTypeText & "Update, "
1971: End If
1972:
1973: If TriggerIsDelete = True Then
1974: TriggerTypeText = TriggerTypeText & "Delete, "
1975: End If
1976:
1977: If Right(TriggerTypeText, 2) = ", " Then
1978: TriggerTypeText = Left(TriggerTypeText, Len(TriggerTypeText) - 2)
1979: End If
1980:
1981: TriggerHTML = ""
1982:
1983: TriggerHTML = TriggerHTML & GetHTMLTableOpener
1984: TriggerHTML = TriggerHTML & GetHTMLTableRowOpener
1985:
1986: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1987: TriggerHTML = TriggerHTML & GetHTMLTableHeaderCell(" ")
1988: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1989: TriggerHTML = TriggerHTML & GetHTMLTableHeaderCell("On Table")
1990: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1991: TriggerHTML = TriggerHTML & GetHTMLTableHeaderCell("For")
1992:
1993: TriggerHTML = TriggerHTML & GetHTMLTableRowCloser
1994:
1995: TriggerHTML = TriggerHTML & GetHTMLTableRowOpener
1996:
1997: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
1998: TriggerHTML = TriggerHTML & GetHTMLTableBodyCell(" ")
1999: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2000: TriggerHTML = TriggerHTML & GetHTMLTableBodyCell("<a href=""Database_" & DatabaseID & "_Table_" & TriggerTableID & ".htm"">" & TriggerTableName & "</a>")
2001: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2002: TriggerHTML = TriggerHTML & GetHTMLTableBodyCell(TriggerTypeText)
2003:
2004: TriggerHTML = TriggerHTML & GetHTMLTableRowCloser
2005:
2006:
2007: TriggerHTML = TriggerHTML & GetHTMLTableCloser
2008:
2009: 'TriggerText = Replace(TriggerText, vbCrLf, "<br>" & vbCrLf)
2010:
2011: ListHTML = ListHTML & "<a href=""Database_" & DatabaseID & "_Trigger_" & TriggerID & ".htm"">" & vbCrLf
2012: ListHTML = ListHTML & "" & TriggerName & "</a><br>" & vbCrLf
2013:
2014: If UseColourCoding Then
2015: 'UPGRADE_WARNING: Couldn't resolve default property of object ColorCodeHTML(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2016: TriggerHTML = TriggerHTML & ColorCodeHTML(TriggerText)
2017: Else
2018: 'UPGRADE_WARNING: Couldn't resolve default property of object CodeHTML(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2019: TriggerHTML = TriggerHTML & CodeHTML(TriggerText)
2020: End If
2021:
2022: 'Add trigger text in textarea
2023: TriggerHTML = TriggerHTML & "<form name=""FormView"">" & vbCrLf
2024: TriggerHTML = TriggerHTML & "<hr>" & vbCrLf
2025: TriggerHTML = TriggerHTML & "Copy and Paste Version of Trigger SQL:<br>" & vbCrLf
2026: TriggerHTML = TriggerHTML & "<textarea rows=""18"" cols=""70"">" & vbCrLf
2027: 'UPGRADE_WARNING: Couldn't resolve default property of object CodeHTMLBasic(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2028: TriggerHTML = TriggerHTML & CodeHTMLBasic(TriggerText)
2029: TriggerHTML = TriggerHTML & "</textarea>" & vbCrLf
2030: TriggerHTML = TriggerHTML & "</form>" & vbCrLf
2031:
2032:
2033: 'Build a trigger details page for the particular trigger
2034: PageTitle = "Trigger " & DatabaseName & ".." & TriggerName
2035: PageBody = TriggerHTML
2036: Call CreatePage("Trigger " & DatabaseName & ".." & TriggerName, DocFolderPath, "Database_" & DatabaseID & "_Trigger_" & TriggerID & ".htm", PageTitle, PageBody, True)
2037:
2038: NumberOfTriggers = NumberOfTriggers + 1
2039:
2040: RSTriggers.MoveNext()
2041:
2042: Loop
2043:
2044: If NumberOfTriggers = 0 Then
2045: ListHTML = "<p>No triggers were found.</p>"
2046: DatabaseTextFile = DatabaseTextFile & "No triggers were found." & vbCrLf
2047: End If
2048:
2049: 'Build a triggers list page for the particular database
2050: PageTitle = "Triggers in Database " & DatabaseName
2051: PageBody = ListHTML
2052: Call CreatePage("Triggers in Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & "_Triggers.htm", PageTitle, PageBody, True)
2053:
2054: 'Build database triggers part of text file for each database
2055: If MakeTextFile Then
2056:
2057: Call AppendFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", DatabaseTextFile & vbCrLf)
2058:
2059: End If
2060:
2061: RSDatabases.MoveNext()
2062:
2063: Loop
2064:
2065: End Sub
2066: Public Sub CreateIndexesListAndTablesPages()
2067: Dim IndexID As Object
2068:
2069: Dim ListHTML As String
2070: ListHTML = ""
2071:
2072: Dim IndexHTML As String
2073: Dim IndexTableHTML As String
2074: Dim NumberOfIndexes As Integer
2075: 'Dim NumberOfTablesInFullTextCatalog As Long
2076:
2077: Dim RSDatabases As New ADODB.Recordset
2078: Dim RSIndexes As New ADODB.Recordset
2079: Dim RSIndexKeys As New ADODB.Recordset
2080: ' Dim RSFullTextCatalogsTables As New ADODB.Recordset
2081: ' Dim RSFullTextCatalogsTableColumns As New ADODB.Recordset
2082: Dim DataConnection As New ADODB.Connection
2083: Dim SQL As String
2084: Dim DatabaseID As Integer
2085: Dim DatabaseName As String
2086: Dim PageBody As String
2087: Dim PageTitle As String
2088: Dim TriggerID As Integer
2089: Dim IndexName As String
2090: Dim IndexDescription As String
2091: Dim IndexKeysHTML As String
2092: Dim TableName As String
2093: Dim ColumnID As Integer
2094: Dim ColumnName As String
2095: Dim ColumnTableID As Integer
2096: Dim ColumnTableName As String
2097: Dim DatabaseTextFile As String
2098:
2099: SQL = "SELECT t_Databases.* "
2100: SQL = SQL & "FROM t_Parses "
2101: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
2102: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
2103:
2104: RSDatabases = DataStore.GetRecordSet(SQL)
2105:
2106: Do While Not RSDatabases.EOF
2107:
2108: DatabaseID = RSDatabases.Fields("DatabaseID").Value
2109: DatabaseName = RSDatabases.Fields("DatabaseName").Value
2110: DatabaseTextFile = "INDEXES" & vbCrLf & vbCrLf
2111:
2112: ListHTML = ""
2113: NumberOfIndexes = 0
2114:
2115: SQL = "SELECT t_TableIndexes.*, t_Tables.* "
2116: SQL = SQL & "FROM t_TableIndexes "
2117: SQL = SQL & "INNER JOIN t_Tables ON t_Tables.TableID = t_TableIndexes.fk_TableID "
2118: SQL = SQL & "WHERE "
2119: SQL = SQL & "t_Tables.fk_ParseID = " & DocParseID
2120: SQL = SQL & " AND t_Tables.fk_DatabaseID = " & DatabaseID
2121: RSIndexes = DataStore.GetRecordSet(SQL)
2122:
2123: Do While Not RSIndexes.EOF
2124:
2125: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2126: IndexID = RSIndexes.Fields("IndexID").Value
2127: IndexName = RSIndexes.Fields("IndexName").Value
2128: IndexDescription = RSIndexes.Fields("IndexDescription").Value
2129: TableName = RSIndexes.Fields("TableName").Value
2130:
2131: DatabaseTextFile = DatabaseTextFile & IndexName & vbCrLf
2132:
2133: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & IndexName)
2134:
2135: 'Store this index
2136: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2137: Call StoreHTMLHelpIndexContent(IndexName, "Index", "Database_" & DatabaseID & "_Index_" & IndexID & ".htm", "", DatabaseID, 0, 0)
2138:
2139: IndexHTML = ""
2140: IndexTableHTML = ""
2141: IndexKeysHTML = ""
2142:
2143: 'Determine the keys associated with this index
2144: SQL = "SELECT t_TableIndexColumns.*, t_TableColumns.ColumnID, t_TableColumns.fk_TableID, t_TableColumns.ColumnName, t_Tables.TableName "
2145: SQL = SQL & "FROM (t_TableIndexColumns "
2146: SQL = SQL & "INNER JOIN t_TableColumns ON t_TableColumns.ColumnID = t_TableIndexColumns.fk_ColumnID) "
2147: SQL = SQL & "INNER JOIN t_Tables ON t_TableColumns.fk_TableID = t_Tables.TableID "
2148: SQL = SQL & "WHERE "
2149: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2150: SQL = SQL & "t_TableIndexColumns.fk_IndexID = " & IndexID
2151: RSIndexKeys = DataStore.GetRecordSet(SQL)
2152:
2153: Do While Not RSIndexKeys.EOF
2154:
2155: ColumnID = RSIndexKeys.Fields("ColumnID").Value
2156: ColumnTableID = RSIndexKeys.Fields("fk_TableID").Value
2157: ColumnName = RSIndexKeys.Fields("ColumnName").Value
2158: ColumnTableName = RSIndexKeys.Fields("TableName").Value
2159:
2160: IndexKeysHTML = IndexKeysHTML & "<a href=""Database_" & DatabaseID & "_Table_" & ColumnTableID & ".htm#" & ColumnID & """>" & ColumnName & "</a>,<br>"
2161:
2162: RSIndexKeys.MoveNext()
2163: Loop
2164:
2165: 'Trim trailing ", "
2166: If Len(IndexKeysHTML) > 2 Then
2167: IndexKeysHTML = Left(IndexKeysHTML, Len(IndexKeysHTML) - 5)
2168: End If
2169:
2170: IndexTableHTML = IndexTableHTML & GetHTMLTableOpener
2171: IndexTableHTML = IndexTableHTML & GetHTMLTableRowOpener
2172:
2173: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2174: IndexTableHTML = IndexTableHTML & GetHTMLTableHeaderCell(" ")
2175: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2176: IndexTableHTML = IndexTableHTML & GetHTMLTableHeaderCell("On Table")
2177: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2178: IndexTableHTML = IndexTableHTML & GetHTMLTableHeaderCell("Index Description")
2179: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2180: IndexTableHTML = IndexTableHTML & GetHTMLTableHeaderCell("Index Keys")
2181:
2182: IndexTableHTML = IndexTableHTML & GetHTMLTableRowCloser
2183:
2184: 'Display details of this index
2185: IndexTableHTML = IndexTableHTML & GetHTMLTableRowOpener
2186:
2187: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2188: IndexTableHTML = IndexTableHTML & GetHTMLTableBodyCell(" ")
2189: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2190: IndexTableHTML = IndexTableHTML & GetHTMLTableBodyCell(TableName)
2191: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2192: IndexTableHTML = IndexTableHTML & GetHTMLTableBodyCell(IndexDescription)
2193: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2194: IndexTableHTML = IndexTableHTML & GetHTMLTableBodyCell(IndexKeysHTML)
2195:
2196: IndexTableHTML = IndexTableHTML & GetHTMLTableRowCloser
2197:
2198: IndexTableHTML = IndexTableHTML & GetHTMLTableCloser
2199:
2200: IndexHTML = IndexHTML & IndexTableHTML
2201:
2202: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2203: ListHTML = ListHTML & "<a href=""Database_" & DatabaseID & "_Index_" & IndexID & ".htm"">" & vbCrLf
2204: ListHTML = ListHTML & "" & IndexName & "</a><br>" & vbCrLf
2205:
2206: 'Build a full-text catalog details page for the particular full-text catalog
2207: PageTitle = "Index " & DatabaseName & ".." & IndexName
2208: PageBody = IndexHTML
2209: 'UPGRADE_WARNING: Couldn't resolve default property of object IndexID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2210: Call CreatePage("Index " & DatabaseName & ".." & IndexName, DocFolderPath, "Database_" & DatabaseID & "_Index_" & IndexID & ".htm", PageTitle, PageBody, True)
2211:
2212: NumberOfIndexes = NumberOfIndexes + 1
2213:
2214: RSIndexes.MoveNext()
2215:
2216: Loop
2217:
2218: If NumberOfIndexes = 0 Then
2219: ListHTML = "<p>No indexes were found.</p>"
2220: DatabaseTextFile = DatabaseTextFile & "No indexes were found." & vbCrLf
2221: End If
2222:
2223: 'Build an index list page for the particular database
2224: PageTitle = "Indexes in Database " & DatabaseName
2225: PageBody = ListHTML
2226: Call CreatePage("Indexes in Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & "_Indexes.htm", PageTitle, PageBody, True)
2227:
2228: 'Build database indexes part of text file for each database
2229: If MakeTextFile Then
2230:
2231: Call AppendFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", DatabaseTextFile & vbCrLf)
2232:
2233: End If
2234:
2235: RSDatabases.MoveNext()
2236:
2237: Loop
2238:
2239: End Sub
2240:
2241: Public Sub CreateFullTextCatalogsListAndTablesPages()
2242: Dim FullTextCatalogTableName As Object
2243: Dim FullTextCatalogTableID As Object
2244: Dim FullTextCatalogID As Object
2245:
2246: Dim ListHTML As String
2247: ListHTML = ""
2248:
2249: Dim FullTextCatalogsHTML As String
2250: Dim FullTextCatalogsTableHTML As String
2251: Dim NumberOfFullTextCatalogs As Integer
2252: Dim NumberOfTablesInFullTextCatalog As Integer
2253:
2254: Dim RSDatabases As New ADODB.Recordset
2255: Dim RSFullTextCatalogs As New ADODB.Recordset
2256: Dim RSFullTextCatalogsTables As New ADODB.Recordset
2257: Dim RSFullTextCatalogsTableColumns As New ADODB.Recordset
2258: Dim DataConnection As New ADODB.Connection
2259: Dim SQL As String
2260: Dim DatabaseID As Integer
2261: Dim DatabaseName As String
2262: Dim PageBody As String
2263: Dim PageTitle As String
2264: Dim TriggerID As Integer
2265: Dim FullTextCatalogName As String
2266: Dim DatabaseTextFile As String
2267: Dim FullTextCatalogTableColumnsHTML As String
2268: Dim FullTextCatalogTableColumnID As Integer
2269: Dim FullTextCatalogTableColumnName As String
2270: Dim FullTextCatalogTableIndexName As String
2271: Dim FullTextCatalogTableIndexNameHTML As String
2272:
2273: SQL = "SELECT t_Databases.* "
2274: SQL = SQL & "FROM t_Parses "
2275: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID "
2276: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID
2277:
2278: RSDatabases = DataStore.GetRecordSet(SQL)
2279:
2280: Do While Not RSDatabases.EOF
2281:
2282: DatabaseID = RSDatabases.Fields("DatabaseID").Value
2283: DatabaseName = RSDatabases.Fields("DatabaseName").Value
2284: DatabaseTextFile = "FULL-TEXT CATALOGS" & vbCrLf & vbCrLf
2285:
2286: ListHTML = ""
2287: NumberOfFullTextCatalogs = 0
2288:
2289: SQL = "SELECT t_FullTextCatalogs.* "
2290: SQL = SQL & "FROM t_FullTextCatalogs "
2291: SQL = SQL & "WHERE "
2292: SQL = SQL & "t_FullTextCatalogs.fk_ParseID = " & DocParseID
2293: SQL = SQL & " AND t_FullTextCatalogs.fk_DatabaseID = " & DatabaseID
2294: RSFullTextCatalogs = DataStore.GetRecordSet(SQL)
2295:
2296: Do While Not RSFullTextCatalogs.EOF
2297:
2298: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2299: FullTextCatalogID = RSFullTextCatalogs.Fields("FullTextCatalogID").Value
2300: FullTextCatalogName = RSFullTextCatalogs.Fields("FullTextCatalogName").Value
2301:
2302: DatabaseTextFile = DatabaseTextFile & FullTextCatalogName & vbCrLf
2303:
2304: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseName & ".." & FullTextCatalogName)
2305:
2306: 'Store this full-text catalog
2307: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2308: Call StoreHTMLHelpIndexContent(FullTextCatalogName, "Full-Text Catalog", "Database_" & DatabaseID & "_FullTextCatalog_" & FullTextCatalogID & ".htm", "", DatabaseID, 0, 0)
2309:
2310:
2311: FullTextCatalogsHTML = ""
2312: FullTextCatalogsTableHTML = ""
2313:
2314: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableOpener
2315: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableRowOpener
2316:
2317: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2318: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableHeaderCell(" ")
2319: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2320: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableHeaderCell("Tables")
2321: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2322: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableHeaderCell("Index Name")
2323: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2324: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableHeaderCell("Table Columns")
2325:
2326: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableRowCloser
2327:
2328: 'Tables in full-text catalog
2329: NumberOfTablesInFullTextCatalog = 0
2330:
2331: SQL = "SELECT t_FullTextCatalogsTables.*, t_Tables.* "
2332: SQL = SQL & "FROM t_FullTextCatalogsTables "
2333: SQL = SQL & "INNER JOIN t_Tables ON t_Tables.TableID = t_FullTextCatalogsTables.fk_TableID "
2334: SQL = SQL & "WHERE "
2335: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2336: SQL = SQL & "t_FullTextCatalogsTables.fk_FullTextCatalogID = " & FullTextCatalogID
2337: RSFullTextCatalogsTables = DataStore.GetRecordSet(SQL)
2338:
2339: Do While Not RSFullTextCatalogsTables.EOF
2340:
2341:
2342: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2343: FullTextCatalogTableID = RSFullTextCatalogsTables.Fields("fk_TableID").Value
2344: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2345: FullTextCatalogTableName = RSFullTextCatalogsTables.Fields("TableName").Value
2346: FullTextCatalogTableIndexName = RSFullTextCatalogsTables.Fields("FullTextCatalogTableIndexName").Value
2347: FullTextCatalogTableColumnsHTML = ""
2348:
2349: FullTextCatalogTableIndexNameHTML = FullTextCatalogTableIndexName
2350:
2351: 'Determine the table columns in this table in the full-text catalog
2352: SQL = "SELECT t_FullTextCatalogsTableColumns.*, t_TableColumns.* "
2353: SQL = SQL & "FROM t_FullTextCatalogsTableColumns "
2354: SQL = SQL & "INNER JOIN t_TableColumns ON t_FullTextCatalogsTableColumns.fk_ColumnID = t_TableColumns.ColumnID "
2355: SQL = SQL & "WHERE "
2356: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2357: SQL = SQL & "t_FullTextCatalogsTableColumns.fk_TableID = " & FullTextCatalogTableID
2358: 'SQL = SQL & " AND t_FullTextCatalogs.fk_DatabaseID = " & DatabaseID
2359: RSFullTextCatalogsTableColumns = DataStore.GetRecordSet(SQL)
2360:
2361: Do While Not RSFullTextCatalogsTableColumns.EOF
2362:
2363: FullTextCatalogTableColumnID = RSFullTextCatalogsTableColumns.Fields("ColumnID").Value
2364: FullTextCatalogTableColumnName = RSFullTextCatalogsTableColumns.Fields("ColumnName").Value
2365:
2366: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2367: FullTextCatalogTableColumnsHTML = FullTextCatalogTableColumnsHTML & "<a href=""Database_" & DatabaseID & "_Table_" & FullTextCatalogTableID & ".htm#" & FullTextCatalogTableColumnID & """>"
2368: FullTextCatalogTableColumnsHTML = FullTextCatalogTableColumnsHTML & FullTextCatalogTableColumnName
2369: FullTextCatalogTableColumnsHTML = FullTextCatalogTableColumnsHTML & "</a>"
2370: FullTextCatalogTableColumnsHTML = FullTextCatalogTableColumnsHTML & "<br>" & vbCrLf
2371:
2372: RSFullTextCatalogsTableColumns.MoveNext()
2373:
2374: Loop
2375:
2376:
2377: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableRowOpener
2378: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2379: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell(" ")
2380: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogTableName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2381: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2382: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2383: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell("<a href=""Database_" & DatabaseID & "_Table_" & FullTextCatalogTableID & ".htm"">" & FullTextCatalogTableName & "</a>")
2384: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2385: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell(FullTextCatalogTableIndexNameHTML)
2386: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2387: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell(FullTextCatalogTableColumnsHTML)
2388: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableRowCloser
2389:
2390: NumberOfTablesInFullTextCatalog = NumberOfTablesInFullTextCatalog + 1
2391:
2392: RSFullTextCatalogsTables.MoveNext()
2393:
2394: Loop
2395:
2396: FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableCloser
2397:
2398: If NumberOfTablesInFullTextCatalog > 0 Then
2399:
2400: FullTextCatalogsHTML = FullTextCatalogsHTML & FullTextCatalogsTableHTML
2401:
2402: Else
2403:
2404: FullTextCatalogsHTML = FullTextCatalogsHTML & "There are no table columns in this full-text catalog."
2405:
2406:
2407: End If
2408:
2409: 'TriggerText = Replace(TriggerText, vbCrLf, "<br>" & vbCrLf)
2410:
2411: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2412: ListHTML = ListHTML & "<a href=""Database_" & DatabaseID & "_FullTextCatalog_" & FullTextCatalogID & ".htm"">" & vbCrLf
2413: ListHTML = ListHTML & "" & FullTextCatalogName & "</a><br>" & vbCrLf
2414:
2415: 'Build a full-text catalog details page for the particular full-text catalog
2416: PageTitle = "Full Text Catalog " & DatabaseName & ".." & FullTextCatalogName
2417: PageBody = FullTextCatalogsHTML
2418: 'UPGRADE_WARNING: Couldn't resolve default property of object FullTextCatalogID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2419: Call CreatePage("Full-Text Catalog " & DatabaseName & ".." & FullTextCatalogName, DocFolderPath, "Database_" & DatabaseID & "_FullTextCatalog_" & FullTextCatalogID & ".htm", PageTitle, PageBody, True)
2420:
2421: NumberOfFullTextCatalogs = NumberOfFullTextCatalogs + 1
2422:
2423: RSFullTextCatalogs.MoveNext()
2424:
2425: Loop
2426:
2427: If NumberOfFullTextCatalogs = 0 Then
2428: ListHTML = "<p>No full-text catalogs were found.</p>"
2429: DatabaseTextFile = DatabaseTextFile & "No full-text catalogs were found." & vbCrLf
2430: End If
2431:
2432: 'Build a full-text catalogs list page for the particular database
2433: PageTitle = "Full-Text Catalogs in Database " & DatabaseName
2434: PageBody = ListHTML
2435: Call CreatePage("Full-Text Catalogs in Database " & DatabaseName, DocFolderPath, "Database_" & DatabaseID & "_FullTextCatalogs.htm", PageTitle, PageBody, True)
2436:
2437: 'Build database full-text catalogs part of text file for each database
2438: If MakeTextFile Then
2439:
2440: Call AppendFile(DocFolderPath, CurrentProjectName & "_" & DatabaseName & ".txt", DatabaseTextFile & vbCrLf)
2441:
2442: End If
2443:
2444: RSDatabases.MoveNext()
2445:
2446: Loop
2447:
2448: End Sub
2449: 'Builds the DTS pages
2450: Private Function CreateDTSPackagePages() As Object
2451:
2452: Dim HTML As String
2453: HTML = ""
2454:
2455: Dim RS As New ADODB.Recordset
2456: Dim DataConnection As New ADODB.Connection
2457: Dim SQL As String
2458: Dim DatabaseID As Integer
2459: Dim DatabaseName As String
2460: Dim DatabaseServer As String
2461: Dim TextReportsLinks As String
2462: Dim PreviousDatabaseServer As String
2463: Dim IsFirstDatabase As Boolean
2464: Dim RSDTSPackages As New ADODB.Recordset
2465: Dim ConnectionID As Integer
2466: Dim PackageID As Integer
2467: Dim PackageName As String
2468: Dim PackageDescription As String
2469: Dim PackageOwner As String
2470: Dim PackageSize As Integer
2471: Dim PackageCreateDate As String
2472: Dim NumberOfDTSPackages As Integer
2473: Dim DTSPackageHTML As String
2474: Dim DTSPackageTableHTML As String
2475: Dim PageBody As String
2476: Dim PageTitle As String
2477: Dim ListHTML As String
2478:
2479: SQL = "SELECT t_Databases.*, t_Connections.ConnectionID, t_Connections.DatabaseServer "
2480: SQL = SQL & "FROM (t_Parses "
2481: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID) "
2482: SQL = SQL & "INNER JOIN t_Connections on t_Databases.fk_ConnectionID = t_Connections.ConnectionID "
2483: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID & " "
2484: SQL = SQL & "ORDER BY t_Connections.DatabaseServer"
2485:
2486: RS = DataStore.GetRecordSet(SQL)
2487:
2488: HTML = "" 'HTML & "<h2>Database Documentation Summary</h2>" & vbCrLf
2489: TextReportsLinks = "Text Reports:<br>"
2490: PreviousDatabaseServer = ""
2491: IsFirstDatabase = True
2492:
2493: Do While Not RS.EOF
2494:
2495: ConnectionID = RS.Fields("ConnectionID").Value
2496: DatabaseID = RS.Fields("DatabaseID").Value
2497: DatabaseName = RS.Fields("DatabaseName").Value
2498: DatabaseServer = RS.Fields("DatabaseServer").Value
2499:
2500: If DatabaseServer <> PreviousDatabaseServer Then
2501: If IsFirstDatabase = False Then
2502: 'HTML = HTML & "</p>" & vbCrLf
2503: End If
2504:
2505: 'Do the DTS Packages for this server
2506: SQL = "SELECT t_Packages.* "
2507: SQL = SQL & "FROM t_Packages "
2508: SQL = SQL & "WHERE "
2509: SQL = SQL & "t_Packages.fk_ParseID = " & DocParseID
2510: SQL = SQL & " AND t_Packages.fk_ConnectionID = " & ConnectionID
2511: RSDTSPackages = DataStore.GetRecordSet(SQL)
2512:
2513: NumberOfDTSPackages = 0
2514: ListHTML = ""
2515:
2516: Do While Not RSDTSPackages.EOF
2517:
2518: PackageID = RSDTSPackages.Fields("PackageID").Value
2519: PackageName = RSDTSPackages.Fields("PackageName").Value
2520: PackageDescription = RSDTSPackages.Fields("PackageDescription").Value
2521: PackageOwner = RSDTSPackages.Fields("PackageOwner").Value
2522: PackageSize = RSDTSPackages.Fields("PackageSize").Value
2523: PackageCreateDate = RSDTSPackages.Fields("PackageCreateDate").Value
2524:
2525: NumberOfDTSPackages = NumberOfDTSPackages + 1
2526: ListHTML = ListHTML & "<a href=""Connection_" & ConnectionID & "_Package_" & PackageID & ".htm"">" & PackageName & "</a><br>"
2527:
2528: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseServer & ".." & PackageName)
2529:
2530: 'Store this full-text catalog
2531: Call StoreHTMLHelpIndexContent(PackageName, "DTS Package", "Connection_" & ConnectionID & "_Package_" & PackageID & ".htm", "", DatabaseID, 0, 0)
2532:
2533: DTSPackageHTML = ""
2534: DTSPackageTableHTML = ""
2535:
2536: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableOpener
2537: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowOpener
2538: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2539: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Item")
2540: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2541: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Value")
2542: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowCloser
2543:
2544: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowOpener
2545: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2546: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Package Name")
2547: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2548: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableBodyCell(PackageName)
2549: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowCloser
2550:
2551: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowOpener
2552: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2553: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Package Description")
2554: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2555: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableBodyCell(PackageDescription)
2556: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowCloser
2557:
2558: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowOpener
2559: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2560: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Package Owner")
2561: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2562: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableBodyCell(PackageOwner)
2563: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowCloser
2564:
2565: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowOpener
2566: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2567: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Package Size")
2568: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2569: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableBodyCell(CStr(PackageSize))
2570: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowCloser
2571:
2572: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowOpener
2573: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2574: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableHeaderCell("Package Creation Date")
2575: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2576: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableBodyCell(CStr(PackageCreateDate))
2577: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableRowCloser
2578:
2579: DTSPackageTableHTML = DTSPackageTableHTML & GetHTMLTableCloser
2580:
2581: 'FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableRowOpener
2582: 'FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell(" ")
2583: 'FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell("<a href=""Database_" & DatabaseID & "_Table_" & FullTextCatalogTableID & ".htm"">" & FullTextCatalogTableName & "</a>")
2584: 'FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell(FullTextCatalogTableIndexNameHTML)
2585: 'FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableBodyCell(FullTextCatalogTableColumnsHTML)
2586: 'FullTextCatalogsTableHTML = FullTextCatalogsTableHTML & GetHTMLTableRowCloser
2587:
2588:
2589: DTSPackageHTML = DTSPackageHTML & DTSPackageTableHTML
2590:
2591: 'Build a DTS Package details page for the particular DTS Package
2592: PageTitle = "DTS Package " & PackageName & " in SQL Server " & DatabaseServer
2593: PageBody = DTSPackageHTML
2594: Call CreatePage("DTS Package " & PackageName & " in SQL Server " & DatabaseServer, DocFolderPath, "Connection_" & ConnectionID & "_Package_" & PackageID & ".htm", PageTitle, PageBody, True)
2595:
2596:
2597: RSDTSPackages.MoveNext()
2598:
2599:
2600: Loop
2601:
2602:
2603: If NumberOfDTSPackages > 0 Then
2604:
2605: ListHTML = ListHTML & ""
2606:
2607: Else
2608:
2609: ListHTML = "There are no DTS packages in this database."
2610:
2611: End If
2612:
2613: 'Build a DTS package list page
2614: PageTitle = "DTS Packages in SQL Server " & DatabaseServer
2615: PageBody = ListHTML
2616: Call CreatePage("DTS Packages in SQL Server " & DatabaseServer, DocFolderPath, "Connection_" & ConnectionID & "_DTSPackages.htm", PageTitle, PageBody, True)
2617:
2618: Else
2619:
2620: End If
2621:
2622:
2623:
2624:
2625: PreviousDatabaseServer = DatabaseServer
2626: IsFirstDatabase = False
2627:
2628: RS.MoveNext()
2629: Loop
2630:
2631:
2632:
2633:
2634: 'UPGRADE_WARNING: Couldn't resolve default property of object CreateDTSPackagePages. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2635: CreateDTSPackagePages = True
2636:
2637: End Function
2638: 'Builds the DTS pages
2639: Private Function CreateJobsPages() As Object
2640: Dim JobScheduleID As Object
2641:
2642: Dim HTML As String
2643: HTML = ""
2644:
2645: Dim RS As New ADODB.Recordset
2646: Dim DataConnection As New ADODB.Connection
2647: Dim SQL As String
2648: Dim DatabaseID As Integer
2649: Dim DatabaseName As String
2650: Dim DatabaseServer As String
2651: Dim TextReportsLinks As String
2652: Dim PreviousDatabaseServer As String
2653: Dim IsFirstDatabase As Boolean
2654: Dim RSJobs As New ADODB.Recordset
2655: Dim RSJobSteps As New ADODB.Recordset
2656: Dim RSJobSchedule As New ADODB.Recordset
2657: Dim ConnectionID As Integer
2658: Dim JobID As Integer
2659: Dim JobName As String
2660: Dim JobDescription As String
2661: Dim JobCategory As String
2662: Dim JobOwner As String
2663: Dim JobCreateDate As String
2664: Dim JobModifiedDate As String
2665: Dim JobIsEnabled As Boolean
2666: Dim NumberOfJobs As Integer
2667: Dim JobHTML As String
2668: Dim JobTableHTML As String
2669: Dim PageBody As String
2670: Dim PageTitle As String
2671: Dim ListHTML As String
2672: Dim JobStepSQLID As Integer
2673: Dim JobStepName As String
2674: Dim JobStepSubsystem As String
2675: Dim JobStepCommand As String
2676: Dim JobScheduleIsEnabled As Boolean
2677: Dim JobScheduleName As String
2678: Dim JobScheduleDescription As String
2679: Dim JobScheduleCreateDate As String
2680: Dim JobScheduleFrequencyType As String
2681: Dim JobScheduleFrequencyInterval As String
2682: Dim JobScheduleFrequencyDescription As String
2683: Dim JobScheduleStartDate As String
2684: Dim JobScheduleEndDate As String
2685: Dim JobScheduleStartTime As String
2686: Dim JobScheduleEndTime As String
2687:
2688: SQL = "SELECT t_Databases.*, t_Connections.ConnectionID, t_Connections.DatabaseServer "
2689: SQL = SQL & "FROM (t_Parses "
2690: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID) "
2691: SQL = SQL & "INNER JOIN t_Connections on t_Databases.fk_ConnectionID = t_Connections.ConnectionID "
2692: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID & " "
2693: SQL = SQL & "ORDER BY t_Connections.DatabaseServer"
2694:
2695: RS = DataStore.GetRecordSet(SQL)
2696:
2697: HTML = "" 'HTML & "<h2>Database Documentation Summary</h2>" & vbCrLf
2698: TextReportsLinks = "Text Reports:<br>"
2699: PreviousDatabaseServer = ""
2700: IsFirstDatabase = True
2701:
2702: Do While Not RS.EOF
2703:
2704: ConnectionID = RS.Fields("ConnectionID").Value
2705: DatabaseID = RS.Fields("DatabaseID").Value
2706: DatabaseName = RS.Fields("DatabaseName").Value
2707: DatabaseServer = RS.Fields("DatabaseServer").Value
2708:
2709: If DatabaseServer <> PreviousDatabaseServer Then
2710: If IsFirstDatabase = False Then
2711: 'HTML = HTML & "</p>" & vbCrLf
2712: End If
2713:
2714: 'Do the DTS Packages for this server
2715: SQL = "SELECT t_Jobs.* "
2716: SQL = SQL & "FROM t_Jobs "
2717: SQL = SQL & "WHERE "
2718: SQL = SQL & "t_Jobs.fk_ParseID = " & DocParseID
2719: SQL = SQL & " AND t_Jobs.fk_ConnectionID = " & ConnectionID
2720: RSJobs = DataStore.GetRecordSet(SQL)
2721:
2722: NumberOfJobs = 0
2723: ListHTML = ""
2724:
2725: Do While Not RSJobs.EOF
2726:
2727: JobID = RSJobs.Fields("JobID").Value
2728: JobName = RSJobs.Fields("JobName").Value
2729: JobDescription = RSJobs.Fields("JobDescription").Value
2730: JobCategory = RSJobs.Fields("JobCategory").Value
2731: JobOwner = RSJobs.Fields("JobOwner").Value
2732: JobCreateDate = RSJobs.Fields("JobCreateDate").Value
2733: JobModifiedDate = RSJobs.Fields("JobModifiedDate").Value
2734: JobIsEnabled = RSJobs.Fields("JobIsEnabled").Value
2735:
2736: NumberOfJobs = NumberOfJobs + 1
2737: ListHTML = ListHTML & "<a href=""Connection_" & ConnectionID & "_Job_" & JobID & ".htm"">" & JobName & "</a><br>"
2738:
2739: Call FormMain.DefInstance.UpdateCurrentItem(DatabaseServer & ".." & JobName)
2740:
2741: 'Store this Job
2742: Call StoreHTMLHelpIndexContent(JobName, "Job", "Connection_" & ConnectionID & "_Job_" & JobID & ".htm", "", DatabaseID, 0, 0)
2743:
2744: JobHTML = ""
2745: JobTableHTML = ""
2746:
2747: JobTableHTML = JobTableHTML & GetHTMLTableOpener
2748: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2749: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2750: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Item")
2751: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2752: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Value")
2753: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2754:
2755: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2756: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2757: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Name")
2758: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2759: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobName)
2760: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2761:
2762: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2763: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2764: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Description")
2765: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2766: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobDescription)
2767: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2768:
2769: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2770: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2771: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Category")
2772: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2773: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobCategory)
2774: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2775:
2776: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2777: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2778: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Owner")
2779: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2780: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobOwner)
2781: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2782:
2783: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2784: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2785: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Creation Date")
2786: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2787: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobCreateDate)
2788: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2789:
2790: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2791: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2792: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Modified Date")
2793: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2794: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobModifiedDate)
2795: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2796:
2797: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2798: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2799: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Is Enabled?")
2800: If JobIsEnabled Then
2801: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2802: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Yes")
2803: Else
2804: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2805: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("No")
2806: End If
2807: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2808:
2809:
2810: JobTableHTML = JobTableHTML & GetHTMLTableCloser
2811:
2812: JobHTML = JobHTML & JobTableHTML
2813:
2814: 'Job Steps
2815: JobTableHTML = ""
2816: JobHTML = JobHTML & "<h2>Job Steps</h2>" & vbCrLf
2817:
2818: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableOpener. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2819: JobTableHTML = GetHTMLTableOpener
2820: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2821: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2822: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Job Step")
2823: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2824: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Subsystem")
2825: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2826: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Command")
2827: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2828:
2829:
2830: SQL = "SELECT t_JobSteps.* "
2831: SQL = SQL & "FROM t_JobSteps "
2832: SQL = SQL & "WHERE "
2833: SQL = SQL & "t_JobSteps.fk_JobID = " & JobID & " "
2834: SQL = SQL & "ORDER BY fk_JobID, JobStepSQLID "
2835: RSJobSteps = DataStore.GetRecordSet(SQL)
2836:
2837: Do While Not RSJobSteps.EOF
2838:
2839: JobStepSQLID = RSJobSteps.Fields("JobStepSQLID").Value
2840: JobStepName = RSJobSteps.Fields("JobStepName").Value
2841: JobStepSubsystem = RSJobSteps.Fields("JobStepSubsystem").Value
2842: JobStepCommand = RSJobSteps.Fields("JobStepCommand").Value
2843:
2844: JobStepCommand = Replace(JobStepCommand, "<", "<")
2845: JobStepCommand = Replace(JobStepCommand, ">", ">")
2846:
2847: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2848: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2849: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobStepName)
2850: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2851: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobStepSubsystem)
2852: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2853: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobStepCommand)
2854: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2855:
2856: RSJobSteps.MoveNext()
2857: Loop
2858:
2859: JobTableHTML = JobTableHTML & GetHTMLTableCloser
2860: JobHTML = JobHTML & JobTableHTML
2861:
2862:
2863:
2864: 'Job Schedule
2865: JobTableHTML = ""
2866: JobHTML = JobHTML & "<h2>Job Schedule</h2>" & vbCrLf
2867:
2868: JobTableHTML = JobTableHTML & GetHTMLTableOpener
2869: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2870: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2871: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Schedule Name")
2872: 'JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Subsystem")
2873: 'JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell("Command")
2874: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2875:
2876: SQL = "SELECT t_JobSchedules.* "
2877: SQL = SQL & "FROM t_JobSchedules "
2878: SQL = SQL & "WHERE "
2879: SQL = SQL & "t_JobSchedules.fk_JobID = " & JobID & " "
2880: SQL = SQL & "ORDER BY fk_JobID, JobScheduleID "
2881: RSJobSchedule = DataStore.GetRecordSet(SQL)
2882:
2883: Do While Not RSJobSchedule.EOF
2884:
2885: 'UPGRADE_WARNING: Couldn't resolve default property of object JobScheduleID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2886: JobScheduleID = RSJobSchedule.Fields("JobScheduleID").Value
2887: JobScheduleName = RSJobSchedule.Fields("JobScheduleName").Value
2888: JobScheduleDescription = RSJobSchedule.Fields("JobScheduleDescription").Value
2889: JobScheduleIsEnabled = RSJobSchedule.Fields("JobScheduleIsEnabled").Value
2890: JobScheduleCreateDate = RSJobSchedule.Fields("JobScheduleCreateDate").Value
2891: JobScheduleFrequencyType = RSJobSchedule.Fields("JobScheduleFrequencyType").Value
2892: JobScheduleFrequencyInterval = RSJobSchedule.Fields("JobScheduleFrequencyInterval").Value
2893: JobScheduleStartDate = RSJobSchedule.Fields("JobScheduleStartDate").Value
2894: 'UPGRADE_WARNING: Use of Null/IsNull() detected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1049"'
2895: If IsDbNull(RSJobSchedule.Fields("JobScheduleEndDate").Value) Then
2896: JobScheduleEndDate = ""
2897: Else
2898: JobScheduleEndDate = RSJobSchedule.Fields("JobScheduleEndDate").Value
2899: End If
2900: JobScheduleStartTime = RSJobSchedule.Fields("JobScheduleStartTime").Value
2901: JobScheduleEndTime = RSJobSchedule.Fields("JobScheduleEndTime").Value
2902:
2903: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableOpener. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2904: JobTableHTML = GetHTMLTableOpener
2905: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2906: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2907: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell(JobScheduleName)
2908: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2909: JobTableHTML = JobTableHTML & GetHTMLTableHeaderCell(" ")
2910: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2911: 'JobStepCommand = Replace(JobStepCommand, "<", "<")
2912: 'JobStepCommand = Replace(JobStepCommand, ">", ">")
2913:
2914: 'Job Schedule Description
2915: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2916: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2917: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Description")
2918: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2919: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobScheduleDescription)
2920: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2921:
2922: 'Job Schedule Scheduling
2923: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2924: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2925: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Runs")
2926: If Len(JobScheduleFrequencyInterval) > 0 Then
2927: JobScheduleFrequencyDescription = JobScheduleFrequencyType & ": " & JobScheduleFrequencyInterval
2928: Else
2929: JobScheduleFrequencyDescription = JobScheduleFrequencyType
2930: End If
2931:
2932: 'For "Once" jobs show the start date and time
2933: If UCase(JobScheduleFrequencyType) = "ONCE" Then
2934: JobScheduleFrequencyDescription = "One time. On date: " & JobScheduleStartDate & " At time: " & JobScheduleStartTime
2935: End If
2936:
2937:
2938: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2939: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobScheduleFrequencyDescription)
2940:
2941: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2942:
2943: 'Job schedule not required for "Once" schedules
2944: If UCase(JobScheduleFrequencyType) <> "ONCE" Then
2945: 'Job Schedule Start and End Date
2946: If JobScheduleEndDate <> "" Then
2947:
2948: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2949: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2950: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Duration")
2951: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2952: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Start date: " & JobScheduleStartDate & " End date: " & JobScheduleEndDate)
2953: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2954:
2955: Else
2956: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2957: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2958: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Duration")
2959: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2960: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Start date: " & JobScheduleStartDate & ". No end date.")
2961: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2962:
2963: End If
2964: End If
2965: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2966: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2967: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Date Created")
2968: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2969: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobScheduleCreateDate)
2970: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2971:
2972: 'Job Schedule Create Date
2973: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2974: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2975: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Date Created")
2976: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2977: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell(JobScheduleCreateDate)
2978: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2979:
2980: JobTableHTML = JobTableHTML & GetHTMLTableRowOpener
2981: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2982: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Is Enabled")
2983: If JobScheduleIsEnabled Then
2984: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2985: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("Yes")
2986: Else
2987: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
2988: JobTableHTML = JobTableHTML & GetHTMLTableBodyCell("No")
2989: End If
2990: JobTableHTML = JobTableHTML & GetHTMLTableRowCloser
2991:
2992: JobTableHTML = JobTableHTML & GetHTMLTableCloser
2993: JobHTML = JobHTML & JobTableHTML
2994:
2995:
2996: RSJobSchedule.MoveNext()
2997: Loop
2998:
2999:
3000:
3001: 'Build a Job details page for the particular Job
3002: PageTitle = "Job " & JobName & " in SQL Server " & DatabaseServer
3003: PageBody = JobHTML
3004: Call CreatePage("Job " & JobName & " in SQL Server " & DatabaseServer, DocFolderPath, "Connection_" & ConnectionID & "_Job_" & JobID & ".htm", PageTitle, PageBody, True)
3005:
3006:
3007: RSJobs.MoveNext()
3008:
3009:
3010: Loop
3011:
3012:
3013: If NumberOfJobs > 0 Then
3014:
3015: ListHTML = ListHTML & ""
3016:
3017: Else
3018:
3019: ListHTML = "There are no Jobs in this database."
3020:
3021: End If
3022:
3023: 'Build a Jobs list page
3024: PageTitle = "Jobs in SQL Server " & DatabaseServer
3025: PageBody = ListHTML
3026: Call CreatePage("Jobs in SQL Server " & DatabaseServer, DocFolderPath, "Connection_" & ConnectionID & "_Jobs.htm", PageTitle, PageBody, True)
3027:
3028: Else
3029:
3030: End If
3031:
3032: PreviousDatabaseServer = DatabaseServer
3033: IsFirstDatabase = False
3034:
3035: RS.MoveNext()
3036: Loop
3037:
3038: 'UPGRADE_WARNING: Couldn't resolve default property of object CreateJobsPages. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3039: CreateJobsPages = True
3040:
3041: End Function
3042: Private Function GetHTMLTableOpener() As Object
3043:
3044: Dim HTML As String
3045:
3046: HTML = "<p align=""left""><table border=""0"" cellpadding=""2"" cellspacing=""2"" width=""100%"">" & vbCrLf
3047:
3048: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableOpener. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3049: GetHTMLTableOpener = HTML
3050:
3051:
3052: End Function
3053: Private Function GetHTMLTableOpenerWithWidth(ByRef PercentageWidth As Integer) As Object
3054:
3055: Dim HTML As String
3056:
3057: HTML = "<p align=""left""><table border=""0"" cellpadding=""2"" cellspacing=""2"" width=""" & PercentageWidth & "%"">" & vbCrLf
3058:
3059: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableOpenerWithWidth. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3060: GetHTMLTableOpenerWithWidth = HTML
3061:
3062:
3063: End Function
3064: Private Function GetHTMLTableRowOpener() As Object
3065:
3066: Dim HTML As String
3067:
3068: HTML = vbTab & "<tr>" & vbCrLf
3069:
3070: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableRowOpener. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3071: GetHTMLTableRowOpener = HTML
3072:
3073:
3074: End Function
3075: Private Function GetHTMLTableRowCloser() As Object
3076:
3077: Dim HTML As String
3078:
3079: HTML = vbTab & "</tr>" & vbCrLf
3080:
3081: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableRowCloser. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3082: GetHTMLTableRowCloser = HTML
3083:
3084:
3085: End Function
3086: Private Function GetHTMLTableHeaderCell(ByRef Heading As String) As Object
3087:
3088: Dim HTML As String
3089:
3090: HTML = vbTab & vbTab & "<td bgcolor=""#8888DD"" align=""left"" valign=""top"">"
3091: HTML = HTML & Heading
3092: HTML = HTML & "</td>" & vbCrLf
3093:
3094: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableHeaderCell. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3095: GetHTMLTableHeaderCell = HTML
3096:
3097:
3098: End Function
3099: Private Function GetHTMLTableBodyCell(ByRef Heading As String) As Object
3100:
3101: Dim HTML As String
3102:
3103: HTML = vbTab & vbTab & "<td bgcolor=""#BBBBDD"" align=""left"" valign=""top"">"
3104: HTML = HTML & Heading
3105: HTML = HTML & "</td>" & vbCrLf
3106:
3107: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableBodyCell. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3108: GetHTMLTableBodyCell = HTML
3109:
3110:
3111: End Function
3112: Private Function GetHTMLTableCloser() As Object
3113:
3114: Dim HTML As String
3115:
3116: HTML = "</table></p>" & vbCrLf
3117:
3118: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLTableCloser. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3119: GetHTMLTableCloser = HTML
3120:
3121: End Function
3122: Private Sub StoreHTMLHelpIndexContent(ByRef ItemName As String, ByRef ItemType As String, ByRef ItemFileName As String, ByRef ItemBookmark As String, ByRef ItemDatabaseID As Integer, ByRef ItemTableID As Integer, ByRef ItemViewID As Integer)
3123:
3124: ItemName = Replace(ItemName, "|", "")
3125: ItemType = Replace(ItemType, "|", "")
3126: ItemFileName = Replace(ItemFileName, "|", "")
3127: ItemBookmark = Replace(ItemBookmark, "|", "")
3128:
3129: HTMLHelpIndexContents.Add((ItemName & "|" & ItemType & "|" & ItemFileName & "|" & ItemBookmark & "|" & ItemDatabaseID & "|" & ItemTableID & "|" & ItemViewID))
3130:
3131: End Sub
3132: Private Function GetHTMLHelpProjectFile() As Object
3133: Dim File As Object
3134:
3135: Dim HTML As String
3136: Dim CConCat As New CConCat
3137:
3138: HTML = ""
3139:
3140: HTML = HTML & "[Options]" & vbCrLf
3141: HTML = HTML & "Compatibility = 1.1 Or later" & vbCrLf
3142: HTML = HTML & "Compiled file=" & CurrentProjectName & ".chm" & vbCrLf
3143: HTML = HTML & "Contents File = " & CurrentProjectName & ".hhc" & vbCrLf
3144: HTML = HTML & "Default topic = Introduction.htm" & vbCrLf
3145: HTML = HTML & "Display compile progress=No" & vbCrLf
3146: HTML = HTML & "Full-text search=Yes" & vbCrLf
3147: HTML = HTML & "Index File = " & CurrentProjectName & ".hhk" & vbCrLf
3148: HTML = HTML & "Error log file = " & CurrentProjectName & "_HTMLHelpLog.txt" & vbCrLf
3149:
3150:
3151: HTML = HTML & "Language=0x409 English (United States)" & vbCrLf
3152: HTML = HTML & "Title=" & CurrentProjectName & " Help" & vbCrLf
3153: HTML = HTML & "[Files]" & vbCrLf
3154:
3155: For Each File In FilesCreated
3156:
3157: 'UPGRADE_WARNING: Couldn't resolve default property of object File. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3158: CConCat.Cat((File & vbCrLf))
3159:
3160: Next File
3161:
3162: HTML = HTML & CConCat.Text
3163:
3164: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLHelpProjectFile. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3165: GetHTMLHelpProjectFile = HTML
3166:
3167: End Function
3168:
3169: Private Function GetHTMLHelpIndexFile() As Object
3170: Dim Content As Object
3171:
3172: Dim HTML As String
3173:
3174: Dim CConCat As New CConCat
3175:
3176: HTML = ""
3177:
3178: HTML = HTML & "<!DOCTYPE HTML PUBLIC ""-//IETF//DTD HTML//EN\"">" & vbCrLf
3179: HTML = HTML & "<HTML>" & vbCrLf
3180: HTML = HTML & "<HEAD>" & vbCrLf
3181: HTML = HTML & "<meta name=""GENERATOR"" content=""SQL Documentation Tool"">" & vbCrLf
3182: HTML = HTML & "<!-- Sitemap 1.0 -->" & vbCrLf
3183: HTML = HTML & "</HEAD><BODY>" & vbCrLf
3184: HTML = HTML & "<OBJECT type=""text/site properties"">" & vbCrLf
3185: HTML = HTML & "<param name=""ImageType"" value=""Folder"">" & vbCrLf
3186: HTML = HTML & "</OBJECT>" & vbCrLf
3187: HTML = HTML & "<UL>" & vbCrLf
3188:
3189: 'Summary
3190: HTML = HTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3191: HTML = HTML & "<param name=""Name"" value=""Summary"">" & vbCrLf
3192: HTML = HTML & "</OBJECT>" & vbCrLf
3193: HTML = HTML & "<UL>" & vbCrLf
3194:
3195: HTML = HTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3196: HTML = HTML & "<param name=""Name"" value=""" & CurrentProjectName & """ > " & vbCrLf
3197: HTML = HTML & "<param name=""Local"" value=""Introduction.htm"">" & vbCrLf
3198: HTML = HTML & "</OBJECT>" & vbCrLf
3199: HTML = HTML & "</UL>" & vbCrLf
3200:
3201: Dim EntityName As String
3202: Dim EntityType As String
3203: Dim EntityFileName As String
3204: Dim EntityBookmark As String
3205: Dim CurrentContent As String
3206: Dim CurrentContents() As String
3207:
3208: For Each Content In HTMLHelpIndexContents
3209:
3210: 'UPGRADE_WARNING: Couldn't resolve default property of object Content. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3211: CurrentContent = Content
3212: CurrentContents = Split(CurrentContent, "|")
3213: EntityName = CurrentContents(0)
3214: EntityType = CurrentContents(1)
3215: EntityFileName = CurrentContents(2)
3216: EntityBookmark = CurrentContents(3)
3217:
3218: CConCat.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3219: CConCat.Cat(("<param name=""Name"" value=""" & EntityName & ", " & EntityType & """ > " & vbCrLf))
3220: CConCat.Cat(("<param name=""Name"" value=""" & EntityType & ": " & EntityFileName & """ > " & vbCrLf))
3221: CConCat.Cat(("<param name=""Local"" value=""" & EntityFileName))
3222: If EntityBookmark <> "" Then
3223: CConCat.Cat(("#" & EntityBookmark))
3224: End If
3225: CConCat.Cat((""" > " & vbCrLf))
3226:
3227: CConCat.Cat(("</OBJECT>" & vbCrLf))
3228:
3229: Next Content
3230:
3231:
3232: HTML = HTML & CConCat.Text
3233:
3234: 'End of everything
3235: HTML = HTML & "</UL>" & vbCrLf
3236:
3237: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLHelpIndexFile. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3238: GetHTMLHelpIndexFile = HTML
3239:
3240: End Function
3241:
3242: Private Function GetHTMLHelpTableOfContentsFile() As Object
3243: Dim ViewColumnHTML As Object
3244: Dim ColumnEntityViewID As Object
3245: Dim ColumnEntityTableID As Object
3246: Dim ColumnEntityDatabaseID As Object
3247: Dim ColumnEntityBookmark As Object
3248: Dim ColumnEntityFileName As Object
3249: Dim ColumnEntityType As Object
3250: Dim ColumnEntityName As Object
3251: Dim ColumnCurrentContents As Object
3252: Dim ColumnCurrentContent As Object
3253: Dim ColumnContent As Object
3254: Dim EntityViewID As Object
3255: Dim EntityTableID As Object
3256: Dim EntityDatabaseID As Object
3257: Dim EntityBookmark As Object
3258: Dim EntityFileName As Object
3259: Dim EntityType As Object
3260: Dim EntityName As Object
3261: Dim CurrentContents As Object
3262: Dim CurrentContent As Object
3263: Dim Content As Object
3264: Dim ListHTML As Object
3265:
3266: Dim HTML As String
3267: Dim RSDatabases As New ADODB.Recordset
3268: Dim DataConnection As New ADODB.Connection
3269: Dim SQL As String
3270: Dim DatabaseID As Integer
3271: Dim ConnectionID As Integer
3272: Dim DatabaseName As String
3273: Dim NumberOfTables As String
3274: Dim TablesHTML As String
3275: Dim NumberOfViews As String
3276: Dim ViewsHTML As String
3277: Dim NumberOfStoredProcedures As String
3278: Dim StoredProceduresHTML As String
3279: Dim NumberOfTriggers As String
3280: Dim NumberOfIndexes As String
3281: Dim TriggersHTML As String
3282: Dim IndexesHTML As String
3283: Dim CConCatTables As New CConCat
3284: Dim CConCatViews As New CConCat
3285: Dim CConCatTriggers As New CConCat
3286: Dim CConCatIndexes As New CConCat
3287: Dim CConCatStoredProcedures As New CConCat
3288: Dim PreviousDatabaseServer As String
3289: Dim IsFirstDatabase As Boolean
3290: Dim DatabaseServer As String
3291: Dim NumberOfDTSPackages As Integer
3292: Dim CConCatDTSPackages As New CConCat
3293: Dim DTSLink As String
3294: Dim RSDTSPackages As New ADODB.Recordset
3295: Dim PackageID As Integer
3296: Dim PackageName As String
3297: Dim NumberOfJobs As Integer
3298: Dim CConCatJobs As New CConCat
3299: Dim JobLink As String
3300: Dim RSJobs As New ADODB.Recordset
3301: Dim JobID As Integer
3302: Dim JobName As String
3303: Dim NumberOfDatabaseServers As Integer
3304: Dim NumberOfDatabases As Integer
3305:
3306: PreviousDatabaseServer = ""
3307: IsFirstDatabase = True
3308: NumberOfDatabaseServers = 0
3309: NumberOfDatabases = 0
3310:
3311: HTML = ""
3312:
3313: HTML = HTML & "<!DOCTYPE HTML PUBLIC ""-//IETF//DTD HTML//EN\"">" & vbCrLf
3314: HTML = HTML & "<HTML>" & vbCrLf
3315: HTML = HTML & "<HEAD>" & vbCrLf
3316: HTML = HTML & "<meta name=""GENERATOR"" content=""SQL Documentation Tool"">" & vbCrLf
3317: HTML = HTML & "<!-- Sitemap 1.0 -->" & vbCrLf
3318: HTML = HTML & "</HEAD><BODY>" & vbCrLf
3319: HTML = HTML & "<OBJECT type=""text/site properties"">" & vbCrLf
3320: HTML = HTML & "<param name=""ImageType"" value=""Folder"">" & vbCrLf
3321: HTML = HTML & "</OBJECT>" & vbCrLf
3322: HTML = HTML & "<UL>" & vbCrLf
3323:
3324: 'Summary
3325: HTML = HTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3326: HTML = HTML & "<param name=""Name"" value=""Summary"">" & vbCrLf
3327: HTML = HTML & "</OBJECT>" & vbCrLf
3328: HTML = HTML & "<UL>" & vbCrLf
3329:
3330: HTML = HTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3331: HTML = HTML & "<param name=""Name"" value=""" & CurrentProjectName & """ > " & vbCrLf
3332: HTML = HTML & "<param name=""Local"" value=""Introduction.htm"">" & vbCrLf
3333: HTML = HTML & "</OBJECT>" & vbCrLf
3334: HTML = HTML & "</UL>" & vbCrLf
3335:
3336: 'SQL = "SELECT t_Databases.*, t_Connections.DatabaseServer "
3337: 'SQL = SQL & "FROM (t_Parses "
3338: 'SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID) "
3339: 'SQL = SQL & "INNER JOIN t_Connections on t_Databases.fk_ConnectionID = t_Connections.ConnectionID "
3340: 'SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID & " "
3341: 'SQL = SQL & "ORDER BY t_Connections.DatabaseServer"
3342:
3343: SQL = "SELECT t_Databases.*, t_Connections.ConnectionID, t_Connections.DatabaseServer "
3344: SQL = SQL & "FROM (t_Parses "
3345: SQL = SQL & "INNER JOIN t_Databases on t_Parses.fk_ProjectID = t_Databases.fk_ProjectID) "
3346: SQL = SQL & "INNER JOIN t_Connections on t_Databases.fk_ConnectionID = t_Connections.ConnectionID "
3347: SQL = SQL & "WHERE t_Parses.ParseID = " & DocParseID & " "
3348: SQL = SQL & "ORDER BY t_Connections.DatabaseServer"
3349:
3350: RSDatabases = DataStore.GetRecordSet(SQL)
3351:
3352: 'UPGRADE_WARNING: Couldn't resolve default property of object ListHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3353: ListHTML = ""
3354:
3355: 'Iterate databases
3356: Do While Not RSDatabases.EOF
3357:
3358: DatabaseID = RSDatabases.Fields("DatabaseID").Value
3359: ConnectionID = RSDatabases.Fields("ConnectionID").Value
3360: DatabaseName = RSDatabases.Fields("DatabaseName").Value
3361: DatabaseServer = RSDatabases.Fields("DatabaseServer").Value
3362:
3363: If DatabaseServer <> PreviousDatabaseServer Then
3364:
3365: If IsFirstDatabase = False Then
3366: HTML = HTML & DTSLink
3367: HTML = HTML & JobLink
3368: HTML = HTML & ("</UL>" & vbCrLf)
3369: End If
3370:
3371: HTML = HTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3372: HTML = HTML & "<param name=""Name"" value=""" & DatabaseServer & """>" & vbCrLf
3373: HTML = HTML & "<param name=""Local"" value=""Database_" & DatabaseID & ".htm"" >" & vbCrLf
3374: HTML = HTML & "</OBJECT>" & vbCrLf
3375: HTML = HTML & "<UL>" & vbCrLf
3376:
3377: Else
3378: ' HTML = HTML & "<br>" & vbCrLf
3379: End If
3380:
3381: DTSLink = ""
3382: JobLink = ""
3383:
3384:
3385: 'Specific database
3386: HTML = HTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3387: HTML = HTML & "<param name=""Name"" value=""" & DatabaseName & """>" & vbCrLf
3388: HTML = HTML & "<param name=""Local"" value=""Database_" & DatabaseID & ".htm"" >" & vbCrLf
3389: HTML = HTML & "</OBJECT>" & vbCrLf
3390: HTML = HTML & "<UL>" & vbCrLf
3391:
3392: NumberOfDatabases = NumberOfDatabases + 1
3393:
3394: 'Tables
3395: NumberOfTables = CStr(0)
3396: 'TablesHTML = ""
3397:
3398: CConCatTables.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3399: CConCatTables.Cat(("<param name=""Name"" value=""Tables"">" & vbCrLf))
3400: CConCatTables.Cat(("<param name=""Local"" value=""Database_" & DatabaseID & "_Tables.htm"" >" & vbCrLf))
3401: CConCatTables.Cat(("</OBJECT>" & vbCrLf))
3402: CConCatTables.Cat(("<UL>" & vbCrLf))
3403:
3404: For Each Content In HTMLHelpIndexContents
3405:
3406: 'UPGRADE_WARNING: Couldn't resolve default property of object Content. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3407: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3408: CurrentContent = Content
3409: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3410: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3411: CurrentContents = Split(CurrentContent, "|")
3412: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3413: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3414: EntityName = CurrentContents(0)
3415: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3416: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3417: EntityType = CurrentContents(1)
3418: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3419: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3420: EntityFileName = CurrentContents(2)
3421: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3422: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3423: EntityBookmark = CurrentContents(3)
3424: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3425: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3426: EntityDatabaseID = CurrentContents(4)
3427: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3428: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3429: EntityTableID = CurrentContents(5)
3430: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3431: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3432: EntityViewID = CurrentContents(6)
3433:
3434: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3435: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3436: If EntityType = "Table" And EntityDatabaseID = DatabaseID Then
3437:
3438: CConCatTables.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3439: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3440: CConCatTables.Cat(("<param name=""Name"" value=""" & EntityName & """ > " & vbCrLf))
3441: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3442: CConCatTables.Cat(("<param name=""Local"" value=""" & EntityFileName))
3443: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3444: If EntityBookmark <> "" Then
3445: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3446: CConCatTables.Cat(("#" & EntityBookmark))
3447: End If
3448: CConCatTables.Cat((""" > " & vbCrLf))
3449: CConCatTables.Cat(("</OBJECT>" & vbCrLf))
3450:
3451: NumberOfTables = CStr(CDbl(NumberOfTables) + 1)
3452:
3453: 'Table columns
3454: CConCatTables.Cat(("<UL>" & vbCrLf))
3455:
3456: For Each ColumnContent In HTMLHelpIndexContents
3457:
3458: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3459: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3460: ColumnCurrentContent = ColumnContent
3461: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3462: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3463: ColumnCurrentContents = Split(ColumnCurrentContent, "|")
3464: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3465: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3466: ColumnEntityName = ColumnCurrentContents(0)
3467: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3468: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3469: ColumnEntityType = ColumnCurrentContents(1)
3470: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3471: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3472: ColumnEntityFileName = ColumnCurrentContents(2)
3473: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3474: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3475: ColumnEntityBookmark = ColumnCurrentContents(3)
3476: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3477: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3478: ColumnEntityDatabaseID = ColumnCurrentContents(4)
3479: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3480: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3481: ColumnEntityTableID = ColumnCurrentContents(5)
3482: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3483: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3484: ColumnEntityViewID = ColumnCurrentContents(6)
3485:
3486: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3487: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3488: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3489: If ColumnEntityType = "Column" And CShort(EntityTableID) = CShort(ColumnEntityTableID) Then
3490:
3491: CConCatTables.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3492: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3493: CConCatTables.Cat(("<param name=""Name"" value=""" & ColumnEntityName & """ > " & vbCrLf))
3494: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3495: CConCatTables.Cat(("<param name=""Local"" value=""" & ColumnEntityFileName))
3496: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3497: If ColumnEntityBookmark <> "" Then
3498: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3499: CConCatTables.Cat(("#" & ColumnEntityBookmark))
3500: End If
3501: CConCatTables.Cat((""" > " & vbCrLf))
3502:
3503: CConCatTables.Cat(("</OBJECT>" & vbCrLf))
3504:
3505: End If
3506:
3507: Next ColumnContent
3508:
3509: CConCatTables.Cat(("</UL>" & vbCrLf))
3510: 'End of table columns
3511:
3512: End If
3513:
3514: Next Content
3515:
3516: If CDbl(NumberOfTables) > 0 Then
3517: CConCatTables.Cat(("</UL>" & vbCrLf))
3518: HTML = HTML & CConCatTables.Text
3519: End If
3520:
3521: 'UPGRADE_NOTE: Object CConCatTables may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3522: CConCatTables = Nothing
3523:
3524: 'Views
3525: NumberOfViews = CStr(0)
3526: 'ViewsHTML = ""
3527:
3528: CConCatViews.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3529: CConCatViews.Cat(("<param name=""Name"" value=""Views"">" & vbCrLf))
3530: CConCatViews.Cat(("<param name=""Local"" value=""Database_" & DatabaseID & "_Views.htm"" >" & vbCrLf))
3531: CConCatViews.Cat(("</OBJECT>" & vbCrLf))
3532: CConCatViews.Cat(("<UL>" & vbCrLf))
3533:
3534: For Each Content In HTMLHelpIndexContents
3535:
3536: 'UPGRADE_WARNING: Couldn't resolve default property of object Content. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3537: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3538: CurrentContent = Content
3539: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3540: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3541: CurrentContents = Split(CurrentContent, "|")
3542: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3543: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3544: EntityName = CurrentContents(0)
3545: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3546: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3547: EntityType = CurrentContents(1)
3548: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3549: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3550: EntityFileName = CurrentContents(2)
3551: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3552: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3553: EntityBookmark = CurrentContents(3)
3554: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3555: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3556: EntityDatabaseID = CurrentContents(4)
3557: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3558: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3559: EntityTableID = CurrentContents(5)
3560: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3561: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3562: EntityViewID = CurrentContents(6)
3563:
3564: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3565: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3566: If EntityType = "View" And EntityDatabaseID = DatabaseID Then
3567:
3568: CConCatViews.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3569: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3570: CConCatViews.Cat(("<param name=""Name"" value=""" & EntityName & """ > " & vbCrLf))
3571: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3572: CConCatViews.Cat(("<param name=""Local"" value=""" & EntityFileName))
3573: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3574: If EntityBookmark <> "" Then
3575: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3576: CConCatViews.Cat(("#" & EntityBookmark))
3577: End If
3578: CConCatViews.Cat((""" > " & vbCrLf))
3579:
3580: CConCatViews.Cat(("</OBJECT>" & vbCrLf))
3581:
3582: NumberOfViews = CStr(CDbl(NumberOfViews) + 1)
3583:
3584: 'View columns
3585: CConCatViews.Cat(("<UL>" & vbCrLf))
3586:
3587: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3588: ViewColumnHTML = ""
3589:
3590: For Each ColumnContent In HTMLHelpIndexContents
3591:
3592: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3593: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3594: ColumnCurrentContent = ColumnContent
3595: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3596: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3597: ColumnCurrentContents = Split(ColumnCurrentContent, "|")
3598: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3599: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3600: ColumnEntityName = ColumnCurrentContents(0)
3601: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3602: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3603: ColumnEntityType = ColumnCurrentContents(1)
3604: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3605: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3606: ColumnEntityFileName = ColumnCurrentContents(2)
3607: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3608: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3609: ColumnEntityBookmark = ColumnCurrentContents(3)
3610: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3611: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3612: ColumnEntityDatabaseID = ColumnCurrentContents(4)
3613: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3614: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3615: ColumnEntityTableID = ColumnCurrentContents(5)
3616: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnCurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3617: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3618: ColumnEntityViewID = ColumnCurrentContents(6)
3619:
3620: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3621: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3622: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3623: If ColumnEntityType = "Column" And CShort(EntityViewID) = CShort(ColumnEntityViewID) Then
3624:
3625: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3626: ViewColumnHTML = ViewColumnHTML & "<LI> <OBJECT type=""text/sitemap"">" & vbCrLf
3627: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3628: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3629: ViewColumnHTML = ViewColumnHTML & "<param name=""Name"" value=""" & ColumnEntityName & """ > " & vbCrLf
3630: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3631: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3632: ViewColumnHTML = ViewColumnHTML & "<param name=""Local"" value=""" & ColumnEntityFileName
3633: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3634: If ColumnEntityBookmark <> "" Then
3635: 'UPGRADE_WARNING: Couldn't resolve default property of object ColumnEntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3636: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3637: ViewColumnHTML = ViewColumnHTML & "#" & ColumnEntityBookmark
3638: End If
3639: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3640: ViewColumnHTML = ViewColumnHTML & """ > " & vbCrLf
3641:
3642: 'UPGRADE_WARNING: Couldn't resolve default property of object ViewColumnHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3643: ViewColumnHTML = ViewColumnHTML & "</OBJECT>" & vbCrLf
3644:
3645: End If
3646:
3647: Next ColumnContent
3648: CConCatViews.Cat((ViewColumnHTML))
3649: CConCatViews.Cat(("</UL>" & vbCrLf))
3650: 'End of view columns
3651:
3652: End If
3653:
3654: Next Content
3655:
3656: If CDbl(NumberOfViews) > 0 Then
3657: CConCatViews.Cat(("</UL>" & vbCrLf))
3658: HTML = HTML & CConCatViews.Text
3659: End If
3660:
3661: 'UPGRADE_NOTE: Object CConCatViews may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3662: CConCatViews = Nothing
3663:
3664: 'Triggers
3665: NumberOfTriggers = CStr(0)
3666:
3667: CConCatTriggers.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3668: CConCatTriggers.Cat(("<param name=""Name"" value=""Triggers"">" & vbCrLf))
3669: CConCatTriggers.Cat(("<param name=""Local"" value=""Database_" & DatabaseID & "_Triggers.htm"" >" & vbCrLf))
3670: CConCatTriggers.Cat(("</OBJECT>" & vbCrLf))
3671: CConCatTriggers.Cat(("<UL>" & vbCrLf))
3672:
3673: For Each Content In HTMLHelpIndexContents
3674:
3675: 'UPGRADE_WARNING: Couldn't resolve default property of object Content. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3676: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3677: CurrentContent = Content
3678: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3679: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3680: CurrentContents = Split(CurrentContent, "|")
3681: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3682: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3683: EntityName = CurrentContents(0)
3684: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3685: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3686: EntityType = CurrentContents(1)
3687: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3688: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3689: EntityFileName = CurrentContents(2)
3690: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3691: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3692: EntityBookmark = CurrentContents(3)
3693: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3694: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3695: EntityDatabaseID = CurrentContents(4)
3696: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3697: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3698: EntityTableID = CurrentContents(5)
3699: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3700: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3701: EntityViewID = CurrentContents(6)
3702:
3703: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3704: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3705: If EntityType = "Trigger" And EntityDatabaseID = DatabaseID Then
3706:
3707: CConCatTriggers.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3708: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3709: CConCatTriggers.Cat(("<param name=""Name"" value=""" & EntityName & """ > " & vbCrLf))
3710: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3711: CConCatTriggers.Cat(("<param name=""Local"" value=""" & EntityFileName))
3712: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3713: If EntityBookmark <> "" Then
3714: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3715: CConCatTriggers.Cat(("#" & EntityBookmark))
3716: End If
3717: CConCatTriggers.Cat((""" > " & vbCrLf))
3718:
3719: CConCatTriggers.Cat(("</OBJECT>" & vbCrLf))
3720:
3721: NumberOfTriggers = CStr(CDbl(NumberOfTriggers) + 1)
3722:
3723: End If
3724:
3725: Next Content
3726:
3727: If CDbl(NumberOfTriggers) > 0 Then
3728: CConCatTriggers.Cat(("</UL>" & vbCrLf))
3729: HTML = HTML & CConCatTriggers.Text
3730: End If
3731:
3732: 'UPGRADE_NOTE: Object CConCatTriggers may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3733: CConCatTriggers = Nothing
3734:
3735: 'Indexes
3736: NumberOfIndexes = CStr(0)
3737:
3738: CConCatIndexes.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3739: CConCatIndexes.Cat(("<param name=""Name"" value=""Indexes"">" & vbCrLf))
3740: CConCatIndexes.Cat(("<param name=""Local"" value=""Database_" & DatabaseID & "_Indexes.htm"" >" & vbCrLf))
3741: CConCatIndexes.Cat(("</OBJECT>" & vbCrLf))
3742: CConCatIndexes.Cat(("<UL>" & vbCrLf))
3743:
3744: For Each Content In HTMLHelpIndexContents
3745:
3746: 'UPGRADE_WARNING: Couldn't resolve default property of object Content. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3747: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3748: CurrentContent = Content
3749: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3750: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3751: CurrentContents = Split(CurrentContent, "|")
3752: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3753: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3754: EntityName = CurrentContents(0)
3755: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3756: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3757: EntityType = CurrentContents(1)
3758: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3759: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3760: EntityFileName = CurrentContents(2)
3761: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3762: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3763: EntityBookmark = CurrentContents(3)
3764: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3765: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3766: EntityDatabaseID = CurrentContents(4)
3767: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3768: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3769: EntityTableID = CurrentContents(5)
3770: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3771: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3772: EntityViewID = CurrentContents(6)
3773:
3774: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3775: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3776: If EntityType = "Index" And EntityDatabaseID = DatabaseID Then
3777:
3778: CConCatIndexes.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3779: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3780: CConCatIndexes.Cat(("<param name=""Name"" value=""" & EntityName & """ > " & vbCrLf))
3781: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3782: CConCatIndexes.Cat(("<param name=""Local"" value=""" & EntityFileName))
3783: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3784: If EntityBookmark <> "" Then
3785: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3786: CConCatIndexes.Cat(("#" & EntityBookmark))
3787: End If
3788: CConCatIndexes.Cat((""" > " & vbCrLf))
3789:
3790: CConCatIndexes.Cat(("</OBJECT>" & vbCrLf))
3791:
3792: NumberOfIndexes = CStr(CDbl(NumberOfIndexes) + 1)
3793:
3794: End If
3795:
3796: Next Content
3797:
3798: If CDbl(NumberOfIndexes) > 0 Then
3799: CConCatIndexes.Cat(("</UL>" & vbCrLf))
3800: HTML = HTML & CConCatIndexes.Text
3801: End If
3802:
3803: 'UPGRADE_NOTE: Object CConCatIndexes may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3804: CConCatIndexes = Nothing
3805:
3806: 'Stored Procedures
3807: NumberOfStoredProcedures = CStr(0)
3808: 'StoredProceduresHTML = ""
3809:
3810: CConCatStoredProcedures.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3811: CConCatStoredProcedures.Cat(("<param name=""Name"" value=""Stored Procedures"">" & vbCrLf))
3812: CConCatStoredProcedures.Cat(("<param name=""Local"" value=""Database_" & DatabaseID & "_StoredProcedures.htm"" >" & vbCrLf))
3813: CConCatStoredProcedures.Cat(("</OBJECT>" & vbCrLf))
3814: CConCatStoredProcedures.Cat(("<UL>" & vbCrLf))
3815:
3816: For Each Content In HTMLHelpIndexContents
3817:
3818: 'UPGRADE_WARNING: Couldn't resolve default property of object Content. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3819: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3820: CurrentContent = Content
3821: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContent. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3822: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3823: CurrentContents = Split(CurrentContent, "|")
3824: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3825: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3826: EntityName = CurrentContents(0)
3827: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3828: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3829: EntityType = CurrentContents(1)
3830: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3831: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3832: EntityFileName = CurrentContents(2)
3833: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3834: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3835: EntityBookmark = CurrentContents(3)
3836: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3837: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3838: EntityDatabaseID = CurrentContents(4)
3839: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3840: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityTableID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3841: EntityTableID = CurrentContents(5)
3842: 'UPGRADE_WARNING: Couldn't resolve default property of object CurrentContents(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3843: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityViewID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3844: EntityViewID = CurrentContents(6)
3845:
3846: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityDatabaseID. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3847: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityType. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3848: If EntityType = "Stored Procedure" And EntityDatabaseID = DatabaseID Then
3849:
3850: CConCatStoredProcedures.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3851: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3852: CConCatStoredProcedures.Cat(("<param name=""Name"" value=""" & EntityName & """ > " & vbCrLf))
3853: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityFileName. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3854: CConCatStoredProcedures.Cat(("<param name=""Local"" value=""" & EntityFileName))
3855: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3856: If EntityBookmark <> "" Then
3857: 'UPGRADE_WARNING: Couldn't resolve default property of object EntityBookmark. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
3858: StoredProceduresHTML = StoredProceduresHTML & "#" & EntityBookmark
3859: End If
3860: CConCatStoredProcedures.Cat((""" > " & vbCrLf))
3861:
3862: CConCatStoredProcedures.Cat(("</OBJECT>" & vbCrLf))
3863:
3864: NumberOfStoredProcedures = CStr(CDbl(NumberOfStoredProcedures) + 1)
3865:
3866: End If
3867:
3868: Next Content
3869:
3870: If CDbl(NumberOfStoredProcedures) > 0 Then
3871: CConCatStoredProcedures.Cat(("</UL>" & vbCrLf))
3872: HTML = HTML & CConCatStoredProcedures.Text
3873: End If
3874:
3875: 'UPGRADE_NOTE: Object CConCatStoredProcedures may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3876: CConCatStoredProcedures = Nothing
3877:
3878:
3879:
3880: 'Ends a specific database
3881: HTML = HTML & "</UL>" & vbCrLf
3882:
3883: PreviousDatabaseServer = DatabaseServer
3884: IsFirstDatabase = False
3885:
3886: 'DTS Packages
3887: NumberOfDTSPackages = 0
3888:
3889: CConCatDTSPackages.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3890: CConCatDTSPackages.Cat(("<param name=""Name"" value=""DTS Packages"">" & vbCrLf))
3891: CConCatDTSPackages.Cat(("<param name=""Local"" value=""Connection_" & ConnectionID & "_DTSPackages.htm"" >" & vbCrLf))
3892: CConCatDTSPackages.Cat(("</OBJECT>" & vbCrLf))
3893: CConCatDTSPackages.Cat(("<UL>" & vbCrLf))
3894:
3895: 'Do the DTS Packages for this server
3896: SQL = "SELECT t_Packages.* "
3897: SQL = SQL & "FROM t_Packages "
3898: SQL = SQL & "WHERE "
3899: SQL = SQL & "t_Packages.fk_ParseID = " & DocParseID
3900: SQL = SQL & " AND t_Packages.fk_ConnectionID = " & ConnectionID
3901: RSDTSPackages = DataStore.GetRecordSet(SQL)
3902:
3903: Do While Not RSDTSPackages.EOF
3904:
3905: PackageID = RSDTSPackages.Fields("PackageID").Value
3906: PackageName = RSDTSPackages.Fields("PackageName").Value
3907:
3908: CConCatDTSPackages.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3909: CConCatDTSPackages.Cat(("<param name=""Name"" value=""" & PackageName & """ > " & vbCrLf))
3910: CConCatDTSPackages.Cat(("<param name=""Local"" value=""Connection_" & ConnectionID & "_Package_" & PackageID & ".htm"))
3911:
3912: CConCatDTSPackages.Cat((""" > " & vbCrLf))
3913:
3914: CConCatDTSPackages.Cat(("</OBJECT>" & vbCrLf))
3915:
3916: NumberOfDTSPackages = NumberOfDTSPackages + 1
3917:
3918:
3919: RSDTSPackages.MoveNext()
3920: Loop
3921:
3922:
3923: If NumberOfDTSPackages > 0 Then
3924: CConCatDTSPackages.Cat(("</UL>" & vbCrLf))
3925: DTSLink = DTSLink & CConCatDTSPackages.Text
3926: Else
3927: DTSLink = ""
3928: End If
3929:
3930: 'UPGRADE_NOTE: Object CConCatDTSPackages may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3931: CConCatDTSPackages = Nothing 'End of DTS Packages
3932:
3933: 'Jobs
3934: NumberOfJobs = 0
3935:
3936: CConCatJobs.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3937: CConCatJobs.Cat(("<param name=""Name"" value=""Jobs"">" & vbCrLf))
3938: CConCatJobs.Cat(("<param name=""Local"" value=""Connection_" & ConnectionID & "_Jobs.htm"" >" & vbCrLf))
3939: CConCatJobs.Cat(("</OBJECT>" & vbCrLf))
3940: CConCatJobs.Cat(("<UL>" & vbCrLf))
3941:
3942: 'Do the Jobs for this server
3943: SQL = "SELECT t_Jobs.* "
3944: SQL = SQL & "FROM t_Jobs "
3945: SQL = SQL & "WHERE "
3946: SQL = SQL & "t_Jobs.fk_ParseID = " & DocParseID
3947: SQL = SQL & " AND t_Jobs.fk_ConnectionID = " & ConnectionID
3948: RSJobs = DataStore.GetRecordSet(SQL)
3949:
3950: Do While Not RSJobs.EOF
3951:
3952: JobID = RSJobs.Fields("JobID").Value
3953: JobName = RSJobs.Fields("JobName").Value
3954:
3955: CConCatJobs.Cat(("<LI> <OBJECT type=""text/sitemap"">" & vbCrLf))
3956: CConCatJobs.Cat(("<param name=""Name"" value=""" & JobName & """ > " & vbCrLf))
3957: CConCatJobs.Cat(("<param name=""Local"" value=""Connection_" & ConnectionID & "_Job_" & JobID & ".htm"))
3958:
3959: CConCatJobs.Cat((""" > " & vbCrLf))
3960:
3961: CConCatJobs.Cat(("</OBJECT>" & vbCrLf))
3962:
3963: NumberOfJobs = NumberOfJobs + 1
3964:
3965:
3966: RSJobs.MoveNext()
3967: Loop
3968:
3969:
3970: If NumberOfJobs > 0 Then
3971: CConCatJobs.Cat(("</UL>" & vbCrLf))
3972: JobLink = JobLink & CConCatJobs.Text
3973: Else
3974: JobLink = ""
3975: End If
3976:
3977: 'UPGRADE_NOTE: Object CConCatJobs may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
3978: CConCatJobs = Nothing 'End of Jobs
3979:
3980: NumberOfDatabaseServers = NumberOfDatabaseServers + 1
3981: RSDatabases.MoveNext()
3982:
3983:
3984:
3985: Loop
3986:
3987: 'Put in DTS and Jobs data if there is only 1 database and 1 database server
3988: 'If NumberOfDatabases = 1 And NumberOfDatabaseServers = 1 Then
3989:
3990: HTML = HTML & DTSLink
3991: HTML = HTML & JobLink
3992:
3993: 'End If
3994:
3995:
3996:
3997: 'End of everything
3998: HTML = HTML & "</UL>" & vbCrLf
3999:
4000: 'UPGRADE_WARNING: Couldn't resolve default property of object GetHTMLHelpTableOfContentsFile. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
4001: GetHTMLHelpTableOfContentsFile = HTML
4002:
4003: End Function
4004: 'Provides encoding of HTML without colour coding or syntax highlighting of TransactSQL
4005: Private Function CodeHTML(ByRef HTML As String) As Object
4006:
4007: Dim EncodedHTML As String
4008: EncodedHTML = HTML
4009:
4010: 'Change each tab to four non-breaking spaces
4011: EncodedHTML = Replace(EncodedHTML, vbTab, " ")
4012:
4013: 'Encode HTML tags
4014: EncodedHTML = Replace(EncodedHTML, "<", "<")
4015: EncodedHTML = Replace(EncodedHTML, ">", ">")
4016:
4017: 'Change each double space to four non-breaking spaces
4018: EncodedHTML = Replace(EncodedHTML, " ", " ")
4019:
4020: 'Put HTML linebreaks in
4021: EncodedHTML = Replace(EncodedHTML, vbCrLf, "<br>" & vbCrLf)
4022:
4023: 'UPGRADE_WARNING: Couldn't resolve default property of object CodeHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
4024: CodeHTML = EncodedHTML
4025:
4026: End Function
4027: 'Provides basic encoding of HTML without HTML tag addition
4028: Private Function CodeHTMLBasic(ByRef HTML As String) As Object
4029:
4030: Dim EncodedHTML As String
4031: EncodedHTML = HTML
4032:
4033: 'Change each tab to four non-breaking spaces
4034: 'EncodedHTML = Replace(EncodedHTML, vbTab, " ")
4035:
4036: 'Remove <br> tags
4037: 'EncodedHTML = Replace(EncodedHTML, "<br>", "")
4038:
4039: 'Encode HTML tags
4040: EncodedHTML = Replace(EncodedHTML, "<", "<")
4041: EncodedHTML = Replace(EncodedHTML, ">", ">")
4042:
4043: 'Change each double space to four non-breaking spaces
4044: 'EncodedHTML = Replace(EncodedHTML, " ", " ")
4045:
4046: 'Put HTML linebreaks in
4047: 'EncodedHTML = Replace(EncodedHTML, vbCrLf, "<br>" & vbCrLf)
4048:
4049: 'UPGRADE_WARNING: Couldn't resolve default property of object CodeHTMLBasic. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
4050: CodeHTMLBasic = EncodedHTML
4051:
4052: End Function
4053: 'Provides encoding of HTML with colour coding and syntax highlighting of TransactSQL
4054: Private Function ColorCodeHTML(ByRef HTML As String) As Object
4055:
4056: Dim RegularExpression As New VBScript_RegExp_55.RegExp
4057: Dim EncodedHTML() As String
4058: Dim CurrentLine As String
4059: Dim IsCommentLine As Boolean
4060: Dim IsMultiLineCommentLine As Boolean
4061: 'Dim CommentPos As Long
4062:
4063: 'Split Lines
4064: EncodedHTML = Split(HTML, vbCrLf)
4065:
4066:
4067: 'EncodedHTML = HTML
4068:
4069: Dim i As Integer
4070:
4071: For i = 0 To UBound(EncodedHTML)
4072:
4073: 'Put trailing space on for syntax highlighting help
4074: CurrentLine = EncodedHTML(i) & " "
4075: IsCommentLine = False
4076:
4077: 'Change each tab to four non-breaking spaces
4078: CurrentLine = Replace(CurrentLine, vbTab, " ")
4079:
4080: 'Encode HTML tags
4081: CurrentLine = Replace(CurrentLine, "<", "<")
4082: CurrentLine = Replace(CurrentLine, ">", ">")
4083:
4084: 'Change each double space to four non-breaking spaces
4085: CurrentLine = Replace(CurrentLine, " ", " ")
4086:
4087: 'Don't highlight lines beginning with '--'
4088: RegularExpression.Pattern = "^\s*--"
4089: If RegularExpression.Test(CurrentLine) Then
4090: IsCommentLine = True
4091: End If
4092:
4093: If IsCommentLine = False And IsMultiLineCommentLine = False Then
4094: RegularExpression.Global = True
4095: RegularExpression.IgnoreCase = True
4096:
4097: RegularExpression.Pattern = "(^|[^\w])(ADD|ALL|ALTER|AND|ANY|AS|ASC|AUTHORIZATION|BACKUP|BEGIN|BETWEEN|BREAK|BROWSE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4098: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4099:
4100: RegularExpression.Pattern = "(^|[^\w])(BULK|BY|CASCADE|CASE|CHECK|CHECKPOINT|CLOSE|CLUSTERED|COALESCE|COLLATE|COLUMN)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4101: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4102:
4103: RegularExpression.Pattern = "(^|[^\w])(COMMIT|COMPUTE|CONSTRAINT|CONTAINS|CONTAINSTABLE|CONTINUE|CONVERT|CREATE|CROSS)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4104: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4105:
4106: RegularExpression.Pattern = "(^|[^\w])(CURRENT|CURRENT_DATE|CURRENT_TIME|CURRENT_TIMESTAMP|CURRENT_USER|CURSOR|DATABASE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4107: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4108:
4109: RegularExpression.Pattern = "(^|[^\w])(DBCC|DEALLOCATE|DECLARE|DEFAULT|DELETE|DENY|DESC|DISK|DISTINCT|DISTRIBUTED|DOUBLE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4110: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4111:
4112: RegularExpression.Pattern = "(^|[^\w])(DROP|DUMMY|DUMP|ELSE|END|ERRLVL|ESCAPE|EXCEPT|EXEC|EXECUTE|EXISTS|EXIT|FETCH|FILE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4113: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4114:
4115: RegularExpression.Pattern = "(^|[^\w])(FILLFACTOR|FOR|FOREIGN|FREETEXT|FREETEXTTABLE|FROM|FULL|FUNCTION|GOTO|GRANT|GROUP)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4116: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4117:
4118: RegularExpression.Pattern = "(^|[^\w])(HAVING|HOLDLOCK|IDENTITY|IDENTITYCOL|IDENTITY_INSERT|IF|IN|INDEX|INNER|INSERT)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4119: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4120:
4121: RegularExpression.Pattern = "(^|[^\w])(INTERSECT|INTO|IS|JOIN|KEY|KILL|LEFT|LIKE|LINENO|LOAD|NATIONAL |NOCHECK|NONCLUSTERED)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4122: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4123:
4124: RegularExpression.Pattern = "(^|[^\w])(NOT|NULL|NULLIF|OF|OFF|OFFSETS|ON|OPEN|OPENDATASOURCE|OPENQUERY|OPENROWSET|OPENXML)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4125: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4126:
4127: RegularExpression.Pattern = "(^|[^\w])(OPTION|OR|ORDER|OUTER|OVER|PERCENT|PLAN|PRECISION|PRIMARY|PRINT|PROC|PROCEDURE|PUBLIC)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4128: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4129:
4130: RegularExpression.Pattern = "(^|[^\w])(RAISERROR|READ|READTEXT|RECONFIGURE|REFERENCES|REPLICATION|RESTORE|RESTRICT|RETURN|RETURNS|REVOKE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4131: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4132:
4133: RegularExpression.Pattern = "(^|[^\w])(RIGHT|ROLLBACK|ROWCOUNT|ROWGUIDCOL|RULE|SAVE|SCHEMA|SELECT|SESSION_USER|SET|SETUSERSHUTDOWN)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4134: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4135:
4136: RegularExpression.Pattern = "(^|[^\w])(SOME|STATISTICS|SYSTEM_USER|TABLE|TEXTSIZE|THEN|TO|TOP|TRAN|TRANSACTION|TRIGGER|TRUNCATE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4137: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4138:
4139: RegularExpression.Pattern = "(^|[^\w])(TSEQUAL|UNION|UNIQUE|UPDATE|UPDATETEXT|USE|USER|VALUES|VARYING|VIEW|WAITFOR|WHEN|WHERE)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4140: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4141:
4142: RegularExpression.Pattern = "(^|[^\w])(WHILE|WITH|WRITETEXT)([ |:|\(|\)|,|'|\t|\r|\n|%])"
4143: CurrentLine = RegularExpression.Replace(CurrentLine, "$1<font color=""blue"">$2</font>$3")
4144:
4145: End If
4146:
4147: 'Does a multi-line comment start on this line? /*
4148: RegularExpression.Pattern = "\/\*"
4149: If RegularExpression.Test(CurrentLine) Then
4150: IsMultiLineCommentLine = True
4151: End If
4152:
4153: 'Does a multi-line comment end on this line? */
4154: RegularExpression.Pattern = "\*\/"
4155: If RegularExpression.Test(CurrentLine) Then
4156:
4157: 'If there is a multiline comment ending on this line then colour the comment
4158: If IsMultiLineCommentLine Then
4159: CurrentLine = "<font color=""green"">" & CurrentLine
4160: CurrentLine = Replace(CurrentLine, "*/", "*/</font>")
4161:
4162: End If
4163:
4164: IsMultiLineCommentLine = False
4165: End If
4166:
4167: 'Colour comment lines beginning with '--' green
4168: RegularExpression.Pattern = "^\s*--"
4169: If RegularExpression.Test(CurrentLine) Then
4170: CurrentLine = "<font color=""green"">" & CurrentLine & "</font>"
4171: Else
4172: If IsCommentLine Then
4173: 'Regular multi-line comment
4174: CurrentLine = "<font color=""green"">" & CurrentLine & "</font>"
4175: Else
4176: 'Line with a comment at the end of it
4177: RegularExpression.Pattern = "--"
4178: If RegularExpression.Test(CurrentLine) Then
4179:
4180: 'CommentPos = InStr(CurrentLine, "--")
4181:
4182: 'CurrentLine = CommentPos & CurrentLine
4183:
4184: 'If CommentPos > 0 Then
4185:
4186: RegularExpression.Pattern = "(--[^<]*)<[^>]+>"
4187: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4188: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4189: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4190: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4191: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4192: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4193: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4194: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4195: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4196: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4197: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4198: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4199: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4200: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4201: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4202: CurrentLine = RegularExpression.Replace(CurrentLine, "$1")
4203:
4204: 'Remove keyword highlighting from comment
4205: ' CurrentLine = Replace(CurrentLine, "--", "@@@@", CommentPos, 1000, vbTextCompare)
4206: 'CurrentLine = Replace(CurrentLine, "<font color=""blue"">", "", CommentPos, 100, vbTextCompare)
4207: 'CurrentLine = Replace(CurrentLine, "</font>", "", CommentPos, 100, vbTextCompare)
4208:
4209: CurrentLine = Replace(CurrentLine, "--", "<font color=""green"">--")
4210: CurrentLine = CurrentLine & "</font>"
4211:
4212: 'End If
4213:
4214: End If
4215: End If
4216:
4217: If IsMultiLineCommentLine Then
4218: CurrentLine = "<font color=""green"">" & CurrentLine & "</font>"
4219: End If
4220: End If
4221:
4222: 'Colour comments of lines with closing '*/' green
4223: 'RegularExpression.Pattern = "\*\/"
4224: 'If RegularExpression.Test(CurrentLine) Then
4225:
4226: ' CurrentLine = Replace(CurrentLine, "*/", "<font color=""red"">" & CurrentLine & "</font>"
4227: ' Else
4228:
4229:
4230: 'Put HTML linebreaks in
4231: CurrentLine = CurrentLine & "<br>" & vbCrLf
4232: 'UPGRADE_WARNING: Couldn't resolve default property of object ColorCodeHTML. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
4233: ColorCodeHTML = ColorCodeHTML & CurrentLine
4234: 'CurrentLine = Replace(CurrentLine, vbCrLf, "<br>" & vbCrLf)
4235:
4236:
4237:
4238: Next
4239:
4240: 'ColorCodeHTML = EncodedHTML
4241:
4242: End Function
4243: End Class