via.cls

VB写的一个IDE开发环境,支持脚本运行,内置了一个简单的编译器,可以直接生成EXE.. 推荐下载!

    PushFloatEAX
    PushFloatEDX
    AddCodeWord &HC9DE
    AddCodeWord &H1DD9
    AddCodeFixup "$Intern.Float"
    MovEAX "$Intern.Float"
End Sub
Sub ExprFloatDiv()
    Call PopEDX: PopEAX
    PushFloatEAX
    PushFloatEDX
    AddCodeWord &HF9DE
    AddCodeWord &H1DD9
    AddCodeFixup "$Intern.Float"
    MovEAX "$Intern.Float"
End Sub
Sub ExprFloatMod()
    Call PopEDX: PopEAX
    PushFloatEAX
    PushFloatEDX
    AddCodeWord &HF8D9
    AddCodeWord &H1DD9
    AddCodeFixup "$Intern.Float"
    MovEAX "$Intern.Float"
End Sub
Sub ExprSub()
    Call PopEDX: PopEAX
    AddCodeWord &HD029
End Sub
Sub ExprDiv()
    Call PopEDX: PopEAX
    AddCodeWord &HD389
    AddCodeByte &HBA
    AddCodeDWord &H0
    AddCodeWord &HFBF7
End Sub
Sub ExprMul()
    Call PopEDX: PopEAX
    AddCodeWord &HD389
    AddCodeWord &HE3F7
End Sub
Sub ExprMod()
    Call PopEDX: PopEAX
    AddCodeWord &HD389
    AddCodeByte &HBA
    AddCodeDWord &H0
    AddCodeWord &HFBF7
    AddCodeWord &HC28B
End Sub
Sub ExprShl()
    Call PopECX: PopEAX
    AddCodeWord &HE0D3
End Sub
Sub ExprShr()
    Call PopECX: PopEAX
    AddCodeWord &HE8D3
End Sub
Sub ExprAnd()
    Call PopEBX: PopEAX
    AddCodeWord &HC323
End Sub
Sub ExprOr()
    Call PopEBX: PopEAX
    AddCodeWord &HC30B
End Sub
Sub ExprXor()
    Call PopEBX: PopEAX
    AddCodeWord &HC333
End Sub
Sub ExprNeg()
    AddCodeWord &HD8F7
End Sub
Sub ExprNot()
    AddCodeWord &HD0F7
End Sub
Sub MovEAX(Name As String)
    AddCodeByte &HA1: AddCodeFixup Name
End Sub
Sub MovEAXAddress(Name As String)
    AddCodeByte &HB8: AddCodeFixup Name
End Sub
Sub MovEDX(Name As String)
    AddCodeWord &H158B: AddCodeFixup Name
End Sub
Sub ExprCompare(Variable As String, Variable2 As String)
    If CompareOne <> "" And CompareTwo = "" Then
        MovEAX CompareOne: MovEDX Variable2
    ElseIf CompareOne = "" And CompareTwo <> "" Then
        MovEAX Variable:  MovEDX CompareTwo
    ElseIf CompareOne <> "" And CompareTwo <> "" Then
        MovEAX CompareOne: MovEDX CompareTwo
    Else
        MovEAX Variable: MovEDX Variable2
    End If
    AddCodeWord &HD039
    CompareOne = "": CompareTwo = ""
End Sub
Sub ExprCompareS(Variable As String, Variable2 As String)
    PushContent Variable2: PushContent Variable
    InvokeByName "lstrcmp"
    AddCodeByte &H3D: AddCodeDWord &H0
End Sub
Sub AssignEAX(Variable As String)
    AddCodeByte &HA3
    AddFixup Variable, OffsetOf(".code"), Code, &H400000
    AddCodeDWord 0
End Sub
Sub AssignEDX(Variable As String)
    AddCodeWord &H1589
    AddFixup Variable, OffsetOf(".code"), Code, &H400000
    AddCodeDWord 0
End Sub
Sub ExprJE(Name As String)
    AddCodeWord &H840F
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprJNE(Name As String)
    AddCodeWord &H850F
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprJL(Name As String)
    AddCodeWord &H8C0F
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprJLE(Name As String)
    AddCodeByte &HF
    AddCodeByte &H8E
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprJA(Name As String)
    AddCodeWord &H8F0F
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprJAE(Name As String)
    AddCodeWord &H8D0F
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprJump(Name As String)
    AddCodeByte &HE9
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &H0
End Sub
Sub ExprLoop(Name As String)
    AddCodeByte &HE2
    AddCodeByte &HFF - CByte(OffsetOf(".code") - GetSymbolOffset(Name))
End Sub
Sub ExprCall(Name As String)
    AddCodeByte &HE8
    AddFixup Name, OffsetOf(".code"), Code
    AddCodeDWord &HFFFFFFFF
