&ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure 
/*--------------------------------------------------------------------------
    File        : 
    Purpose     :

    Syntax      :

    Description :

    Author(s)   :
    Created     :
    Notes       :
  ------------------------------------------------------------------------*/
/*          This .W file was created with the Progress UIB.             */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE INPUT PARAMETER ipDirectory  AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ipTitle      AS CHARACTER NO-UNDO.

DEF VAR vStatus AS CHAR FORMAT "x(30)" NO-UNDO.

DEFINE FRAME frmStatus
  SKIP(1) SPACE(2) vStatus LABEL "Creating Page" SPACE(2) SKIP(1)
  WITH SIDE-LABELS THREE-D CENTERED VIEW-AS DIALOG-BOX TITLE "Please wait...".

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Procedure



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME



/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Procedure
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: CODE-ONLY COMPILE
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Procedure ASSIGN
         HEIGHT             = 2
         WIDTH              = 40.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME
 



&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure 


/* ***************************  Main Block  *************************** */

  
DISPLAY "index" @ vStatus
  WITH FRAME frmStatus.

OUTPUT TO VALUE( ipDirectory + "/index.htm" ).
RUN Header (ipTitle).
RUN TableList.
RUN Footer.
OUTPUT CLOSE.

FOR EACH DICTDB._File NO-LOCK
  WHERE DICTDB._File._File-name < "_":
  
    ASSIGN vStatus = ipDirectory + "/" + DICTDB._File._Dump-name + ".htm".
    DISPLAY vStatus WITH FRAME frmStatus.
    PROCESS EVENTS.
      
    OUTPUT TO VALUE(vStatus).
    RUN TableHeader (ipTitle, DICTDB._File._File-name).
    RUN FieldList (RECID(_File)).

    PUT UNFORMATTED "</table>" SKIP.
    PUT UNFORMATTED "</p>" SKIP.
    PUT UNFORMATTED "<hr>" SKIP.
    PUT UNFORMATTED "<p><center><font color=blue><h3>" SKIP.
    PUT UNFORMATTED "<a name=""index"">Indexing</a></h3></font></center>" SKIP.
    
    RUN IndexList (RECID(DICTDB._File)).
    RUN TableFooter (DICTDB._File._File-name).
    OUTPUT CLOSE.
