Your routine is not unicode compatible !
Use this one :
Code: Select all
#ODBC_ADD_DSN = 1 ; Add Data source
#ODBC_REMOVE_DSN = 3 ; Remove Data source
Procedure.l MakeKeywordValuePairs(Attributes$)
; ConfigDSN Function from M$
; http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odbc/htm/odbcconfigdsn.asp
; Each pair is terminated with a null byte, and the entire list is terminated with a null byte.
; (That is, two null bytes mark the End of the list.)
While Right(Attributes$,2)<>";;"
Attributes$+";"
Wend
; Allocate enough memory in both Ascii and Unicode mode + space for the terminating zero character
*LPAttribMem=AllocateMemory(Len(Attributes$)*SizeOf(character)+SizeOf(character))
; Copy string to memory
PokeS(*LPAttribMem,Attributes$,Len(Attributes$))
; Replace each ';' with zero character
For L=1 To Len(Attributes$)
CompilerIf #PB_Compiler_Unicode
If PeekW(*LPAttribMem + (l-1) * SizeOf(character))=Asc(";")
PokeW(*LPAttribMem + (l-1) * SizeOf(character),0)
EndIf
CompilerElse
If PeekB(*LPAttribMem + l -1)=Asc(";")
PokeB(*LPAttribMem + l -1,0)
EndIf
CompilerEndIf
Next
ProcedureReturn *LPAttribMem
EndProcedure
Procedure.b MakeConnection(Driver$,Attributes$)
*KVPBuffer=MakeKeywordValuePairs(Attributes$)
Result=SQLConfigDataSource_(0,#ODBC_ADD_DSN,Driver$,*KVPBuffer)
FreeMemory(*KVPBuffer)
ProcedureReturn Result
EndProcedure
Procedure.b DeleteConnection(Driver$,DSN$)
DSN$="DSN="+DSN$
*KVPBuffer=MakeKeywordValuePairs(DSN$)
Result=SQLConfigDataSource_(0,#ODBC_REMOVE_DSN,@Driver$,*KVPBuffer)
FreeMemory(*KVPBuffer)
ProcedureReturn Result
EndProcedure
and the code for peeking the DB-Handle :
Code: Select all
CompilerSelect #PB_Compiler_Version
CompilerCase 410
UseODBCDatabase() ; new in PB4.10
;Peeking SQL_HANDLE PureBasic Version 4.10 Beta 4
Macro SQL_HANDLE_ENV(Database)
PeekL(PeekL(IsDatabase(Database))-4)
EndMacro
Macro SQL_HANDLE_STMT(Database)
PeekL(PeekL(IsDatabase(Database)+4)+4)
EndMacro
Macro SQL_HANDLE_DBC(Database)
PeekL(PeekL(IsDatabase(Database)+4))
EndMacro
CompilerCase 4.02
InitDatabase()
;Peeking SQL_HANDLE PureBasic Version 4.02
Macro SQL_HANDLE_ENV(Database)
0
EndMacro
Macro SQL_HANDLE_STMT(Database)
PeekL(IsDatabase(Database)+4)
EndMacro
Macro SQL_HANDLE_DBC(Database)
PeekL(IsDatabase(Database))
EndMacro
CompilerEndSelect
Code for getting the tablenames :
Code: Select all
#SQL_SUCCESS = 0
#SQL_SUCCESS_WITH_INFO = 1
Procedure.l GetDatabaseTables(Database)
SQLCancel_(SQL_HANDLE_STMT(Database))
res.w=SQLTables_(SQL_HANDLE_STMT(Database),0,0,0,0,0,0,0,0)
If res = 0 Or res = 1 ; #SQL_SUCCESS / #SQL_SUCCESS_WITH_INFO
ProcedureReturn 1
EndIf
EndProcedure
Procedure.l GetDatabaseDBNames(Database)
SQLCancel_(SQL_HANDLE_STMT(Database))
res.w=SQLTables_(SQL_HANDLE_STMT(Database),"%",-3,"",-3,"",-3,"",-3)
If res = 0 Or res = 1 ; #SQL_SUCCESS / #SQL_SUCCESS_WITH_INFO
ProcedureReturn 1
EndIf
EndProcedure
Example Nr.1 for Access MDB :
Code: Select all
Driver$="Microsoft Access Driver (*.mdb)"
DSN$="DB-Test"
File$=GetCurrentDirectory()+"DB-Test.mdb"
Attrib$="DSN="+DSN$+";DBQ="+File$
If MakeConnection(Driver$,Attrib$)
Debug "MakeConnection ok"
If OpenDatabase(1,"DB-Test","Admin","")
Debug "OpenDatabase ok"
Debug "ID="+Str(IsDatabase(1))
Debug "SQL_HANDLE_ENV="+Hex(SQL_HANDLE_ENV(1))
Debug "SQL_HANDLE_STMT="+Hex(SQL_HANDLE_STMT(1))
Debug "SQL_HANDLE_DBC="+Hex(SQL_HANDLE_DBC(1))
If GetDatabaseTables(1)
While NextDatabaseRow(1)
Debug "Database: " + GetDatabaseString(1,0)
Debug "Table:" + GetDatabaseString(1,2)
Debug "Type: " + GetDatabaseString(1,3)
Debug "-----------------------------------------------------------------"
Wend
Else
GetSQLMessages(1)
EndIf
Debug "*******"
If GetDatabaseDBNames(1)
While NextDatabaseRow(1)
Debug "Database: " + GetDatabaseString(1,0)
Debug "Table:" + GetDatabaseString(1,2)
Debug "Type: " + GetDatabaseString(1,3)
Debug "-----------------------------------------------------------------"
Wend
Else
GetSQLMessages(1)
EndIf
Query$="SELECT * FROM TBL_Fabriknr"
If DatabaseQuery(1,Query$)
Debug "Query ok"
Columns=DatabaseColumns(1)
While NextDatabaseRow(1)
If columns
For i=1 To columns
Debug GetDatabaseString(1,i-1)
Next
EndIf
Wend
Else
Debug "Query failed"
Debug DatabaseError()
EndIf
CloseDatabase(1)
EndIf
If DeleteConnection(Driver$,DSN$)
Debug "DeleteConnection ok"
EndIf
EndIf
Example Nr.2 for MS-Excel :
Code: Select all
Driver$="Microsoft Excel Driver (*.xls)"
DSN$="DB-Test"
File$=GetCurrentDirectory()+"Excel97.xls"
Attrib$="DSN="+DSN$+";Description=Description For Purebasic Excel;FileType=Excel97;DBQ="+File$+";"
Result=Makeconnection(Driver$,Attrib$)
If MakeConnection(Driver$,Attrib$)
Debug "MakeConnection ok"
If OpenDatabase(1,"DB-Test","Admin","")
Debug "OpenDatabase ok"
Debug "ID="+Str(IsDatabase(1))
Debug "SQL_HANDLE_ENV="+Hex(SQL_HANDLE_ENV(1))
Debug "SQL_HANDLE_STMT="+Hex(SQL_HANDLE_STMT(1))
Debug "SQL_HANDLE_DBC="+Hex(SQL_HANDLE_DBC(1))
If GetDatabaseTables(1)
While NextDatabaseRow(1)
Debug "Database: " + GetDatabaseString(1,0)
Debug "Table:" + GetDatabaseString(1,2)
Debug "Type: " + GetDatabaseString(1,3)
Debug "-----------------------------------------------------------------"
Wend
Else
GetSQLMessages(1)
EndIf
Debug "*******"
If GetDatabaseDBNames(1)
While NextDatabaseRow(1)
Debug "Database: " + GetDatabaseString(1,0)
Debug "Table:" + GetDatabaseString(1,2)
Debug "Type: " + GetDatabaseString(1,3)
Debug "-----------------------------------------------------------------"
Wend
Else
GetSQLMessages(1)
EndIf
Query$="SELECT * FROM [Tabelle1$]"
If DatabaseQuery(1,Query$)
Debug "Query ok"
Columns=DatabaseColumns(1)
While NextDatabaseRow(1)
If columns
For i=1 To columns
Debug GetDatabaseString(1,i-1)
Next
EndIf
Wend
Else
Debug "Query failed"
Debug DatabaseError()
EndIf
CloseDatabase(1)
EndIf
If DeleteConnection(Driver$,DSN$)
Debug "DeleteConnection ok"
EndIf
EndIf
Regards Klaus