Module MSAccess ODBC on the fly

Share your advanced PureBasic knowledge/code with the community.
QuimV
Enthusiast
Enthusiast
Posts: 337
Joined: Mon May 29, 2006 11:29 am
Location: BARCELONA - SPAIN

Module MSAccess ODBC on the fly

Post by QuimV »

I hope it will be useful to someone.

Code: Select all

;
;- TOP
; This section will be available from outside.
;
DeclareModule odbcAccess
  
  ;- Public constants
  #Author$ = "QuimV"
  #CreationDate$ = "Abril de 2017"
  #Version$ = "1.0.0"
  
  ;- Declares
  Declare.l CreateODBCDatabase(DataBasePathAndName$, ErrorText$, FlagOverWrite.l)
  Declare.l DeleteODBCDatabase(DataBasePathAndName$, ErrorText$)
  Declare.l RepairODBCDatabase(DataBasePathAndName$, ErrorText$)
  Declare.l CompactODBCDatabase(DataBasePathAndName$,ErrorText$)
  Declare.l CreateODBCEntry(ODBCEntrydName$)
  Declare.l ExistODBCEntry(ODBCEntrydName$)
  Declare.l DeleteODBCEntry(ODBCEntrydName$)
  
  
EndDeclareModule
  
; This section will be private.
;
Module odbcAccess
  
  EnableExplicit
  
  ; ODBC Constants
  #ODBC_ADD_DSN = 1
  #ODBC_CONFIG_DSN = 2
  #ODBC_REMOVE_DSN = 3
  #ODBC_ADD_SYS_DSN = 4
  #ODBC_CONFIG_SYS_DSN = 5
  #ODBC_REMOVE_SYS_DSN = 6
  #ODBC_REMOVE_DEFAULT_DSN = 7
  
  ; Other Constants
  #DriverName$ = "Microsoft Access Driver (*.mdb)"
  #CreateAttribute$ = "CREATE_DB="
  #RepairAttribute$ = "REPAIR_DB="
  #CompactAttribute$ = "COMPACT_DB="
  
  Global odbcAccessDatabaseName$, odbcAccessEntryName$
  
  Procedure.l CreateODBCDatabase(DataBasePathAndName$, ErrorText$, FlagOverWrite.l)    
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    ; With CREATE_DB, the file named in <path name> must Not exist at the time SQLCOnfigDataSource is called.

    If FileSize(DataBasePathAndName$) > 0
      If FlagOverWrite
        ; Delete file if exists and FlagOverWrite = #True
        DeleteFile(DataBasePathAndName$)      
      Else
        ; FlagOverWrite = #False -> OverWrite file?
        Result = MessageRequester("", ErrorText$, #PB_MessageRequester_YesNo | #PB_MessageRequester_Warning)
        If Result = #PB_MessageRequester_Yes
          DeleteFile(DataBasePathAndName$)      
        Else
          odbcAccessDatabaseName$ = DataBasePathAndName$
          ProcedureReturn #False
        EndIf
      EndIf      
    EndIf
    
    ; Create database file
    Result = #False
    LibODBC = OpenLibrary(#PB_Any, "ODBCCP32.DLL")
    If LibODBC
      Attributes$ = #CreateAttribute$ + DataBasePathAndName$
      *DriverName = AllocateMemory(Len(#DriverName$) + 1)
      If *DriverName
        PokeS(*DriverName, #DriverName$, -1, #PB_Ascii)
        *Attributes = AllocateMemory(Len(Attributes$) + 2) ; + 2 -> double 0 terminated
        If *Attributes
          PokeS(*Attributes, Attributes$, -1, #PB_Ascii)
          For Cnt = 1 To MemorySize(*Attributes)
            If PeekA(*Attributes + Cnt - 1) = ';'
              PokeA(*Attributes + Cnt - 1, 0)
            EndIf
          Next Cnt
          If CallFunction(LibODBC, "SQLConfigDataSource", 0, #ODBC_ADD_SYS_DSN, *DriverName, *Attributes)
            odbcAccessDatabaseName$ = DataBasePathAndName$
            Result = #True
          EndIf
          FreeMemory(*Attributes)
        EndIf
        FreeMemory(*DriverName)
      EndIf
      ; Free library
      CloseLibrary(LibODBC)
    EndIf
    ProcedureReturn Result
  EndProcedure  
  
  Procedure.l DeleteODBCDatabase(DataBasePathAndName$, ErrorText$)    
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    If FileSize(odbcAccessDatabaseName$) > 0
      ; Delete file
      DeleteFile(odbcAccessDatabaseName$)
      odbcAccessDatabaseName$ = ""
      ProcedureReturn #True
    Else
      ; File does not exist
      Result = MessageRequester("", ErrorText$, #PB_MessageRequester_Ok | #PB_MessageRequester_Warning)
      ProcedureReturn #False
    EndIf
    
  EndProcedure
  
  Procedure.l RepairODBCDatabase(DataBasePathAndName$,ErrorText$)
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    ; With REPAIR_DB, the file named in <path name> must be a valid .MDB file.
    
    If FileSize(DataBasePathAndName$) <= 0
      ; File does not exist
      Result = MessageRequester("", ErrorText$, #PB_MessageRequester_Ok | #PB_MessageRequester_Warning)
      odbcAccessDatabaseName$ = ""
      ProcedureReturn #False
    EndIf
    
    ; Repair database file
    odbcAccessDatabaseName$ = DataBasePathAndName$
    Result = #False
    LibODBC = OpenLibrary(#PB_Any, "ODBCCP32.DLL")
    If LibODBC
      Attributes$ = #RepairAttribute$ + odbcAccessDatabaseName$
      *DriverName = AllocateMemory(Len(#DriverName$) + 1)
      If *DriverName
        PokeS(*DriverName, #DriverName$, -1, #PB_Ascii)
        *Attributes = AllocateMemory(Len(Attributes$) + 2) ; + 2 -> double 0 terminated
        If *Attributes
          PokeS(*Attributes, Attributes$, -1, #PB_Ascii)
          For Cnt = 1 To MemorySize(*Attributes)
            If PeekA(*Attributes + Cnt - 1) = ';'
              PokeA(*Attributes + Cnt - 1, 0)
            EndIf
          Next Cnt
          If CallFunction(LibODBC, "SQLConfigDataSource", 0, #ODBC_ADD_SYS_DSN, *DriverName, *Attributes)
            Result = #True
          EndIf
          FreeMemory(*Attributes)
        EndIf
        FreeMemory(*DriverName)
      EndIf
      ; Free library
      CloseLibrary(LibODBC)
    EndIf
    ProcedureReturn Result
    
  EndProcedure
  
  Procedure.l CompactODBCDatabase(DataBasePathAndName$, ErrorText$)
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    ; With COMPACT_DB, the file named in <source path> must be a valid .MDB file. <destination path> can point To the same file As <source path>, 
    ; in which Case the file will be compacted into the same location. If <destination path> names a different file than <source path>, the file named 
    ; As the <destination path> must Not exist at the time SQLConfigDataSource is called.
    
    If FileSize(odbcAccessDatabaseName$) <= 0
      ; File does not exist
      Result = MessageRequester("", ErrorText$, #PB_MessageRequester_Ok | #PB_MessageRequester_Warning)
      odbcAccessDatabaseName$ = ""
      ProcedureReturn #False
    EndIf
    
    ; Compact database file
    odbcAccessDatabaseName$ = DataBasePathAndName$
    Result = #False
    LibODBC = OpenLibrary(#PB_Any, "ODBCCP32.DLL")
    If LibODBC
      ; Destination odbcAccessDatabaseName$ = Source odbcAccessDatabaseName$
      Attributes$ = #CompactAttribute$ + odbcAccessDatabaseName$ + " " + odbcAccessDatabaseName$
      *DriverName = AllocateMemory(Len(#DriverName$) + 1)
      If *DriverName
        PokeS(*DriverName, #DriverName$, -1, #PB_Ascii)
        *Attributes = AllocateMemory(Len(Attributes$) + 2) ; + 2 -> double 0 terminated
        If *Attributes
          PokeS(*Attributes, Attributes$, -1, #PB_Ascii)
          For Cnt = 1 To MemorySize(*Attributes)
            If PeekA(*Attributes + Cnt - 1) = ';'
              PokeA(*Attributes + Cnt - 1, 0)
            EndIf
          Next Cnt
          If CallFunction(LibODBC, "SQLConfigDataSource", 0, #ODBC_ADD_DSN, *DriverName, *Attributes)
            Result = #True
          EndIf
          FreeMemory(*Attributes)
        EndIf
        FreeMemory(*DriverName)
      EndIf
      ; Free library
      CloseLibrary(LibODBC)
    EndIf
    ProcedureReturn Result
    
  EndProcedure
  
  Procedure.l CreateODBCEntry(ODBCEntrydName$)
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    ; Create database file
    Result = #False
    LibODBC = OpenLibrary(#PB_Any, "ODBCCP32.DLL")
    If LibODBC
      Attributes$ = "UID=;PSW=;DBQ=" + odbcAccessDatabaseName$ + ";DSN=" + ODBCEntrydName$
      
      *DriverName = AllocateMemory(Len(#DriverName$) + 1)
      If *DriverName
        PokeS(*DriverName, #DriverName$, -1, #PB_Ascii)
        *Attributes = AllocateMemory(Len(Attributes$) + 2) ; + 2 -> double 0 terminated
        If *Attributes
          PokeS(*Attributes, Attributes$, -1, #PB_Ascii)
          For Cnt = 1 To MemorySize(*Attributes)
            If PeekA(*Attributes + Cnt - 1) = ';'
              PokeA(*Attributes + Cnt - 1, 0)
            EndIf
          Next Cnt
          If CallFunction(LibODBC, "SQLConfigDataSource", 0, #ODBC_ADD_SYS_DSN, *DriverName, *Attributes)
            odbcAccessEntryName$ = ODBCEntrydName$
            Result = #True
          EndIf
          FreeMemory(*Attributes)
        EndIf
        FreeMemory(*DriverName)
      EndIf
      ; Free library
      CloseLibrary(LibODBC)
    EndIf
    ProcedureReturn Result

  EndProcedure
  
  Procedure.l DeleteODBCEntry(ODBCEntrydName$)
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    ; Create database file
    Result = #False
    LibODBC = OpenLibrary(#PB_Any, "ODBCCP32.DLL")
    If LibODBC
      Attributes$ =   "DSN=" + ODBCEntrydName$
      *DriverName = AllocateMemory(Len(#DriverName$) + 1)
      If *DriverName
        PokeS(*DriverName, #DriverName$, -1, #PB_Ascii)
        *Attributes = AllocateMemory(Len(Attributes$) + 2) ; + 2 -> double 0 terminated
        If *Attributes
          PokeS(*Attributes, Attributes$, -1, #PB_Ascii)
          For Cnt = 1 To MemorySize(*Attributes)
            If PeekA(*Attributes + Cnt - 1) = ';'
              PokeA(*Attributes + Cnt - 1, 0)
            EndIf
          Next Cnt
          If CallFunction(LibODBC, "SQLConfigDataSource", 0, #ODBC_REMOVE_SYS_DSN, *DriverName, *Attributes)
            odbcAccessEntryName$ = ""
            Result = #True
          EndIf
          FreeMemory(*Attributes)
        EndIf
        FreeMemory(*DriverName)
      EndIf
      ; Free library
      CloseLibrary(LibODBC)
    EndIf
    ProcedureReturn Result

  EndProcedure
  
  Procedure.l ExistODBCEntry(ODBCEntrydName$)
    Protected Attributes$, Result.l, LibODBC.l, Cnt.l, *DriverName, *Attributes
    
    ; Create database file
    Result = #False
    LibODBC = OpenLibrary(#PB_Any, "ODBCCP32.DLL")
    If LibODBC
      Attributes$ = "UID=;PSW=;DBQ=" + odbcAccessDatabaseName$ + ";DSN=" + ODBCEntrydName$      
      *DriverName = AllocateMemory(Len(#DriverName$) + 1)
      If *DriverName
        PokeS(*DriverName, #DriverName$, -1, #PB_Ascii)
        *Attributes = AllocateMemory(Len(Attributes$) + 2) ; + 2 -> double 0 terminated
        If *Attributes
          PokeS(*Attributes, Attributes$, -1, #PB_Ascii)
          For Cnt = 1 To MemorySize(*Attributes)
            If PeekA(*Attributes + Cnt - 1) = ';'
              PokeA(*Attributes + Cnt - 1, 0)
            EndIf
          Next Cnt
          If CallFunction(LibODBC, "SQLConfigDataSource", 0, #ODBC_CONFIG_SYS_DSN, *DriverName, *Attributes)
            odbcAccessEntryName$ = ODBCEntrydName$
            Result = #True
          EndIf
          FreeMemory(*Attributes)
        EndIf
        FreeMemory(*DriverName)
      EndIf
      ; Free library
      CloseLibrary(LibODBC)
    EndIf
    ProcedureReturn Result

  EndProcedure

  
EndModule



CompilerIf #PB_Compiler_IsMainFile
  ;- Main
  
  ;- Example sequence
  Debug odbcAccess::CreateODBCDatabase("c:\tmp\testOdbcDatabase.mdb","The file already exists. Delete it?",#False)
  Debug odbcAccess::CompactODBCDatabase("c:\tmp\testOdbcDatabase.mdb","The file does Not exist!.")
  Debug odbcAccess::RepairODBCDatabase("c:\tmp\testOdbcDatabase.mdb","The file does Not exist!.")
  Debug odbcAccess::CreateODBCEntry("Purebasic_DSN_Test")
  Debug odbcAccess::ExistODBCEntry("Purebasic_DSN_Test")
  Debug odbcAccess::DeleteODBCEntry("Purebasic_DSN_Test")
  Debug odbcAccess::DeleteODBCDatabase("c:\tmp\testOdbcDatabase.mdb","The file does Not exist!.")
  
CompilerEndIf


QuimV