Install/Test DBD DLL with VB

Steps to install and test the DBD DLL with VB.
1. Download DLL appropriate for your OS and save in C:\Temp\Test directory.
2. Expand zip. It contains dbd.dll
3. Copy dbd.dll into C:\Temp\Test
4. Run VB, select Standard EXE in the New Project Dialog Box.
5. Double click on Form1 to edit "Sub Form_Load()".
6. Copy the code shown below.
7. Click Save button in tool bar and save Form1 and Project1 in C:\Temp\Test
8. Single-step code by pressing F8 repeatedly.
Verify error codes are 0.
Single-step code three more times to execute all sections.
9. Exit VB.
10. Verify data in C:\Temp\Test\Db1.dbd with dbd.exe
11. To uninstall, delete folder C:\Temp\Test
'****************************************************************************
Option Explicit

Private Declare Sub Db_init Lib "dbd.dll" ()
Private Declare Function Db_FileSpec_set_r& Lib "dbd.dll" (ByVal fileSpec$)
Private Declare Function Db_File_exists_b& Lib "dbd.dll" ()

Private Declare Function Db_File_create_r& Lib "dbd.dll" (ByVal sizeInInts&)
Private Declare Function Db_File_open_r& Lib "dbd.dll" ()

Private Declare Sub Db_File_save Lib "dbd.dll" ()
Private Declare Function Db_File_close_r& Lib "dbd.dll" (ByVal sizeInInts&)

Private Declare Sub Db_FileSpecDef_get_r Lib "dbd.dll" (ByVal sFileSpec_r$, ByVal strSz&)
Private Declare Sub Db_FileSpec_get_r Lib "dbd.dll" (ByVal sFileSpec_r$, ByVal strSz&)

Private Declare Function Db_MemSize_get Lib "dbd.dll" ()
Private Declare Function Db_MemSizeAvail_get Lib "dbd.dll" ()
Private Declare Function Db_MemSizeAvail_b Lib "dbd.dll" (ByVal szWanted&)
Private Declare Function Db_Mem_isLow_b Lib "dbd.dll" ()
Private Declare Function Db_Version_get& Lib "dbd.dll" ()
Private Declare Function Db_Mem_defrag_r& Lib "dbd.dll" ()
Private Declare Function Db_verify_r& Lib "dbd.dll" ()

Private Declare Function N_create& Lib "dbd.dll" (ByVal pSrc&, ByVal pGate&)

Private Declare Function Xp_Node& Lib "dbd.dll" (ByVal pN&, ByRef p&)
Private Declare Function Xp_S_getSVO& Lib "dbd.dll" (ByVal eS&, ByRef p&)


Private Declare Function N_SV_get& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal x&)
Private Declare Function N_SV_getElseCreate& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal x&)
Private Declare Function N_SV_getSVO& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal x&)
Private Declare Function N_SV_getO& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal x&)
Private Declare Function N_SVO_get_y& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal eO&, ByRef p&, ByVal x&)
Private Declare Function N_SVO_get& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObj&, ByVal x&)
Private Declare Function N_SVO_set_y& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal eO&, ByRef p&)
Private Declare Function N_SVO_set& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObj&)
Private Declare Function N_SVO_set_wRR_y& Lib "dbd.dll" (ByVal eS&, ByVal eV&, ByVal eO&, ByRef p&)
Private Declare Function N_SVO_set_wRR& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObj&)
Private Declare Function N_VO_getSVO& Lib "dbd.dll" (ByVal pVb&, ByVal pObj&, ByVal x&)
Private Declare Function N_VO_getS& Lib "dbd.dll" (ByVal pVb&, ByVal pObj&, ByVal x&)
Private Declare Function N_O_getSVO& Lib "dbd.dll" (ByVal pObj&, ByVal x&)
Private Declare Function N_O_getS& Lib "dbd.dll" (ByVal pObj&, ByVal x&)
Private Declare Function N_SVO_getElem& Lib "dbd.dll" (ByVal pN&, ByVal seqElem&)
Private Declare Function N_SVO_getRecip Lib "dbd.dll" (ByVal pN&)
Private Declare Function N_SVO_getSymm& Lib "dbd.dll" (ByVal pN&)
Private Declare Function N_Vb_getRecip& Lib "dbd.dll" (ByVal pVb&)