End Sub
Sub StartFrame()
    AddCodeByte &H55
    AddCodeByte &H89
    AddCodeByte &HE5
End Sub
Sub EndFrame(Value As Integer)
    AddCodeByte &HC9
    AddCodeByte &HC2
    AddCodeWord Value
End Sub
Sub InitializeDLL()
    StartFrame
    AddCodeByte &HB8
    AddCodeDWord &H1
    EndFrame &HC
End Sub


Sub Compile(sFile As String, bRun As Boolean)
    InitSummary
    InfMessage "正在初始化模块 .."
    InitSections
    InitSymbols
    InitResources
    InitImports
    InitExports
    InitFixups
    InitFrames
    InitData
    InitTypes
    InitParser
    InfMessage "分析中 .."
    Parse
    If IsDLL Then NameDLL = Right(sFile, Len(sFile) - InStrRev(sFile, "\", -1, vbTextCompare)): NameDLL = Left(NameDLL, Len(NameDLL) - 3): NameDLL = NameDLL & "DLL"
    If pError = True Then WriteSummary Summary: Exit Sub
    If bLibrary = True Then ExportLibrary sFile: Exit Sub
    InitLinker sFile
    If pError = True Then WriteSummary Summary: Exit Sub
    DoFixups
    Link sFile, bRun
    Exit Sub
CompileFailed:
    pError = True
    ErrMessage "内部错误 -> " & Err.Description
    WriteSummary Summary
End Sub
Sub AddCodeByte(Value As Byte)
    ReDim Preserve Section(2).Bytes(UBound(Section(2).Bytes) + 1) As Byte
    Section(2).Bytes(UBound(Section(2).Bytes)) = Value
End Sub
Sub AddCodeWord(Value As Integer)
    AddCodeByte LoByte(Value)
    AddCodeByte HiByte(Value)
End Sub
Sub AddCodeSingle(Value As Single)
    Dim B1 As Byte: Dim B2 As Byte
    Dim B3 As Byte: Dim B4 As Byte
    Open App.Path & "\single.dmp" For Binary As #1
        Put #1, 1, Value
        Get #1, 1, B4: Get #1, 2, B3
        Get #1, 3, B2: Get #1, 4, B1
    Close #1
    AddCodeByte B4: AddCodeByte B3
    AddCodeByte B2: AddCodeByte B1
    Kill App.Path & "\single.dmp"
End Sub
Sub AddCodeDWord(Value As Long)
    AddCodeWord LoWord(Value)
    AddCodeWord HiWord(Value)
End Sub
Sub AddDataByte(Value As Byte)
    ReDim Preserve Section(1).Bytes(UBound(Section(1).Bytes) + 1) As Byte
    Section(1).Bytes(UBound(Section(1).Bytes)) = Value
End Sub
Sub AddDataWord(Value As Integer)
    AddDataByte LoByte(Value)
    AddDataByte HiByte(Value)
End Sub
Sub AddDataSingle(Value As Single)
    Dim B1 As Byte: Dim B2 As Byte
    Dim B3 As Byte: Dim B4 As Byte
    Open App.Path & "\single.dmp" For Binary As #1
        Put #1, 1, Value
        Get #1, 1, B4: Get #1, 2, B3
        Get #1, 3, B2: Get #1, 4, B1
    Close #1
    AddDataByte B4: AddDataByte B3
    AddDataByte B2: AddDataByte B1
    Kill App.Path & "\single.dmp"
End Sub
Sub AddDataDWord(Value As Long)
    AddDataWord LoWord(Value)
    AddDataWord HiWord(Value)
End Sub
Sub AddImportByte(Value As Byte)
    AddSectionNameByte ".idata", Value
End Sub
Sub AddImportWord(Value As Integer)
    AddSectionNameWord ".idata", Value
End Sub
Sub AddImportDWord(Value As Long)
    AddSectionNameDWord ".idata", Value
End Sub
Sub AddExportByte(Value As Byte)
    AddSectionNameByte ".edata", Value
End Sub
Sub AddExportWord(Value As Integer)
    AddSectionNameWord ".edata", Value
End Sub
Sub AddExportDWord(Value As Long)
    AddSectionNameDWord ".edata", Value
End Sub
Sub AddResourceByte(Value As Byte)
    AddSectionNameByte ".rsrc", Value
End Sub
Sub AddResourceWord(Value As Integer)
    AddSectionNameWord ".rsrc", Value
End Sub
Sub AddResourceDWord(Value As Long)
    AddSectionNameDWord ".rsrc", Value
End Sub
Sub AddRelocationByte(Value As Byte)
    AddSectionNameByte ".reloc", Value
End Sub
Sub AddRelocationWord(Value As Integer)
    AddSectionNameWord ".reloc", Value
End Sub
Sub AddRelocationDWord(Value As Long)
    AddSectionNameDWord ".reloc", Value
End Sub


Sub InitData()
    lUniqueID = 0
    sUniqueID = 0
    dUniqueID = 0
    fUniqueID = 0
End Sub
Sub DeclareDataSingle(Name As String, Value As Single)
    AddSymbol Name, OffsetOf(".data"), Data, ST_SINGLE
    AddDataSingle Value
End Sub
Sub DeclareDataDWord(Name As String, Value As Long)
    AddSymbol Name, OffsetOf(".data"), Data, ST_DWORD
    AddDataDWord Value
End Sub
Sub DeclareDataWord(Name As String, Value As Integer)
    AddSymbol Name, OffsetOf(".data"), Data, ST_WORD
    AddDataWord Value
End Sub
Sub DeclareDataByte(Name As String, Value As Byte)
    AddSymbol Name, OffsetOf(".data"), Data, ST_BYTE
    AddDataByte Value
End Sub
Sub DeclareDataUnsignedDWord(Name As String, Value As Long)
    AddSymbol Name, OffsetOf(".data"), Data, ST_US_DWORD
    AddDataDWord Value
End Sub
Sub DeclareDataUnsignedWord(Name As String, Value As Integer)
    AddSymbol Name, OffsetOf(".data"), Data, ST_US_WORD
    AddDataWord Value
End Sub
Sub DeclareDataUnsignedByte(Name As String, Value As Byte)
    AddSymbol Name, OffsetOf(".data"), Data, ST_US_BYTE
    AddDataByte Value
End Sub
Sub DeclareDataString(Name As String, Text As String, Optional Space As Long)
    Dim i As Integer: Dim n As Integer
    Dim Tmp As String: Dim LoopEnd As String
    AddSymbol Name, OffsetOf(".data"), Data, ST_STRING
    For i = 1 To Len(Text)
        Tmp = Mid$(Text, i, 1)
        If LenB(StrConv(Tmp, vbFromUnicode)) = 2 Then
            For n = 1 To Len(Hex(Asc(Tmp))) Step 2
                AddDataByte CLng("&H" & Mid(Hex(Asc(Tmp)), n, 2))
            Next n
        Else
            AddDataByte Asc(Tmp)
        End If
    Next i
    If Space > 0 Then
        For i = Len(Text) To Space
            AddDataByte &H0
        Next i
    End If
    AddDataByte &H0
End Sub


Sub InitExports()
    IsDLL = False
    ReDim Exports(0) As TYPE_EXPORT
    ReDim Relocations(0) As TYPE_RELOCATION
End Sub
Sub AddExport(Name As String)
    ReDim Preserve Exports(UBound(Exports) + 1) As TYPE_EXPORT
    Exports(UBound(Exports)).Name = Name
End Sub
Sub AddRelocation(Offset As Long)
    ReDim Preserve Relocations(UBound(Relocations) + 1) As TYPE_RELOCATION
    Relocations(UBound(Relocations)).Offset = Offset
End Sub
Sub WriteRelocations()
    Dim i As Integer
    CurrentSection = ".reloc"
    AddSectionDWord VirtualAddressOf(Code)
    AddFixup "Reloc_Last", OffsetOf(".reloc"), Relocate, (VirtualAddressOf(Relocate)) * (-1#)
    AddSectionDWord &H0
    For i = 1 To UBound(Relocations)
        If Relocations(i).Offset <> 0 Then
            AddSectionWord CInt(Relocations(i).Offset + &H3000)
        End If
    Next i
    AddSymbol "Reloc_Last", OffsetOf(".reloc"), Relocate
End Sub
Sub SortExports()
    Dim i As Integer
    Dim Elements() As String
    ReDim Elements(UBound(Exports)) As String
    For i = 1 To UBound(Exports)
        Elements(i) = Exports(i).Name
    Next i
    SortStringArray Elements, 1, UBound(Elements)
    For i = 1 To UBound(Elements)
        Exports(i).Name = Elements(i)
        Exports(i).Ordinal = i
    Next i
End Sub
Sub GenerateExportTable()
    Dim i As Integer
    Dim ii As Integer
    If UBound(Exports) = 0 Then Exit Sub
    CurrentSection = ".edata"
    SortExports
    AddSectionDWord 0
    AddSectionDWord 0
    AddSectionDWord 0
    AddFixup "DLL_NAME", OffsetOf(".edata"), Export
    AddSectionDWord 0
    AddSectionDWord 1
    AddSectionDWord UBound(Exports)
    AddSectionDWord UBound(Exports)
    AddFixup "ADDRESSES_TABLE", OffsetOf(".edata"), Export
    AddSectionDWord 0