home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Object = "{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0"; "MSSCRIPT.OCX"
- Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
- Begin VB.Form ScriptForm
- Caption = "Interactive Script Editor"
- ClientHeight = 6180
- ClientLeft = 165
- ClientTop = 735
- ClientWidth = 9090
- LinkTopic = "Form1"
- ScaleHeight = 6180
- ScaleWidth = 9090
- StartUpPosition = 3 'Windows Default
- Begin MSComDlg.CommonDialog CommonDialog1
- Left = 8040
- Top = 240
- _ExtentX = 847
- _ExtentY = 847
- _Version = 393216
- End
- Begin MSScriptControlCtl.ScriptControl ScriptControl1
- Left = 7320
- Top = 120
- _ExtentX = 1005
- _ExtentY = 1005
- AllowUI = -1 'True
- End
- Begin VB.CommandButton bttnListProcs
- Caption = "List Procedures"
- BeginProperty Font
- Name = "Verdana"
- Size = 9.75
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 645
- Left = 7215
- TabIndex = 3
- TabStop = 0 'False
- Top = 2385
- Width = 1785
- End
- Begin VB.TextBox Text2
- BeginProperty Font
- Name = "Courier New"
- Size = 9.75
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 2085
- Left = 90
- MultiLine = -1 'True
- ScrollBars = 2 'Vertical
- TabIndex = 2
- TabStop = 0 'False
- Top = 3945
- Width = 8895
- End
- Begin VB.CommandButton bttnExecute
- Caption = "Execute Script"
- BeginProperty Font
- Name = "Verdana"
- Size = 9.75
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 645
- Left = 7215
- TabIndex = 1
- TabStop = 0 'False
- Top = 3120
- Width = 1785
- End
- Begin VB.TextBox Text1
- BeginProperty Font
- Name = "Verdana"
- Size = 9
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 3645
- Left = 75
- MultiLine = -1 'True
- ScrollBars = 3 'Both
- TabIndex = 0
- TabStop = 0 'False
- Text = "Script.frx":0000
- Top = 105
- Width = 7035
- End
- Begin VB.Menu FileMenu
- Caption = "File"
- Begin VB.Menu FileNew
- Caption = "New Script"
- End
- Begin VB.Menu FileLoad
- Caption = "Load Script"
- End
- Begin VB.Menu FileSave
- Caption = "Save Script"
- End
- Begin VB.Menu separator1
- Caption = "-"
- End
- Begin VB.Menu FileExit
- Caption = "Exit"
- End
- End
- Attribute VB_Name = "ScriptForm"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- ' ******************************
- ' ******************************
- ' ** MASTERING VB6 **
- ' ** by Evangelos Petroutos **
- ' ** SYBEX, 1998 **
- ' ******************************
- ' ******************************
- Private display As New DisplayClass
- Private Statistics As New AXStats
- Private Sub bttnExecute_Click()
- On Error GoTo CodeError
- ScriptControl1.AddCode Text1.Text
- ScriptControl1.Run "Main"
- Exit Sub
- CodeError:
- If ScriptControl1.Error.Number <> 0 Then
- msg = ScriptControl1.Error.Description & bvcrlf
- msg = msg & "In line " & ScriptControl1.Error.Line & ", column " & ScriptControl1.Error.Column
- MsgBox msg, , "Error in script"
- Else
- MsgBox "ERROR # " & Err.Number & vbCrLf & Err.Description
- Debug.Print ScriptControl1.Error.Line
- End If
- End Sub
- Private Sub bttnListProcs_Click()
- On Error GoTo CodeError
- ScriptControl1.AddCode Text1.Text
- For i = 1 To ScriptControl1.Procedures.Count
- If ScriptControl1.Procedures(i).HasReturnValue Then
- Text2.Text = Text2.Text & vbCrLf & "Function " & ScriptControl1.Procedures(1).Name
- Else
- Text2.Text = Text2.Text & vbCrLf & "Subroutine " & ScriptControl1.Procedures(1).Name
- End If
- Next
- Exit Sub
- CodeError:
- MsgBox Err.Description
- End Sub
- Private Sub FileLoad_Click()
- On Error GoTo OpenError
- CommonDialog1.Filter = "Scripts|*.SCR|Text Files|*.TXT|All Files|*.*"
- CommonDialog1.CancelError = True
- CommonDialog1.ShowOpen
- Fnum = FreeFile
- Open CommonDialog1.FileName For Binary As #Fnum
- scriptText = Input(LOF(Fnum), Fnum)
- Close #Fnum
- Text1.Text = scriptText
- Exit Sub
- OpenError:
- End Sub
- Private Sub FileNew_Click()
- Text1.Text = ""
- Text2.Text = ""
- End Sub
- Private Sub FileSave_Click()
- On Error GoTo SaveError
- CommonDialog1.Filter = "Scripts|*.SCR|Text Files|*.TXT|All Files|*.*"
- CommonDialog1.DefaultExt = "*.SCR"
- CommonDialog1.CancelError = True
- CommonDialog1.InitDir = App.Path
- CommonDialog1.ShowSave
- Fnum = FreeFile
- Open CommonDialog1.FileName For Output As #Fnum
- Close #Fnum
- Open CommonDialog1.FileName For Binary As #Fnum
- Put #Fnum, , Text1.Text
- Close #Fnum
- Exit Sub
- SaveError:
- End Sub
- Private Sub Form_Load()
- ScriptControl1.AddObject "Output", display, True
- ScriptControl1.AddObject "Stat", Statistics, True
- End Sub
- Private Sub ScriptControl1_Error()
- ' msg = ScriptControl1.Error.Description & bvcrlf
- ' msg = msg & "In line " & ScriptControl1.Error.Line & ", column " & ScriptControl1.Error.Column
- ' MsgBox msg, , "Error in Script Control"
- End Sub
-