END.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CrossReference Procedure 
PROCEDURE CrossReference :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipTableRecid AS RECID NO-UNDO.
    DEFINE INPUT PARAMETER ipFieldName  AS CHARACTER NO-UNDO.
    
    DEFINE VARIABLE lvFirst   AS LOGICAL INITIAL TRUE NO-UNDO.
    DEFINE VARIABLE lvRefFile AS CHARACTER NO-UNDO.
    
    DEFINE BUFFER bField FOR DICTDB._Field.
    DEFINE BUFFER bFile FOR DICTDB._File.
    
    PUT UNFORMATTED "<td>".

    FOR EACH bField NO-LOCK
      WHERE bField._Field-name = ipFieldName
      AND bField._File-Recid <> ipTableRecid,
        FIRST bFile OF bField NO-LOCK
        BY bFile._File-name:
    
        IF lvFirst THEN ASSIGN lvFirst = FALSE.

        RUN HTMLFile (bFile._Dump-name, OUTPUT lvRefFile).
        
        PUT UNFORMATTED "<a href=" + lvRefFile + ">" + 
                        bFile._File-name + "." + bField._Field-name + 
                        "</a> ".
    END.
    
    IF lvFirst THEN PUT UNFORMATTED "&nbsp".
    
    PUT UNFORMATTED "</td>" SKIP.    
    
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FieldList Procedure 
PROCEDURE FieldList :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipTableRecid AS RECID NO-UNDO.
    
    FOR EACH DICTDB._Field NO-LOCK
      WHERE DICTDB._Field._File-Recid = ipTableRecid
      BY _Order:
    
        PUT UNFORMATTED "<tr>" SKIP.
        PUT UNFORMATTED "<td>" + _field._field-name.
        PUT UNFORMATTED "</td>" SKIP.
        PUT UNFORMATTED "<td>" + _field._data-type.
        PUT UNFORMATTED "</td>" SKIP.
        PUT UNFORMATTED "<td align=right>".
        PUT UNFORMATTED _field._format + "</td>" SKIP.
        
        IF _field._extent > 0 
        THEN PUT UNFORMATTED "<td align=right>" _field._extent "</td>" SKIP.
        ELSE PUT UNFORMATTED "<td align=right>1</td>" SKIP.
        
        IF TRIM(_field._initial) = "" OR _field._initial = ? 
        THEN PUT UNFORMATTED "<td>&nbsp</td>" SKIP.
        ELSE PUT UNFORMATTED "<td>" + _field._initial + "</td>" SKIP.
        
        IF TRIM(_field._desc) = "" 
        THEN PUT UNFORMATTED "<td>&nbsp</td>" SKIP.
        ELSE PUT UNFORMATTED "<td>" + _field._desc  + "</td>" SKIP.

        RUN CrossReference (ipTableRecid, _Field._Field-name).
        
        PUT UNFORMATTED "</tr>" SKIP.

    END.
    
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Footer Procedure 
PROCEDURE Footer :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    PUT UNFORMATTED "</table>" SKIP.
    PUT UNFORMATTED "</center></div>" SKIP.
    PUT UNFORMATTED "</p><br>" SKIP.
    PUT UNFORMATTED "<hr><br>" SKIP.
    PUT UNFORMATTED "<center>" SKIP.
    PUT UNFORMATTED "<i>Last updated " + string( today, "99/99/9999" ) + " ".
    PUT UNFORMATTED string( time, "hh:mm:ss am" ) + "</i><br><p>" SKIP.
    PUT UNFORMATTED "<hr><br>" SKIP.
    PUT UNFORMATTED "</center><br><p>" SKIP.
    PUT UNFORMATTED "</body>" SKIP.
    PUT UNFORMATTED "</html>" SKIP.

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE Header Procedure 
PROCEDURE Header :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipTitle AS CHARACTER NO-UNDO.
    
    PUT UNFORMATTED "<html>" SKIP.
    PUT UNFORMATTED "<head>" SKIP.
    PUT UNFORMATTED "<title>" + ipTitle + "</title><p>" SKIP.
    PUT UNFORMATTED "</head>" SKIP.
    PUT UNFORMATTED "<body bgcolor=""white"">" SKIP.
    PUT UNFORMATTED "<hr>" SKIP.
    PUT UNFORMATTED "<h1><center><font color=red>" + ipTitle. 
    PUT UNFORMATTED "</font></center></h1>" SKIP.
    PUT UNFORMATTED "<hr>" SKIP.
    PUT UNFORMATTED "<p>" SKIP.
    PUT UNFORMATTED "<div align=""center""><center>" SKIP.
    PUT UNFORMATTED "<table border=""0"" cellpadding=""5"" cellspacing=""5"">" SKIP.
    
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE HTMLFile Procedure 
PROCEDURE HTMLFile :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER  ipDumpName AS CHARACTER NO-UNDO.
    DEFINE OUTPUT PARAMETER opFileName AS CHARACTER NO-UNDO.
    
    /** replace any # (hashes) with special encoding for URL %23 = # **/

    DO WHILE INDEX( ipDumpName, "#" ) > 0:
        ASSIGN SUBSTRING( ipDumpName, INDEX( ipDumpName, "#" ), 1 ) = "%23".
    END. /* do while index( ipDumpName, "#" ) > 0: */

    ASSIGN opFileName = ipDumpName + ".htm".

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE IndexList Procedure 
PROCEDURE IndexList :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipTableRecid AS RECID NO-UNDO.
    
    FOR EACH DICTDB._index NO-LOCK
      WHERE DICTDB._index._file-recid = ipTableRecid:
      
        PUT UNFORMATTED "<br><font color=red><b>". 
        PUT UNFORMATTED _index._index-name + "</b></font>" SKIP.
      
        IF DICTDB._File._prime-index = RECID(_index) 
        THEN PUT UNFORMATTED "<font color=blue><i> - Primary </i></font>" SKIP.
      
        IF _index._unique 
        THEN PUT UNFORMATTED "<font color=blue><i> - Unique </i></font>" SKIP.

        FOR EACH DICTDB._index-field NO-LOCK
          WHERE DICTDB._index-field._index-recid = RECID(_index):

            FIND DICTDB._field
              WHERE RECID(_field) = _index-field._field-recid 
              NO-LOCK.

            IF AVAIL _field 
            THEN PUT UNFORMATTED "<br>" + _field._field-name SKIP.
        END. /* FOR EACH _index-field WHERE */
        PUT UNFORMATTED "<p>" SKIP.
        
    END. /* FOR EACH _index WHERE */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TableFooter Procedure 
