Guidance
指路人
g.yi.org
software / rapidq / Examples / String & Text / CodeReporter / Codepart.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
     REP_DirDT.directory = homedir
     REP_Form.SHOWMODAL

'______________________________________________________________________________
     SUB REP_Changedir
      REP_FilesFL.directory = REP_DirDT.directory
     END SUB

'______________________________________________________________________________

     SUB REP_ChangePanel

      IF REP_TabTC.Tabindex = 0 THEN
       REP_ReportPanel.Visible = 1
       REP_SettingsPanel.Visible = 0
      ELSEIF REP_TabTC.Tabindex = 1 THEN
       REP_ReportPanel.Visible = 0
       REP_SettingsPanel.Visible = 1
      END IF

     END SUB

'______________________________________________________________________________
     SUB REP_SelectFile
      REP_OriginalFile = REP_FilesFL.Filename
      REP_File = REP_FilesFL.Filename
      REP_PrepareFile
     END SUB

'______________________________________________________________________________
     SUB REP_PrepareFile
      CopyFile (REP_File, Fullpathnoext(REP_File) + ".crf", 0)
      REP_File = Fullpathnoext(REP_File) + ".crf"
      REP_re.loadfromfile (REP_File)
      REP_re.text = REPLACESUBSTR$(REP_re.text, CHR$(9), " ")
      REP_re.text = REPLACESUBSTR$(REP_RE.text, ("_" & CHR$(13) & CHR$(10)), "")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "(" , " ( ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, ")" , " ) ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "," , " , ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "=" , " = ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "+" , " + ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "&" , " & ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "*" , " * ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "/" , " / ")
      REP_re.text = REPLACESUBSTR$(REP_re.text, "-" , " - ")

      DIM x AS INTEGER
      DIM count AS INTEGER

      count = REP_re.linecount
      x = 0
      REP_Gauge.min = 0
      REP_Gauge.max = count
      DO
       REP_RE.line(x) = RTRIM$(LTRIM$(UCASE$(REP_re.line(x))))
       REP_RE.line(x) = REPLACESUBSTR$(REP_Re.line(x), CHR$(9), " ")
       rep_RE.line(x) = REP_RE.line(x) + " "
       REP_Gauge.position = x
       INC(x)
      LOOP UNTIL x = count
      REP_Gauge.position = 0
      REP_Gauge.max = count * 4

      DO
       IF TALLY (REP_RE.text, "  ") > 0 THEN
        REP_RE.text = REPLACESUBSTR$(REP_RE.text, "  ", " ")
       ELSE
        EXIT DO
       END IF
      LOOP
      REP_re.text = REPLACESUBSTR$(REP_RE.text, ("_ " & CHR$(13) & CHR$(10)), "")

      REP_CreateReport
     END SUB

'______________________________________________________________________________
     SUB REP_CreateReport

      Html_row_Face = REP_S_CellFontBOX.text
      Html_row_color = REP_S_CellColorBOX.text
      Html_row_Size = REP_S_CellSizeBOX.text
      Html_row_Bold = REP_S_CellBoldCH.checked

      REP_Html = Fullpathnoext(REP_OriginalFile) + ".htm"
      DIM htm_fs AS QFILESTREAM

      htm_fs.OPEN (REP_Html, 65535)
      WITH htm_fs

       .writeline  REP_NewHtmlPage
       .writeline  REP_Stats
       .writeline  REP_ObjAndVar

'    .writeline  REP_Declarations
'.................. End of file
       .writeline "</Font></BODY></HTML>"
      END WITH
      REP_Gauge.Position = 0
      htm_fs.CLOSE
      RUN("Explorer " & REP_html)
     END SUB

