Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

NetDB.bi

Uploader:MitgliedThePuppetMaster
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