PROCEDURE TableFooter :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipTableName AS CHARACTER NO-UNDO.

    PUT UNFORMATTED "</p><br>" SKIP.
    PUT UNFORMATTED "<hr><br>" SKIP.
    PUT UNFORMATTED "<i>Last updated " + string( today, "99/99/9999" ) + " ".
    PUT UNFORMATTED string( time, "hh:mm:ss am" ) + "</i>" SKIP.
    PUT UNFORMATTED "<p><br>" SKIP.
    PUT UNFORMATTED "<a href=""index.htm"">Return to Listing Of Database ".
    PUT UNFORMATTED "Tables</a><br><p>" SKIP.
    PUT UNFORMATTED "<hr><br>" SKIP.
    PUT UNFORMATTED "<p><br><br>" SKIP.
    PUT UNFORMATTED "</body>" SKIP.
    PUT UNFORMATTED "</html>" SKIP.
    
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TableHeader Procedure 
PROCEDURE TableHeader :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipTitle     AS CHARACTER NO-UNDO.
    DEFINE INPUT PARAMETER ipTableName AS CHARACTER NO-UNDO.
    
    PUT UNFORMATTED "<html>" SKIP.
    PUT UNFORMATTED "<head>" SKIP.
    PUT UNFORMATTED "<title>" + ipTitle + " -- " + ipTableName.
    PUT UNFORMATTED "</title><p>" SKIP.
    PUT UNFORMATTED "</head>" SKIP.
    PUT UNFORMATTED "<body bgcolor=""white"">" SKIP.
    PUT UNFORMATTED "<hr>" SKIP.
    PUT UNFORMATTED "<h1><center><font color=""red"">".
    PUT UNFORMATTED ipTitle + "</font></center></h1>" SKIP.
    PUT UNFORMATTED "<hr>" SKIP.
    PUT UNFORMATTED "<h2><center><font color=""blue"">".
    PUT UNFORMATTED ipTableName + "</font></h2>" SKIP.
    PUT UNFORMATTED "<p><h3>" + DICTDB._File._desc + "</h3></p></center>" SKIP.
    PUT UNFORMATTED "<h4><center>".
    PUT UNFORMATTED "<a href=" + DICTDB._File._dump-name + ".htm#index>Indexing</a>".
    PUT UNFORMATTED "</center></h4>" SKIP.
    PUT UNFORMATTED "<hr>" SKIP.
    PUT UNFORMATTED "<div align=""center""><center>" SKIP.
    PUT UNFORMATTED "<table border=""1"" cellpadding=""4"" cellspacing=""1""".
    PUT UNFORMATTED "bgcolor=""#C0C0C0"">" SKIP.
    PUT UNFORMATTED "<tr>" SKIP.
    PUT UNFORMATTED "<td align=left><font color=""blue"">".
    PUT UNFORMATTED "Field Name</font></th>" SKIP.
    PUT UNFORMATTED "<td align=left><font color=""blue"">".
    PUT UNFORMATTED "Datatype</font></th>" SKIP.
    PUT UNFORMATTED "<td align=right><font color=""blue"">".
    PUT UNFORMATTED "Format</font></th>" SKIP.
    PUT UNFORMATTED "<td align=left><font color=""blue"">".
    PUT UNFORMATTED "Extent</font></th>" SKIP.
    PUT UNFORMATTED "<td align=left><font color=""blue"">".
    PUT UNFORMATTED "Default</font></th>" SKIP.
    PUT UNFORMATTED "<td align=left><font color=""blue"">".
    PUT UNFORMATTED "Description</font></th>" SKIP.
    PUT UNFORMATTED "<td align=left><font color=""blue"">".
    PUT UNFORMATTED "Cross Reference</font></th>" SKIP.
    PUT UNFORMATTED "</tr>" SKIP.
   
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TableList Procedure 
PROCEDURE TableList :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    DEFINE VARIABLE lvCount     AS INTEGER NO-UNDO.
    DEFINE VARIABLE lvTableName AS CHARACTER NO-UNDO.
    
    FOR EACH DICTDB._File
      WHERE DICTDB._File._file-name < "_" 
      NO-LOCK:

        ASSIGN lvCount = lvCount + 1.

        IF lvCount modulo 5 = 1 THEN PUT UNFORMATTED "<tr>" SKIP.

        RUN HTMLFile (INPUT DICTDB._File._Dump-name, OUTPUT lvTableName).

        PUT UNFORMATTED "<td>".
        PUT UNFORMATTED "<a href=" + lvTableName + ">" + DICTDB._File._file-name. 
        PUT UNFORMATTED "</a></td>" SKIP.
        
        IF lvCount modulo 5 = 0 THEN PUT UNFORMATTED "</tr>" SKIP.
    END. /* FOR EACH DICTDB._File WHERE */

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME