Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
NetDB.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 21.10.2009 10:19:13 |
'##############################################################################################################
'##############################################################################################################
' NetDB - Network DataBase
'##############################################################################################################
'##############################################################################################################
' 2009 By.: /_\ DeltaLab's Germany - Experimental Computing
' Autor: Martin Wiemann
'##############################################################################################################
'######################################################################################################################################################
#Include once "vbcompat.bi"
'######################################################################################################################################################
Enum NETDB_Database_GURU
NETDB_GURU_Unknown = 0
NETDB_GURU_NoError = -1
NETDB_GURU_DBNotFound = -2
NETDB_GURU_HeaderNotFound = -3
NETDB_GURU_DataStreamSyntaxError = -4
NETDB_GURU_DBAlreadyExist = -5
NETDB_GURU_ElementNotFound = -6
End Enum
'######################################################################################################################################################
Enum NETDB_Database_Element_DataType
NETDB_EDT_Unknown = 0
NETDB_EDT_String = 1
NETDB_EDT_Numeric = 2
NETDB_EDT_Date = 3
End Enum
'######################################################################################################################################################
Type NETDB_Database_Element_DataHeader
V_Next as NETDB_Database_Element_DataHeader Ptr
V_Prev as NETDB_Database_Element_DataHeader Ptr
V_Type as NETDB_Database_Element_DataType
V_Name as String
T_Stored as UByte
End Type
'------------------------------------------------------------------------------------------------------------------------------------------------------
Type NETDB_Database_Element_Data
V_Next as NETDB_Database_Element_Data Ptr
V_Prev as NETDB_Database_Element_Data Ptr
V_Data as Any Ptr
T_Stored as UByte
End Type
'------------------------------------------------------------------------------------------------------------------------------------------------------
Type NETDB_Database_Element
V_Next as NETDB_Database_Element Ptr
V_Prev as NETDB_Database_Element Ptr
V_DataF as NETDB_Database_Element_Data Ptr
V_DataL as NETDB_Database_Element_Data Ptr
T_Stored as UByte
End Type
'------------------------------------------------------------------------------------------------------------------------------------------------------
Type NETDB_Database
V_Next as NETDB_Database Ptr
V_Prev as NETDB_Database Ptr
V_Name as String
V_Username as String
V_Password as String
V_Public as UByte
V_HeaderF as NETDB_Database_Element_DataHeader Ptr
V_HeaderL as NETDB_Database_Element_DataHeader Ptr
V_ElementF as NETDB_Database_Element Ptr
V_ElementL as NETDB_Database_Element Ptr
T_Stored as UByte
End Type
'------------------------------------------------------------------------------------------------------------------------------------------------------
Dim Shared NETDB_F as NETDB_Database Ptr
Dim Shared NETDB_L as NETDB_Database Ptr
Dim Shared NETDB_M as Any Ptr
'######################################################################################################################################################
Function NETDB_GetDBPtrByDBID(V_DBID as UInteger) as NETDB_Database Ptr
Dim TPtr as NETDB_Database Ptr = NETDB_F
Dim C as UInteger
Do Until TPtr = 0
C += 1
If C = V_DBID Then Return TPtr
Loop
Return 0
End Function
'######################################################################################################################################################
Function NETDB_GetDBIDByName(V_Name as String, V_Username as String, V_Password as String) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_F
Dim C as UInteger
Dim S as String = LCase(V_Username)
Do Until TPtr = 0
C += 1
If TPtr->V_Name = V_Name Then
If TPtr->V_Username = "" Then MutexUnLock(NETDB_M): Return C
If LCase(TPtr->V_Username) <> S Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
If TPtr->V_Password <> V_Password Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
MutexUnLock(NETDB_M)
Return C
End If
Loop
MutexUnLock(NETDB_M)
Return NETDB_GURU_DBNotFound
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_GetHeaderIDByName(V_DBID as UInteger, V_Name as String) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim HPtr as NETDB_Database_Element_DataHeader Ptr = TPtr->V_HeaderF
Dim C as UInteger
Do Until HPtr = 0
C += 1
If HPtr->V_Name = V_Name Then Return C
HPtr = HPtr->V_Next
Loop
MutexUnLock(NETDB_M)
Return NETDB_GURU_HeaderNotFound
End Function
'######################################################################################################################################################
Function NETDB_Add(V_Name as String, V_Username as String = "", V_Password as String = "", V_Public as UByte = 0) as Integer
Dim RV as Integer = NETDB_GetDBIDByName(V_Name, V_Username, V_Password)
If RV > 0 Then Return NETDB_GURU_DBAlreadyExist
MutexUnLock(NETDB_M)
If NETDB_L <> 0 Then
NETDB_L->V_Next = CAllocate(SizeOf(NETDB_Database))
NETDB_L->V_Next->V_Prev = NETDB_L
NETDB_L = NETDB_L->V_Next
Else
NETDB_L = CAllocate(SizeOf(NETDB_Database))
NETDB_F = NETDB_L
End If
With *NETDB_L
.V_Name = V_Name
.V_Username = V_Username
If V_Username <> "" Then .V_Password = V_Password
.V_Public = V_Public
End With
MutexUnLock(NETDB_M)
End Function
'######################################################################################################################################################
Function NETDB_Clear_All() as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_F
Dim TPtrN as NETDB_Database Ptr
Dim TTypeD() as NETDB_Database_Element_DataType
Dim C as UInteger
Dim TDPtr as UByte Ptr
Do Until TPtr = 0
TPtrN = TPtr->V_Next
With *TPtr
Do Until .V_HeaderF = 0
.V_HeaderL = .V_HeaderF->V_Next
C += 1
ReDim Preserve TTypeD(C) as NETDB_Database_Element_DataType
TTypeD(C) = .V_HeaderF->V_Type
DeAllocate(.V_HeaderF)
.V_HeaderF = .V_HeaderL
Loop
Do Until .V_ElementF = 0
.V_ElementL = .V_ElementF->V_Next
With *.V_ElementF
C = 0
Do Until .V_DataF = 0
C += 1
.V_DataL = .V_DataF->V_Next
If .V_DataF->V_Data <> 0 Then
Select Case TTypeD(C)
Case NETDB_EDT_String
If Cast(UInteger Ptr, .V_DataF->V_Data)[1] <> 0 Then DeAllocate(Cast(Any Ptr, Cast(UInteger Ptr, .V_DataF->V_Data)[1]))
DeAllocate(.V_DataF->V_Data)
Case NETDB_EDT_Numeric
Case NETDB_EDT_Date
DeAllocate(.V_DataF->V_Data)
End Select
.V_DataF->V_Data = 0
End If
DeAllocate(.V_DataF)
.V_DataF = .V_DataL
Loop
End With
DeAllocate(.V_ElementF)
.V_ElementF = .V_ElementL
Loop
End With
TPtr = TPtrN
Loop
MutexUnLock(NETDB_M)
Return -1
End Function
'######################################################################################################################################################
Function NETDB_Clear(V_DBID as UInteger) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim TTypeD() as NETDB_Database_Element_DataType
Dim C as UInteger
Dim TDPtr as UByte Ptr
With *TPtr
Do Until .V_HeaderF = 0
.V_HeaderL = .V_HeaderF->V_Next
C += 1
ReDim Preserve TTypeD(C) as NETDB_Database_Element_DataType
TTypeD(C) = .V_HeaderF->V_Type
DeAllocate(.V_HeaderF)
.V_HeaderF = .V_HeaderL
Loop
Do Until .V_ElementF = 0
.V_ElementL = .V_ElementF->V_Next
With *.V_ElementF
C = 0
Do Until .V_DataF = 0
C += 1
.V_DataL = .V_DataF->V_Next
If .V_DataF->V_Data <> 0 Then
Select Case TTypeD(C)
Case NETDB_EDT_String
If Cast(UInteger Ptr, .V_DataF->V_Data)[1] <> 0 Then DeAllocate(Cast(Any Ptr, Cast(UInteger Ptr, .V_DataF->V_Data)[1]))
DeAllocate(.V_DataF->V_Data)
Case NETDB_EDT_Numeric
Case NETDB_EDT_Date
DeAllocate(.V_DataF->V_Data)
End Select
.V_DataF->V_Data = 0
End If
DeAllocate(.V_DataF)
.V_DataF = .V_DataL
Loop
End With
DeAllocate(.V_ElementF)
.V_ElementF = .V_ElementL
Loop
End With
MutexUnLock(NETDB_M)
Return NETDB_GURU_NoError
End Function
'######################################################################################################################################################
Function NETDB_Header_Count(V_DBID as UInteger) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim HPtr as NETDB_Database_Element_DataHeader Ptr = TPtr->V_HeaderF
Dim C as UInteger
Do Until HPtr = 0
C += 1
HPtr = HPtr->V_Next
Loop
MutexUnLock(NETDB_M)
Return C
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_Header_Add(V_DBID as UInteger, V_HeaderName as String, V_HeaderType as NETDB_Database_Element_DataType) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
With *TPtr
If .V_HeaderL <> 0 Then
.V_HeaderL->V_Next = CAllocate(SizeOf(NETDB_Database_Element_DataHeader))
.V_HeaderL->V_Next->V_Prev = .V_HeaderL
.V_HeaderL = .V_HeaderL->V_Next
Else
.V_HeaderL = CAllocate(SizeOf(NETDB_Database_Element_DataHeader))
.V_HeaderF = .V_HeaderL
End If
With *.V_HeaderL
.V_Name = V_HeaderName
.V_Type = V_HeaderType
End With
End With
MutexUnLock(NETDB_M)
Return NETDB_GURU_NoError
End Function
'######################################################################################################################################################
Function NETDB_Data_Clear(V_DBID as UInteger) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim TTypeD() as NETDB_Database_Element_DataType
Dim HPtr as NETDB_Database_Element_DataHeader Ptr
Dim EPtr as NETDB_Database_Element Ptr
Dim C as UInteger
Dim TDPtr as UByte Ptr
With *TPtr
HPtr = .V_HeaderF
Do Until HPtr = 0
C += 1
ReDim Preserve TTypeD(C) as NETDB_Database_Element_DataType
TTypeD(C) = .V_HeaderF->V_Type
HPtr = HPtr->V_Next
Loop
EPtr = .V_ElementF
Do Until EPtr = 0
With *EPtr
C = 0
Do Until .V_DataF = 0
.V_DataL = .V_DataF->V_Next
C += 1
If .V_DataF->V_Data <> 0 Then
Select Case TTypeD(C)
Case NETDB_EDT_String
If Cast(UInteger Ptr, .V_DataF->V_Data)[1] <> 0 Then DeAllocate(Cast(Any Ptr, Cast(UInteger Ptr, .V_DataF->V_Data)[1]))
DeAllocate(.V_DataF->V_Data)
Case NETDB_EDT_Numeric
Case NETDB_EDT_Date
DeAllocate(.V_DataF->V_Data)
End Select
End If
DeAllocate(.V_DataF)
.V_DataF = .V_DataL
Loop
End With
EPtr = EPtr->V_Next
Loop
End With
MutexUnLock(NETDB_M)
Return NETDB_GURU_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_Data_Count(V_DBID as UInteger) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim EPtr as NETDB_Database_Element Ptr = TPtr->V_ElementF
Dim C as UInteger
Do Until EPtr = 0
C += 1
EPtr = EPtr->V_Next
Loop
MutexUnLock(NETDB_M)
Return C
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_Data_Del(V_DBID as UInteger, V_EntryID as UInteger) as Integer
Return 0
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_Data_Add(V_DBID as UInteger, V_DataD() as String, V_DataC as UInteger) as Integer
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim TTypeD(V_DataC) as NETDB_Database_Element_DataType
Dim HPtr as NETDB_Database_Element_DataHeader Ptr
Dim C as UInteger
Dim TDPtr as UByte Ptr
With *TPtr
HPtr = .V_HeaderF
Do Until HPtr = 0
C += 1
If C > V_DataC Then Return NETDB_GURU_DataStreamSyntaxError
TTypeD(C) = HPtr->V_Type
HPtr = HPtr->V_Next
Loop
If .V_ElementL <> 0 Then
.V_ElementL->V_Next = CAllocate(SizeOf(NETDB_Database_Element))
.V_ElementL->V_Next->V_Prev = .V_ElementL
.V_ElementL = .V_ElementL->V_Next
Else
.V_ElementL = CAllocate(SizeOf(NETDB_Database_Element))
.V_ElementF = .V_ElementL
End If
With *.V_ElementL
For X as UInteger = 1 to V_DataC
If .V_DataL <> 0 Then
.V_DataL->V_Next = CAllocate(SizeOf(NETDB_Database_Element_Data))
.V_DataL->V_Next->V_Prev = .V_DataL
.V_DataL = .V_DataL->V_Next
Else
.V_DataL = CAllocate(SizeOf(NETDB_Database_Element_Data))
.V_DataF = .V_DataL
End If
With *.V_DataL
Select Case TTypeD(X)
Case NETDB_EDT_String
.V_Data = CAllocate(8)
Cast(UInteger Ptr, .V_Data)[0] = Len(V_DataD(X))
Cast(UInteger Ptr, .V_Data)[1] = Cast(UInteger, CAllocate(Len(V_DataD(X))))
TDPtr = Cast(UByte Ptr, Cast(UInteger Ptr, .V_Data)[1])
For Y as UInteger = 1 to Len(V_DataD(X))
TDPtr[Y - 1] = V_DataD(X)[Y - 1]
Next
Case NETDB_EDT_Numeric
Cast(Integer, .V_Data) = ValInt(V_DataD(X))
Case NETDB_EDT_Date
.V_Data = CAllocate(8)
*Cast(Double Ptr, .V_Data) = DateSerial(ValUInt(Left(V_DataD(X), 4)), ValUInt(Mid(V_DataD(X), 6, 2)), ValUInt(Mid(V_DataD(X), 9, 2))) + TimeSerial(ValUInt(Mid(V_DataD(X), 12, 2)), ValUInt(Mid(V_DataD(X), 15, 2)), ValUInt(Mid(V_DataD(X), 18, 2)))
End Select
End With
Next
End With
End With
MutexUnLock(NETDB_M)
Return NETDB_GURU_NoError
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_Data_GetByIndex(V_DBID as UInteger, V_Index as UInteger, R_DataD() as String, ByRef R_DataC as UInteger) as Integer
If V_Index = 0 Then Return NETDB_GURU_ElementNotFound
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim EPtr as NETDB_Database_Element Ptr = TPtr->V_ElementF
Dim DPtr as NETDB_Database_Element_Data Ptr
Dim TTypeD() as NETDB_Database_Element_DataType
Dim HPtr as NETDB_Database_Element_DataHeader Ptr
Dim TC as UInteger
With *TPtr
HPtr = .V_HeaderF
Do Until HPtr = 0
TC += 1
Redim Preserve TTypeD(TC) as NETDB_Database_Element_DataType
TTypeD(TC) = HPtr->V_Type
HPtr = HPtr->V_Next
Loop
End With
If TC = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_NoError
ReDim Preserve R_DataD(R_DataC + TC) as String
Dim DX as UInteger
Dim C as UInteger
Dim XL as UInteger
Dim TDPtr as UByte Ptr
Do Until EPtr = 0
C += 1
If C = V_Index Then
DPtr = EPtr->V_DataF
TC = 0
Do Until DPtr = 0
TC += 1
If DPtr->V_Data <> 0 Then
Select Case TTypeD(TC)
Case NETDB_EDT_Numeric
R_DataD(R_DataC + TC) = Str(Cast(Integer, DPtr->V_Data))
Case NETDB_EDT_String
XL = Cast(UInteger Ptr, DPtr->V_Data)[0]
TDPtr = Cast(UByte Ptr, Cast(UInteger Ptr, DPtr->V_Data)[1])
R_DataD(R_DataC + TC) = Space(XL)
For X as UInteger = 1 to XL
R_DataD(R_DataC + TC)[X - 1] = TDPtr[X - 1]
Next
Case NETDB_EDT_Date
R_DataD(R_DataC + TC) = Format(*Cast(Double Ptr, DPtr->V_Data), "yyyy.mm.dd-hh:nn:ss")
End Select
End If
DPtr = DPtr->V_Next
Loop
R_DataC += TC
MutexUnLock(NETDB_M)
Return NETDB_GURU_NoError
End If
EPtr = EPtr->V_Next
Loop
MutexUnLock(NETDB_M)
Return NETDB_GURU_ElementNotFound
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_Data_DelByIndex(V_DBID as UInteger, V_Index as UInteger) as Integer
If V_Index = 0 Then Return NETDB_GURU_ElementNotFound
MutexLock(NETDB_M)
Dim TPtr as NETDB_Database Ptr = NETDB_GetDBPtrByDBID(V_DBID)
If TPtr = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_DBNotFound
Dim TTypeD() as NETDB_Database_Element_DataType
Dim HPtr as NETDB_Database_Element_DataHeader Ptr
Dim TC as UInteger
With *TPtr
HPtr = .V_HeaderF
Do Until HPtr = 0
TC += 1
Redim Preserve TTypeD(TC) as NETDB_Database_Element_DataType
TTypeD(TC) = HPtr->V_Type
HPtr = HPtr->V_Next
Loop
End With
If TC = 0 Then MutexUnLock(NETDB_M): Return NETDB_GURU_NoError
Dim EPtr as NETDB_Database_Element Ptr = TPtr->V_ElementF
Dim C as UInteger
Do Until EPtr = 0
C += 1
If C = V_Index Then
With *EPtr
C = 0
Do Until .V_DataF = 0
.V_DataL = .V_DataF->V_Next
C += 1
If .V_DataF->V_Data <> 0 Then
Select Case TTypeD(C)
Case NETDB_EDT_String
If Cast(UInteger Ptr, .V_DataF->V_Data)[1] <> 0 Then DeAllocate(Cast(Any Ptr, Cast(UInteger Ptr, .V_DataF->V_Data)[1]))
DeAllocate(.V_DataF->V_Data)
Case NETDB_EDT_Numeric
Case NETDB_EDT_Date
DeAllocate(.V_DataF->V_Data)
End Select
End If
DeAllocate(.V_DataF)
.V_DataF = .V_DataL
Loop
End With
If EPtr->V_Next <> 0 Then EPtr->V_Next->V_Prev = EPtr->V_Prev
If EPtr->V_Prev <> 0 Then EPtr->V_Prev->V_Next = EPtr->V_Next
If TPtr->V_ElementF = EPtr Then TPtr->V_ElementF = EPtr->V_Next
If TPtr->V_ElementL = EPtr Then TPtr->V_ElementL = EPtr->V_Prev
DeAllocate(EPtr)
MutexUnLock(NETDB_M)
Return NETDB_GURU_NoError
End If
EPtr = EPtr->V_Next
Loop
MutexUnLock(NETDB_M)
Return NETDB_GURU_ElementNotFound
End Function
'######################################################################################################################################################
Function NETDB_EncodeData(V_Data as String) as String
Dim Y as UInteger
For X as UInteger = 1 to Len(V_Data)
Select Case V_Data[X - 1]
Case 10, 13, 39, 47: Y += 1
End Select
Next
If Y = 0 Then Return V_Data
If Len(V_Data) < Y Then Return V_Data
Dim O as String = Space(Len(V_Data) + Y)
Y = 0
For X as UInteger = 1 to Len(O)
Y += 1
Select Case V_Data[X - 1]
Case 13: O[Y - 1] = 47: O[Y] = 99: Y += 1
Case 10: O[Y - 1] = 47: O[Y] = 108: Y += 1
Case 39: O[Y - 1] = 47: O[Y] = 34: Y += 1
Case 47: O[Y - 1] = 47: O[Y] = 47: Y += 1
Case Else: O[Y - 1] = V_Data[X - 1]
End Select
Next
Return O
End Function
'------------------------------------------------------------------------------------------------------------------------------------------------------
Function NETDB_DecodeData(V_Data as String) as String
Dim Y as UInteger
For X as UInteger = 1 to Len(V_Data)
Select Case V_Data[X - 1]
Case 47: Y += 1: X += 1
End Select
Next
If Y = 0 Then Return V_Data
If Len(V_Data) < Y Then Return V_Data
Dim O as String = Space(Len(V_Data) - Y)
Y = 0
For X as UInteger = 1 to Len(V_Data)
Y += 1
If V_Data[X - 1] = 47 Then
Select Case V_Data[X]
Case 99 : O[Y - 1] = 13
Case 108 : O[Y - 1] = 10
Case 34 : O[Y - 1] = 39
Case 47 : O[Y - 1] = 47
End Select
X += 1
Else: O[Y - 1] = V_Data[X - 1]
End If
Next
Return O
End Function
'######################################################################################################################################################
Function NETDB_DoCommandStream(ByRef RV_DataStream as String, R_ReturnDataD() as String, ByRef R_ReturnDataC as UInteger) as Integer
R_ReturnDataC = 0
'SpezialChrs
' "'" = /'
' "/" = //
' "CR" = /c
' "LF" = /l
Dim T as String = RV_DataStream
Dim T1 as String
Dim T2 as String
Dim BC as UByte
Dim CC as UByte
Dim DOK as UByte
Dim DNew as UByte = 1
Dim SDNew as UByte = 0
Dim MX as UInteger = Len(T)
Dim MY as UInteger
Dim XPos as UInteger = 1
Dim YPos as UInteger
Dim RV as Integer
Dim EPtr as NETDB_Database_Element Ptr
Dim DD() as String
Dim DC as UInteger
Dim DX as UInteger
Dim TDBCMD as UInteger '1 = headadd 2 = dataadd
Dim TDBID as Integer
Dim TDBN as String
Dim TDBAccUser as String
Dim TDBAccPass as String
Dim TDIndexF as UInteger
Dim TDIndexL as UInteger
For X as UInteger = 1 to MX
Select Case T[X - 1]
Case 39
If X > 1 Then
If T[X - 2] <> 47 Then If BC = 0 Then BC = 1 Else BC = 0
Else: If BC = 0 Then BC = 1 Else BC = 0
End If
Case 44: If BC = 0 Then T1 = Trim(Mid(T, XPos, X - XPos)): XPos = X + 1
Case 10: If (XPos + 1) < X Then T1 = Trim(Mid(T, XPos, X - XPos)): XPos = X + 1: SDNew = 1
Case 13: T[X - 1] = 32
End Select
If T1 <> "" Then
DOK = 0
MY = Len(T1)
CC = 0
For Y as UInteger = 1 to MY
Select Case T1[Y - 1]
Case 39
If Y > 1 Then
If T1[Y - 2] <> 47 Then If CC = 0 Then CC = 1 Else CC = 0
Else: If CC = 0 Then CC = 1 Else CC = 0
End If
Case 61
If CC = 0 Then
DNew = 1
T2 = Mid(T1, Y + 1)
T1 = Left(T1, Y - 1)
' Print "CMD >"; T1; "<___>"; T2; "<"
Select Case LCase(T1)
Case "db"
If Len(T2) >= 2 Then
If T2[0] = 39 Then T2 = Mid(T2, 2)
If T2[Len(T2) - 1] = 39 Then T2 = Left(T2, Len(T2) - 1)
End If
TDBN = T2
TDBAccUser = ""
TDBAccPass = ""
Case "acc"
If Len(T2) >= 2 Then
If T2[0] = 39 Then T2 = Mid(T2, 2)
If T2[Len(T2) - 1] = 39 Then T2 = Left(T2, Len(T2) - 1)
End If
YPos = InStr(1, T2, ":")
If YPos > 0 Then
TDBAccUser = Left(T2, YPos - 1)
TDBAccPass = Mid(T2, YPos + 1)
End If
Case "index"
If Len(T2) >= 2 Then
If T2[0] = 39 Then T2 = Mid(T2, 2)
If T2[Len(T2) - 1] = 39 Then T2 = Left(T2, Len(T2) - 1)
End If
YPos = InStr(1, T2, "-")
If YPos > 0 Then
TDIndexF = ValUInt(Left(T2, YPos - 1))
TDIndexL = ValUInt(Mid(T2, YPos + 1))
Else
TDIndexF = ValUInt(T2)
TDIndexL = TDIndexF
End If
Case "cmd"
If TDBN = "" Then Return NETDB_GURU_DataStreamSyntaxError
TDBID = NETDB_GetDBIDByName(TDBN, TDBAccUser, TDBAccPass)
If TDBID = 0 Then Return NETDB_GURU_DBNotFound
If (TDBID <= 0) and (TDBID <> NETDB_GURU_NoError) Then Return TDBID
RV = NETDB_GURU_NoError
Select Case LCase(T2)
Case "clearall": RV = NETDB_Clear(TDBID)
Case "headeradd": TDBCMD = 1
Case "getheadercount": R_ReturnDataC += 1: ReDim Preserve R_ReturnDataD(R_ReturnDataC) as String: R_ReturnDataD(R_ReturnDataC) = Str(NETDB_Header_Count(TDBID))
Case "dataadd": TDBCMD = 2
Case "dataclear": RV = NETDB_Data_Clear(TDBID)
Case "getdatacount": R_ReturnDataC += 1: ReDim Preserve R_ReturnDataD(R_ReturnDataC) as String: R_ReturnDataD(R_ReturnDataC) = Str(NETDB_Data_Count(TDBID))
Case "getdatabyindex"
For Z as UInteger = TDIndexF to TDIndexL
RV = NETDB_Data_GetByIndex(TDBID, Z, R_ReturnDataD(), R_ReturnDataC)
If RV = 0 Then Return NETDB_GURU_DBNotFound
If (RV <= 0) and (RV <> NETDB_GURU_NoError) Then Return RV
Next
Case "deldatabyindex"
For Z as UInteger = TDIndexL to TDIndexF Step -1
RV = NETDB_Data_DelByIndex(TDBID, Z)
If RV = 0 Then Return NETDB_GURU_DBNotFound
If (RV <= 0) and (RV <> NETDB_GURU_NoError) Then Return RV
Next
Case "export"
Case Else: Return NETDB_GURU_DataStreamSyntaxError
End Select
If RV = 0 Then Return NETDB_GURU_DBNotFound
If (RV <= 0) and (RV <> NETDB_GURU_NoError) Then Return RV
Case Else
If Len(T2) >= 2 Then
If T2[0] = 39 Then T2 = Mid(T2, 2)
If T2[Len(T2) - 1] = 39 Then T2 = Left(T2, Len(T2) - 1)
End If
If Len(T1) >= 2 Then
If T1[0] = 39 Then T1 = Mid(T1, 2)
If T1[Len(T1) - 1] = 39 Then T1 = Left(T1, Len(T1) - 1)
End If
Select Case TDBCMD
Case 1 'headeradd
If TDBN = "" Then Return NETDB_GURU_DataStreamSyntaxError
TDBID = NETDB_GetDBIDByName(TDBN, TDBAccUser, TDBAccPass)
If TDBID = 0 Then Return NETDB_GURU_DBNotFound
If (TDBID <= 0) and (TDBID <> NETDB_GURU_NoError) Then Return TDBID
Select Case LCase(T2)
Case "num", "numeric": RV = NETDB_Header_Add(TDBID, T1, NETDB_EDT_Numeric)
Case "str", "string": RV = NETDB_Header_Add(TDBID, T1, NETDB_EDT_String)
Case "date": RV = NETDB_Header_Add(TDBID, T1, NETDB_EDT_Date)
Case Else: Return NETDB_GURU_DataStreamSyntaxError
End Select
If RV = 0 Then Return NETDB_GURU_DBNotFound
If (RV <= 0) and (RV <> NETDB_GURU_NoError) Then Return RV
End Select
End Select
DOK = 1
Exit For
End If
End Select
Next
If DOK = 0 Then
Select Case TDBCMD
Case 2 'dataadd
If DNew = 1 Then
DNew = 0
If DC > 0 Then
If TDBN = "" Then Return NETDB_GURU_DataStreamSyntaxError
TDBID = NETDB_GetDBIDByName(TDBN, TDBAccUser, TDBAccPass)
If TDBID = 0 Then Return NETDB_GURU_DBNotFound
If (TDBID <= 0) and (TDBID <> NETDB_GURU_NoError) Then Return TDBID
NETDB_Data_Add(TDBID, DD(), DC)
End If
DC = 0
End If
If Len(T1) >= 2 Then
If T1[0] = 39 Then T1 = Mid(T1, 2)
If T1[Len(T1) - 1] = 39 Then T1 = Left(T1, Len(T1) - 1)
End If
DC += 1
If DX < DC Then
DX += 5
Redim Preserve DD(DX) as String
End If
DD(DC) = T1
End Select
End If
T1 = ""
If SDNew = 1 Then DNew = 1
SDNew = 0
End If
Next
If DC > 0 Then
If TDBN = "" Then Return NETDB_GURU_DataStreamSyntaxError
TDBID = NETDB_GetDBIDByName(TDBN, TDBAccUser, TDBAccPass)
If TDBID = 0 Then Return NETDB_GURU_DBNotFound
If (TDBID <= 0) and (TDBID <> NETDB_GURU_NoError) Then Return TDBID
NETDB_Data_Add(TDBID, DD(), DC)
End If
RV_DataStream = T
Return NETDB_GURU_NoError
End Function