/*-----------------------------------------------------------------------*
File : dicthtml.p
Version : 1.0 First Public Release 26/06/2002 (dmy)
Description : Generates HTML pages containing the schema of all
attached databases (uses dynamic queries).
Instructions: Connect databases, run program, enjoy. No configuration
is required but see Notes if you do want to change things.
Input Param : <none>
Output Param: <none>
Author : Stephen Martin Email: smaklnz@hotmail.com
Copyright : FreeFramework 2000 - http://www.freeframework.org
Created : June 2002
Notes : By default the base file is called dbdict.html and is
generated into a subdirectory of the session temp directory
called dbdict. This will be created if it does not exist.
A sub-directory is created for each connected database
and a file is created per table in the appropriate
database sub-directory.
The where clause filters out system tables by default.
In theory there is no limit to the number of databases
that can be processed together but with too many databases
the Contents and index Pages may get a bit unwieldy.
Platform Note: I wrote this to be executable on any platform with the
HTML files usable on any platform or browser. But I've
only ever run it on Windows and accessed it with IE 6
and NS 6. No promises on any other platform or browser.
There is some DHTML and CSS stuff which probably won't
work on other browsers but none of it is required to use
the pages - just flashy toys.
Credit : Carl Woodruff (Carlwood@aol.com) Due credit to Carl who
wrote a progress program many years ago to generate an RTF
from Database Schema for conversion to a Windows Help file.
He made it freely available at the time and I've used a
modified version of it ever since. In comparison to the
hideous RTF commands that were required, generating it as
HTML is easy.
*-----------------------------------------------------------------------*/
DEFINE VARIABLE iDbCounter AS INTEGER NO-UNDO.
DEFINE VARIABLE cBaseDir AS CHARACTER NO-UNDO.
DEFINE VARIABLE cFileWhere AS CHARACTER NO-UNDO.
DEFINE VARIABLE hQuery AS HANDLE NO-UNDO.
DEFINE VARIABLE hBuffer AS HANDLE NO-UNDO.
DEFINE VARIABLE hField AS HANDLE NO-UNDO EXTENT 5.
DEFINE TEMP-TABLE tIndex NO-UNDO
FIELD cIndexItem AS CHARACTER
FIELD cItemType AS CHARACTER
FIELD cRelURL AS CHARACTER
INDEX tIndexPK IS PRIMARY cIndexItem ASCENDING
.
DEFINE STREAM sTOC.
DEFINE STREAM sPage.
&SCOPED-DEFINE sTOC PUT STREAM sTOC UNFORMATTED
&SCOPED-DEFINE sPage PUT STREAM sPage UNFORMATTED
/*-----------------------------------------------------------------------*
Directory Names, File Names, and File Filter.
If you want to change these then change them here. There is no good
reason why 2 of them are pre-processor variables and the others are
run-time variables, it just turned out that way. One day when it annoys
me enough I'll change them all to be the same.
*-----------------------------------------------------------------------*/
&SCOPED-DEFINE cBaseFileName "dbdict.html"
&SCOPED-DEFINE cIndexFileName "dbindex.html"
ASSIGN
cBaseDir = SESSION:TEMP-DIR + "dbdict"
cFileWhere = "WHERE _Tbl-Type = 'T'".
OS-CREATE-DIR VALUE(cBaseDir).
/*-----------------------------------------------------------------------*
--- MAIN BLOCK ---
*-----------------------------------------------------------------------*/
/* Generate the base details, title etc. */
OUTPUT STREAM sTOC TO VALUE(cBaseDir + "/" + {&cBaseFileName}).
{&sTOC}
"<html><head>" SKIP
"<title>Database Schema as HTML</title>" SKIP
"<style>" SKIP "<!--" SKIP
"h1 ~{ font-family: Times; font-size: 16pt; font-weight: bold; margin-top: 0; margin-bottom: 4 ~}" SKIP
"h2 ~{ font-family: Times; font-size: 14pt; font-weight: bold; text-transform: capitalize; ~}" SKIP
"table ~{ border: thin solid #CCCCCC; ~}" SKIP
"th ~{ font-family: Times; font-size: 10pt; font-weight: bold; " SKIP
" background-color: #DDDDDD; " SKIP
" vertical-align: bottom; text-align:left; " SKIP
" margin-top: 0; margin-bottom: 0; white-space: nowrap; ~}" SKIP
"td ~{ font-family: Times; font-size: 10pt; " SKIP
" background-color: #EEEEEE; " SKIP
" vertical-align: top; margin-top: 0; margin-bottom: 0 ~}" SKIP
"-->" SKIP "</style>" SKIP
"</head>" SKIP
"<script language=javascript>" SKIP
"// " SKIP
"// Toggle to Show or Hide a block of HTML, usually a DIV. " SKIP
"// " SKIP
"function showHide(divID) ~{ " SKIP
" thisBlock = document.getElementById(divID); " SKIP
" if (thisBlock.style.display != 'none') ~{ " SKIP
" thisBlock.style.display = 'none'; " SKIP
" ~} " SKIP
" else ~{ " SKIP
" thisBlock.style.display = 'block'; " SKIP
" ~} " SKIP
"~} " SKIP
"</script>" SKIP
"<body>" SKIP
"<h1>Database Schema as HTML</h1>" SKIP.
/* Get a List of Connected Databases then Cycle Through them */
db_loop:
DO iDbCounter = 1 TO NUM-DBS:
{&sTOC}
"<h2 id=db_" + LDBNAME(iDbCounter) + " style='cursor:hand' onClick='showHide(~"" + LDBNAME(iDbCounter) + "~");return false;'>" + LDBNAME(iDbCounter) + "</h2>" SKIP
"<div id=" + LDBNAME(iDbCounter) + ">" SKIP
"<table>" SKIP
" <tr>"
"<th>Table</th>"
"<th>Dump Name</th>"
"<th>Description</th>"
"<th>Label</th>"
"</tr>" SKIP.
OS-CREATE-DIR VALUE(cBaseDir + "/" + LOWER(LDBNAME(iDbCounter))).
RUN CreateIndexEntry (INPUT LDBNAME(iDbCounter),
INPUT "Database",
INPUT LOWER(LDBNAME(iDbCounter)),
INPUT "",
INPUT "").
/* For each database, query all of the files/tables in the database */
CREATE QUERY hQuery.
CREATE BUFFER hBuffer FOR TABLE LDBNAME(iDbCounter) + "._File".
hQuery:SET-BUFFERS(hBuffer).
IF hQuery:QUERY-PREPARE("FOR EACH " + LDBNAME(iDbCounter) + "._File " + cFileWhere + " BY _File-name")
THEN hQuery:QUERY-OPEN().
ELSE DO: /* --- ERROR --- */
MESSAGE "Prepare Query Failed: " + "FOR EACH " + LDBNAME(iDbCounter) + "._File " + cFileWhere + " BY _File-name" VIEW-AS ALERT-BOX.
NEXT db_loop.
END.
REPEAT:
hQuery:GET-NEXT.
IF hQuery:QUERY-OFF-END THEN LEAVE.
/* Build the Contents Page from the Table Names */
hField[1] = hBuffer:BUFFER-FIELD("_File-name").
hField[2] = hBuffer:BUFFER-FIELD("_Dump-name").
hField[3] = hBuffer:BUFFER-FIELD("_File-label").
hField[4] = hBuffer:BUFFER-FIELD("_Desc").
hField[5] = hBuffer:BUFFER-FIELD("_Prime-Index").
{&sTOC} " <tr>"
"<td><a href=" + LOWER(LDBNAME(iDbCounter) + "/" + hField[2]:BUFFER-VALUE + ".html") + ">" + LOWER(STRING(hField[1]:BUFFER-VALUE)) + "</a> </td>"
"<td>" + LOWER(STRING(hField[2]:BUFFER-VALUE)) " </td>"
"<td>" + STRING(hField[4]:BUFFER-VALUE) " </td>"
"<td>" + (IF hField[3]:BUFFER-VALUE <> ? THEN STRING(hField[3]:BUFFER-VALUE) ELSE "") + " </td>"
"</tr>" SKIP.
/* Generate a details page per Table */
RUN TableDetailsPage (INPUT LDBNAME(iDbCounter), INPUT hField[1]:STRING-VALUE, INPUT hField[2]:STRING-VALUE, INPUT hBuffer:RECID).
END. /* Repeat: Loop Through Tables */
/* Close the TOC for the Database and clear the _File queries */
{&sTOC}
"</table>" SKIP
"</div>" SKIP.
hQuery:QUERY-CLOSE().
DELETE OBJECT hBuffer.
DELETE OBJECT hQuery.
END. /* Cycle through databases */
/* Close the Contents Page */
{&sTOC}
"<p align=center> - <a href=" + {&cIndexFileName} + ">Index Page</a> - </p>" SKIP
"</body></html>" SKIP.
OUTPUT STREAM sTOC CLOSE.
/* Generate the Index Page */
RUN GenerateIndex.
/*-----------------------------------------------------------------------*
--- INTERNAL PROCEDURES ---
*-----------------------------------------------------------------------*/
/* --------------------------------------------------------------------- */
/* Generate the Table Details Page: ./DbName/TableDumpName.html */
PROCEDURE TableDetailsPage:
DEFINE INPUT PARAMETER cDbName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cFileDump AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER rFileRecid AS RECID NO-UNDO.
DEFINE VARIABLE hFieldQry AS HANDLE NO-UNDO.
DEFINE VARIABLE hFieldBuf AS HANDLE NO-UNDO.
DEFINE VARIABLE hFieldFld AS HANDLE NO-UNDO EXTENT 16.
CREATE QUERY hFieldQry.
CREATE BUFFER hFieldBuf FOR TABLE cDbName + "._Field".
hFieldQry:SET-BUFFERS(hFieldBuf).
IF hFieldQry:QUERY-PREPARE("FOR EACH " + cDbName + "._Field WHERE _File-recid = " + STRING(rFileRecid) + " BY _Field-name")
THEN hFieldQry:QUERY-OPEN().
ELSE DO: /* --- ERROR --- */
MESSAGE "Prepare Query Failed: " + "FOR EACH " + cDbName + "._Field WHERE _File-recid = rFileRecid BY _Field-name" VIEW-AS ALERT-BOX ERROR.
RETURN.
END.
RUN CreateIndexEntry (INPUT cFileName,
INPUT "Table",
INPUT LOWER(cDbName),
INPUT LOWER(cFileName),
INPUT cFileDump).
/* Generate a details page per Table */
OUTPUT STREAM sPage TO VALUE(cBaseDir + "/" + LOWER(TRIM(cDbName) + "/" + TRIM(cFileDump) + ".html")).
{&sPage}
"<html><head>" SKIP
"<title>Database Schema as HTML - " + cDbName + "." + cFileName + "</title>" SKIP
"<style>" SKIP "<!--" SKIP
"h1 ~{ font-family: Times; font-size: 16pt; font-weight: bold; margin-top: 0; margin-bottom: 4 ~}" SKIP
"h2 ~{ font-family: Times; font-size: 14pt; font-weight: bold; text-transform: capitalize; ~}" SKIP
"table ~{ border: thin solid #CCCCCC; ~}" SKIP
"th ~{ font-family: Times; font-size: 10pt; font-weight: bold; " SKIP
" background-color: #DDDDDD; " SKIP
" vertical-align: bottom; text-align:left; " SKIP
" margin-top: 0; margin-bottom: 0; white-space: nowrap; ~}" SKIP
"td ~{ font-family: Times; font-size: 10pt; " SKIP
" background-color: #EEEEEE; " SKIP
" vertical-align: top; margin-top: 0; margin-bottom: 0 ~}" SKIP
".label ~{ text-align: right; font-style: italic; ~}" SKIP
"p ~{ font-family: Arial; font-size: 10pt; margin-top: 2; margin-bottom: 2 ~}" SKIP
"-->" SKIP "</style>" SKIP
"</head>" SKIP
"<script language=javascript>" SKIP
"// " SKIP
"// Toggle to Show or Hide a block of HTML, usually a DIV. " SKIP
"// " SKIP
"function showHide(divID) ~{ " SKIP
" thisBlock = document.getElementById(divID); " SKIP
" if (thisBlock.style.display != 'none') ~{ " SKIP
" thisBlock.style.display = 'none'; " SKIP
" ~} " SKIP
" else ~{ " SKIP
" thisBlock.style.display = 'block'; " SKIP
" ~} " SKIP
"~} " SKIP
"</script>" SKIP
"<body>" SKIP
"<h1><a href=../" + {&cBaseFileName} + "#db_" + cDbName + ">" + cDbName + "</a>." + cFileName + "</h1>" SKIP
"<p>" + STRING(hField[4]:BUFFER-VALUE) + " </p>" SKIP /* Table Description */
"<table>" SKIP
" <tr><th>Field</th>"
"<th>Label</th>"
"<th>Column<br>Label</th>"
"<th>Data Type</th>"
"<th>Ext</th>"
"<th>Format</th>"
"<th>Mandatory</th>"
"<th>Case<br>Sensitive</th>"
"<th>Initial<br>Value</th>"
"<th>Order</th>"
"</tr>" SKIP.
REPEAT:
hFieldQry:GET-NEXT.
IF hFieldQry:QUERY-OFF-END THEN LEAVE.
hFieldFld[1] = hFieldBuf:BUFFER-FIELD("_Field-name").
hFieldFld[2] = hFieldBuf:BUFFER-FIELD("_Label").
hFieldFld[3] = hFieldBuf:BUFFER-FIELD("_Data-Type").
hFieldFld[4] = hFieldBuf:BUFFER-FIELD("_Extent").
hFieldFld[5] = hFieldBuf:BUFFER-FIELD("_Format").
hFieldFld[6] = hFieldBuf:BUFFER-FIELD("_Order").
hFieldFld[7] = hFieldBuf:BUFFER-FIELD("_Col-Label").
hFieldFld[8] = hFieldBuf:BUFFER-FIELD("_Mandatory").
hFieldFld[9] = hFieldBuf:BUFFER-FIELD("_Fld-Case").
hFieldFld[10] = hFieldBuf:BUFFER-FIELD("_Initial").
hFieldFld[11] = hFieldBuf:BUFFER-FIELD("_Help").
hFieldFld[12] = hFieldBuf:BUFFER-FIELD("_Valexp").
hFieldFld[13] = hFieldBuf:BUFFER-FIELD("_ValMsg").
hFieldFld[14] = hFieldBuf:BUFFER-FIELD("_View-As").
hFieldFld[15] = hFieldBuf:BUFFER-FIELD("_desc").
hFieldFld[16] = hFieldBuf:BUFFER-FIELD("_Decimals").
/* Comment: What I'd like to do is allow the user to Show/Hide
the field details (desc, validation, etc. This is possible
under Netscape 4 by using the classes object but this is not
available under Ns6 or IE. I'll come back to this if I ever
work out how it can be done without generating an ID per line
and a function that hides each line individually.
*/
{&sPage}
" <tr id=" + TRIM(hFieldFld[1]:STRING-VALUE) + ">"
/* "<td><a onClick='showHide(~"" + TRIM(LOWER(hFieldFld[1]:STRING-VALUE)) + "~");'>" + TRIM(LOWER(hFieldFld[1]:STRING-VALUE)) + "</a> </td>" */
"<td>" + TRIM(LOWER(hFieldFld[1]:STRING-VALUE)) + " </td>"
"<td>" + TRIM(hFieldFld[2]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[7]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[3]:STRING-VALUE)
+ (IF SUBSTRING(hFieldFld[3]:STRING-VALUE,1,4) = "DECI"
THEN " " + TRIM("(" + hFieldFld[16]:STRING-VALUE + ")") ELSE "") " </td>"
"<td>" + TRIM(hFieldFld[4]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[5]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[8]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[9]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[10]:STRING-VALUE) + " </td>"
"<td>" + TRIM(hFieldFld[6]:STRING-VALUE) + " </td>"
" </tr>" SKIP.
{&sPage}
/* "<div id=" + TRIM(LOWER(hFieldFld[1]:STRING-VALUE)) + ">" */
(IF hFieldFld[15]:BUFFER-VALUE <> ? AND hFieldFld[15]:BUFFER-VALUE <> ""
THEN " <tr><td colspan=2 class='label'>Description:</td><td colspan=8>" + STRING(hFieldFld[15]:BUFFER-VALUE) + " </td></tr>"
ELSE "")
(IF hFieldFld[11]:BUFFER-VALUE <> ? AND hFieldFld[11]:BUFFER-VALUE <> ""
THEN " <tr><td colspan=2 class='label'>Help:</td><td colspan=8>" + STRING(hFieldFld[11]:BUFFER-VALUE) + " </td></tr>"
ELSE "")
(IF hFieldFld[12]:BUFFER-VALUE <> ? AND hFieldFld[12]:BUFFER-VALUE <> ""
THEN " <tr><td colspan=2 class='label'>Validation:</td><td colspan=8>" + STRING(hFieldFld[12]:BUFFER-VALUE) + " </td></tr>"
ELSE "")
(IF hFieldFld[13]:BUFFER-VALUE <> ? AND hFieldFld[13]:BUFFER-VALUE <> ""
THEN " <tr><td colspan=2 class='label'>Val. Message:</td><td colspan=8>" + STRING(hFieldFld[13]:BUFFER-VALUE) + " </td></tr>"
ELSE "")
(IF hFieldFld[14]:BUFFER-VALUE <> ? AND hFieldFld[14]:BUFFER-VALUE <> ""
THEN " <tr><td colspan=2 class='label'>View-As:</td><td colspan=8>" + STRING(hFieldFld[14]:BUFFER-VALUE) + " </td></tr>"
ELSE "")
/* "</div>" */
SKIP.
RUN CreateIndexEntry (INPUT TRIM(hFieldFld[1]:STRING-VALUE),
INPUT "Field",
INPUT LOWER(cDbName),
INPUT LOWER(cFileName),
INPUT cFileDump).
END. /* Repeat: Loop Through Fields */
{&sPage} "</table>" SKIP.
/* Generate Index Details */
RUN IndexDetailsTable (INPUT cDbName, INPUT cFileName, INPUT rFileRecid).
/* Generate File and Field Trigger Details */
RUN TriggerDetailsTable (INPUT cDbName, INPUT cFileName, INPUT rFileRecid).
{&sPage} "<table>" SKIP.
hFieldQry:GET-FIRST().
REPEAT:
IF hFieldQry:QUERY-OFF-END THEN LEAVE.
hFieldFld[1] = hFieldBuf:BUFFER-FIELD("_Field-name").
RUN FieldTriggerDetails (INPUT cDbName, INPUT TRIM(hFieldFld[1]:STRING-VALUE), INPUT hFieldBuf:RECID).
hFieldQry:GET-NEXT().
END.
{&sPage} "</table>" SKIP.
/* Close the table page and queries */
{&sPage}
"<p align=center> - <a href=../" + {&cBaseFileName} + ">Contents Page</a> - "
"<a href=../" + {&cIndexFileName} + ">Index Page</a> - </p>" SKIP
"</body></html>" SKIP.
OUTPUT STREAM sPage CLOSE.
hFieldQry:QUERY-CLOSE().
DELETE OBJECT hFieldBuf.
DELETE OBJECT hFieldQry.
END PROCEDURE. /* TableDetailsPage */
/* --------------------------------------------------------------------- */
/* Generate the Index Details as a Table within the Table page. */
PROCEDURE IndexDetailsTable:
DEFINE INPUT PARAMETER cDbName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER rFileRecid AS RECID NO-UNDO.
DEFINE VARIABLE hIndexQry AS HANDLE NO-UNDO.
DEFINE VARIABLE hIndexBuf AS HANDLE NO-UNDO.
DEFINE VARIABLE hIndexFld AS HANDLE NO-UNDO EXTENT 4.
DEFINE VARIABLE hIxFldQry AS HANDLE NO-UNDO.
DEFINE VARIABLE hIxFldBuf AS HANDLE NO-UNDO.
DEFINE VARIABLE hFieldBuf AS HANDLE NO-UNDO.
DEFINE VARIABLE hIxFldFld AS HANDLE NO-UNDO EXTENT 3.
CREATE QUERY hIndexQry.
CREATE BUFFER hIndexBuf FOR TABLE cDbName + "._Index".
hIndexQry:SET-BUFFERS(hIndexBuf).
CREATE QUERY hIxFldQry.
CREATE BUFFER hIxFldBuf FOR TABLE cDbName + "._Index-Field".
CREATE BUFFER hFieldBuf FOR TABLE cDbName + "._Field".
hIxFldQry:SET-BUFFERS(hIxFldBuf,hFieldBuf).
IF hIndexQry:QUERY-PREPARE("FOR EACH " + cDbName + "._Index WHERE _File-recid = " + STRING(rFileRecid) + " BY _Index-Name")
THEN hIndexQry:QUERY-OPEN().
ELSE DO: /* --- ERROR --- */
MESSAGE "Prepare Query Failed: " + "FOR EACH " + cDbName + "._index WHERE _File-recid = rFileRecid BY _Index-Name" VIEW-AS ALERT-BOX ERROR.
RETURN.
END.
/* Start the Index section for the Table */
{&sPage}
"<h2>Indices on " + cFileName + "</h2>" SKIP
"<table>" SKIP.
REPEAT:
hIndexQry:GET-NEXT.
IF hIndexQry:QUERY-OFF-END THEN LEAVE.
hIndexFld[1] = hIndexBuf:BUFFER-FIELD("_Index-name").
hIndexFld[2] = hIndexBuf:BUFFER-FIELD("_Active").
hIndexFld[3] = hIndexBuf:BUFFER-FIELD("_Unique").
/* hIndexFld[4] = hIndexBuf:BUFFER-FIELD("_Desc"). */
/* I dropped the Index Description out as it almost never gets used.
There are 3 lines to un-comment if you want to put it back in. */
{&sPage}
" <tr><th>" + hIndexFld[1]:BUFFER-VALUE + " </th>"
"<td>" + STRING(hIndexFld[2]:BUFFER-VALUE,"Active/Inactive") + " </td>"
"<td>" +
(IF hField[5]:BUFFER-VALUE = hIndexBuf:RECID THEN "<span style='font-weight:bold'>Primary</span> " ELSE "") +
STRING(hIndexFld[3]:BUFFER-VALUE,"Unique/ ") +
" </td>"
/* "<td>" + hIndexFld[4]:STRING-VALUE + " </td>" */
"</tr>" SKIP.
IF hIxFldQry:QUERY-PREPARE("FOR EACH " + cDbName + "._Index-Field WHERE _Index-recid = " + STRING(hIndexBuf:RECID) +
", EACH " + cDbName + "._Field OF _Index-Field")
THEN hIxFldQry:QUERY-OPEN().
ELSE DO: /* --- ERROR --- */
MESSAGE "Prepare Query Failed: " +
"FOR EACH " + cDbName + "._Index-Field WHERE _Index-recid = " + STRING(hIndexBuf:RECID) +
", EACH " + cDbName + "._Field OF _Index-Field"
VIEW-AS ALERT-BOX ERROR.
NEXT.
END.
REPEAT:
hIxFldQry:GET-NEXT.
IF hIxFldQry:QUERY-OFF-END THEN LEAVE.
hIxFldFld[1] = hFieldBuf:BUFFER-FIELD("_Field-Name").
hIxFldFld[2] = hIxFldBuf:BUFFER-FIELD("_Index-seq").
hIxFldFld[3] = hIxFldBuf:BUFFER-FIELD("_ascending").
{&sPage}
" <tr>"
"<td> " + hIxFldFld[1]:BUFFER-VALUE + " </td>"
"<td>" + TRIM(hIxFldFld[2]:STRING-VALUE) + " </td>"
"<td>" + STRING(hIxFldFld[3]:BUFFER-VALUE,"Ascending/Descending") + " </td>"
/* "<td> </td>" */
"</tr>" SKIP.
END. /* Repeat: Loop Through Index Fields */
hIxFldQry:QUERY-CLOSE().
{&sPage} /* Blank Line */
" <tr><td colspan=3> </td></tr>" SKIP.
/* Increase the ColSpan by 1 if you put the Desc back in */
END. /* Repeat: Loop Through Indices */
{&sPage} "</table>" SKIP.
hIndexQry:QUERY-CLOSE().
DELETE OBJECT hIndexBuf.
DELETE OBJECT hIndexQry.
DELETE OBJECT hIxFldBuf.
DELETE OBJECT hFieldBuf.
DELETE OBJECT hIxFldQry.
END PROCEDURE. /* IndexDetailsTable */
/* --------------------------------------------------------------------- */
/* Generate the File Triggers as a Table within the Table page. */
PROCEDURE TriggerDetailsTable:
DEFINE INPUT PARAMETER cDbName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER rFileRecid AS RECID NO-UNDO.
DEFINE VARIABLE hTriggerQry AS HANDLE NO-UNDO.
DEFINE VARIABLE hTriggerBuf AS HANDLE NO-UNDO.
DEFINE VARIABLE hTriggerFld AS HANDLE NO-UNDO EXTENT 3.
CREATE QUERY hTriggerQry.
CREATE BUFFER hTriggerBuf FOR TABLE cDbName + "._File-Trig".
hTriggerQry:SET-BUFFERS(hTriggerBuf).
IF hTriggerQry:QUERY-PREPARE("FOR EACH " + cDbName + "._File-Trig WHERE _File-recid = " + STRING(rFileRecid))
THEN hTriggerQry:QUERY-OPEN().
ELSE DO: /* --- ERROR --- */
MESSAGE "Prepare Query Failed: " + "FOR EACH " + cDbName + "._File-Trig WHERE _File-recid = rFileRecid" VIEW-AS ALERT-BOX ERROR.
RETURN.
END.
{&sPage}
"<h2>Triggers on " + cFileName + "</h2>" SKIP
"<table>" SKIP.
REPEAT:
hTriggerQry:GET-NEXT.
IF hTriggerQry:QUERY-OFF-END THEN LEAVE.
hTriggerFld[1] = hTriggerBuf:BUFFER-FIELD("_Event").
hTriggerFld[2] = hTriggerBuf:BUFFER-FIELD("_Proc-Name").
hTriggerFld[3] = hTriggerBuf:BUFFER-FIELD("_Override").
{&sPage}
" <tr><td>" + hTriggerFld[1]:BUFFER-VALUE + " </td>"
"<td>" + hTriggerFld[2]:BUFFER-VALUE + " </td>"
"<td>Override: " + STRING(hTriggerFld[3]:BUFFER-VALUE,"Yes/No") + " </td>"
"</tr>" SKIP.
END. /* Repeat: Loop Through File Triggers */
{&sPage} "</table>" SKIP.
hTriggerQry:QUERY-CLOSE().
DELETE OBJECT hTriggerBuf.
DELETE OBJECT hTriggerQry.
END PROCEDURE. /* TriggerDetailsTable */
/* --------------------------------------------------------------------- */
/* Generate the Field Triggers as a Table within the Table page. */
PROCEDURE FieldTriggerDetails:
DEFINE INPUT PARAMETER cDbName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cFileName AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER rFieldRecid AS RECID NO-UNDO.
DEFINE VARIABLE hTriggerQry AS HANDLE NO-UNDO.
DEFINE VARIABLE hTriggerBuf AS HANDLE NO-UNDO.
DEFINE VARIABLE hTriggerFld AS HANDLE NO-UNDO EXTENT 3.
CREATE QUERY hTriggerQry.
CREATE BUFFER hTriggerBuf FOR TABLE cDbName + "._Field-Trig".
hTriggerQry:SET-BUFFERS(hTriggerBuf).
IF hTriggerQry:QUERY-PREPARE("FOR EACH " + cDbName + "._Field-Trig WHERE _Field-recid = " + STRING(rFieldRecid))
THEN hTriggerQry:QUERY-OPEN().
ELSE DO: /* --- ERROR --- */
MESSAGE "Prepare Query Failed: " + "FOR EACH " + cDbName + "._Field-Trig WHERE _Field-recid = rFieldRecid" VIEW-AS ALERT-BOX ERROR.
RETURN.
END.
IF hTriggerQry:NUM-RESULTS > 0 THEN DO:
{&sPage} " <tr><th colspan=3>Field Triggers on " + cFileName + " </th></tr>" SKIP.
REPEAT:
hTriggerQry:GET-NEXT.
IF hTriggerQry:QUERY-OFF-END THEN LEAVE.
hTriggerFld[1] = hTriggerBuf:BUFFER-FIELD("_Event").
hTriggerFld[2] = hTriggerBuf:BUFFER-FIELD("_Proc-Name").
hTriggerFld[3] = hTriggerBuf:BUFFER-FIELD("_Override").
{&sPage}
" <tr><td>" + hTriggerFld[1]:BUFFER-VALUE + " </td>"
"<td>" + hTriggerFld[2]:BUFFER-VALUE + " </td>"
"<td>Override: " + STRING(hTriggerFld[3]:BUFFER-VALUE,"Yes/No") + " </td>"
"</tr>" SKIP.
END. /* Repeat: Loop Through Field Triggers */
END. /* > 0 Results */
hTriggerQry:QUERY-CLOSE().
DELETE OBJECT hTriggerBuf.
DELETE OBJECT hTriggerQry.
END PROCEDURE. /* FieldTriggerDetails */
/* --------------------------------------------------------------------- */
/* Common procedure to create an entry in the Index Temp Table. */
PROCEDURE CreateIndexEntry:
DEFINE INPUT PARAMETER cItem AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cType AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cDatabase AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cTable AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER cTab_Dump AS CHARACTER NO-UNDO.
ASSIGN
cItem = TRIM(cItem)
cDatabase = TRIM(cDatabase)
cTable = TRIM(cTable)
cTab_Dump = TRIM(cTab_Dump).
CREATE tIndex.
ASSIGN
cIndexItem = cItem
cItemType = cType.
CASE cType:
WHEN "Database" THEN ASSIGN
cRelURL = "./" + {&cBaseFileName} + "#" + cDatabase.
WHEN "Table" THEN ASSIGN
cRelURL = "./" + cDatabase + "/" + cTab_Dump + ".html"
cItemType = cItemType + " in " + cDatabase + " databse.".
WHEN "Field" THEN ASSIGN
cRelURL = "./" + cDatabase + "/" + cTab_Dump + ".html#" + cItem
cItemType = cItemType + " in " + cDatabase + "." + cTable.
WHEN "Index" THEN ASSIGN
cRelURL = "./" + cDatabase + "/" + cTab_Dump + ".html#" + cItem
cItemType = cItemType + " in " + cDatabase + "." + cTable.
END CASE.
END PROCEDURE. /* CreateIndexEntry */
/* --------------------------------------------------------------------- */
/* Generate the Index Page from the Temp-Table. */
PROCEDURE GenerateIndex:
DEFINE VARIABLE cLastAlpha AS CHARACTER NO-UNDO.
DEFINE VARIABLE cAlphaIndex AS CHARACTER NO-UNDO.
DEFINE VARIABLE iLoopCounter AS INTEGER NO-UNDO.
DO iLoopCounter = 97 TO 122: /* a to z */
ASSIGN cAlphaIndex = cAlphaIndex +
"<a href=#" + CHR(iLoopCounter) + ">" + CAPS(CHR(iLoopCounter)) + "</a> ".
END.
OUTPUT STREAM sTOC TO VALUE(cBaseDir + "/" + {&cIndexFileName}).
{&sTOC}
"<html><head>" SKIP
"<title>Database Schema as HTML - INDEX</title>" SKIP
"<style>" SKIP "<!--" SKIP
"h1 ~{ font-family: Times; font-size: 16pt; font-weight: bold; margin-top: 0; margin-bottom: 4 ~}" SKIP
"h2 ~{ font-family: Times; font-size: 14pt; font-weight: bold; text-transform: capitalize; ~}" SKIP
"p ~{ font-family: Arial; font-size: 10pt; margin-top: 0; margin-bottom: 0 ~}" SKIP
"a ~{ text-decoration: none ~}" SKIP
"-->" SKIP "</style>" SKIP
"</head>" SKIP
"<body>" SKIP
"<h1>Alphabetical index of all Databases, Tables and Fields</h1>" SKIP
.
FOR EACH tIndex:
IF SUBSTRING(cIndexItem,1,1) <> cLastAlpha THEN DO:
ASSIGN cLastAlpha = SUBSTRING(cIndexItem,1,1).
{&sTOC}
"<p align=right>" cAlphaIndex "</p>" SKIP
"<h2 id=" + cLastAlpha + ">" + CAPS(cLastAlpha) + "</h2>" SKIP
.
END.
{&sTOC}
"<p><a href=" + cRelURL + ">" + cIndexItem + "</a> " + cItemType + "</p>" SKIP.
END.
{&sTOC}
"<p align=center> - <a href=" + {&cBaseFileName} + ">Contents Page</a> - </p>" SKIP
"</body></html>" SKIP.
OUTPUT STREAM sTOC CLOSE.
END PROCEDURE. /* GenerateIndex */
/* --- eof --- */