Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Einfacher BASIC-Interpreter
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 02.11.2007 02:19:45 |
'#######################################################################################
' C4BSI - CIC4-Skripter-BASIC-Interpreter
'#######################################################################################
'(c) 2007 By.: /_\ DeltaLab's - Deutschland
'Autor: Martin Wiemann
'============================================================================
'Alle Rechte vorbehalten!
'Admin@MLN.ath.cx
'#######################################################################################
#include "vbcompat.bi"
#include "dir.bi"
Dim Shared G_Command As String
Dim Shared G_LocalExec As Long
Dim Shared G_PathInput As String
Dim Shared G_PathOutput As String
Dim Shared G_PathOutputHeader As String
Dim Shared G_PathServerinfo As String
Dim Shared G_PathWWWRoot As String
Dim Shared G_Request As String
Dim Shared G_RequestType As String
Dim Shared G_IPA As String
Dim Shared G_Port As String
Dim Shared G_OverrideOutputfile As Long
Dim Shared G_ExecTimeOut as Long
Dim Shared G_Echo as String
Private Type Var_Type
V_Name As String
V_Value As String
End Type
Private Type Var_Dyn_Type
V_ValueD(255) As Var_Type
V_Count As String
End Type
Private Type Sub_Var_Type
V_Name As String
V_ByRef As Long
End Type
Private Type Sub_Type
V_FromFile As String
V_FromLine As Long
V_Name As String
V_ValD(255) As Sub_Var_Type
V_ValC As Long
V_Code As String
End Type
Dim Shared G_VarD() As Var_Type
Dim Shared G_VarC As Long
Dim Shared G_SubD() As Sub_Type
Dim Shared G_SubC As Long
Dim Shared G_FOFN As Integer
Dim Shared G_FOEFN As Integer
Dim Shared ExOut As Long
Dim Shared ExecTimeOut as Long
Declare Sub Main()
Declare Function C4S_Read_File(ByRef V_FilePathName As String) As Long
Declare Function C4S_Read_Subs(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_Line As String) As String
Declare Function C4S_Do_Sub(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_Name As String, ByRef V_ValParam As String) As String
Declare Function C4S_Read_Sub_Decode(ByRef V_FPN As String, ByRef V_SID As Long, ByRef V_Line As String, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long, ByRef V_LoopExit As Long) As String
Declare Function C4S_Do_Sub_Line(ByRef V_FPN As String, ByRef V_SID As Long, ByRef V_Line As String, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long, ByRef V_LoopExit As Long) As String
Declare Function C4S_Do_Sub_Block(ByRef V_FPN As String, ByRef V_Line As String, ByRef V_SID As Long, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long) As String
Declare Function C4S_Do_Sub_Block_Exec(ByRef V_FPN As String, ByRef V_Line As String, ByRef V_SID As Long, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long) As String
Declare Sub C4S_Calc(ByRef V_OP As String, V_DD() As String, V_DC As Long)
Declare Function C4S_InterFunc(ByRef V_FPN As String, ByRef V_Func As String, ByRef V_Data As String, ByRef B_Data As String) As Long
Declare Function C4S_Sub_Add(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_Name As String, ByRef V_Var As String, ByRef V_Code As String) As Long
Declare Function C4S_Var_Add(ByRef V_Name As String, ByRef V_Value As String) As Long
Declare Function C4S_Var_Get(ByRef V_Name As String, ByRef B_Value As String) As Long
Declare Function C4S_Var_Set(ByRef V_Name As String, ByRef V_Value As String) As Long
Declare Function C4S_Var_Exist(ByRef V_Name As String) As Long
Declare Sub F_SplitString(V_Data As String, B_DD() As String, ByRef B_DC As Long, V_CutString As String, V_ClearArray As Byte, V_Casesensitivity As Byte, V_AddEmpty As Byte)
Declare Sub F_Print(ByRef V_Text As String)
Declare Sub F_PrintOut(ByRef V_Text As String)
Declare Sub F_ErrAdd(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_EC As Long, V_AddInfo As String = "")
Declare Function F_ErrCodeDesc(ByRef V_ErrCode As Long, V_AddInfo As String = "") As String
Declare Sub C4S_SplitParam(ByRef V_Data As String, B_DD() As String, ByRef B_DC As Long)
Declare Function C4S_Trim(ByRef V_Data As String) as String
Main
end 0
Sub Main()
Dim X As Long
Dim DD() As String
Dim DC As Long
Dim XPos As Long
Dim X_FFN As Integer
Dim D As String
Dim T As String
ExOut = 0
G_Echo = "Echo: "
G_Command = Command
F_SplitString G_Command, DD(), DC, " ", 1, 0, 1
For X = 1 To DC Step 2
Select Case LCase(DD(X))
case "-e": G_Echo = DD(X + 1)
case "-ex": G_ExecTimeOut = val(DD(X + 1))
Case "-h": G_PathOutputHeader = DD(X + 1)
Case "-i": G_IPA = DD(X + 1)
Case "-k": X = X - 1: G_OverrideOutputfile = 1
case "-l": X = X - 1: G_LocalExec = 1
Case "-o": G_PathOutput = DD(X + 1)
Case "-p": G_Port = DD(X + 1)
Case "-r": G_Request = DD(X + 1)
Case "-s": G_PathInput = DD(X + 1)
Case "-t": G_RequestType = DD(X + 1)
Case "-v": G_PathServerinfo = DD(X + 1)
Case "-w": G_PathWWWRoot = DD(X + 1)
Case "-help", "--help"
F_Print "[C4S][HELP]"
F_Print "(c) 2007 By.: /_\ DeltaLab's Deutschland --- Martin Wiemann"
F_Print ""
F_Print "Syntax: C4BSI <Parameter> [<Parameter-Wert>] ..."
F_Print "-e <Text> = Legt einen Wert fest, der vor einer 'Echo' Ausgabe erscheinen soll. [Standard: 'ECHO']"
F_Print "-ex <ZeitInSek.> = Legt eine maximale Zeit fest, die dem SourceCode gegeben, bevor es durch Zwang abgebrochen wird."
F_Print "-h <DateiPathName> = Legt eine Ausgabedatei fest, in der Header-Informationen für HTTP-Server hinterlegt werden."
F_Print "-i <IP-Adresse> = Legt eine IP-Adresse fest. (Wenn ein SourceCode z.B. über einen HTTP-Server gestartet wurde)."
F_Print "-k = Diese Option überschreibt bereits vorhandene Ausgabedatein."
F_Print "-l = Diese Option teilt dem Interpreter mit, das der Quellcode Lokal ausgeführt wird."
F_Print " Daraufhin werden keine Ausgabedatein erstellt, und es wird zusätzlich nur der -s Parameter benötigt."
F_Print "-o <DateiPathName> = Legt eine Ausgabedatei fest, in welcher Daten mit dem 'Print' Kommando gespeichert werden.."
F_Print "-p <Port> = Hier muss ein Port angegeben werden, auf dem z.B. der HTTP_Server auf Verbindungsanfragen wartet."
F_Print "-r <Anfrage> = Diese Option überträgt eine Anfrage vom Server in eine Globale Variable im Interpreter."
F_Print "-s <DateiPathName> = Hier muss die Quell-Datei angegeben werden, in welchem sich der auszuführende Code befindet."
F_Print "-t <AnfrageTyp> = Diese Option Speichert den Typ der Anfrage in eine Globale Variable. z.B. GET, POST, PUT,..."
F_Print "-v <DateiPathName> = Dieser Pfad legt eien Datei fest, in welcher sich Server-Informationen befinden."
F_Print "-w <DateiPathName> = Hier wird ein ROOT-Verzeichniss angegeben, das bei Verzeichnisslistung nicht unterschritten werden darf."
F_Print ""
End 0
Case Else: F_Print "[C4S][E] Syntaxfehler! Gewählter Parameter existiert nicht! => " & DD(X): End -1
End Select
Next
If G_PathInput = "" Then F_Print "[C4S][E] Syntaxfehler! Keine Eingabedatei angegeben!": End -1
if G_LocalExec = 0 then
If G_PathOutput = "" Then F_Print "[C4S][E] Syntaxfehler! Keine Ausgabedatei angegeben!": End -1
If G_PathOutputHeader = "" Then F_Print "[C4S][E] Syntaxfehler! Keine Header Ausgabedatei angegeben!": End -1
If G_PathWWWRoot = "" Then F_Print "[C4S][E] Syntaxfehler! Kein WWW-Root-Pfad angegeben!": End -1
If G_Request = "" Then F_Print "[C4S][E] Syntaxfehler! Keine Anfrage-URL angegeben!": End -1
If G_RequestType = "" Then F_Print "[C4S][E] Syntaxfehler! Kein Anfrage-Typ angegeben!": End ' -1
If G_IPA = "" Then F_Print "[C4S][E] Syntaxfehler! Keine IP-Adresse angegeben!": End -1
If G_Port = "" Then F_Print "[C4S][E] Syntaxfehler! Kein Server-Port angegeben!": End -1
End If
If Dir(G_PathInput, fbNormal) = "" Then F_Print "[C4S][E] Eingabedatei wurde nicht gefunden!": End -1
If G_LocalExec = 0 then
If Dir(G_PathOutput, fbNormal) <> "" Then
If G_OverrideOutputfile = 1 Then
Kill G_PathOutput
If Dir(G_PathOutput, fbNormal) <> "" Then F_Print "[C4S][E] Konnte Ausgabedatei nicht löschen!": End -1
Else: F_Print "[C4S][E] Ausgabedatei existiert bereits!": End -1
End If
End If
If Dir(G_PathOutputHeader, fbNormal) <> "" Then
If G_OverrideOutputfile = 1 Then
Kill G_PathOutputHeader
If Dir(G_PathOutputHeader, fbNormal) <> "" Then F_Print "[C4S][E] Konnte Header Ausgabedatei nicht löschen!": End -1
Else: F_Print "[C4S][E] Header Ausgabedatei existiert bereits!": End -1
End If
End If
If Dir(G_PathOutput & ".ErrLog", fbNormal) <> "" Then
Kill G_PathOutput & ".ErrLog"
If Dir(G_PathOutput & ".ErrLog", fbNormal) <> "" Then F_Print "[C4S][E] Konnte FehlerLog-Ausgabedatei nicht löschen!": End -1
End If
If G_PathServerinfo <> "" Then
If Dir(G_PathServerinfo, fbNormal Or fbReadOnly) = "" Then F_Print "[C4S][E] ServerInfo-Datei existiert nicht!": End -1
X_FFN = FreeFile
Open G_PathServerinfo For Binary As #X_FFN
Do
If EOF(X_FFN) = -1 Then Exit Do
Line Input #X_FFN, T
If D <> "" And Left(D, 1) <> "'" Then
XPos = InStr(1, D, "=")
If XPos > 0 Then
T = Mid(D, XPos + 1)
D = Mid(D, 1, XPos - 1)
C4S_Var_Add D, T
End If
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Exit Sub
Loop
End If
Close #X_FFN: X_FFN = 0
G_FOEFN = FreeFile
Open G_PathOutput & ".ErrLog" For Binary As #G_FOEFN
G_FOFN = FreeFile
Open G_PathOutput For Binary As #G_FOFN
End If
ExecTimeOut = Timer + G_ExecTimeOut
print ExecTimeOut
Print Timer
Print G_ExecTimeOut
C4S_Read_File G_PathInput
T = C4S_Do_Sub(G_PathInput, 0, "main", "")
Close #G_FOFN: G_FOFN = 0
Close #G_FOEFN: G_FOEFN = 0
End Sub
Function C4S_Read_File(ByRef V_FilePathName As String) As Long
Dim XFIFN As Integer
Dim XLineC As Long
Dim D As String
Dim T As String
Dim TIV As Long
Dim X As Long
If Mid(V_FilePathName, 1, 1) <> "/" Then
If Dir(EXEPath & "/" & V_FilePathName, fbnormal or fbreadonly) = "" then Return 0
XFIFN = FreeFile
Open EXEPath & "/" & V_FilePathName For Binary As #XFIFN
Else
If Dir(V_FilePathName, fbnormal or fbreadonly) = "" then Return 0
XFIFN = FreeFile
Open V_FilePathName For Binary As #XFIFN
End If
Do
If EOF(XFIFN) = -1 Then Exit Do
D = ""
Line Input #XFIFN, D
XLineC = XLineC + 1
For X = 1 To Len(D)
Select Case Mid(D, X, 1)
Case """": If TIV = 0 Then TIV = 1 Else TIV = 0
Case "'"
If TIV = 0 Then
D = C4S_Trim(Mid(D, 1, X - 1))
Exit For
End If
End Select
If ExOut = 1 Then Return 0
Next
T = T & C4S_Trim(D)
If D <> "" Then
If Right(T, 1) <> "_" Then
T = C4S_Read_Subs(V_FilePathName, XLineC, T)
If T <> "" Then T = T & ":"
Else: T = Left(T, Len(T) - 1)
End If
End If
If ExOut = 1 Then Return 0
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return 0
Loop
Close #XFIFN: XFIFN = 0
return 0
End Function
Function C4S_Read_Subs(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_Line As String) As String
Dim X As Long
Dim Y As Long
Dim XPos As Long
Dim T As String
Dim SP1 As String
Dim SP2 As String
Dim PSub As String
Dim PSubX As Long
Dim DD() As String
Dim DC As Long
Dim LSVarD() As Var_Type
Dim LSVarC As Long
Dim TX As Long
Dim TD As String
PSubX = 1
For X = 1 To Len(V_Line) - 4
If ExOut = 1 Then Return ""
Select Case LCase(Mid(V_Line, X, 4))
Case "sub ": Y = X
Case "end "
If X + 4 <= Len(V_Line) Then
If LCase(Mid(V_Line, X + 3, 4)) = " sub" Then
If Y > 0 Then
T = Mid(V_Line, Y + 4, X - Y - 4)
PSub = Mid(V_Line, PSubX, Y - 1)
PSubX = Y + 8
XPos = InStr(1, T, ":")
If XPos > 0 Then
SP1 = C4S_Trim(Mid(T, 1, XPos - 1))
T = C4S_Trim(Mid(T, XPos + 1))
XPos = InStr(1, SP1, "(")
If XPos > 0 Then
SP2 = Mid(SP1, 1, XPos - 1)
SP1 = Mid(SP1, XPos + 1)
If Right(SP1, 1) = ")" Then
SP1 = Left(SP1, Len(SP1) - 1)
If PSub <> "" Then TD = C4S_Read_Sub_Decode(V_FPN, 0, PSub, DD(), DC, LSVarD(), LSVarC, TX)
C4S_Sub_Add V_FPN, V_LID, SP2, SP1, T
Else: F_ErrAdd V_FPN, V_LID, -4
End If
Else: F_ErrAdd V_FPN, V_LID, -3
End If
Else: F_ErrAdd V_FPN, V_LID, -2
End If
V_Line = Mid(V_Line, X + 8)
X = 0
Y = 0
Else: F_ErrAdd V_FPN, V_LID, -1
End If
End If
End If
End Select
If X >= Len(V_Line) - 4 Then Exit For
If ExOut = 1 Then Return ""
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
Return V_Line
End Function
Function C4S_Do_Sub(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_Name As String, ByRef V_ValParam As String) As String
Dim X As Long
Dim Y As Long
Dim S As String
Dim D As String
Dim T As String
Dim DD() As String
Dim DC As Long
Dim SID As Long
Dim TIV As Long
Dim BVV As String
Dim LSVarD() As Var_Type
Dim LSVarC As Long
Dim XOK As Long
C4S_SplitParam V_ValParam, DD(), DC
S = LCase(V_Name)
For X = 1 To G_SubC
If G_SubD(X).V_Name = S Then
SID = X: Exit For
End If
Next
If SID > 0 Then
D = G_SubD(SID).V_Code
BVV = C4S_Read_Sub_Decode(V_FPN, SID, D, DD(), DC, LSVarD(), LSVarC, XOK)
Else
If S = "main" Then
F_ErrAdd V_FPN, 0, -7
Else: F_ErrAdd V_FPN, V_LID, -8, V_Name
End If
End If
Return BVV
End Function
Function C4S_Read_Sub_Decode(ByRef V_FPN As String, ByRef V_SID As Long, ByRef V_Line As String, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long, ByRef V_LoopExit As Long) As String
Dim X As Long
Dim Y As Long
Dim D As String
Dim T As String
Dim BVV As String
Dim TIV As Long
Dim Z As Long
Dim ZTIV As Long
Dim P1 As String
Dim P2 As String
Dim PE As String
Dim PS As Long
Dim IFIN As Long
Dim IFID As String
Dim IFIX As Long
Dim IFOPX As String
Dim PrCS As Long
Dim PrCD As String
Dim DoX As Long
Dim IfOK As Long
Dim XT as String
D = V_Line
Y = 1
PrCS = 0
For X = 1 To Len(D)
If ExOut = 1 Then Return ""
Select Case Mid(D, X, 1)
Case """": If TIV = 0 Then TIV = 1 Else TIV = 0
Case ":"
If TIV = 0 Then
T = C4S_Trim(Mid(D, Y, X - Y))
If (LCase(Left(T, 3)) = "if ") And ((PrCS = 0) Or (PrCS = 1)) Then
IFIX = IFIX + 1
If IFIX = 1 Then
PS = 3
P1 = ""
P2 = ""
PE = ""
IFID = ""
IFOPX = ""
For Z = PS To Len(T)
Select Case Mid(T, Z, 1)
Case """": If ZTIV = 0 Then ZTIV = 1 Else ZTIV = 0
Case "=", "<", ">"
If ZTIV = 0 Then
IFOPX = IFOPX & Mid(T, Z, 1)
If P1 = "" Then P1 = C4S_Trim(Mid(T, PS, Z - PS))
PS = Z + 1
End If
Case Else: If IFOPX <> "" Then Exit For
End Select
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
For Z = PS To Len(T)
Select Case Mid(T, Z, 1)
Case """": If ZTIV = 0 Then ZTIV = 1 Else ZTIV = 0
Case Else
If ZTIV = 0 Then
If LCase(Mid(T, Z, 5)) = " then" Then
P2 = C4S_Trim(Mid(T, PS, Z - PS))
PE = C4S_Trim(Mid(T, Z + 5))
Exit For
End If
End If
End Select
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
P1 = C4S_Do_Sub_Line(V_FPN, V_SID, P1, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
P2 = C4S_Do_Sub_Line(V_FPN, V_SID, P2, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
IFIN = 1
PrCS = 1
IfOK = 0
Select Case IFOPX
Case "=": If P1 = P2 Then IfOK = 1
Case "<": If val(P1) < val(P2) Then IfOK = 1
Case ">": If val(P1) > val(P2) Then IfOK = 1
Case "=<", "<=": If val(P1) <= val(P2) Then IfOK = 1
Case "=>", ">=": If val(P1) >= val(P2) Then IfOK = 1
Case "<>": If P1 <> P2 Then IfOK = 1
End Select
If IfOK = 1 Then
IFIN = 3
If PE <> "" Then
IFID = PE & ":"
If IFID <> "" Then
XT = C4S_Read_Sub_Decode(V_FPN, V_SID, IFID, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
If V_LoopExit <> 0 Then Exit For
IFID = ""
IFIX = IFIX - 1
End If
IFIN = 0
End If
End If
Else: IFID = IFID & T & ":"
End If
ElseIf (LCase(Left(T, 7)) = "elseif " And (IFIX = 1)) And ((PrCS = 0) Or (PrCS = 1)) Then
If IFIN = 1 Then
PS = 7
P1 = ""
P2 = ""
PE = ""
IFOPX = ""
For Z = PS To Len(T)
Select Case Mid(T, Z, 1)
Case """": If ZTIV = 0 Then ZTIV = 1 Else ZTIV = 0
Case "=", "<", ">"
If ZTIV = 0 Then
IFOPX = IFOPX & Mid(T, Z, 1)
If P1 = "" Then P1 = C4S_Trim(Mid(T, PS, Z - PS))
PS = Z + 1
End If
Case Else: If IFOPX <> "" Then Exit For
End Select
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
For Z = PS To Len(T)
Select Case Mid(T, Z, 1)
Case """": If ZTIV = 0 Then ZTIV = 1 Else ZTIV = 0
Case Else
If ZTIV = 0 Then
If LCase(Mid(T, Z, 5)) = " then" Then
P2 = C4S_Trim(Mid(T, PS, Z - PS))
exit for
End If
End If
End Select
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
P1 = C4S_Do_Sub_Line(V_FPN, V_SID, P1, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
P2 = C4S_Do_Sub_Line(V_FPN, V_SID, P2, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
IFIN = 1
IfOK = 0
Select Case IFOPX
Case "=": If P1 = P2 Then IfOK = 1
Case "<": If val(P1) < val(P2) Then IfOK = 1
Case ">": If val(P1) > val(P2) Then IfOK = 1
Case "<=", "=<": If val(P1) <= val(P2) Then IfOK = 1
Case "=>", ">=": If val(P1) >= val(P2) Then IfOK = 1
Case "<>": If P1 <> P2 Then IfOK = 1
End Select
If IfOK = 1 Then IFIN = 3
Else: IFIN = 4
End If
ElseIf ((LCase(Left(T, 4)) = "else") And (Len(T) = 4) And (IFIX = 1)) And ((PrCS = 0) Or (PrCS = 1)) Then
If IFIN = 1 Then
IFID = ""
IFIN = 3
Else: IFIN = 4
End If
ElseIf (((LCase(Left(T, 6)) = "end if") Or (LCase(Left(T, 5)) = "endif"))) And ((PrCS = 0) Or (PrCS = 1)) Then
If IFIX = 1 Then
If IFID <> "" Then
XT = C4S_Read_Sub_Decode(V_FPN, V_SID, IFID, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
If V_LoopExit <> 0 Then Exit For
IFID = ""
End If
IFIN = 0
Else: IFID = IFID & T & ":"
End If
IFIX = IFIX - 1
ElseIf ((LCase(Left(T, 2)) = "do") And (Len(T) = 2)) And (PrCS = 0) Then
DoX = DoX + 1
If DoX = 1 Then PrCS = 2
ElseIf ((LCase(Left(T, 4)) = "loop") And (Len(T) = 4)) And ((PrCS = 2) Or (PrCS = 1)) Then
If DoX = 1 Then
If PrCD <> "" Then
V_LoopExit = 0
Do
BVV = C4S_Read_Sub_Decode(V_FPN, V_SID, PrCD, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
If V_LoopExit <> 0 Then Exit Do
If ExOut = 1 Then Exit Do
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Exit Do
Loop
V_LoopExit = 0
PrCD = ""
End If
End If
PrCS = 0
DoX = DoX - 1
ElseIf PrCS = 1 Then
If IFIN = 3 Then
IFID = IFID & T & ":"
ElseIf IFIN = 0 Then
If IFIX = 0 Then
BVV = C4S_Do_Sub_Line(V_FPN, V_SID, T, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
If V_LoopExit <> 0 Then Return BVV
End If
End If
Else
If PrCS > 0 Then
PrCD = PrCD & T & ":"
Else
If IFIN = 0 Then
BVV = C4S_Do_Sub_Line(V_FPN, V_SID, T, V_VD(), V_VC, BV_VarD(), BV_VarC, V_LoopExit)
End If
If V_LoopExit <> 0 Then Return BVV
End If
End If
If IFIX < 0 Then IFIX = 0
If DoX < 0 Then DoX = 0
Y = X + 1
End If
End Select
If ExOut = 1 Then Return ""
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
Return V_Line
End Function
Function C4S_Do_Sub_Line(ByRef V_FPN As String, ByRef V_SID As Long, ByRef V_Line As String, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long, ByRef V_LoopExit As Long) As String
Dim X As Long
Dim Y As Long
Dim XDest As String
Dim XSource As String
Dim XVB As Long
Dim BV As String
For X = 1 To Len(V_Line)
Select Case Mid(V_Line, X, 1)
Case " "
If XDest = "" Then XDest = C4S_Trim(Mid(V_Line, 1, X))
Case "=": If XVB = 0 Then XVB = 1
Case Else
If XDest <> "" Then
XSource = C4S_Trim(Mid(V_Line, X))
BV = C4S_Do_Sub_Block(V_FPN, XSource, V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC)
If XVB = 0 Then
Select Case LCase(XDest)
Case "return": V_LoopExit = 1: Return BV
Case "echo": F_Print G_Echo & BV
case "print": F_PrintOut BV
Case "dim"
BV_VarC = BV_VarC + 1
ReDim Preserve BV_VarD(BV_VarC) As Var_Type
With BV_VarD(BV_VarC)
.V_Name = LCase(BV)
.V_Value = ""
End With
Case "global"
BV = Lcase(BV)
If C4S_Var_Exist(BV) = 0 then C4S_Var_Add BV, ""
Case "#include": XVB = C4S_Read_File(BV)
Case "beep": Beep
Case "exit"
Select Case LCase(BV)
case "do": V_LoopExit = 1
case else: ExOut = 1
End Select
End Select
Else
XDest = LCase(XDest)
For Y = 1 To BV_VarC
If BV_VarD(Y).V_Name = XDest Then
BV_VarD(Y).V_Value = BV
Return ""
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If C4S_Var_Exist(XDest) > 0 then C4S_Var_Set XDest, BV
End If
Return ""
End If
End Select
If ExOut = 1 Then Return ""
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
Return C4S_Do_Sub_Block_Exec(V_FPN, V_Line, V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC)
End Function
Function C4S_Do_Sub_Block(ByRef V_FPN As String, ByRef V_Line As String, ByRef V_SID As Long, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long) As String
Dim X As Long
Dim Y As Long
Dim TIV As Long
Dim LC As String
Dim KGUV As Long
Dim BV As String
Dim LLC As String
Dim LLX As Long
Dim XFu As String
Dim DD() As String
Dim DC As Long
Dim Z As Long
Dim D As String
Dim SID As Long
Dim ED As String
Dim BVI As Long
Dim T As String
X = 0
LLX = 0
Do
X = X + 1
If X > Len(V_Line) Then Exit Do
Select Case Mid(V_Line, X, 1)
Case " "
Case """": If TIV = 0 Then TIV = 1 Else TIV = 0
Case "("
If TIV = 0 Then
LLC = C4S_Trim(LC)
BV = C4S_Do_Sub_Block(V_FPN, Mid(V_Line, X + 1), V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC)
Select Case C4S_Trim(LLC)
Case "&", "+", "-", "/", "\", "*", "^", "": V_Line = Mid(V_Line, 1, X - 1) & BV
Case Else: V_Line = Mid(V_Line, 1, X) & BV
End Select
Y = X + 1
End If
Case ")"
If (TIV = 0) And (Y > 0) Then
Select Case C4S_Trim(LLC)
Case "&", "+", "-", "/", "\", "*", "^", ""
BV = C4S_Do_Sub_Block_Exec(V_FPN, Mid(V_Line, Y - 1, X - Y + 1), V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC)
V_Line = Mid(V_Line, 1, Y - 2) & BV & Mid(V_Line, X + 1)
X = Y - 1
Case Else
If LLX = 0 Then LLX = 1
XFu = LCase(C4S_Trim(Mid(V_Line, LLX, Y - LLX - 1)))
For Z = 1 To G_SubC
If G_SubD(Z).V_Name = XFu Then
SID = Z
Exit For
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
C4S_SplitParam Mid(V_Line, Y, X - Y), DD(), DC
If SID > 0 Then
If G_SubD(SID).V_ValC = DC Then
D = ""
For Z = 1 To DC
T = C4S_Do_Sub_Block(V_FPN, DD(Z), V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC)
If Val(T) <> 0 Then
D = D & T & ","
Else: D = D & """" & T & ""","
End If
If ExOut = 1 Then Return ""
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If Right(D, 1) = "," Then D = Left(D, Len(D) - 1)
BV = C4S_Do_Sub(V_FPN, 0, XFu, D)
T = Mid(V_Line, 1, LLX - 1) & """" & BV & """" & Mid(V_Line, X + 1)
V_Line = T
X = LLX - 1
LLX = 0
Else: F_ErrAdd V_FPN, -1, -10, XFu
End If
Else
BVI = C4S_InterFunc(V_FPN, XFu, Mid(V_Line, Y, X - Y), BV)
If BVI = 0 Then
D = ""
For Z = 1 To DC
D = D & C4S_Do_Sub_Block(V_FPN, DD(Z), V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC) & ","
If ExOut = 1 Then Return ""
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If Right(D, 1) = "," Then D = Left(D, Len(D) - 1)
V_Line = Mid(V_Line, 1, LLX - 1) & BV & Mid(V_Line, X + 1)
X = LLX - 1
Else: F_ErrAdd V_FPN, -1, BVI, XFu
End If
End If
End Select
Y = 0
End If
Case "&", "+", "-", "/", "\", "*", "^"
If TIV = 0 Then
LC = Mid(V_Line, X, 1)
LLX = 0
End If
Case Else
If TIV = 0 Then
LC = Mid(V_Line, X, 1)
If LLX = 0 Then LLX = X
End If
End Select
If ExOut = 1 Then Return ""
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Loop
Return C4S_Do_Sub_Block_Exec(V_FPN, V_Line, V_SID, V_VD(), V_VC, BV_VarD(), BV_VarC)
End Function
Function C4S_Do_Sub_Block_Exec(ByRef V_FPN As String, ByRef V_Line As String, ByRef V_SID As Long, V_VD() As String, ByRef V_VC As Long, BV_VarD() As Var_Type, ByRef BV_VarC As Long) As String
Dim X As Long
Dim Y As Long
Dim T1 As String
Dim T2 As String
Dim BV As String
Dim DD() As String
Dim DC As Long
Dim TIV As Long
Dim XS As String
Dim ROK As Long
Dim D As String
D = V_Line
DC = 0
For X = 1 To Len(D)
T1 = ""
T2 = ""
If X > Len(D) Then Exit For
Select Case Mid(D, X, 1)
Case """": If TIV = 0 Then TIV = 1 Else TIV = 0
Case "&", "+", "-", "/", "\", "*", "^"
If TIV = 0 Then
T1 = Mid(D, 1, X - 1)
T2 = Mid(D, X, 1)
D = C4S_Trim(Mid(D, X + 1))
X = 0
End If
End Select
If (T1 <> "") And (T2 <> "") Then
DC = DC + 2
ReDim Preserve DD(DC) As String
DD(DC - 1) = C4S_Trim(T1)
DD(DC) = C4S_Trim(T2)
T1 = ""
T2 = ""
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If D <> "" Then
DC = DC + 1
ReDim Preserve DD(DC) As String
DD(DC) = C4S_Trim(D)
Else: Return ""
End If
Dim DOC As Long
DOC = 1
For X = 1 To DC
Select Case Left(DD(X), 1)
Case ")", "(": DOC = 0
End Select
Select Case Right(DD(X), 1)
Case ")", "(": DOC = 0
End Select
If DOC = 0 Then Exit For
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If DOC = 0 Then
For X = 2 To DC
DD(1) = DD(1) & " " & DD(X)
Next
Return DD(1)
End If
For X = 1 To DC
If (Left(DD(X), 1) <> """") Or (Right(DD(X), 1) <> """") Then
ROK = 0
Select Case DD(X)
Case "+", "-", "*", "/", "\", "^", "&"
Case Else
XS = LCase(DD(X))
For Y = 1 To BV_VarC
If XS = LCase(BV_VarD(Y).V_Name) Then
DD(X) = BV_VarD(Y).V_Value
ROK = 1
Exit For
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If ROK = 0 Then
If V_SID > 0 Then
With G_SubD(V_SID)
For Y = 1 To .V_ValC
If XS = LCase(.V_ValD(Y).V_Name) Then
If .V_ValD(Y).V_ByRef = 0 Then
If V_VC >= Y Then
DD(X) = V_VD(Y)
If (Left(DD(X), 1) = """") And (Right(DD(X), 1) = """") Then DD(X) = Mid(DD(X), 2, Len(DD(X)) - 2)
End If
Else: DD(X) = str(Y)
End If
ROK = 1
Exit For
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
End With
End If
End If
If ROK = 0 Then
XS = LCase(DD(X))
For Y = 1 To G_VarC
If XS = LCase(G_VarD(Y).V_Name) Then
DD(X) = G_VarD(Y).V_Value
ROK = 1
Exit For
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
End If
If ROK = 0 Then
ROK = C4S_InterFunc(V_FPN, DD(X), "", XS)
If ROK = 0 Then DD(X) = XS: ROK = 1
End If
If (ROK = 0) And (DC > 1) Then F_ErrAdd V_FPN, -1, -13, DD(X)
End Select
Else: DD(X) = Mid(DD(X), 2, Len(DD(X)) - 2)
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Next
If DC > 2 Then
C4S_Calc "^", DD(), DC
C4S_Calc "*", DD(), DC
C4S_Calc "\", DD(), DC
C4S_Calc "/", DD(), DC
C4S_Calc "-", DD(), DC
C4S_Calc "+", DD(), DC
C4S_Calc "&", DD(), DC
End If
Return DD(1)
End Function
Sub C4S_Calc(ByRef V_OP As String, V_DD() As String, V_DC As Long)
Dim X As Long
Dim Y As Long
Dim BV As String
Dim V1 As String
Dim V2 As String
Dim V1X As Long
For X = 1 To V_DC
V1 = ""
V2 = ""
Select Case V_DD(X)
Case V_OP
V1X = 0
For Y = X - 1 To 1 Step -1
Select Case V_DD(Y)
Case ""
Case "+", "-", "*", "/", "\", "^", "&"
Case Else
V1 = V_DD(Y)
V1X = Y
Exit For
End Select
Next
If V1X = 0 then V1X = 1
For Y = X + 1 To V_DC
Select Case V_DD(Y)
Case ""
Case "+", "-", "*", "/", "\", "^", "&"
Case Else
V2 = V_DD(Y)
V_DD(Y) = ""
Exit For
End Select
Next
If ((Val(V1) <> 0) or (V1 = "0")) And ((Val(V2) <> 0) or (V2 = "0")) Then
BV = ""
Select Case V_OP
Case "+": BV = str(Val(V1) + Val(V2))
Case "-": BV = str(Val(V1) - Val(V2))
Case "*": BV = str(Val(V1) * Val(V2))
Case "/": BV = str(Val(V1) / Val(V2))
Case "\": BV = str(Val(V1) \ Val(V2))
Case "^": BV = str(Val(V1) ^ Val(V2))
Case "&": BV = V1 & V2
End Select
V_DD(V1X) = BV
Else
BV = ""
Select Case V_OP
Case "&": BV = V1 & V2
End Select
V_DD(V1X) = BV
End If
End Select
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Exit Sub
Next
End Sub
Function C4S_InterFunc(ByRef V_FPN As String, ByRef V_Func As String, ByRef V_Data As String, ByRef B_Data As String) As Long
Dim BV As String
Dim OV As String
Dim DD() As String
Dim DC As Long
Dim X As Long
C4S_SplitParam V_Data, DD(), DC
For X = 1 To DC
If Left(DD(X), 1) = """" And Right(DD(X), 1) = """" Then DD(X) = Mid(DD(X), 2, Len(DD(X)) - 2)
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return -15
Next
If DC > 0 Then BV = DD(1)
Select Case LCase(V_Func)
Case "abs": OV = str(Abs(Val(BV)))
Case "asc": OV = str(Asc(BV))
Case "abs": OV = str(Abs(Val(BV)))
Case "abs": OV = str(Abs(Val(BV)))
Case "atn": OV = str(Atn(Val(BV)))
Case "cbyte": OV = str(CByte(Val(BV)))
Case "clng": OV = str(CLng(Val(BV)))
Case "cint": OV = str(CInt(Val(BV)))
Case "cdbl": OV = str(CDbl(Val(BV)))
Case "csng": OV = str(CSng(Val(BV)))
Case "chr": OV = Chr(Val(BV))
Case "__command": OV = G_Command
Case "cos": OV = str(Cos(Val(BV)))
Case "date": OV = Str(Date)
Case "dir"
Select Case DC
Case 1: OV = Dir(BV)
Case 2: OV = Dir(BV, Val(DD(2)))
Case Else: OV = Dir("")
End Select
Case "fix": OV = Str(Fix(Val(BV)))
Case "filelen": OV = Str(FileLen(BV))
Case "freefile": OV = Str(FreeFile)
Case "format"
Select Case DC
Case 2: OV = Format(val(DD(1)), DD(2))
Case Else: F_ErrAdd V_FPN, -1, -10, LCase(V_Func)
End Select
Case "hex": OV = Hex(Val(BV))
Case "__ipa": OV = G_IPA
Case "len": OV = str(Len(BV))
Case "ltrim": OV = LTrim(BV)
Case "left"
Select Case DC
Case 2: OV = Left(DD(1), Val(DD(2)))
Case Else: F_ErrAdd V_FPN, -1, -10, LCase(V_Func)
End Select
Case "mid"
Select Case DC
Case 2: OV = Mid(DD(1), Val(DD(2)))
Case 3: OV = Mid(DD(1), Val(DD(2)), Val(DD(3)))
Case Else: F_ErrAdd V_FPN, -1, -10, LCase(V_Func)
End Select
Case "now": OV = Str(Now)
Case "oct": OV = Oct(Val(BV))
Case "__port": OV = G_Port
Case "__request": OV = G_Request
Case "__request_type": OV = G_RequestType
Case "rtrim": OV = RTrim(BV)
Case "randomize": Randomize Val(BV)
Case "right"
Select Case DC
Case 2: OV = Right(DD(1), Val(DD(2)))
Case Else: F_ErrAdd V_FPN, -1, -10, LCase(V_Func)
End Select
Case "sin": OV = str(Sin(Val(BV)))
Case "tan": OV = str(Tan(Val(BV)))
Case "time": OV = Str(Time)
Case "timer": OV = Str(Timer)
Case "trim": OV = Trim(BV)
Case "val": OV = str(Val(BV))
Case Else: Return -8
End Select
B_Data = OV
return 0
End Function
Function C4S_Sub_Add(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_Name As String, ByRef V_Var As String, ByRef V_Code As String) As Long
Dim X As Long
Dim XPos As Long
Dim DD() As String
Dim DC As Long
Dim T1 As String
Dim T2 As String
T1 = LCase(V_Name)
For X = 1 To G_SubC
If G_SubD(X).V_Name = T1 Then F_ErrAdd V_FPN, V_LID, -9: Return -9
Next
G_SubC = G_SubC + 1
ReDim Preserve G_SubD(G_SubC) As Sub_Type
With G_SubD(G_SubC)
.V_Name = T1
.V_FromFile = V_FPN
.V_FromLine = V_LID
.V_Code = V_Code
If Right(.V_Code, 1) <> ":" Then .V_Code = .V_Code & ":"
F_SplitString V_Var, DD(), DC, ",", 1, 1, 1
For X = 1 To DC
T1 = C4S_Trim(DD(X))
If T1 <> "" Then
XPos = InStr(1, T1, " ")
If XPos > 0 Then
T2 = C4S_Trim(Mid(T1, 1, XPos - 1))
T1 = C4S_Trim(Mid(T1, XPos + 1))
Else: T2 = ""
End If
If T1 <> "" Then
If .V_ValC < 255 Then
.V_ValC = .V_ValC + 1
With .V_ValD(.V_ValC)
.V_Name = T1
Select Case LCase(T2)
Case "byval", "": .V_ByRef = 0
Case "byref": .V_ByRef = 1
Case Else: F_ErrAdd V_FPN, V_LID, -6, T2: Return -6
End Select
End With
Else: F_ErrAdd V_FPN, V_LID, -5: Return -5
End If
End If
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return -15
Next
End With
Return G_SubC
End Function
Function C4S_Var_Add(ByRef V_Name As String, ByRef V_Value As String) As Long
G_VarC = G_VarC + 1
ReDim Preserve G_VarD(G_VarC) As Var_Type
With G_VarD(G_VarC)
.V_Name = LCase(V_Name)
.V_Value = V_Value
End With
Return G_VarC
End Function
Function C4S_Var_Get(ByRef V_Name As String, ByRef B_Value As String) As Long
Dim X As Long
Dim S As String
S = LCase(V_Name)
For X = 1 To G_VarC
If G_VarD(X).V_Name = S Then B_Value = G_VarD(X).V_Value: Return X
Next
Return 0
End Function
Function C4S_Var_Set(ByRef V_Name As String, ByRef V_Value As String) As Long
Dim X As Long
Dim S As String
S = LCase(V_Name)
For X = 1 To G_VarC
If G_VarD(X).V_Name = S Then G_VarD(X).V_Value = V_Value: Return X
Next
Return 0
End Function
Function C4S_Var_Exist(ByRef V_Name As String) As Long
Dim X As Long
Dim S As String
S = LCase(V_Name)
For X = 1 To G_VarC
If G_VarD(X).V_Name = S Then Return X
Next
Return 0
End Function
Sub F_SplitString(V_Data As String, B_DD() As String, ByRef B_DC As Long, V_CutString As String, V_ClearArray As Byte, V_Casesensitivity As Byte, V_AddEmpty As Byte)
If V_ClearArray = 1 Then B_DC = 0
ReDim Preserve B_DD(B_DC) As String
Dim X As Long
Dim Pos1 As Long
Dim Pos2 As Long
Dim SLen As Long
Dim T As String
Dim S As String
Dim XOK As Byte
S = V_CutString
If V_Casesensitivity = 0 Then S = LCase(V_CutString)
SLen = Len(S)
Pos1 = 1
Pos2 = 1
For X = 1 To Len(V_Data) - SLen
If V_Casesensitivity = 0 Then
If LCase(Mid(V_Data, X, SLen)) = S Then
T = Mid(V_Data, Pos1, X - Pos1 + SLen - 1)
X = X + SLen - 1
Pos1 = X + 1
End If
Else
If Mid(V_Data, X, SLen) = V_CutString Then
T = Mid(V_Data, Pos1, X - Pos1 + SLen - 1)
X = X + SLen
Pos1 = X
End If
End If
If Pos1 <> Pos2 Or X = Len(V_Data) - SLen Then
If Pos1 = Pos2 Then T = Mid(V_Data, Pos1)
XOK = 1
If T = "" Then If V_AddEmpty = 0 Then XOK = 0
If XOK = 1 Then
B_DC = B_DC + 1
ReDim Preserve B_DD(B_DC) As String
B_DD(B_DC) = T
End If
Pos2 = Pos1
End If
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Exit Sub
Next
End Sub
Sub F_Print(ByRef V_Text As String)
Print V_Text
End Sub
Sub F_PrintOut(ByRef V_Text As String)
if G_LocalExec = 0 then Print #G_FOFN, Lof(G_FOFN), V_Text
End Sub
Sub F_ErrAdd(ByRef V_FPN As String, ByRef V_LID As Long, ByRef V_EC As Long, V_AddInfo As String = "")
Dim T as string
T = "[" & V_FPN & "]__[" & V_LID & "](" & V_EC & ") " & F_ErrCodeDesc(V_EC, V_AddInfo)
If G_LocalExec = 0 then
Print #G_FOEFN, Lof(G_FOEFN), T
Else: Print T
End If
End Sub
Function F_ErrCodeDesc(ByRef V_ErrCode As Long, V_AddInfo As String = "") As String
Dim D As String
Select Case V_ErrCode
Case Is > 0
Case 0: D = "Keine Fehler!"
Case -1: D = "'End Sub' vor 'Sub()' gefunden."
Case -2: D = "'Sub()' ohne 'End Sub'."
Case -3: D = "Fehlendes '(' in Sub-Deklaration."
Case -4: D = "Fehlendes ')' in Sub-Deklaration."
Case -5: D = "'Sub()' Parameter hat maximalanzahl überschritten (255)."
Case -6: D = "'Sub()' ByVal / ByRef Definitionsangabe unbekannt. [" & V_AddInfo & "]"
Case -7: D = "Keine 'Sub Main()' gefunden."
Case -8: D = "Sub() nicht gefunden. [" & V_AddInfo & "]"
Case -9: D = "Sub() existiert bereits. [" & V_AddInfo & "]"
Case -10: D = "Anzahl übergebener Parameter stimmt mit Sub()-Deklaration nicht überein. [" & V_AddInfo & "]"
Case -11: D = "'End If' in 'If' nicht gefunden."
Case -12: D = "'End If' ohne 'If' gefunden."
Case -13: D = "Variable oder 'Sub()' nicht gefunden. [" & V_AddInfo & "]"
Case -14: D = "Unzureichende Parameter für Operationsvorgang."
Case -15: D = "Zeitüberschreitung der Abarbeitungszeit"
End Select
Return D
End Function
Sub C4S_SplitParam(ByRef V_Data As String, B_DD() As String, ByRef B_DC As Long)
B_DC = 0
ReDim Preserve B_DD(B_DC) As String
Dim X As Long
Dim TIV As Long
Dim KIV As Long
Dim D As String
Dim XOP As Long
D = V_Data
For X = 1 To Len(D)
Select Case Mid(D, X, 1)
Case """": If TIV = 0 Then TIV = 1 Else TIV = 0
Case "(": If TIV = 0 Then KIV = KIV + 1
Case ")": If TIV = 0 Then KIV = KIV - 1
Case ","
If KIV <= 0 Then
If B_DC < 255 Then
XOP = 1
B_DC = B_DC + 1
ReDim Preserve B_DD(B_DC) As String
B_DD(B_DC) = Mid(D, 1, X - 1)
D = Mid(D, X + 1)
X = 0
End If
End If
End Select
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Exit sub
Next
If Len(D) > 0 Or XOP = 0 Then
If B_DC < 255 Then
B_DC = B_DC + 1
ReDim Preserve B_DD(B_DC) As String
B_DD(B_DC) = D
End If
End If
End Sub
Function C4S_Trim(ByRef V_Data As String) as String
Dim X as Long
Do
X = 0
If asc(Left(V_Data, 1)) = 9 then V_Data = Mid(V_Data, 2): X = 1
If asc(Right(V_Data, 1)) = 9 then V_Data = Mid(V_Data, 1, Len(V_Data) - 1): X = 1
If asc(Left(V_Data, 1)) = 32 then V_Data = Mid(V_Data, 2): X = 1
If asc(Right(V_Data, 1)) = 32 then V_Data = Mid(V_Data, 1, Len(V_Data) - 1): X = 1
If (X = 0) or (Len(V_Data) = 0) then Exit do
If G_ExecTimeOut > 0 then If ExecTimeOut < Timer then Return ""
Loop
Return V_Data
End Function