VB 版 (精华区)
发信人: zxfsnow (最近睡眠太少), 信区: VB
标 题: 一个VB-VC翻译器
发信站: 哈工大紫丁香 (2000年06月07日18:30:50 星期三), 转信
发信人: wolf2000 (火凤凰-水中的精灵), 信区: VisualBasic
标 题: 一个VB-VC翻译器
发信站: BBS 水木清华站 (Fri Jan 7 16:44:40 2000)
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain
BorderStyle = 4 'Fixed ToolWindow
Caption = "VB-VC程序转换器"
ClientHeight = 1320
ClientLeft = 45
ClientTop = 270
ClientWidth = 6345
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1320
ScaleWidth = 6345
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdOutput
Height = 375
Left = 1200
TabIndex = 3
Top = 360
Width = 4935
End
Begin VB.CommandButton cmdInput
Height = 375
Left = 1200
TabIndex = 2
Top = 0
Width = 4935
End
Begin MSComDlg.CommonDialog cmdOpenClose
Left = 240
Top = 720
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "*.bas|*.bas|*.frm|*frm|*.cls|*.cls|*.ctl|*.ctl|*.
cpp|*.cpp|*.h|*.h"
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 = 2040
TabIndex = 0
Top = 840
Width = 1935
End
Begin VB.Label Label2
Caption = "输出文件"
Height = 255
Left = 120
TabIndex = 5
Top = 360
Width = 855
End
Begin VB.Label Label1
Caption = "输入文件"
Height = 255
Left = 120
TabIndex = 4
Top = 0
Width = 975
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 cmdInput_Click()
On Error GoTo errHandle
cmdOpenClose.CancelError = True
cmdOpenClose.ShowOpen
cmdInput.Caption = cmdOpenClose.FileName
errHandle:
End Sub
Private Sub cmdOutput_Click()
On Error GoTo errHandle
cmdOpenClose.CancelError = True
cmdOpenClose.ShowSave
cmdOutput.Caption = cmdOpenClose.FileName
errHandle:
End Sub
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
Dim changeequal As Boolean
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
Dim BeginNum As Integer
Dim tmpline1 As String
inputdir = cmdInput.Caption
outputdir = cmdOutput.Caption
If Dir(inputdir) = "" Then Exit Sub
FileName = inputdir
FileExt = Mid(FileName, InStr(FileName, ".") + 1)
OutputName = outputdir
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, tmpline1
tmpline = tmpline1
Do While Right(tmpline1, 1) = "_"
Line Input #FileNumber, tmpline1
tmpline = Left(tmpline, Len(tmpline) - 1) + tmpline1
Loop
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
If BeginNum = 0 Then
For j = 0 To bound
Select Case words(j)
Case "Begin", "BEGIN"
BeginNum = BeginNum + 1
j = bound
Case "If"
words(j) = "if ("
changeequal = True
Add = False
For k = j + 1 To bound
If words(k) = "=" And changeequal Then words
(k) = "=="
If words(k) = "Else" Then words(k) = "else"
If words(k) = "Then" Then
changeequal = False
If k <> bound Then
words(k) = ")"
Add = True
Else
words(k) = ")" + Chr(13) + Chr(10) +
String(TabNum, Chr(9)) + "{"
TabNum = TabNum + 1
End If
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) = "struct"
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(TabN
um, Chr(9)) + "else{"
Add = False
Case "ByVal", "ByRef"
words(j) = ""
Case "Me"
words(j) = "this"
Case "ElseIf"
words(j) = "}" + Chr(13) + Chr(10) + String(TabN
um, 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) + Stri
ng(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 < 0 Then Exit Do
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) = word
s(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) + Strin
g(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;" + Ch
r(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;" + Ch
r(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(1
3) + 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 "To"
words(j) = ""
words(j - 1) = ""
Case Else
If WithOption Then If Left(words(j), 1) = "." Th
en words(j) = WithVar + words(j)
End Select
Next j
If BeginNum = 0 Then
If Trim(Annotation) <> "" Then Print #OutputNumber, "//"
+ Trim(Annotation): x = x + 1
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 The
n
Print #OutputNumber, String(TabNum, Chr(9)) + Trim(tm
pline1)
Print #OutputNumber, "/*" + (tmpline) + "*/"
End If
End If
Else
bound = UBound(words)
For j = 0 To bound
Select Case words(j)
Case "Begin", "BEGIN"
BeginNum = BeginNum + 1
j = bound
Case "End", "END"
BeginNum = BeginNum - 1
j = bound
End Select
Next j
End If
End If
Loop
Close OutputNumber
Close FileNumber
Sort OutputName
GenerateHeader OutputName
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 < j Then outstr(bound + 1 + l) = """" + tmpstr(i + 1) + """
"
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" Or outstr(i) = "VERSION" 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 < 0 Then Num = 0
Print #h2, String(Num, Chr(9)) + tmpline
Num = Num + NextExt
NextExt = 0
If Num < 0 Then Num = 0
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 And InStr(tmpline1, "enum") = 0 And I
nStr(tmpline1, "struct") = 0 Then Print #h2, Left(tmpline, InStr(tmpline, "{
") - 1)
Num = Num + NextExt
NextExt = 0
End If
Loop
Close #h1
Close #h2
End Sub
--
起于混沌,归于清明
怒发浊水,厉激烈焰
当天空变成呜咽的黑
凤凰从平静的水中飞起
血红的火焰从水中迸发
火凤凰将带来无限的光明-火凤凰,不死的精灵,水中的烈焰
--
以科计为本,以产业报国!
超越自我,飞跃无限!
※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.235.252]
Powered by KBS BBS 2.0 (http://dev.kcn.cn)
页面执行时间：605.151毫秒