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