'______________________________________________________________________________
     FUNCTION REP_Stats
      DIM TempOut AS STRING
      DIM tempname AS STRING
      DIM tempfilesize AS STRING
      DIM rs AS QFILESTREAM
      DIM x AS INTEGER
      DIM count AS INTEGER
      REP_IncSL.clear
      REP_ResourcesSL.clear

      x = 0
      count = REP_re.linecount
      DO
       tempfilesize = "Unknown"
       IF LEFT$(REP_re.line(x), 8) = "$INCLUDE" THEN
        tempname = FIELD$(REP_re.line(x), CHR$(34), 2)
        IF FILEEXISTS(Homedir & tempname) OR _
         IF  FILEEXISTS(tempname) THEN
         rs.OPEN(tempname, 0)
         rs.position = 0
         tempfilesize = STR$(rs.size)
         rs.CLOSE
         tempname = Html_insertlink(tempname, tempname)
        END IF
        REP_IncSL.additems (tempname & "|" &_
         STR$(x) & "|" & tempfilesize)
       END IF
       REP_Gauge.position = REP_Gauge.position + x
       INC(x)
      LOOP UNTIL x = count

      tempout = Html_InsertAnchor ("IncludedFiles")
      IF REP_IncSL.itemcount > 0 THEN
       tempout = tempout & "<CENTER><H3>Included Code Files</H3></CENTER>"
       tempout = tempout & Html_TableHeader ("Name,Line,Size (Bytes)", _
        REP_S_TableColorBOX.text, _
        REP_S_TableBorderSizeBOX.text, _
        REP_S_TableBorderColorBOX.text, _
        REP_S_TablePaddingBOX.text, _
        REP_S_TableSpacingBOX.text, _
        REP_S_TableCollapseCH.checked)
       tempout = tempout & Html_Multirow (REP_IncSL, "|")
       tempout = tempout & "</TABLE><BR><BR>"
      ELSE
       tempout = "<CENTER><H3>No Included Code Files Found</H3></CENTER>"
      END IF


'鞍鞍鞍鞍鞍鞍鞍鞍鞍 Resources
      x = 0
      DO
       tempfilesize = "Unknown"
       IF LEFT$(REP_re.line(x), 9) = "$RESOURCE" THEN
        tempname = FIELD$(REP_re.line(x), CHR$(34), 2)
        IF FILEEXISTS(Homedir & tempname) OR _
         IF  FILEEXISTS(tempname) THEN
         rs.OPEN(tempname, 0)
         rs.position = 0
         tempfilesize = STR$(rs.size)
         rs.CLOSE
         tempname = Html_insertlink(tempname, tempname)
        END IF

        REP_ResourcesSL.additems (tempname & "|" &_
         STR$(x) & "|" & tempfilesize)
       END IF
       REP_Gauge.position = REP_Gauge.position + x
       INC(x)
      LOOP UNTIL x = count

      tempout = tempout & Html_InsertAnchor ("ResourceFiles")

      IF REP_ResourcesSL.itemcount > 0 THEN
       tempout = tempout & "<CENTER><H3>Resource Files</H3></CENTER>"
       tempout = tempout & Html_TableHeader ("Name,Line,Size (Bytes)", _
        REP_S_TableColorBOX.text, _
        REP_S_TableBorderSizeBOX.text, _
        REP_S_TableBorderColorBOX.text, _
        REP_S_TablePaddingBOX.text, _
        REP_S_TableSpacingBOX.text, _
        REP_S_TableCollapseCH.checked)
       tempout = tempout & Html_Multirow (REP_ResourcesSL, "|")
       tempout = tempout & "</TABLE>"
      ELSE
       tempout = tempout & "<CENTER><H3>No Resource Files Found</H3></CENTER>"
      END IF
      result = tempout
     END FUNCTION