Private Declare Function N_Elem_change_r& Lib "dbd.dll" (ByVal pN&, ByVal pElemNew&)
Private Declare Function N_SV_changeO& Lib "dbd.dll" (ByVal pSub&, ByVal pVb&, ByVal pObjOld&, ByVal pObjNew&)
Private Declare Function N_ClsInst_getSVO& Lib "dbd.dll" (ByVal pCls&, ByVal pInstNameStr&, ByVal create_b As Boolean)
Private Declare Function N_ClsInst_get& Lib "dbd.dll" (ByVal pCls&, ByVal pInstNameStr&, ByVal create_b As Boolean)
Private Declare Function N_EA_getV& Lib "dbd.dll" (ByVal pEn&, ByVal pAttrib&, ByRef pQ, ByRef p, ByVal searchCls_b As Boolean)
Private Declare Function N_EA_setV_wAStr& Lib "dbd.dll" (ByVal pEn&, ByVal pAttrib&, ByVal sVal$, ByVal replace_b As Boolean)

Private Declare Function N_delete& Lib "dbd.dll" (ByVal pN&)

Private Declare Function AStr_getStr& Lib "dbd.dll" (ByVal str$, ByVal create_b As Boolean)
Private Declare Function AStr_getNamed& Lib "dbd.dll" (ByVal str$)
Private Declare Sub N_Name_getEx Lib "dbd.dll" (ByVal pN&, ByVal str_r$, ByVal strSz&, ByVal fullName_b As Boolean, ByVal addParen_b As Boolean, ByVal ignMnCls_b As Boolean, ByVal Ign1&, ByVal pIgn2&)
Private Declare Sub N_Name_get Lib "dbd.dll" (ByVal pN&, ByVal str_r$, ByVal strSz&)

Private Declare Function Xp_compile& Lib "dbd.dll" (ByVal str$)
Private Declare Function Xp_execute& Lib "dbd.dll" (ByVal pE&)
Private Declare Function Xp_process_r& Lib "dbd.dll" (ByVal expr$)

'This function trims strings returned by DLL
Private Function TrimStr$(str$)
  TrimStr$ = Left(str$, InStr(str$, Chr(0)) - 1)
End Function

