1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
|
Public Type File
Header As String
body As String
End Type
Public Type body
Comments As String
Code As String
End Type
Public Function Fun1(ByVal FileName) As File
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim StrMessage As String
StrMessage = ""
Flag = 1
Dim F As File
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(FileName, 1, False)
Set objRegEx = CreateObject("VBScript.RegExp")
Set objShell = CreateObject("WScript.Shell")
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
objRegEx.Global = True
objRegEx.Pattern = "^\s+\entity"
Do While Not objFile.AtEndOfStream
Strline = objFile.ReadLine
Set colMatches = objRegEx.Execute(Strline)
If colMatches.Count > 0 Then
StrMessage = StrMessage & Strline & vbLf
Flag = 0
Do
Strline = objFile.ReadLine
StrMessage = StrMessage & Strline & vbLf
Loop Until InStr(Strline, "end")
End If
Loop
objFile.Close
Set objFile = objFSO.OpenTextFile(FileName, 1, False)
objRegEx.Pattern = "^\s*\--\s*\*"
Do While Not objFile.AtEndOfStream
Strline = objFile.ReadLine
Set colMatches = objRegEx.Execute(Strline)
If colMatches.Count > 0 Then
StrMessage1 = StrMessage1 & Strline & vbLf
Flag1 = 0
StrMessage1 = StrMessage1 & Strline & vbLf
End If
Loop
If (Flag = 1) Or (Flag1 = 1) Then
MsgBox "File ERROR"
Else
F.body = StrMessage
F.Header = StrMessage1
Fun1 = F
End If
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End Function
Public Function Fun2(ByRef F As File) As body
Dim StrMessage2 As String
StrMessage2 = ""
Flag = 1
Dim B As body
Set objRegEx = CreateObject("VBScript.RegExp")
Set objShell = CreateObject("WScript.Shell")
objRegEx.IgnoreCase = True
objRegEx.MultiLine = True
objRegEx.Global = True
objRegEx.Pattern = "^\s*\--"
MsgBox F.body
ch = Split(F.body, vbLf)
For i = 1 To UBound(ch)
Set colMatches = objRegEx.Execute(Strline)
If colMatches.Count > 0 Then
StrMessage2 = StrMessage2 & ch(i) & vbLf
Flag1 = 0
End If
Next i
If (Flag1 = 1) Then
MsgBox "Comments ERROR"
Else
MsgBox StrMessage2
B.Comments = StrMessage2
Fun2 = B
End If
End Function
Public Sub Parser()
Dim F As File
Dim B As body
FileName = "C:\test.txt"
Call Fun1(ByVal FileName)
Call Fun2(F)
End Sub |
Partager