'______________________________________________________________________________

     FUNCTION REP_ObjAndVar
      DIM x AS INTEGER
      DIM Count AS INTEGER
      DIM Output AS STRING
      REP_ObjectsSL.Clear
      REP_VariablesSL.Clear

      DIM level AS INTEGER
      DIM y AS INTEGER
      DIM temprow AS STRING
      DIM NC_Objects AS INTEGER
      DIM J_temprow AS STRING

      Output = ""
      level = -1
      y = 0
      temprow = ""
      NC_Objects = 0
      J_temprow = ""

      x = 0
      Count = REP_re.linecount

      DO
       IF FIELD$(REP_Re.line(x), " ", 1) = "DIM" THEN
        IF FIELD$(REP_Re.line(x), " ", 4) = "INTEGER" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "STRING" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "DOUBLE" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "SINGLE" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "SHORT" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "DWORD" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "LONG" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "WORD" OR _
         FIELD$(REP_Re.line(x), " ", 4) = "BYTE" THEN
         REP_VariablesSL.additems _
          FIELD$(REP_Re.line(x), " ", 2) & "|" & _
          FIELD$(REP_Re.line(x), " ", 4) & "|" & STR$(x)
        ELSE
         REP_ObjectsSL.additems _
          FIELD$(REP_Re.line(x), " ", 2) & "|" & _
          FIELD$(REP_Re.line(x), " ", 4) & "|" & STR$(x)
        END IF
       END IF
       REP_GAuge.position = REP_Gauge.position + x
       INC(x)
      LOOP UNTIL x = count

      OutPut = Html_InsertAnchor ("Variables")
      IF REP_VariablesSL.itemcount > 0 THEN
       Output = Output & "<CENTER><H3>Variables</H3></CENTER>"
       Output = Output & Html_TableHeader ("Name,Type,Line", _
        REP_S_TableColorBOX.text, _
        REP_S_TableBorderSizeBOX.text, _
        REP_S_TableBorderColorBOX.text, _
        REP_S_TablePaddingBOX.text, _
        REP_S_TableSpacingBOX.text, _
        REP_S_TableCollapseCH.checked)

       Output = Output & Html_MultiRow(REP_VariablesSL, "|")
       Output = Output & "</TABLE><BR><BR>"
      ELSE
       Output = Output & "<CENTER><H3>No DIMmed Variables Found</H3></CENTER>"
      END IF

      Output = Output & Html_InsertAnchor ("ComAndObj")
      IF REP_ObjectsSL.itemcount > 0 THEN
       OutPut = Output & "<CENTER><H3>Components & Objects</H3></CENTER>"
       OutPut = OutPut & Html_TableHeader ("Name,Type,Line", _
        REP_S_TableColorBOX.text, _
        REP_S_TableBorderSizeBOX.text, _
        REP_S_TableBorderColorBOX.text, _
        REP_S_TablePaddingBOX.text, _
        REP_S_TableSpacingBOX.text, _
        REP_S_TableCollapseCH.checked)
       Output = Output & Html_MultiRow(REP_ObjectsSL, "|")
       Output = Output & "</TABLE><BR><BR>"
      ELSE
       Output = Output & "<CENTER><H3>" & _
        "No DIMmed Components/Objects Found</H3></CENTER>"
      END IF


      x = 0
      DO
       IF FIELD$(REP_Re.line(x), " ", 1) = "CREATE" THEN
        level = level + 1
        NC_Objects = NC_Objects + 1
        temprow = ""
        IF level > 0 THEN
         y = 0
         DO
          temprow = Html_InsertImage("empty.gif", 16, 16) & temprow
          INC(y)
         LOOP UNTIL y = level
        END IF
        temprow = temprow & Html_Insertimage("level.gif",16,16) & _
         FIELD$(REP_Re.line(x), " ", 2) & "|" & _
         FIELD$(REP_Re.line(x), " ", 4) & "|" & STR$(x)
        J_temprow = J_temprow & Html_TableRow (temprow, "|", 0) & CRLF
       ELSEIF FIELD$(REP_Re.line(x), " ", 1) & _
         FIELD$(REP_Re.line(x), " ", 2) = "ENDCREATE" THEN
         level = level - 1
        END IF
        REP_Gauge.position = REP_Gauge.position + x
        INC(x)
       LOOP UNTIL x = count

       OutPut = Output &  Html_InsertAnchor ("ComAndObjCreate")
       IF NC_Objects > 0 THEN
        OutPut = Output & "<CENTER><H3>Components and Objects " & _
         "(using CREATE)</H3></CENTER>"
        OutPut = OutPut & Html_TableHeader ("Name,Type,Line", _
         REP_S_TableColorBOX.text, _
         REP_S_TableBorderSizeBOX.text, _
         REP_S_TableBorderColorBOX.text, _
         REP_S_TablePaddingBOX.text, _
         REP_S_TableSpacingBOX.text, _
         REP_S_TableCollapseCH.checked)
        Output = Output & J_Temprow
        Output = Output & "</TABLE><BR><BR>"
       ELSE
        Output = Output & "<CENTER><H3>"  & _
         "No CREATEd Components/Objects Found</H3></CENTER>"
       END IF
       result = output
      END FUNCTION