'This code manages dynamic data structures via dbd
Private Sub Form_Load()
  Const kDbSzDef_g = 256000
  Dim errCode&
  
  Db_init
  errCode& = Db_FileSpec_set_r("Db1.dbd")
  If (False = Db_File_exists_b) Then
    '****************************************
    '* This code is executed during 1st run *

    'Create db file
      errCode = Db_File_create_r(kDbSzDef_g)

    'Open db file
      errCode = Db_File_open_r()

    'Create gender
      Xp_process_r ("(new 'gender)")

    'Create a person named john and set his gender to male
      Xp_process_r ("(new 'john 'person)")
      Xp_process_r ("(set+ john gender 'male)")

    'Create a person named mary and set her gender to female
      Xp_process_r ("(new 'mary 'person)")
      Xp_process_r ("(set+ mary gender 'female)")
  Else
    'Open db file
      errCode = Db_File_open_r()

    'If bob is missing in db
      Dim pBob&: pBob& = AStr_getNamed("bob")
      If (0 = pBob) Then
        '*******************************************
        '* This is code is executed during 2nd run *

        'Create age,
          Xp_process_r ("(new 'age)")

        'Create a person named bob
        'Set his gender to male and age to 35
          Xp_process_r ("(new 'bob 'person)")
          Xp_process_r ("(set+ bob gender 'male)")
          Xp_process_r ("(set+ bob age '35)")

        'Set john's age to 30
          Xp_process_r ("(set+ john age '30)")

        'Get all person that are male
        'Following prints john and bob
          Dim pQry&
          pQry& = Xp_compile("(and (get person instance *) (get * gender male))")
          Dim pPersonX&: pPersonX& = Xp_execute(pQry&)
          Do While (pPersonX&)
            Const strSz = 255
            Dim sName$: sName$ = Space(strSz)
            Call N_Name_get(pPersonX&, sName$, strSz)
            sName$ = TrimStr$(sName$)
            Debug.Print sName
              
            pPersonX& = Xp_execute(pQry&)
          Loop
      Else
          Dim pBuild&: pBuild& = AStr_getNamed&("build")
          If (0 = pBuild) Then
            '*******************************************
            '* This is code is executed during 3nd run *

            'Create body build
              Xp_process_r ("(new 'build)")

            'Set bob's build to tall
              Xp_process_r ("(set+ bob build 'tall)")

            'Set mary's build to thin and petite
              Xp_process_r ("(set+ mary build 'thin)")
              Xp_process_r ("(set+ mary build 'petite)")
          Else
            Dim pSue&: pSue& = AStr_getNamed("sue")
            If (0 = pSue) Then
              '*******************************************
              '* This is code is executed during 4th run *
              'It uses low-level methods

              'Create a person named sue
                pSue& = N_create(0, 0)
                Dim pPerson&: pPerson& = AStr_getNamed("person")
                Dim pInst_g&: pInst_g& = AStr_getNamed("instance")
                Call N_SVO_set(pPerson&, pInst_g&, pSue&)
                Dim pStrSue&: pStrSue& = AStr_getStr("sue", True)
                Dim pName_g&: pName_g& = AStr_getNamed("name")
                Call N_SVO_set(pSue&, pName_g&, pStrSue&)

              'Set sue's gender to female
                Dim pGender&: pGender& = AStr_getNamed("gender")
                Dim pFemale&: pFemale& = AStr_getNamed("female")
                Call N_SVO_set(pSue&, pGender&, pFemale&)

              'Set sue's age to 21
                Dim pAge&: pAge& = AStr_getNamed("age")
                Dim pStr21&: pStr21& = AStr_getStr("21", True)
                Dim pAge21&: pAge21& = N_ClsInst_get(pAge&, pStr21&, True)
                Call N_SVO_set(pSue&, pAge&, pAge21&)

              'Set sue's build to fat and short
                Call N_EA_setV_wAStr(pSue&, pBuild&, "fat", False)
                Call N_EA_setV_wAStr(pSue&, pBuild&, "short", False)

              'Change john's age from 30 to 40
                Dim pJohn&: pJohn& = AStr_getNamed("john")
                Dim pStr30&: pStr30& = AStr_getStr("30", True)
                Dim pAge30&: pAge30& = N_ClsInst_get(pAge&, pStr30&, True)
                Dim pStr40&: pStr40& = AStr_getStr("40", True)
                Dim pAge40&: pAge40& = N_ClsInst_get(pAge&, pStr40&, True)
                Call N_SV_changeO(pJohn&, pAge&, pAge30&, pAge40&)

              'Delete mary's build is thin
                Dim pMary&: pMary& = AStr_getNamed("mary")
                Dim pThin&: pThin& = AStr_getNamed("thin")
                Dim pSVO&: pSVO& = N_SVO_get(pMary&, pBuild&, pThin&, 1)
                N_delete (pSVO&)
            End If
          End If
      End If
  End If
  
  
  '********************************************
  '* This is code is executed during all runs *
  'Print each person's attributes and values

  'During 1st run, prints:
  '  john gender male
  '  mary gender female
  
  'During 2nd run, prints:
  '  john gender male
  '  john age 30
  '  mary gender female
  '  bob gender male
  '  bob age 35

  'During 3rd run, prints:
  '  john gender male
  '  john age 30
  '  mary gender female
  '  mary build thin
  '  mary build petite
  '  bob gender male
  '  bob age 35
  '  bob build tall

  'During 4th run, prints:
  '  john gender male
  '  john age 40
  '  mary gender female
  '  mary build petite
  '  bob gender male
  '  bob age 35
  '  bob build tall
  '  sue gender female
  '  sue age 21
  '  sue build fat
  '  sue build short

    pName_g& = AStr_getNamed("name")
    pQry& = Xp_compile("(get person instance *)")
    Dim pPtX&: pPtX& = Xp_execute(pQry&)
    Do While (pPtX&)
      Dim pA&(256)
      Dim p&: p& = VarPtr(pA(0))
      Dim eS&: eS& = Xp_Node(pPtX, p&)
      Dim eSVO&: eSVO& = Xp_S_getSVO(eS, p&)
      pSVO& = Xp_execute(eSVO&)
      Do While (pSVO&)
        Dim pSub&: pSub& = N_SVO_getElem(pSVO&, 0)
        Dim pVb&: pVb& = N_SVO_getElem(pSVO&, 1)
        Dim pObj&: pObj& = N_SVO_getElem(pSVO&, 2)
        If (pVb& <> pName_g&) Then
          'Print "person attribute value"
            Dim sEntity$: sEntity$ = Space$(strSz)
            Call N_Name_get(pSub, sEntity$, strSz)
            sEntity$ = TrimStr$(sEntity$)

            Dim sProp$: sProp$ = Space$(strSz)
            Call N_Name_get(pVb&, sProp$, strSz)
            sProp$ = TrimStr$(sProp$)

            Dim sVal$: sVal$ = Space$(strSz)
            Call N_Name_get(pObj&, sVal$, strSz)
            sVal$ = TrimStr$(sVal$)

            Debug.Print sEntity$, sProp, sVal
        End If
        
        pSVO = Xp_execute(eSVO)
        
      Loop
      
      pPtX& = Xp_execute(pQry&)
    Loop


  Db_File_save
  Db_File_close_r (0)
  
End Sub
'****************************************************************************
The creation of rolex replica the watch is inspired by the retro and elegant money of rolex replica watches the brand's round watch. The chronograph is omega replica simple and stylish, with the line features of rolex replica uk the watch series.

CM ©2000-2007