via.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Via"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private lModuleID As Long
Private lResourceID As Long
Private cNodeKey As Long
Private lLastTab As String
Private AutoTemplates As Boolean
Private NoBeforeClickEvent As Boolean
Private LastMnuIndex As Long
Private LastMnuOpenIndex As Long
Private cDFile As String
Private 编译进程 As String
Private 错误信息 As String
Private 内容信息 As String

Private bLibrary As Boolean
Private LibraryName As String
Private NameDLL As String
Private IsCmdCompile As Boolean
Private lUniqueID As Long
Private sUniqueID As Long
Private dUniqueID As Long
Private fUniqueID As Long
Private Type TYPE_EXPORT
    Name As String
    Ordinal As Integer
End Type
Private Type TYPE_RELOCATION
    Offset As Long
End Type
Private IsDLL As Boolean
Private Exports() As TYPE_EXPORT
Private Relocations() As TYPE_RELOCATION
Private IsFloat As Boolean
Private Relation As String
Private eUniqueID As Long
Private CompareOne As String
Private CompareTwo As String
Private Assignment As String
Private BracketsOpen As Byte
Private EvaluateCount As Long
Private IsStringCompare As Boolean
Private Type TYPE_FIXUP
    Name As String
    Offset As Long
    Value As Long
    ExtraAdd As Long
    Section As ENUM_SECTION_TYPE
    Deleted As Boolean
End Type
Private Fixups() As TYPE_FIXUP
Private Type TYPE_FRAME
    Name As String
    Declares As String
    ReturnAs As String
    Property As Boolean
End Type
Private IsCallFrame As Boolean
Private Frames() As TYPE_FRAME
Private ArgCount As Long
Private CurrentFrame As String
Private fcUniqueID As Long
Private Type TYPE_IMPORT
    Name As String
    Alias As String
    Library As String
    pCount As Long
    Used As Boolean
End Type
Private Imports() As TYPE_IMPORT
Enum ENUM_APP_TYPE
    GUI = 2
    CUI = 3
End Enum
Enum ENUM_SECTION_TYPE
    Data = 1
    Code = 2
    Import = 3
    Export = 4
    Resource = 5
    Linker = 6
    Relocate = 7
End Enum
Enum ENUM_SECTION_CHARACTERISTICS
    CH_CODE = &H20
    CH_INITIALIZED_DATA = &H40
    CH_UNINITIALIZED_DATA = &H80
    CH_MEM_DISCARDABLE = &H2000000
    CH_MEM_NOT_CHACHED = &H4000000
    CH_MEM_NOT_PAGED = &H8000000
    CH_MEM_SHARED = &H10000000
    CH_MEM_EXECUTE = &H20000000
    CH_MEM_READ = &H40000000
    CH_MEM_WRITE = &H80000000
End Enum
Private Type TYPE_SECTION
    Name As String
    Bytes() As Byte
    SectionType As ENUM_SECTION_TYPE
    Characteristics As ENUM_SECTION_CHARACTERISTICS
End Type
Private Section() As TYPE_SECTION
Private SizeOfHeader As Integer
Private AppType As ENUM_APP_TYPE
Private SizeOfAllSectionsBefore As Long
Private SizeOfAllSectionsBeforeRaw As Long
Private Type TYPE_QWORD
    Value As Currency
End Type
Private Type TYPE_LOHIQWORD
    lLoDWord As Long
    lHiDWord As Long
End Type
Private Source As String
Private Position As Long
Private WithIdent As String
Private EntryPoint As String
Private UnsignedDeclare As Boolean


Private Type TYPE_RES_RESOURCE
    Value As Long
    FileName As String
    SymbolName As String
End Type
Private Type TYPE_RES_ITEM
    Value As Long
    RE() As TYPE_RES_RESOURCE
End Type
Private Type TYPE_RES_DIRECTORY
    Value As Long
    IT() As TYPE_RES_ITEM
End Type
Private D() As TYPE_RES_DIRECTORY
Private lUniqueBMP As Long

Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Errors As Long
Private pError As Boolean
Private Summary As String
Private ShowSummary As Boolean
Private sFileToRun As String
Private LenIncludes As Long
Private LenProcModules As Long

Enum ENUM_SYMBOL_TYPE
    ST_RVA = 1
    ST_LABEL = 2
    ST_DWORD = 3
    ST_WORD = 4
    ST_BYTE = 5
    ST_US_DWORD = 6
    ST_US_WORD = 7
    ST_US_BYTE = 8
    ST_STRING = 9
    ST_TYPE = 10
    ST_IMPORT = 11
    ST_EXPORT = 12
    ST_RESOURCE = 13
    ST_FRAME = 14
    ST_LOCAL_DWORD = 15
    ST_LOCAL_STRING = 16
    ST_LOCAL_SINGLE = 17
    ST_SINGLE = 18
End Enum
Private Type TYPE_SYMBOL
    Name As String
    Offset As Long
    Section As ENUM_SECTION_TYPE
    SymType As ENUM_SYMBOL_TYPE
    IsProto As Boolean
End Type
Private Type TYPE_CONSTANT
    Name As String
    Value As String
End Type
Private Constants() As TYPE_CONSTANT
Private Symbols() As TYPE_SYMBOL

Private CurrentSection As String
Private CurrentModule As String
Private Type TYPE_TYPE
    Name As String
    Source As String
End Type
Private Types() As TYPE_TYPE
Private CurrentType As String
Private TypesLeft As Long

Private GridSize As Long
Private ExitCode As Long
Private hWndProg As Long
Private DoCreateObject As Boolean
Private Const SHCNE_ASSOCCHANGED = &H8000000
Private Const SHCNF_IDLIST = &H0
Private Const PROCESS_ALL_ACCESS& = &H1F0FFF
Private Const STILL_ACTIVE& = &H103&
Private Const INFINITE& = &HFFFF
Private Const WM_SYSCOMMAND = &H112
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub SHChangeNotify Lib "shell32" (ByVal wEventId As Long, ByVal uFlags As Long, ByVal dwItem1 As Long, ByVal dwItem2 As Long)
Private DbgCounter As Single



Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1&


Private Declare Function GradientFill Lib "msimg32" (ByVal hdc As Long, ByRef pVertex As TRIVERTEX, ByVal dwNumVertex As Long, pMesh As Any, ByVal dwNumMesh As Long, ByVal dwMode As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Const COLOR_BTNFACE = 15
Private Type TRIVERTEX
    X As Long
    Y As Long
    Red As Integer
    Green As Integer
    Blue As Integer
    Alpha As Integer
End Type
Private Type GRADIENT_RECT
    UpperLeft As Long
    LowerRight As Long
End Type
Enum GradientDirection
    [GR_Fill_None] = -1
    [gr_Fill_Horizontal] = 0
    [GR_Fill_Vertical] = 1
End Enum
Private Const EX_ENTRY = 0
Private Const EX_MODULE = 1
Private Const EX_DIALOG = 2
Private Type TYPE_VIRTUAL_FILE
    Name As String
    Extension As Long
    Content As String
    Used As Boolean
End Type
Private VirtualFiles() As TYPE_VIRTUAL_FILE
Private Const ERROR_BADKEY = 2&
Private Const ERROR_CANTOPEN = 3&
Private Const ERROR_CANTREAD = 4&
Private Const ERROR_CANTWRITE = 5&
Private Const ERROR_OUTOFMEMORY = 6&
Private Const ERROR_INVALID_PARAMETER = 7&
Private Const ERROR_ACCESS_DENIED = 8&
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_CREATE_SUB_KEY = &H4&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const KEY_SET_VALUE = &H2&
Private Const MAX_PATH = 260&
Private Const REG_DWORD As Long = 4
Private Const REG_SZ = 1
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003


Sub PopEAX()
    If Not OptimizeAble("PopEAX") Then
        AddCodeByte &H58
    End If
End Sub
Sub PopEBX()
    AddCodeByte &H5B
End Sub
Sub PopECX()
    AddCodeByte &H59
End Sub
Sub PopEDX()
    AddCodeByte &H5A
End Sub
Sub PushEAX()
    AddCodeByte &H50
End Sub
Sub PushECX()
    AddCodeByte &H51
End Sub
Sub DecECX()
    AddCodeByte &H49
End Sub
Sub IncECX()
    AddCodeByte &H41
End Sub
Sub StoreECX()
    AddCodeWord &HD89
    AddCodeFixup "$Intern.Loop"
End Sub
Sub RestoreECX()
    AddCodeWord &HD8B
    AddCodeFixup "$Intern.Loop"
End Sub
Sub Push(Optional Value As Long)
    AddCodeByte &H68
    AddCodeDWord Value
End Sub
Sub PushF(Optional Value As Single)
    AddCodeByte &H68
    AddCodeSingle Value
End Sub
Sub PushContent(Variable As String)
    AddCodeWord &H35FF
    AddFixup Variable, OffsetOf(".code"), Code, &H400000
    AddRelocation OffsetOf(".code")
    AddCodeDWord &H0
End Sub
Sub PushAddress(Variable As String)
    AddCodeByte &H68
    AddFixup Variable, OffsetOf(".code"), Code, &H400000
    AddRelocation OffsetOf(".code")
    AddCodeDWord &H0
End Sub
Sub PushFloatEAX()
    fUniqueID = fUniqueID + 1
    DeclareDataSingle "$Float" & fUniqueID, 0
    AssignEAX "$Float" & fUniqueID
    PushFloatContent "$Float" & fUniqueID
End Sub
Sub PushFloatEDX()
    fUniqueID = fUniqueID + 1
    DeclareDataSingle "$Float" & fUniqueID, 0
    AssignEDX "$Float" & fUniqueID
    PushFloatContent "$Float" & fUniqueID
End Sub
Sub PushFloat(Value As Single)
    fUniqueID = fUniqueID + 1
    DeclareDataSingle "$Float" & fUniqueID, Value
    PushFloatContent "$Float" & fUniqueID
End Sub
Sub PushFloatContent(Name As String)
    AddCodeWord &H5D9
    AddCodeFixup Name
End Sub
Sub Invoke()
    AddCodeWord &H15FF
End Sub
Sub InvokeByName(Name As String)
    Call Invoke
    SetImportUsed Name, OffsetOf(".code")
    AddFixup Name, OffsetOf(".code"), Code, &H400000
    AddCodeDWord &H0
End Sub
Sub ExprAdd()
    Call PopEDX: PopEAX
    AddCodeWord &HD001
End Sub
Sub ExprFloatAdd()
    Call PopEDX: PopEAX
    PushFloatEAX
    PushFloatEDX
    AddCodeWord &HC1DE
    AddCodeWord &H1DD9
    AddCodeFixup "$Intern.Float"
    MovEAX "$Intern.Float"
End Sub
Sub ExprFloatSub()
    Call PopEDX: PopEAX
    PushFloatEAX
    PushFloatEDX
    AddCodeWord &HE9DE
    AddCodeWord &H1DD9
    AddCodeFixup "$Intern.Float"
    MovEAX "$Intern.Float"
End Sub
Sub ExprFloatMul()
    Call PopEDX: PopEAX