VERSION 5.00
Begin VB.Form AwkForm
BorderStyle = 1 'Fixed Single
Caption = "ASE.COM.AWK"
ClientHeight = 8100
ClientLeft = 45
ClientTop = 330
ClientWidth = 12900
LinkTopic = "AwkForm"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 8100
ScaleWidth = 12900
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton btnClearAll
Caption = "Clear All"
Height = 375
Left = 240
TabIndex = 14
Top = 4560
Width = 2295
End
Begin VB.CommandButton btnAddArgument
Caption = "Add"
Height = 375
Left = 1920
TabIndex = 12
Top = 4080
Width = 615
End
Begin VB.TextBox txtArgument
Height = 375
Left = 240
TabIndex = 11
Top = 4080
Width = 1575
End
Begin VB.ListBox lstArguments
Height = 2595
Left = 240
TabIndex = 10
Top = 1320
Width = 2295
End
Begin VB.ComboBox EntryPoint
Height = 315
ItemData = "AwkForm.frx":0000
Left = 240
List = "AwkForm.frx":0007
TabIndex = 9
Top = 480
Width = 2295
End
Begin VB.TextBox ConsoleIn
BeginProperty Font
Name = "Courier New"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3735
Left = 2760
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 2
Top = 4320
Width = 5055
End
Begin VB.TextBox SourceIn
BeginProperty Font
Name = "Courier New"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3615
Left = 2760
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Top = 360
Width = 5055
End
Begin VB.TextBox SourceOut
BeginProperty Font
Name = "Courier New"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3615
Left = 7920
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 1
Top = 360
Width = 4935
End
Begin VB.CommandButton btnExecute
Caption = "Execute"
Height = 375
Left = 1440
TabIndex = 5
Top = 7680
Width = 1215
End
Begin VB.TextBox ConsoleOut
BeginProperty Font
Name = "Courier New"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3735
Left = 7920
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 3
Top = 4320
Width = 4935
End
Begin VB.Frame Frame1
Caption = "Arguments"
Height = 4335
Left = 120
TabIndex = 13
Top = 1080
Width = 2535
Begin VB.CheckBox chkPassToEntryPoint
Caption = "Pass To Entry Point"
Height = 255
Left = 360
TabIndex = 16
Top = 3960
Width = 1815
End
End
Begin VB.Frame Frame2
Caption = "Entry Point"
Height = 855
Left = 120
TabIndex = 15
Top = 120
Width = 2535
End
Begin VB.Label Label4
Caption = "Console Out"
Height = 255
Left = 7920
TabIndex = 8
Top = 4080
Width = 3735
End
Begin VB.Label Label3
Caption = "Console In"
Height = 255
Left = 2760
TabIndex = 7
Top = 4080
Width = 3735
End
Begin VB.Label Label2
Caption = "Source Out"
Height = 255
Left = 7920
TabIndex = 6
Top = 120
Width = 3735
End
Begin VB.Label Label1
Caption = "Source In"
Height = 255
Left = 2760
TabIndex = 4
Top = 120
Width = 2415
End
End
Attribute VB_Name = "AwkForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 0
Dim source_first As Boolean
Public WithEvents Awk As ASECOM.Awk
Attribute Awk.VB_VarHelpID = -1
Private Sub btnAddArgument_Click()
Dim arg As String
arg = txtArgument.Text
If Len(arg) > 0 Then
lstArguments.AddItem (arg)
txtArgument.Text = ""
txtArgument.SetFocus
End If
End Sub
Private Sub btnClearAll_Click()
lstArguments.Clear
End Sub
Private Sub btnExecute_Click()
source_first = True
ConsoleOut.Text = ""
SourceOut.Text = ""
Set Awk = New ASECOM.Awk
'Awk.SetWord "BEGIN", "xxx"
'Awk.SetWord "END", "yyy"
'Awk.SetWord "length", "len"
'Awk.UnsetWord "END"
Awk.ExplicitVariable = True
Awk.ImplicitVariable = True
Awk.UseCrlf = True
Awk.IdivOperator = True
Awk.ShiftOperators = True
Awk.MaxDepthForBlockParse = 20
Awk.MaxDepthForBlockRun = 30
Awk.MaxDepthForExprParse = 20
Awk.MaxDepthForExprRun = 30
'Awk.MaxDepthForRexBuild = 10
'Awk.MaxDepthForRexMatch = 10
Awk.UseLongLong = False
Awk.Debug = True
If Not Awk.AddFunction("sin", 1, 1) Then
MsgBox "Cannot add builtin function - " + Awk.ErrorMessage
Exit Sub
End If
If Not Awk.AddFunction("cos", 1, 1) Then
MsgBox "Cannot add builtin function - " + Awk.ErrorMessage
Exit Sub
End If
Call Awk.AddFunction("tan", 1, 1)
Call Awk.AddFunction("sqrt", 1, 1)
Call Awk.AddFunction("trim", 1, 1)
'Call Awk.DeleteFunction("tan")
If Not Awk.Parse() Then
MsgBox "PARSE ERROR [" + Str(Awk.ErrorLine) + "]" + Awk.ErrorMessage
Else
Dim n As Boolean
Awk.EntryPoint = Trim(EntryPoint.Text)
If lstArguments.ListCount = 0 Then
n = Awk.Run(Null)
Else
ReDim Args(lstArguments.ListCount - 1) As String
Dim i As Integer
Awk.ArgumentsToEntryPoint = chkPassToEntryPoint.value
For i = 0 To lstArguments.ListCount - 1
Args(i) = lstArguments.List(i)
Next i
n = Awk.Run(Args)
End If
If Not n Then
MsgBox "RUN ERROR [" + Str(Awk.ErrorLine) + "]" + Awk.ErrorMessage
End If
End If
Set Awk = Nothing
End Sub
Function Awk_OpenSource(ByVal mode As ASECOM.AwkSourceMode) As Long
Awk_OpenSource = 1
End Function
Function Awk_CloseSource(ByVal mode As ASECOM.AwkSourceMode) As Long
Awk_CloseSource = 0
End Function
Function Awk_ReadSource(ByVal buf As ASECOM.Buffer) As Long
If source_first Then
buf.value = SourceIn.Text
Awk_ReadSource = Len(buf.value)
source_first = False
Else
Awk_ReadSource = 0
End If
End Function
Function Awk_WriteSource(ByVal buf As ASECOM.Buffer) As Long
Dim value As String
Dim l As Integer
value = buf.value
l = Len(value)
SourceOut.Text = SourceOut.Text + value
Awk_WriteSource = Len(value)
End Function
Function Awk_OpenExtio(ByVal extio As ASECOM.AwkExtio) As Long
Awk_OpenExtio = -1
Select Case extio.Type
Case ASECOM.AWK_EXTIO_CONSOLE
If extio.mode = ASECOM.AWK_EXTIO_CONSOLE_READ Then
extio.Handle = New AwkExtioConsole
With extio.Handle
.EOF = False
End With
Awk_OpenExtio = 1
ElseIf extio.mode = ASECOM.AWK_EXTIO_CONSOLE_WRITE Then
extio.Handle = New AwkExtioConsole
With extio.Handle
.EOF = False
End With
Awk_OpenExtio = 1
End If
Case ASECOM.AWK_EXTIO_FILE
If extio.mode = ASECOM.AWK_EXTIO_FILE_READ Then
extio.Handle = FreeFile
On Error GoTo ErrorTrap
Open extio.name For Input As #extio.Handle
On Error GoTo 0
Awk_OpenExtio = 1
ElseIf extio.mode = ASECOM.AWK_EXTIO_FILE_WRITE Then
extio.Handle = FreeFile
On Error GoTo ErrorTrap
Open extio.name For Output As #extio.Handle
On Error GoTo 0
Awk_OpenExtio = 1
ElseIf extio.mode = ASECOM.AWK_EXTIO_FILE_APPEND Then
extio.Handle = FreeFile
On Error GoTo ErrorTrap
Open extio.name For Append As #extio.Handle
On Error GoTo 0
Awk_OpenExtio = 1
End If
Case ASECOM.AWK_EXTIO_PIPE
Awk_OpenExtio = -1
Case ASECOM.AWK_EXTIO_COPROC
Awk_OpenExtio = -1
End Select
Exit Function
ErrorTrap:
Exit Function
End Function
Function Awk_CloseExtio(ByVal extio As ASECOM.AwkExtio) As Long
Awk_CloseExtio = -1
Select Case extio.Type
Case ASECOM.AWK_EXTIO_CONSOLE
If extio.mode = ASECOM.AWK_EXTIO_CONSOLE_READ Or _
extio.mode = ASECOM.AWK_EXTIO_CONSOLE_WRITE Then
extio.Handle = Nothing
Awk_CloseExtio = 0
End If
Case ASECOM.AWK_EXTIO_FILE
If extio.mode = ASECOM.AWK_EXTIO_FILE_READ Or _
extio.mode = ASECOM.AWK_EXTIO_FILE_WRITE Or _
extio.mode = ASECOM.AWK_EXTIO_FILE_APPEND Then
Close #extio.Handle
Awk_CloseExtio = 0
End If
Case ASECOM.AWK_EXTIO_PIPE
Awk_CloseExtio = -1
Case ASECOM.AWK_EXTIO_COPROC
Awk_CloseExtio = -1
End Select
End Function
Function Awk_ReadExtio(ByVal extio As ASECOM.AwkExtio, ByVal buf As ASECOM.Buffer) As Long
Awk_ReadExtio = -1
Select Case extio.Type
Case ASECOM.AWK_EXTIO_CONSOLE
If extio.mode = ASECOM.AWK_EXTIO_CONSOLE_READ Then
Awk_ReadExtio = ReadExtioConsole(extio, buf)
End If
Case ASECOM.AWK_EXTIO_FILE
If extio.mode = ASECOM.AWK_EXTIO_FILE_READ Then
Awk_ReadExtio = ReadExtioFile(extio, buf)
End If
Case ASECOM.AWK_EXTIO_PIPE
Awk_ReadExtio = -1
Case ASECOM.AWK_EXTIO_COPROC
Awk_ReadExtio = -1
End Select
End Function
Function Awk_WriteExtio(ByVal extio As ASECOM.AwkExtio, ByVal buf As ASECOM.Buffer) As Long
Awk_WriteExtio = -1
Select Case extio.Type
Case ASECOM.AWK_EXTIO_CONSOLE
If extio.mode = ASECOM.AWK_EXTIO_CONSOLE_WRITE Then
Awk_WriteExtio = WriteExtioConsole(extio, buf)
End If
Case ASECOM.AWK_EXTIO_FILE
If extio.mode = ASECOM.AWK_EXTIO_FILE_WRITE Or _
extio.mode = ASECOM.AWK_EXTIO_FILE_APPEND Then
Awk_WriteExtio = WriteExtioFile(extio, buf)
End If
Case ASECOM.AWK_EXTIO_PIPE
Awk_WriteExtio = -1
Case ASECOM.AWK_EXTIO_COPROC
Awk_WriteExtio = -1
End Select
End Function
Function ReadExtioConsole(ByVal extio As ASECOM.AwkExtio, ByVal buf As ASECOM.Buffer) As Long
Dim value As String
If Not extio.Handle.EOF Then
value = ConsoleIn.Text
extio.Handle.EOF = True
buf.value = value
ReadExtioConsole = Len(value)
Else
ReadExtioConsole = 0
End If
End Function
Function ReadExtioFile(ByVal extio As ASECOM.AwkExtio, ByVal buf As ASECOM.Buffer) As Long
Dim value As String
If EOF(extio.Handle) Then
ReadExtioFile = 0
Exit Function
End If
On Error GoTo ErrorTrap
Line Input #extio.Handle, value
On Error GoTo 0
value = value + vbCrLf
buf.value = value
ReadExtioFile = Len(buf.value)
Exit Function
ErrorTrap:
ReadExtioFile = -1
Exit Function
End Function
Function WriteExtioConsole(ByVal extio As ASECOM.AwkExtio, ByVal buf As ASECOM.Buffer) As Long
Dim value As String
value = buf.value
ConsoleOut.Text = ConsoleOut.Text + value
WriteExtioConsole = Len(value)
End Function
Function WriteExtioFile(ByVal extio As ASECOM.AwkExtio, ByVal buf As ASECOM.Buffer) As Long
Dim value As String
WriteExtioFile = -1
value = buf.value
On Error GoTo ErrorTrap
Print #extio.Handle, value;
On Error GoTo 0
WriteExtioFile = Len(value)
Exit Function
ErrorTrap:
Exit Function
End Function
Function Awk_HandleBuiltinFunction(ByVal name As String, ByVal Args As Variant) As Variant
If name = "sin" Then
If IsNull(Args(0)) Then
Awk_HandleBuiltinFunction = Sin(0)
ElseIf IsNumeric(Args(0)) Then
Awk_HandleBuiltinFunction = Sin(Args(0))
Else
Awk_HandleBuiltinFunction = Sin(Val(Args(0)))
End If
ElseIf name = "cos" Then
If TypeName(Args(0)) = "Long" Or TypeName(Args(0)) = "Double" Then
Awk_HandleBuiltinFunction = Cos(Args(0))
ElseIf TypeName(Args(0)) = "String" Then
Awk_HandleBuiltinFunction = Cos(Val(Args(0)))
ElseIf TypeName(Args(0)) = "Null" Then
Awk_HandleBuiltinFunction = Cos(0)
End If
ElseIf name = "tan" Then
If TypeName(Args(0)) = "Long" Or TypeName(Args(0)) = "Double" Then
Awk_HandleBuiltinFunction = Tan(Args(0))
ElseIf TypeName(Args(0)) = "String" Then
Awk_HandleBuiltinFunction = Tan(Val(Args(0)))
ElseIf TypeName(Args(0)) = "Null" Then
Awk_HandleBuiltinFunction = Tan(0)
End If
ElseIf name = "sqrt" Then
If IsNull(Args(0)) Then
Awk_HandleBuiltinFunction = Sqr(0)
ElseIf IsNumeric(Args(0)) Then
Awk_HandleBuiltinFunction = Sqr(Args(0))
Else
Awk_HandleBuiltinFunction = Sqr(Val(Args(0)))
End If
ElseIf name = "trim" Then
Awk_HandleBuiltinFunction = Trim(Args(0))
End If
'Dim i As Integer
'Dim xxx As String
'MsgBox name
'For i = LBound(args) To UBound(args)
' xxx = xxx & "," & args(i)
'Next i
'MsgBox xxx
End Function
Private Sub Form_Load()
SourceIn.Text = ""
SourceOut.Text = ""
ConsoleIn.Text = ""
ConsoleOut.Text = ""
End Sub