Ist zwar schon etwas älter, habe aber den Code jetzt für MySQL erweitert
Neuer optionaler Parameter "Server" für MySQL. Defaultwert ist "localhost"
Neu von ts-soft (PBOSL)
http://www.purebasic.fr/german/viewtopic.php?t=12402
Datei: "DsnHelper.pb"
Code: Alles auswählen
;-TOP
; Kommentar : DSN Helper
; Version : v1.04
; Author : Michael Kastner
; Datei : DsnHelper.pb
; Erstellt : 28.09.2006
; Geändert : 28.08.2007
; ***************************************************************************************
Enumeration 1
#ODBC_ADD_DSN ; // Add data source
#ODBC_CONFIG_DSN ; // Configure (edit) Data source
#ODBC_REMOVE_DSN ; // Remove data source
#ODBC_ADD_SYS_DSN ; // add a system DSN
#ODBC_CONFIG_SYS_DSN ; // Configure a system DSN
#ODBC_REMOVE_SYS_DSN ; // remove a system DSN
#ODBC_REMOVE_DEFAULT_DSN ; // remove the default DSN
EndEnumeration
; ***************************************************************************************
Procedure.s MyAddDSN(databasename.s, user.s = "", pass.s = "", driver.s = "", server.s = "localhost") ; Result DSN
Protected name.s, prefix.s, strDriver.s, strAttributes.s
Protected L.l, result.l
Protected *buffer.Character
; Databasename erzeugen (DSN)
prefix = ProgramFilename()
prefix = GetFilePart(prefix)
prefix = Left(prefix, Len(prefix) - (Len(GetExtensionPart(prefix)) + 1))
name.s = GetFilePart(databasename)
name = Left(name, Len(name) - (Len(GetExtensionPart(name)) + 1))
name = prefix + "_" + UCase(name)
; Bei fehlenden driver automatisch wählen
If driver = ""
driver = GetExtensionPart(databasename)
EndIf
; Datenbanktreiber auswählen
Select UCase(driver)
Case "MYSQL"
name = prefix + "_" + UCase(databasename)
strDriver.s = "MySQL ODBC 3.51 Driver"
; Attributes zustellen
strAttributes.s = "Server=" + server
strAttributes.s + ";Description=" + name
strAttributes.s + ";DSN=" + name
strAttributes.s + ";DATABASE=" + databasename
strAttributes.s + ";UID=" + user
strAttributes.s + ";PWD=" + pass + ";"
Case "ACCESS", "MDB"
strDriver.s = "Microsoft Access Driver (*.mdb)"
; Attributes zustellen
strAttributes.s = "Server=APServer;Description=" + name
strAttributes.s + ";DSN=" + name
strAttributes.s + ";DBQ=" + databasename
strAttributes.s + ";UID=" + user
strAttributes.s + ";PWD=" + pass + ";"
Case "EXCEL", "XLS"
strDriver.s = "Microsoft Excel Driver (*.xls)"
; Attributes zustellen
strAttributes.s = "Server=APServer;Description=" + name
strAttributes.s + ";DSN=" + name
strAttributes.s + ";DBQ=" + databasename
strAttributes.s + ";UID=" + user
strAttributes.s + ";PWD=" + pass + ";"
Case "DBASE", "DBF"
strDriver.s = "Microsoft dBase Driver (*.dbf)"
; Attributes zustellen
strAttributes.s = "Server=APServer;Description=" + name
strAttributes.s + ";DSN=" + name
strAttributes.s + ";DBQ=" + GetPathPart(databasename)
strAttributes.s + ";UID=" + user
strAttributes.s + ";PWD=" + pass + ";"
Case "TEXT", "TXT", "CSV"
strDriver.s = "Microsoft Text Driver (*.txt; *.csv)"
; Attributes zustellen
strAttributes.s = "Server=APServer;Description=" + name
strAttributes.s + ";DSN=" + name
strAttributes.s + ";DBQ=" + GetPathPart(databasename)
strAttributes.s + ";UID=" + user
strAttributes.s + ";PWD=" + pass + ";"
Default
strDriver.s = driver
EndSelect
*buffer = @strAttributes
For L = 0 To Len(strAttributes) - 1
If *buffer\c = ';'
*buffer\c = 0
EndIf
*buffer + 1
Next L ; Check the next byte
result = SQLConfigDataSource_(0, #ODBC_ADD_DSN, strDriver, @strAttributes) ; Call the function you need from the ODBC library with the right details
If result
ProcedureReturn name
Else
ProcedureReturn ""
EndIf
EndProcedure
; ***************************************************************************************
Procedure.l MyRemoveDSN(databasename.s, driver.s = "")
Protected name.s, prefix.s, strDriver.s, strAttributes.s
Protected L.l, result.l
Protected *buffer.Character
; Databasename erzeugen
prefix = ProgramFilename()
prefix = GetFilePart(prefix)
prefix = Left(prefix, Len(prefix) - (Len(GetExtensionPart(prefix)) + 1))
name = GetFilePart(databasename)
name = Left(name, Len(name) - 4)
name = prefix + "_" + UCase(name)
; Bei fehlenden driver automatisch wählen
If driver = ""
driver = GetExtensionPart(databasename)
EndIf
; Datenbanktreiber auswählen
Select UCase(driver)
Case "MYSQL"
name = prefix + "_" + UCase(databasename)
strDriver.s = "MySQL ODBC 3.51 Driver"
Case "ACCESS", "MDB"
strDriver = "Microsoft Access Driver (*.mdb)"
Case "EXCEL", "XLS"
strDriver = "Microsoft Excel Driver (*.xls)"
Case "DBASE", "DBF"
strDriver = "Microsoft dBase Driver (*.dbf)"
Case "TEXT", "TXT", "CSV"
strDriver = "Microsoft Text Driver (*.txt; *.csv)"
Default
strDriver = driver
EndSelect
; Attributes zustellen
strAttributes = "DSN=" + name + ";"
*buffer = @strAttributes
For L = 0 To Len(strAttributes) - 1
If *buffer\c = ';'
*buffer\c = 0
EndIf
*buffer + 1
Next L
result = SQLConfigDataSource_(0, #ODBC_REMOVE_DSN, strDriver, @strAttributes) ; Call the function you need from the ODBC library with the right details
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure GetTablesList(Datenbank, List.s())
Protected hwnd.l, r1.l, len.l
Protected *buffer
Protected result.s
hwnd = PeekL(IsDatabase(Datenbank) + 4)
If hwnd
r1 = SQLTables_(hwnd,0,0,0,0,0,0,0,0) & $FFFF
If r1 = 0 Or r1 = 1
*buffer = AllocateMemory(256)
SQLBindCol_(hwnd,3,1,*buffer,256,@len)
While SQLFetch_(hwnd) & $FFFF = 0
AddElement(List())
List() = PeekS(*buffer, len)
Wend
FreeMemory(*buffer)
EndIf
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; ***************************************************************************************
Procedure.s GetTables(Datenbank)
Protected hwnd.l, r1.l, len.l
Protected *buffer
Protected result.s
hwnd = PeekL(IsDatabase(Datenbank) + 4)
result.s = ""
If hwnd
r1 = SQLTables_(hwnd,0,0,0,0,0,0,0,0) & $FFFF
Debug r1
If r1 = 0 Or r1 = 1
*buffer = AllocateMemory(256)
SQLBindCol_(hwnd,3,1,*buffer,256,@len)
While SQLFetch_(hwnd) & $FFFF = 0
result + PeekS(*buffer, len) + ";"
Wend
FreeMemory(*buffer)
EndIf
EndIf
ProcedureReturn result
EndProcedure
