发信人: phoenix (凤凰), 信区: VisualBasic
标 题: 一个简单的VB-VC编译器
发信站: PKU BBS (Thu Jan 6 14:05:52 2000), 转信
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 4 'Fixed ToolWindow
Caption = "VB-VC程序转换器"
ClientHeight = 1290
ClientLeft = 45
ClientTop = 270
ClientWidth = 4095
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1290
ScaleWidth = 4095
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtOutput
Height = 285
Left = 1320
TabIndex = 5
Top = 360
Width = 2655
End
Begin VB.TextBox txtInput
Height = 285
Left = 1320
TabIndex = 4
Top = 0
Width = 2655
End
Begin VB.FileListBox File1
Height = 1065
Left = 1800
TabIndex = 1
Top = 1680
Visible = 0 'False
Width = 2175
End
Begin VB.CommandButton cmdTrans
Caption = "转换"
Default = -1 'True
Height = 375
Left = 1080
TabIndex = 0
Top = 840
Width = 1935
End
Begin VB.Label Label2
Caption = "输出目录"
Height = 255
Left = 120
TabIndex = 3
Top = 360
Width = 1095
End
Begin VB.Label Label1
Caption = "输入目录"
Height = 255
Left = 120
TabIndex = 2
Top = 0
Width = 1095
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim FileNumber As Integer
Dim OutputNumber As Integer
Dim VarArr() As String
Dim ArrNum As Integer
Dim GlobalArrNum As Integer
Private Sub cmdTrans_Click()
Dim OutputName As String
Dim FileName As String
Dim i As Integer
Dim tmpline As String
Dim Annotation As String
Dim words() As String
Dim AnnoPos As Integer
Dim SpacePos As Integer
Dim bound As Integer
Dim k As Integer
Dim Add As Boolean
Dim var As String
Dim HasStep As Boolean
Dim FuncName As String
Dim LeftNum As Integer
Dim Stopk As Boolean, Stopm As Boolean
Dim AddStr As String * 1
Dim IsArr As Boolean
Dim TabNum As Integer
Dim IsFunction As Boolean
Dim CaseNum As Integer
TabNum = 0
Dim FileExt As String
Dim m As Integer
Dim n As Integer
Dim l As Integer
Dim j As Integer
Dim x As Integer
Dim WithOption As Boolean
Dim WithVar As String
Dim inputdir As String
Dim outputdir As String
inputdir = txtInput.Text
outputdir = txtOutput.Text
If Dir(inputdir) = "" Then Exit Sub
File1.FileName = inputdir
For i = 0 To File1.ListCount - 1
FileName = File1.Path + "\" + File1.List(i)
FileExt = Mid(FileName, InStr(FileName, ".") + 1)
OutputName = outputdir + Left(File1.List(i), InStr(File1.List(i), ".") - 1) + ".cpp"
FileNumber = FreeFile
Open FileName For Input As FileNumber
OutputNumber = FreeFile
Open OutputName For Output As OutputNumber
Print #OutputNumber, "/*" + FileExt + "*/"
AddStr = ";"
Do While Not EOF(FileNumber)
Line Input #FileNumber, tmpline
AnnoPos = InStr(tmpline, "'")
If AnnoPos <> 0 Then
Annotation = Mid(tmpline, AnnoPos + 1)
tmpline = Left(tmpline, AnnoPos - 1)
Else
Annotation = ""
End If
tmpline = Trim(tmpline)
If tmpline <> "" Then
ReDim words(0)
SplitString tmpline, words
bound = UBound(words)
Add = True
HasStep = False
For j = 0 To bound
Select Case words(j)
Case "If"
words(j) = "if ("
Add = False
For k = j + 1 To bound
If words(k) = "=" Then words(k) = "=="
If words(k) = "Else" Then words(k) = "else"
If words(k) = "Then" Then
If k <> bound Then
words(k) = ")"
Add = True
Else
words(k) = ")" + Chr(13) + Chr(10) + String(TabNum, Chr(9)) + "{"
TabNum = TabNum + 1
End If
Exit For
End If
Next k
Case "GoTo"
words(j) = "goto"
Case "And"
words(j) = "&&"
Case "Is"
words(j) = "=="
Case "Or"
words(j) = "||"
Case "Not"
words(j) = "!"
Case "Open", "Declare"
words(j) = "// " + words(j)
j = bound
Case "Type"
words(j) = "type"
words(bound) = words(bound) + " {"
Case "End"
If j = bound Then
ElseIf words(j + 1) = "With" Then
words(j) = "//" + words(j)
j = bound
WithOption = False
WithVar = ""
Else
words(j) = "}"
j = j + 1
If words(j) = "Enum" Then AddStr = ";"
If words(j) = "Function" Or words(j) = "Sub" Or words(j) = "Property" Then
If IsFunction Then
words(j - 1) = "return _" + FuncName + "_;" + Chr(13) + Chr(10) + String(TabNum, Chr(9))
words(j) = "}"
Else
words(j) = ""
End If
FuncName = ""
ArrNum = 0
ReDim Preserve VarArr(GlobalArrNum)
TabNum = 1
Else
words(j) = ""
TabNum = TabNum - 1
End If
End If
Case "Else"
words(j) = "}" + Chr(13) + Chr(10) + String(TabNum, Chr(9)) + "else{"
Add = False
Case "ByVal", "ByRef"
words(j) = ""
Case "Me"
words(j) = "this"
Case "ElseIf"
words(j) = "}" + Chr(13) + Chr(10) + String(TabNum, Chr(9)) + "else if("
Add = False
For k = j + 1 To bound
If words(k) = "=" Then words(k) = "=="
If words(k) = "Else" Then words(k) = "else"
If words(k) = "Then" Then
words(k) = ")" + Chr(13) + Chr(10) + String(TabNum, Chr(9)) + "{"
TabNum = TabNum + 1
End If
Next k
Case "("
If CheckArray(words(j - 1)) Then
LeftNum = 1
For m = j + 1 To bound
If words(m) = "(" Then LeftNum = LeftNum + 1
If words(m) = ")" Then LeftNum = LeftNum - 1
If LeftNum = 0 Then Exit For
Next m
If m <= bound Then words(m) = "]"
words(j) = "["
End If
Case "As"
m = j - 1
Do
If m = 0 Then Exit Do
If words(m) = "" Then
m = m - 1
Else
Exit Do
End If
Loop
IsArr = False
If words(m) = "]" Or words(m) = ")" Then
words(m) = "]"
m = m - 1
Do
If m
If words(m) = "(" Or words(m) = "[" Then
words(m) = "["
Exit Do
End If
m = m - 1
Loop
IsArr = True
End If
If m > 0 Then
Select Case words(j + 1)
Case "Integer"
words(j + 1) = "int"
Case "Single"
words(j + 1) = "float"
Case "String"
words(j + 1) = "CString"
Case "Double"
words(j + 1) = "double"
Case "Byte"
words(j + 1) = "BYTE"
Case "Boolean"
words(j + 1) = "bool"
Case "Long"
words(j + 1) = "long"
Case "Object"
words(j + 1) = "CObject"
End Select
If IsArr Then
words(j) = words(m - 1)
words(m - 1) = words(j + 1)
words(j + 1) = ""
For n = j - 1 To m + 1 Step -1
words(n) = words(n - 1)
Next n
words(n) = words(j)
words(j) = ""
If FuncName = "" Then
GlobalArrNum = GlobalArrNum + 1
ReDim Preserve VarArr(GlobalArrNum)
VarArr(GlobalArrNum) = words(n)
Else
ArrNum = ArrNum + 1
ReDim Preserve VarArr(GlobalArrNum + ArrNum)
VarArr(GlobalArrNum + ArrNum) = words(n)
End If
Else
words(j) = words(m)
words(m) = words(j + 1)
words(j + 1) = ""
End If
End If
Case "For"
Add = False
words(j) = "for("
For k = j + 1 To bound
If words(k) = "To" Then words(k) = ";" + var + "<="
If words(k) = "=" Then var = words(k - 1)
If words(k) = "Step" Then
words(k) = ";"
words(k + 1) = var + "+=" + words(k + 1) + ") {"
TabNum = TabNum + 1
HasStep = True
End If
Next k
If Not HasStep Then
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = ";" + var + "++ ) {"
TabNum = TabNum + 1
End If
Case "<>"
words(j) = "!="
Case "Next"
words(j + 1) = ""
words(j) = "}"
TabNum = TabNum - 1
Case "Do"
Add = False
If j = bound Then
words(j) = "while(1){"
TabNum = TabNum + 1
Else
words(j) = "while"
words(j + 1) = "("
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = "){"
For k = j + 1 To bound
If words(k) = "=" Then words(k) = "=="
Next k
End If
Case "Loop"
If j = bound Then
words(j) = "}"
Else
words(j) = "if"
words(j + 1) = "(!("
bound = bound + 3
ReDim Preserve words(bound)
words(bound - 2) = ")) break;"
words(bound - 1) = Chr(13) + Chr(10) + String(TabNum, Chr(9))
words(bound) = "}"
End If
TabNum = TabNum - 1
Case "Object"
words(j) = "CObject"
Case "Exit"
words(j) = ""
Select Case words(j + 1)
Case "For"
words(j + 1) = "break"
Case "Sub"
words(j + 1) = "return"
Case "Function"
If IsFunction Then
words(j + 1) = "return _" + FuncName + "_"
Else
words(j + 1) = "return"
End If
Case "Do"
words(j + 1) = "break"
Case "Property"
If IsFunction Then
words(j + 1) = "return _" + FuncName + "_"
Else
words(j + 1) = "return"
End If
End Select
Case "Sub"
Add = False
FuncName = words(j + 1)
words(j) = "void"
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = "{"
TabNum = TabNum + 1
j = j + 1
IsFunction = False
Case "Function"
Add = False
FuncName = words(j + 1)
If words(bound) = ")" Then
words(j) = "void"
words(bound) = ") {"
IsFunction = False
Else
IsFunction = True
Select Case words(bound)
Case "Integer"
words(j) = "int"
Case "Single"
words(j) = "float"
Case "String"
words(j) = "CString"
Case "Double"
words(j) = "double"
Case "Byte"
words(j) = "BYTE"
Case "Boolean"
words(j) = "bool"
Case "Long"
words(j) = "long"
Case "Object"
words(j) = "CObject"
Case Else
words(j) = words(bound)
End Select
words(bound - 1) = ""
words(bound) = "{"
bound = bound + 3
ReDim Preserve words(bound)
words(bound - 2) = Chr(13) + Chr(10)
words(bound - 1) = words(j)
words(bound) = "_" + FuncName + "_ ;"
End If
TabNum = TabNum + 1
j = j + 1
Case "Select"
Add = False
CaseNum = 0
words(j) = "switch"
words(j + 1) = "("
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = ") {"
TabNum = TabNum + 1
Case "Case"
Add = False
If words(j + 1) = "Else" Then
words(j + 1) = "default:"
If CaseNum > 0 Then words(j) = "break;" + Chr(13) + Chr(10) + String(TabNum, Chr(9))
CaseNum = CaseNum + 1
Else
words(j) = "case "
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = ":"
If CaseNum > 0 Then words(j) = "break;" + Chr(13) + Chr(10) + String(TabNum, Chr(9)) + words(j)
CaseNum = CaseNum + 1
End If
Case "Enum"
Add = False
words(j) = "enum"
AddStr = ","
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = "{"
TabNum = TabNum + 1
Case "Property"
FuncName = words(j + 2)
words(j) = ""
words(j + 2) = words(j + 1) + words(j + 2)
Add = False
If words(j + 1) = "Let" Or words(j + 1) = "Set" Then
words(j) = "void"
words(j + 1) = ""
bound = bound + 1
ReDim Preserve words(bound)
words(bound) = "{"
IsFunction = False
Else
IsFunction = True
words(bound - 1) = ""
Select Case words(bound)
Case "Integer"
words(j) = "int"
Case "Single"
words(j) = "float"
Case "String"
words(j) = "CString"
Case "Double"
words(j) = "double"
Case "Byte"
words(j) = "BYTE"
Case "Boolean"
words(j) = "bool"
Case "Long"
words(j) = "long"
Case "Object"
words(j) = "CObject"
Case Else
words(j) = words(bound)
End Select
words(bound) = "{" + Chr(13) + Chr(10)
words(j + 1) = ""
bound = bound + 2
ReDim Preserve words(bound)
words(bound - 1) = words(j)
words(bound) = "_" + FuncName + "_;" + Chr(13) + Chr(10)
End If
TabNum = TabNum + 1
j = j + 1
Case "Const"
words(j) = "const"
Case "Set"
words(j) = ""
Case "Static"
words(j) = "static"
Case "Mod"
words(j) = "/"
Case "Nothing"
words(j) = "NULL"
Case FuncName
If words(j) <> "" Then words(j) = "_" + FuncName + "_"
Case "True"
words(j) = "true"
Case "False"
words(j) = "false"
Case "With"
WithOption = True
WithVar = ""
For m = j + 1 To bound
WithVar = WithVar + words(m)
Next m
Case Else
If WithOption Then If Left(words(j), 1) = "." Then words(j) = WithVar + words(j)
End Select
Next j
If Trim(Annotation) <> "" Then Print #OutputNumber, "//" + Trim(Annotation): x = x + 1
Dim tmpline1 As String
If Add Then
tmpline1 = Join(words) + AddStr
Else
tmpline1 = Join(words)
End If
If TabNum <= 0 Then TabNum = 1
If Trim(tmpline1) <> "" And Trim(tmpline1) <> AddStr Then
Print #OutputNumber, String(TabNum, Chr(9)) + Trim(tmpline1)
Print #OutputNumber, "/*" + (tmpline) + "*/"
End If
' End If
End If
Loop
Close OutputNumber
Close FileNumber
Sort OutputName
GenerateHeader OutputName
Next i
errHandle:
Exit Sub
End Sub
Private Function CheckArray(word As String) As Boolean
Dim i As Integer
Dim varname As String
For i = 1 To GlobalArrNum + ArrNum
If VarArr(i) = word Then
CheckArray = True
Exit Function
End If
Next i
End Function
Private Sub Command2_Click()
cmd.ShowOpen
End Sub
Private Sub SplitString(inputstr As String, outstr() As String)
Dim tmpstr() As String, tmpstr1() As String
Dim i As Integer, j As Integer
Dim tmpstr2 As String
tmpstr = Split(inputstr, "(")
j = UBound(tmpstr)
ReDim Preserve tmpstr1(2 * j)
For i = 0 To j - 1
tmpstr1(2 * i) = tmpstr(i)
tmpstr1(2 * i + 1) = "("
Next i
tmpstr1(2 * j) = tmpstr(j)
tmpstr2 = Join(tmpstr1)
ReDim tmpstr(0)
tmpstr = Split(tmpstr2, ")")
j = UBound(tmpstr)
ReDim Preserve tmpstr1(2 * j)
For i = 0 To j - 1
tmpstr1(2 * i) = tmpstr(i)
tmpstr1(2 * i + 1) = ")"
Next i
tmpstr1(2 * j) = tmpstr(j)
tmpstr2 = Join(tmpstr1)
ReDim tmpstr(0)
tmpstr = Split(tmpstr2, ",")
j = UBound(tmpstr)
ReDim Preserve tmpstr1(2 * j)
For i = 0 To j - 1
tmpstr1(2 * i) = tmpstr(i)
tmpstr1(2 * i + 1) = ","
Next i
tmpstr1(2 * j) = tmpstr(j)
tmpstr2 = Trim(Join(tmpstr1))
Dim s As Integer
If Left(tmpstr2, 1) <> """" Then s = 0 Else s = 1
ReDim tmpstr(0)
tmpstr = Split(tmpstr2, """")
j = UBound(tmpstr)
ReDim outstr(0)
Dim k As Integer, l As Integer
Dim bound As Integer
For i = s To j Step 2
ReDim tmpstr1(0)
tmpstr1 = Split(tmpstr(i))
k = UBound(tmpstr1)
ReDim Preserve outstr(bound + k + 2)
For l = 0 To k
outstr(bound + 1 + l) = tmpstr1(l)
Next l
If i
bound = bound + k + 2
Next i
If outstr(bound) = "" Then ReDim Preserve outstr(bound - 1)
bound = UBound(outstr)
For i = 0 To bound
If outstr(i) = "New" Or outstr(i) = "Dim" Or outstr(i) = "ReDim" Or outstr(i) = "Public" Or outstr(i) = "Private" Or outstr(i) = "Optional" Or outstr(i) = "Global" Or outstr(i) = "Preserve" Then outstr(i) = ""
If outstr(i) = "Option" Or outstr(i) = "Attribute" Or outstr(i) = "On" Then
For j = 0 To bound
outstr(j) = ""
Next j
End If
Next i
tmpstr2 = Join(outstr)
ReDim outstr(0)
outstr = Split(tmpstr2)
End Sub
Private Sub Sort(FileName As String)
Dim h1 As Integer, h2 As Integer
h1 = FreeFile
Open FileName For Input As h1
h2 = FreeFile
Open "C:\TEMP.TXT" For Output As h2
Dim tmpline As String, tmpline1 As String
Dim NextExt As Integer
Dim Num As Integer
Dim tmpstr() As String
Dim i As Integer
Do While Not EOF(h1)
Line Input #h1, tmpline
ReDim tmpstr(0)
tmpstr = Split(tmpline, Chr(9))
tmpline = Join(tmpstr)
tmpline = Trim(tmpline)
ReDim tmpstr(0)
tmpstr = Split(tmpline, """")
tmpline1 = ""
For i = 0 To UBound(tmpstr) Step 2
tmpline1 = tmpline1 + tmpstr(i)
Next i
If InStr(tmpline1, "{") > 0 Then
NextExt = 1
ElseIf InStr(tmpline1, "}") > 0 Then
Num = Num - 1
End If
If Num
Print #h2, String(Num, Chr(9)) + tmpline
Num = Num + NextExt
NextExt = 0
If Num
Loop
Close h1
Close h2
FileCopy "C:\TEMP.TXT", FileName
Kill "C:\TEMP.TXT"
End Sub
Private Sub GenerateHeader(FileName As String)
Dim h1 As Integer, h2 As Integer
h1 = FreeFile
Open FileName For Input As h1
h2 = FreeFile
Open Left(FileName, InStr(FileName, ".") - 1) + ".h" For Output As h2
Dim tmpline As String, tmpline1 As String
Dim tmpstr() As String
Dim i As Integer
Dim NextExt As Integer
Dim Num As Integer
Dim Writed As Boolean
Do While Not EOF(h1)
Line Input #h1, tmpline
Do
If Left(tmpline, 1) <> Chr(9) Then Exit Do
tmpline = Mid(tmpline, 2)
Loop
If Left(Trim(tmpline), 2) <> "/*" And Left(Trim(tmpline), 2) <> "//" Then
ReDim tmpstr(0)
tmpstr = Split(tmpline, Chr(9))
tmpline = Join(tmpstr)
tmpline = Trim(tmpline)
ReDim tmpstr(0)
tmpstr = Split(tmpline, """")
tmpline1 = ""
For i = 0 To UBound(tmpstr) Step 2
tmpline1 = tmpline1 + tmpstr(i)
Next i
If InStr(tmpline1, "{") > 0 Then
NextExt = 1
ElseIf InStr(tmpline1, "}") > 0 Then
Num = Num - 1
End If
If NextExt = 1 And Num = 0 Then Print #h2, Left(tmpline, InStr(tmpline, "{") - 1)
Num = Num + NextExt
NextExt = 0
End If
Loop
Close #h1
Close #h2
End Sub
扫一扫
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
