📄 vbdocsrc.html
字号:
<HTML><TITLE>Source Code</TITLE><BODY><br><FONT COLOR="#007F00">'This Module is for converting VB to HTML with color coding</FONT><br><br><br><br><br><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Sub</FONT> ParseProjectFileVB(sfile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>)<br><FONT COLOR="#007F00">'open the file and parse the lines</FONT><br><FONT COLOR="#00007F">On</FONT> <FONT COLOR="#00007F">Error</FONT> <FONT COLOR="#00007F">GoTo</FONT> EH<br><FONT COLOR="#00007F">Dim</FONT> TextLine<br><FONT COLOR="#00007F">Dim</FONT> sSTART <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> thefile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> ITMX <FONT COLOR="#00007F">As</FONT> ListItem<br><FONT COLOR="#00007F">Dim</FONT> I <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> sFileDir <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> sFileDrive <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> ipos <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br>sLastFile = sfile<br>I = 1<br>Form1.ProgressBar1.Min = I<br>Form1.ProgressBar1.Max = FileLines(sfile)<br>Form1.ProgressBar1.Value = Form1.ProgressBar1.Min<br>sFileDrive = ParsePath(sfile, 0)<br>sFileDir = ParsePath(sfile, 1)<br>sFileDrive = sFileDrive & sFileDir<br>Form1.ListView1.ListItems.Clear<br><FONT COLOR="#00007F">Open</FONT> sfile <FONT COLOR="#00007F">For</FONT> <FONT COLOR="#00007F">Input</FONT> <FONT COLOR="#00007F">As</FONT> #1<br><FONT COLOR="#00007F">Do</FONT> <FONT COLOR="#00007F">While</FONT> <FONT COLOR="#00007F">Not</FONT> EOF(1)<br>Form1.ProgressBar1.Value = I<br>Form1.StatusBar1.Panels(2).Text = "Reading Line " & I<br> I = I + 1<br> <FONT COLOR="#00007F">Line</FONT> <FONT COLOR="#00007F">Input</FONT> #1, TextLine<br><FONT COLOR="#007F00">'get the start of the line</FONT><br>ipos = InStr(1, TextLine, "=", vbBinaryCompare)<br><FONT COLOR="#00007F">If</FONT> ipos <> 0 <FONT COLOR="#00007F">Then</FONT><br>sSTART = Mid(TextLine, 1, ipos - Len("="))<br><FONT COLOR="#007F00">'Set ITMX = Form1.ListView1.ListItems.Add(, , sSTART, , 1)</FONT><br>thefile = Mid(TextLine, ipos + Len("="), Len(TextLine) - ipos)<br> <FONT COLOR="#00007F">Select</FONT> <FONT COLOR="#00007F">Case</FONT> LCase(sSTART)<br> <FONT COLOR="#00007F">Case</FONT> <FONT COLOR="#00007F">Is</FONT> = "form", "usercontrol", "module"<br> ipos = InStr(1, TextLine, ";", vbBinaryCompare)<br> <FONT COLOR="#00007F">If</FONT> ipos <> 0 <FONT COLOR="#00007F">Then</FONT><br> thefile = Mid(TextLine, ipos + Len(";") + 1, Len(TextLine) - ipos)<br> <FONT COLOR="#00007F">Set</FONT> ITMX = Form1.ListView1.ListItems.Add(, , sFileDrive & thefile, , 1)<br> <FONT COLOR="#00007F">Else</FONT><br> <FONT COLOR="#00007F">If</FONT> ipos = 0 <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#00007F">Set</FONT> ITMX = Form1.ListView1.ListItems.Add(, , sFileDrive & thefile, , 1)<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br> <FONT COLOR="#00007F">Case</FONT> <FONT COLOR="#00007F">Is</FONT> = "name"<br> ProjectName = Mid(thefile, 2, Len(thefile) - 2)<br> Form1.Caption = Form1.Caption & " - " & ProjectName<br> <FONT COLOR="#00007F">Case</FONT> <FONT COLOR="#00007F">Is</FONT> = "majorver"<br> ProjectVersion = thefile<br> <FONT COLOR="#00007F">Case</FONT> <FONT COLOR="#00007F">Is</FONT> = "minorver"<br> ProMinVer = "." & thefile<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Select</FONT><br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br><br><FONT COLOR="#00007F">Loop</FONT><br><FONT COLOR="#00007F">Close</FONT> #1<br>Form1.ProgressBar1.Value = Form1.ProgressBar1.Min<br>Form1.StatusBar1.Panels(2).Text = Form1.ListView1.ListItems.Count & " Files in Project"<br>MousePointer = 0<br>Prodir = sFileDrive<br><FONT COLOR="#00007F">Exit</FONT> <FONT COLOR="#00007F">Sub</FONT><br>EH:<br><FONT COLOR="#00007F">Close</FONT><br>Form1.ProgressBar1.Value = Form1.ProgressBar1.Min<br>Form1.ListView1.ListItems.Clear<br>MsgBox Err.Description<br><FONT COLOR="#00007F">Exit</FONT> <FONT COLOR="#00007F">Sub</FONT><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Sub</FONT><br><br><FONT COLOR="#00007F">Public</FONT> <FONT COLOR="#00007F">Sub</FONT> WriteVBHTMLFiles()<br><FONT COLOR="#007F00">'On Error Resume Next</FONT><br><FONT COLOR="#007F00">'write the startup file</FONT><br><FONT COLOR="#00007F">Dim</FONT> sfile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> sWorkFile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> sDir <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> sEXT <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> I <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> IFile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> Qoute <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br>Qoute = Chr(34)<br>IFile = FreeFile<br>sDir = ParsePath(sLastFile, 0)<br>sfile = ParsePath(sLastFile, 1)<br>sWorkFile = DocDir <FONT COLOR="#007F00">'sDir & sfile & "Documentation\"</FONT><br><br>sWorkFile = sWorkFile & "index.html"<br>Form1.ProgressBar1.Min = 1<br>Form1.ProgressBar1.Max = Form1.ListView1.ListItems.Count<br>Form1.ProgressBar1.Value = Form1.ProgressBar1.Min<br><br> <FONT COLOR="#00007F">Open</FONT> sWorkFile <FONT COLOR="#00007F">For</FONT> <FONT COLOR="#00007F">Output</FONT> <FONT COLOR="#00007F">As</FONT> IFile<br> <FONT COLOR="#00007F">Print</FONT> #IFile, "<HTML><HEAD><TITLE>" & ProjectName & "</TITLE></HEAD>"<br> <FONT COLOR="#00007F">Print</FONT> #IFile, "<BODY BGCOLOR=""#FFFFFF"" Text=""#000000"" LINK=""#0000FF"" VLINK=""#000099"" ALINK=""#00FF00"">"<br> Print #IFile, "</FONT><B><FONT SIZE=5 COLOR=""#008080""><P> " & ProjectName & " " & ProjectVersion & ProMinVer & " Source Code Documentation</P></B></FONT><FONT SIZE=2>"<br> Print #IFile, "<P>Source Code Procedures <FONT COLOR="#00007F">And</FONT> <FONT COLOR="#00007F">Function</FONT> Broken down <FONT COLOR="#00007F">To</FONT> a Form <FONT COLOR="#00007F">And</FONT> Module level.<BR><BR><HR><BR>"<br><br> For I = 1 To Form1.ListView1.ListItems.Count<br> 'write the start file<br> 'and all the other files<br> Form1.ListView1.ListItems(I).SmallIcon = 3<br> Form1.ProgressBar1.Value = I<br> sEXT = ParsePath(Form1.ListView1.ListItems(I).Text, 3)<br> sfile = ParsePath(Form1.ListView1.ListItems(I).Text, 2)<br> 'sfile = sfile & sEXT<br> Print #IFile, "<a href=" & Qoute & sfile & ".html" & Qoute & ">" & sfile & sEXT & "</A><BR>" _<br> & "<a href=" & Qoute & sfile & "src.html" & Qoute & ">Source</A><BR><BR>"<br> 'Form1.Caption = Prodir & "Documentation\" & sfile & ".txt"<br> 'write the source code to the file<br> Form1.StatusBar1.Panels(2).Text = "Writing File " & I & " of " & Form1.ListView1.ListItems.Count<br> Form1.ListView1.ListItems(I).SmallIcon = 3<br> Form1.StatusBar1.Panels(2).Text = "Coloring File " & I & " of " & Form1.ListView1.ListItems.Count<br> WriteTXTSCR Form1.ListView1.ListItems(I).Text, DocDir & sfile & "src.html", I<br> Form1.StatusBar1.Panels(2).Text = "Documenting File " & I & " of " & Form1.ListView1.ListItems.Count<br> WriteFRMSCR Form1.ListView1.ListItems(I).Text, DocDir & sfile & ".html", I<br> Form1.StatusBar1.Panels(2).Text = "Finishing File " & I & " of " & Form1.ListView1.ListItems.Count<br>DoEvents<br>Next I<br>Print #IFile, "<BR></FONT></BODY></HTML>"<br>Close #IFile<br>Form1.ProgressBar1.Value = Form1.ProgressBar1.Min<br> Form1.StatusBar1.Panels(2).Text = "Done"<br>End Sub<br><br><br><br>Private Sub WriteTXTSCR(sfile As String, WrFile As String, I As Integer)<br>'look for Attribute VB_Exposed = False<br>'Write the source code in color html<br>On Error GoTo EH<br>Form1.RichTextBox1.SelColor = vbBlack<br>Form1.RichTextBox1.Text = ""<br><FONT COLOR="#00007F">Dim</FONT> IFileA <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> IFileB <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> tmpSTR <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> bFound <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Boolean</FONT><br><FONT COLOR="#00007F">Dim</FONT> sEXT <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> TextLine<br>tmpSTR = LCase("Attribute VB_Exposed = False")<br>bFound = <FONT COLOR="#00007F">False</FONT><br>IFileA = 2<br>IFileB = 3<br><FONT COLOR="#00007F">If</FONT> LCase(ParsePath(sfile, 3)) = ".bas" <FONT COLOR="#00007F">Then</FONT> bFound = <FONT COLOR="#00007F">True</FONT><br><br><FONT COLOR="#00007F">If</FONT> CheckFile(sfile) = <FONT COLOR="#00007F">False</FONT> <FONT COLOR="#00007F">Then</FONT><br>Form1.ListView1.ListItems(I).SmallIcon = 4<br><FONT COLOR="#00007F">Exit</FONT> <FONT COLOR="#00007F">Sub</FONT><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br><FONT COLOR="#00007F">Open</FONT> sfile <FONT COLOR="#00007F">For</FONT> <FONT COLOR="#00007F">Input</FONT> <FONT COLOR="#00007F">As</FONT> IFileA <FONT COLOR="#007F00">'source</FONT><br><FONT COLOR="#007F00">'Open WrFile For Output As IFileB 'target</FONT><br> <FONT COLOR="#00007F">If</FONT> bFound = <FONT COLOR="#00007F">True</FONT> <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#00007F">Line</FONT> <FONT COLOR="#00007F">Input</FONT> #IFileA, TextLine<br> <FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br><FONT COLOR="#00007F">Do</FONT> <FONT COLOR="#00007F">While</FONT> <FONT COLOR="#00007F">Not</FONT> EOF(IFileA)<br> <FONT COLOR="#00007F">Line</FONT> <FONT COLOR="#00007F">Input</FONT> #IFileA, TextLine<br> <br><FONT COLOR="#00007F">If</FONT> LCase(TextLine) = tmpSTR <FONT COLOR="#00007F">Then</FONT><br>bFound = <FONT COLOR="#00007F">True</FONT><br><FONT COLOR="#00007F">Line</FONT> <FONT COLOR="#00007F">Input</FONT> #IFileA, TextLine<br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br><FONT COLOR="#00007F">If</FONT> bFound = <FONT COLOR="#00007F">True</FONT> <FONT COLOR="#00007F">Then</FONT><br> <FONT COLOR="#007F00">'Print #IFileB, TextLine</FONT><br> Form1.RichTextBox1.Text = Form1.RichTextBox1.Text & TextLine & vbCrLf<br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br><FONT COLOR="#00007F">Loop</FONT><br><br><FONT COLOR="#007F00">'Close #IFileB</FONT><br><FONT COLOR="#00007F">Close</FONT> #IFileA<br><FONT COLOR="#007F00">'we have all the text colorize and convert</FONT><br><FONT COLOR="#00007F">Call</FONT> ColorizeWords(Form1.RichTextBox1)<br><br>Form1.RichTextBox1.SaveFile WrFile, 0 <FONT COLOR="#007F00">'rtf</FONT><br>Form1.RichTextBox1.LoadFile WrFile, 1 <FONT COLOR="#007F00">'plain text</FONT><br><br><FONT COLOR="#00007F">Open</FONT> WrFile <FONT COLOR="#00007F">For</FONT> <FONT COLOR="#00007F">Output</FONT> <FONT COLOR="#00007F">As</FONT> IFileB <FONT COLOR="#007F00">'target</FONT><br><FONT COLOR="#00007F">Print</FONT> #IFileB, "<HTML><TITLE>Source Code</TITLE><BODY>" & RTF2HTML(Form1.RichTextBox1.Text) & "</BODY></HTML>"<br><FONT COLOR="#00007F">Close</FONT> #IFileB<br>Form1.RichTextBox1.Text = ""<br><FONT COLOR="#00007F">Exit</FONT> <FONT COLOR="#00007F">Sub</FONT><br>EH:<br>Form1.ListView1.ListItems(I).SmallIcon = 4<br><FONT COLOR="#00007F">Exit</FONT> <FONT COLOR="#00007F">Sub</FONT><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Sub</FONT><br><br><FONT COLOR="#00007F">Private</FONT> <FONT COLOR="#00007F">Sub</FONT> WriteFRMSCR(sfile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, WrFile <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, I <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT>)<br><FONT COLOR="#007F00">'look for Attribute VB_Exposed = False</FONT><br><FONT COLOR="#00007F">On</FONT> <FONT COLOR="#00007F">Error</FONT> <FONT COLOR="#00007F">GoTo</FONT> EH<br><FONT COLOR="#00007F">Dim</FONT> IFileA <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> IFileB <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Integer</FONT><br><FONT COLOR="#00007F">Dim</FONT> tmpSTR <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> bFound <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Boolean</FONT><br><FONT COLOR="#00007F">Dim</FONT> sEXT <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><FONT COLOR="#00007F">Dim</FONT> TextLine<br><FONT COLOR="#00007F">Dim</FONT> bLook <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">Boolean</FONT><br><FONT COLOR="#00007F">Dim</FONT> ssName <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT><br><br>ssName = ParsePath(sfile, 2)<br>ssName = ssName & ParsePath(sfile, 3)<br>bLook = <FONT COLOR="#00007F">False</FONT><br>bFound = <FONT COLOR="#00007F">False</FONT><br>IFileA = 2<br>IFileB = 3<br><br><FONT COLOR="#00007F">If</FONT> CheckFile(sfile) = <FONT COLOR="#00007F">False</FONT> <FONT COLOR="#00007F">Then</FONT><br>Form1.ListView1.ListItems(I).SmallIcon = 4<br><FONT COLOR="#00007F">Exit</FONT> <FONT COLOR="#00007F">Sub</FONT><br><FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT><br><FONT COLOR="#00007F">Open</FONT> sfile <FONT COLOR="#00007F">For</FONT> <FONT COLOR="#00007F">Input</FONT> <FONT COLOR="#00007F">As</FONT> IFileA<br><FONT COLOR="#00007F">Open</FONT> WrFile <FONT COLOR="#00007F">For</FONT> <FONT COLOR="#00007F">Output</FONT> <FONT COLOR="#00007F">As</FONT> IFileB<br><FONT COLOR="#007F00">'write the htmlheader</FONT><br><FONT COLOR="#00007F">Print</FONT> #IFileB, "<HTML><HEAD><TITLE>" & ProjectName & "</TITLE></HEAD>"<br><FONT COLOR="#00007F">Print</FONT> #IFileB, "<BODY BGCOLOR=""#FFFFFF"" Text=""#000000"" LINK=""#0000FF"" VLINK=""#000099"" ALINK=""#00FF00"">"<br>Print #IFileB, "</FONT><B><FONT SIZE=5 COLOR=""#008080"">" & ssName & "</B></FONT><FONT SIZE=2>"<br>Print #IFileB, "<BR><BR><HR><BR>"<br> <br> <br>Do While Not EOF(IFileA)<br> Line Input #IFileA, TextLine<br> <br> If ISWRITABLE(CStr(TextLine)) = True Then 'print the procedure<br> Print #IFileB, "<br><FONT SIZE=3 COLOR=""#008080"">" & TextLine & "</B></FONT><br>"<br> Do<br> 'look for the comments<br> 'advance a line<br> Line Input #IFileA, TextLine<br> tmpSTR = Left$(TextLine, 1)<br> If tmpSTR = "'" Then 'it is a comment<br> tmpSTR = Mid(TextLine, 2, Len(TextLine))<br> Print #IFileB, tmpSTR & "<br>"<br> Else<br> If tmpSTR <> "'" Then<br> Exit Do<br> End If<br> End If<br> Loop<br> <br> End If<br> <br> <br> <br><br><br>Loop<br><br>'write the htmlfooter<br>Print #IFileB, "<BR></FONT></BODY></HTML>"<br>Close #IFileB<br>Close #IFileA<br>Exit Sub<br>EH:<br>Form1.ListView1.ListItems(I).SmallIcon = 4<br>Exit Sub<br>End Sub<br><br>Private Function ISWRITABLE(sTMP As String) As Boolean<br>Dim ipos As Integer<br>Dim bFound As Boolean<br>bFound = False<br>ipos = InStr(1, LCase(sTMP), "private sub", vbBinaryCompare)<br>If ipos <> 0 Then bFound = True<br>ipos = InStr(1, LCase(sTMP), "public sub", vbBinaryCompare)<br>If ipos <> 0 Then bFound = True<br>ipos = InStr(1, LCase(sTMP), "private function", vbBinaryCompare)<br>If ipos <> 0 Then bFound = True<br>ipos = InStr(1, LCase(sTMP), "public function", vbBinaryCompare)<br>If ipos <> 0 Then bFound = True<br>ipos = InStr(1, LCase(sTMP), "public property", vbBinaryCompare)<br>If ipos <> 0 Then bFound = True<br>ipos = InStr(1, LCase(sTMP), "private property", vbBinaryCompare)<br>If ipos <> 0 Then bFound = True<br><br>ISWRITABLE = bFound<br>End Function<br></BODY></HTML>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -