form1.frm

VBScriptcomplier希望大家喜欢。

         Charset         =   238
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Image Image1 
      Height          =   240
      Left            =   2880
      Picture         =   "Form1.frx":4D11
      Top             =   4800
      Width           =   240
   End
   Begin VB.Label Label1 
      Caption         =   """"
      Height          =   855
      Left            =   1200
      TabIndex        =   11
      Top             =   2880
      Visible         =   0   'False
      Width           =   1695
   End
   Begin VB.Label rpl2 
      Caption         =   """)"
      Height          =   495
      Left            =   3480
      TabIndex        =   10
      Top             =   3960
      Width           =   615
   End
   Begin VB.Label rpl1 
      Caption         =   "("""
      Height          =   495
      Left            =   2160
      TabIndex        =   9
      Top             =   4440
      Width           =   615
   End
   Begin VB.Menu file 
      Caption         =   "文件"
      Begin VB.Menu fileNew 
         Caption         =   "&New"
      End
      Begin VB.Menu fileSep1 
         Caption         =   "-"
      End
      Begin VB.Menu fileOpen 
         Caption         =   "&Open..."
         Shortcut        =   ^O
      End
      Begin VB.Menu fileSave 
         Caption         =   "&Save"
         Shortcut        =   ^S
      End
      Begin VB.Menu fileSaveas 
         Caption         =   "Save &As..."
      End
      Begin VB.Menu hhhhhhhhhhh 
         Caption         =   "ghg"
         Visible         =   0   'False
      End
      Begin VB.Menu ruinex 
         Caption         =   "&Test && Compile [F6]"
      End
      Begin VB.Menu fileSep2 
         Caption         =   "-"
      End
      Begin VB.Menu fileExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "剪贴板"
      Begin VB.Menu vbsclip 
         Caption         =   "Open My Clipboard"
         Shortcut        =   ^B
      End
      Begin VB.Menu sep99 
         Caption         =   "-"
      End
      Begin VB.Menu editUndo 
         Caption         =   "VBScripter: &Undo"
         Shortcut        =   {F4}
      End
      Begin VB.Menu sep1 
         Caption         =   "-"
      End
      Begin VB.Menu editCut 
         Caption         =   "VBScripter: Cu&t"
         Shortcut        =   ^F
      End
      Begin VB.Menu editCopy 
         Caption         =   "VBScripter: &Copy"
         Shortcut        =   ^G
      End
      Begin VB.Menu editPaste 
         Caption         =   "VBScripter: &Paste"
         Shortcut        =   ^H
      End
      Begin VB.Menu editSep2 
         Caption         =   "-"
      End
      Begin VB.Menu editSelectAll 
         Caption         =   "VBScripter: &Select All"
         Shortcut        =   ^A
      End
   End
   Begin VB.Menu tools 
      Caption         =   "工具"
      Begin VB.Menu toolsRun 
         Caption         =   "&Run"
         Shortcut        =   {F5}
      End
      Begin VB.Menu ruine 
         Caption         =   "&Test && Compile"
         Shortcut        =   {F6}
      End
      Begin VB.Menu debug 
         Caption         =   "&Debug"
         Begin VB.Menu rss 
            Caption         =   "&Run And Debug Selected Text"
         End
         Begin VB.Menu rada 
            Caption         =   "&Run And Debug All"
         End
      End
      Begin VB.Menu addscr 
         Caption         =   "Add &Script"
      End
      Begin VB.Menu gtli 
         Caption         =   "Goto &Line"
         Shortcut        =   ^Y
      End
      Begin VB.Menu toolsruninIE 
         Caption         =   "Compile &HTA"
      End
      Begin VB.Menu vbscomp 
         Caption         =   "Compile &VBS"
      End
      Begin VB.Menu cf 
         Caption         =   "&Clear Error Log"
      End
      Begin VB.Menu dddddddddddddd 
         Caption         =   "-"
      End
      Begin VB.Menu csztm 
         Caption         =   "&Customize Toolbar"
      End
      Begin VB.Menu fvdfg 
         Caption         =   "-"
      End
      Begin VB.Menu dsdsdscall 
         Caption         =   "Call Script"
         Shortcut        =   {F2}
      End
      Begin VB.Menu toolsSep1 
         Caption         =   "-"
      End
      Begin VB.Menu toolsEncode 
         Caption         =   "&Encode"
         Shortcut        =   ^E
      End
      Begin VB.Menu toolsDecode 
         Caption         =   "&Decode"
         Shortcut        =   ^D
      End
   End
   Begin VB.Menu werdg 
      Caption         =   "错误日志"
   End
   Begin VB.Menu beat 
      Caption         =   "插件"
      Begin VB.Menu enaku 
         Caption         =   "Plugins..."
      End
      Begin VB.Menu dvaka 
         Caption         =   "Insert Output"
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助"
      Begin VB.Menu debmso 
         Caption         =   "&Mouse Commands"
         Shortcut        =   {F1}
      End
      Begin VB.Menu about 
         Caption         =   "&About..."
      End
   End
End
Attribute VB_Name = "mainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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 LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_GEFIRSTVISIBLELINE = &HCE

Dim BL As Long
Dim B  As Long
Private Sub about_Click()
    frmAbout.Show 1
End Sub
Private Sub encode_Click()
    Text1.text = Encode(Text1.text)
End Sub

Private Sub Command2_Click()
On Error GoTo errrrrr
ScriptControl1.AddCode Text1.text
Exit Sub


errrrrr:

SetCursorAtLine Val(ScriptControl1.Error.Line), Text1
Text1.SetFocus
Text1.SelColor = vbRed
Text1.SelText = "'" + Err.Description + " > "


End Sub

Private Sub dva_Click()


SetCursorAtLine Val(ScriptControl1.Error.Line), Text1
Text1.SetFocus
Text1.SelColor = vbRed
Text1.SelText = "'" + Err.Description + " > "

End Sub

Private Sub addscr_Click()
Form3.Show
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cf_Click()
List1.Clear
End Sub

Private Sub csztm_Click()
Toolbar1.Customize
End Sub

Private Sub debmso_Click()
Dialog.Show
End Sub

Private Sub dsdsdscall_Click()
Dim xcv

xcv = InputBox("Enter the name!", "Call")
Text1.SelText = Chr$(13) + Chr$(10) + "call " + xcv + Chr$(13) + Chr$(10)

Colorize Me.Text1, &H8000&, vbRed, &HFF0000
 Text1.SelColor = vbBlack
End Sub

Private Sub dvaka_Click()
editPaste_Click
End Sub

Private Sub editCopy_Click()
    Clipboard.Clear
    Clipboard.SetText Text1.SelText
End Sub
Private Sub editCut_Click()
    Clipboard.Clear
    Clipboard.SetText Text1.SelText
    Text1.SelText = ""
End Sub
Private Sub editPaste_Click()
    Text1.SelText = Clipboard.GetText
    
    Colorize mainForm.Text1, &H8000&, vbRed, &HFF0000
 Text1.SelColor = vbBlack
End Sub

Private Sub editSelectAll_Click()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.text)
End Sub

Private Sub editUndo_Click()
    UNDO
End Sub

Private Sub ena_Click()
On Error GoTo errrrrr
ScriptControl1.AddCode Text1.SelText
Exit Sub


errrrrr:

SetCursorAtLine Val(ScriptControl1.Error.Line), Text1
Text1.SetFocus
Text1.SelColor = vbRed
Text1.SelText = "'" + Err.Description + " > "

End Sub

Private Sub errlog_Click()
Form4.Show
End Sub

Private Sub enaku_Click()
Form7.Show
End Sub

Private Sub fileExit_Click()
    fileNew_Click
Unload Me
End Sub

Private Sub fileNew_Click()
On Error Resume Next
Dim tempscript, yn
tempscript = Environ("temp") & "\tempscript.vbs"
Kill tempscript
If txtChange = True Then
    yn = MsgBox("Save changes?", vbInformation + vbYesNo, "-VBScripter-")
    If yn = 6 Then
        Save
    End If
End If
    Text1.text = ""
    FileName = ""
    txtChange = ""
    Me.Caption = "VBScripter"
End Sub

Private Sub fileOpen_Click()
    Me.MousePointer = 11
    OpenFile
    Me.MousePointer = 0
    Colorize mainForm.Text1, &H8000&, vbRed, vbBlue
End Sub

Private Sub fileSave_Click()
    Save
End Sub

Private Sub fileSaveas_Click()
    SaveAs
End Sub
Function Encode(ArgChr)
Dim i, var1, var2

On Error Resume Next
For i = 1 To Len(ArgChr)
    var1 = Mid(ArgChr, i, 1)
    If Asc(var1) = 13 Then
        var2 = 15
    Else
        var2 = Asc(var1) + 100
    End If
    Encode = Encode & Chr(var2)
Next
End Function

Function Decode(ArgChr)
Dim num, i, var1, var2

On Error Resume Next
num = Val(Chr(49) & Chr(48) & Chr(48))
For i = 1 To Len(ArgChr)
    var1 = Mid(ArgChr, i, 1)
    If Asc(var1) = 15 Then
        Decode = Decode & Chr(13)
    Else
        var2 = Asc(var1) - num
        Decode = Decode & Chr(var2)
    End If
Next
End Function

Private Sub Form_Click()
List2.Visible = False
List1.Visible = False
End Sub