发信人: 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