'______________________________________________________________________________

      FUNCTION REP_Declarations
       DIM x AS INTEGER
       DIM y AS INTEGER
       DIM count AS INTEGER
       DIM Parameters AS STRING
       DIM Returns AS STRING
       DIM output AS STRING

       count = REP_re.linecount
       Parameters = "None"
       Returns = ""
       Output = ""
       y = 0
       REP_DeclarationsSL.clear

       x = 0
       DO
        IF FIELD$(REP_re.line(x), " ", 1) & _
         FIELD$(REP_re.line(x), " ", 2) = "DECLARESUB" _
         OR FIELD$(REP_re.line(x), " ", 1) & _
         FIELD$(REP_re.line(x), " ", 2) = "DECLAREFUNCTION" THEN

         Output = Output &   FIELD$(REP_re.line(x), " ", 3) & "|" &_
          FIELD$(REP_re.line(x), " ", 2) & "|"

         y = TALLY(REP_re.line(x), " ")
         Returns = FIELD$(REP_re.line(x), " ", y) = ""
         Output = Output & Returns & "|"

         IF TALLY(REP_RE.line(x), "(") = 0 THEN
          Parameters = "NONE"
         ELSE
          Parameters = RIGHT$(REP_re.line(x), _
           (LEN(REP_re.line(x)) - INSTR(REP_re.line(x), "(")))
          Parameters = LEFT$(Parameters, INSTR(Parameters, ")") - 2)
          Parameters = REPLACESUBSTR$(Parameters, " , ", "<BR>")
         END IF

         Output = Output & Parameters & "|" & STR$(x)
         REP_DeclarationsSL.additems(Output)
        END IF
        INC(x)
       LOOP UNTIL x = count

       IF REP_DeclarationsSL.itemcount > 0 THEN
        OutPut = "<CENTER><H3>Declared SUBs and FUNCTIONs</H3></CENTER>"
        OutPut = OutPut & Html_TableHeader ("Name,Type,Returns,Parameters,Line", _
         REP_S_TableColorBOX.text, _
         REP_S_TableBorderSizeBOX.text, _
         REP_S_TableBorderColorBOX.text, _
         REP_S_TablePaddingBOX.text, _
         REP_S_TableSpacingBOX.text, _
         REP_S_TableCollapseCH.checked)
        Output = Output & Html_MultiRow(REP_DeclarationsSL, "|")
        Output = Output & "</TABLE><BR><BR>"
       ELSE
        Output =  "<CENTER><H3>No SUBs or FUNCTIONs declared</H3></CENTER>"
       END IF
       result = output
      END FUNCTION

'______________________________________________________________________________

      FUNCTION REP_NewHtmlPage
       Result = _
        "<HTML><HEAD><TITLE>Html Report</TITLE></HEAD>" & CRLF & _
        "<BODY bgcolor=" & REP_S_PageColorBOX.text & " link=" & _
        REP_S_PageLinksBOX.text & " vlink=" &  REP_S_PageLinksBOX.text & _
        " alink =" & REP_S_PageLinksBOX.text & CRLF & _
        "><FONT Face=" & CHR$(34) & REP_S_PageFontBOX.text & _
        CHR$(34) & "Color=" & REP_S_PageFontColorBox.text & ">" & CRLF & _
        "<TABLE width=100% align=center " & _
        "Border=2 Cellspacing=6 Bordercolor=#111111 Cellpadding=4>" & CRLF & _
        "<TR><TD bgcolor=" & REP_S_TitleColorBOX.text & "><FONT color=" & _
        REP_S_TitleFontBOX.text & ">" & _
        "<CENTER><H1>RapidQ Basic IDE 2003" & _
        "<BR>Code Report</H1></CENTER></FONT></TD></TR>" & CRLF & _
        "<TR><TD><b>Jump To: <b><BR><BR>" & _
        Html_Insertlink ("#IncludedFiles", "Included Code Files") & "<BR>" & _
        Html_Insertlink ("#ResourceFiles", "Resource Files") & "<BR>" & _
        Html_Insertlink ("#Variables", "Variables") & "<BR>" & _
        Html_Insertlink ("#ComAndObj", "Components &amp Objects") & "<BR>" & _
        Html_Insertlink ("#ComAndObjCreate", "Components &amp Objects " & _
        "(Using CREATE)") & "<BR>" & _

       "</TD></TR>" & CRLF & _
        "<TR><TD><b>File Name : </b>" & REP_OriginalFile & "<BR>" & _
        "<b>Report Date : </b>" & DATE$ & "<BR>" & _
        "<b>Time Of Creation : </b>" & TIME$ & "</TD></TR></TABLE>"
      END FUNCTION
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Mon 2023-2-6  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2003-08-28 15:37:00