Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
zlscript_zusatzfunctionen.bi
| Uploader: |  XOR |
| Datum/Zeit: | 06.01.2011 02:58:55 |
Function GetNumArgumente(ByVal Text As String)As UInteger
Dim Hohe As UInteger
Dim Arg As UInteger
Dim Zeichen As String
Dim inStri As Byte
If Text = "" Then Return 0
For i As UInteger = 1 To Len(Text)
If Mid(Text,i,1)=Chr(34) Then inStri = not(inStri)
If inStri = 0 then
Select Case Mid(Text,i,1)
Case "("
Hohe+=1
Case ")"
Hohe-=1
Case ","
If Hohe = 0 Then
Arg+=1
EndIf
End Select
EndIf
Next
Arg+=1
Return Arg
End Function
Function GetArgument(ByVal Text As String, ByVal Num As UInteger)As String
Dim Hohe As UInteger
Dim Arg As UInteger
Dim Zeichen As String
Dim Last As UInteger
Dim inStri As Byte
For i As UInteger = 1 To Len(Text)
If Mid(Text,i,1)=Chr(34) Then inStri = not(inStri)
If inStri = 0 Then
Select Case Mid(Text,i,1)
Case "("
Hohe+=1
Case ")"
Hohe-=1
Case ","
If Hohe = 0 Then
Arg+=1
If Arg = Num Then Return Mid(Text,Last+1,i-Last-1)
Last = i
EndIf
End Select
EndIf
Next
If Arg+1 = Num Then
Return Mid(Text,Last+1)
EndIf
Return""
End Function
Sub NewVari(ByVal pBefehl As TBefehl Ptr, ByVal VariType As UInteger, ByVal BeArg As String, ByVal NumArg As UInteger)
Dim Vari As TVari Ptr
Dim Varis1 As TScriptVaris Ptr
Dim Arg As String
pBefehl->Befehl = VariType
pBefehl->numArgumente = NumArg
If memres(@pBefehl->pArgument,Len(TArgument)) = 0 Then Exit Sub
numVaris += NumArg
If memrel(@Varis,Len(TScriptVaris)*numVaris) = 0 Then Exit Sub
Varis1 = Varis
For i As Integer = 0 To NumArg-1
Arg = GetArgument(BeArg,i+1)
pBefehl->pArgument[i].Was = VariType
Vari = Allocate(Len(TVari))
memres(@Varis1[numVaris-i-1].VariName,Len(Arg))
*Varis1[numVaris-i-1].VariName = Arg
Varis1[numVaris-i-1].VariType = VariType
Varis1[numVaris-i-1].VariZeiger = Vari
pBefehl->pArgument[i].Zeiger = Vari
Next
End Sub
Function SucheVariType(ByVal VariName As String) As UInteger
For i As UInteger = 0 To NumVaris-1
If LCase(*(Varis[i].VariName)) = lcase(VariName) Then
Return Varis[i].VariType
EndIf
Next
Return 0
End Function
Function SucheVariZeiger(ByVal VariName As String) As Any Ptr
For i As UInteger = 0 To NumVaris-1
If LCase(*(Varis[i].VariName)) = lcase(VariName) Then
Return Varis[i].VariZeiger
EndIf
Next
Return 0
End Function
Sub SetZahl(ByVal pVari As TArgument Ptr,ByVal VariNew As Double)
Select Case pVari->Was
Case _Byte
*Cast(Byte Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case _UByte
*Cast(UByte Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case _Short
*Cast(Short Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case _UShort
*Cast(UShort Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case _Integer
*Cast(Integer Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case _UInteger
*Cast(UInteger Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case _Single
*Cast(Single Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case Else
Print "SetZahl Error"
End Select
End Sub
Sub SetString(ByVal pVari As TArgument Ptr,ByVal VariNew As String)
Select Case pVari->Was
Case _String
memres(@Cast(ZString Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger),Len(VariNew)+1)
*Cast(ZString Ptr,Cast(TVari Ptr,pVari->Zeiger)->Zeiger) = VariNew
Case Else
Print "SetString Error"
End Select
End Sub
Function memsame(ByVal Zeiger1 As Any Ptr, ByVal Zeiger2 As Any Ptr, ByVal Leng As UInteger) As Byte
If Leng = 0 Or Zeiger1 = 0 Or Zeiger2 = 0 Then Return 0
For i As UInteger = 0 To Leng-1
If Cast(UByte Ptr,Zeiger1)[i] <> Cast(UByte Ptr,Zeiger2)[i] Then Return 0
Next
Return 1
End Function
Sub memcpy(ByVal Zeiger1 As Any Ptr, ByVal Zeiger2 As Any Ptr, ByVal Leng As UInteger)
If Leng = 0 Or Zeiger1 = 0 Or Zeiger2 = 0 Then Exit Sub
For i As UInteger = 0 To Leng-1
Cast(UByte Ptr,Zeiger1)[i] = Cast(UByte Ptr,Zeiger2)[i]
Next
End Sub
Sub memset(ByVal Zeiger As Any Ptr, ByVal NewByte As UByte, ByVal Leng As UInteger)
If Leng = 0 Or Zeiger = 0 Then Exit Sub
For i As UInteger = 0 To Leng-1
Cast(UByte Ptr,Zeiger)[i] = NewByte
Next
End Sub
Function memres(ByVal Zeiger As Any Ptr Ptr, ByVal Leng As UInteger)As Byte
If Leng = 0 Then Return 0
If Zeiger = 0 Then Return 0
*Zeiger = Allocate(Leng)
If *Zeiger = 0 Then Return 0
memset(*Zeiger,0,Leng)
Return 1
End Function
Function memrel(ByVal Zeiger As Any Ptr Ptr, ByVal Leng As UInteger)As Byte
If Leng = 0 Then Return 0
If Zeiger = 0 Then Return 0
If *Zeiger = 0 Then
Return memres(Zeiger,Leng)
Else
Dim Zwischenablage As Any Ptr
Zwischenablage = ReAllocate(*Zeiger,Leng)
*Zeiger = Zwischenablage
If *Zeiger = 0 Then Return 0
EndIf
Return 1
End Function
Sub memfree(ByVal Zeiger As Any Ptr Ptr)
If Zeiger = 0 Then Exit Sub
If *Zeiger = 0 Then Exit Sub
DeAllocate(*Zeiger)
*Zeiger = 0
End Sub
Function between(ByVal Zeiger1 As UInteger, ByVal Zeiger2 As UInteger, ByVal Zeiger3 As UInteger)As Byte
If Zeiger1 >= Zeiger2 and Zeiger1 <= Zeiger3 Then Return -1
Return 0
End Function