Update ExDatabase.pbi with Bugfix PB v5.4x (PBOSL)

[mk-soft]

Update old code ExDatabase.pbi for AddDSN and ExamineTables for PB v5.4x

Code: Select all

;-TOP
; Kommentar     : ExDatabase Lib for Purebasic
; Author 1      : Siegfried Rings
; Author 2      : ts-soft
; Author 3      : mk-soft (Michael Kastner)
; Author 4      : 
; Datei         : ExDatabase.pbi
; Version       : 1.15 (PB4.30) + (PB v5.4x) + (PB v5.6x)
; Erstellt      : 01.03.2007
; Geändert      : 11.01.2009
; Geändert2     : 13.12.2016
; Geändert3     : 17.06.2017 Bugfix v5.4x
; Geändert4     : 01.11.2017 Bugfix v5.6x
; Geändert5     : 01.12.2017 Pointer von Long nach Integer

; Compilermode  :
;
; ***************************************************************************************

; ExDatabase Lib for Purebasic
;
; -----------------------------------------------------------------------------
;     (c) 2004-2005 Siegfried Rings
;     (c) 2007 New functions by mk-soft, ts-soft and german-forum
;
;     This library is free software; you can redistribute it and/or
;     modify it under the terms of the GNU Lesser General Public
;     License as published by the Free Software Foundation; either
;     version 2.1 of the License, Or (at your option) any later version.
;
;     This library is distributed in the hope that it will be useful,
;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;     MERCHANTABILITY Or FITNESS For A PARTICULAR PURPOSE.  See the GNU
;     Lesser General Public License For more details.
; -----------------------------------------------------------------------------

;EnableExplicit
UseODBCDatabase()

; -----------------------------------------------------------------------------
; Bugfix ASCII, Unicode PB v5.4x and PB v5.6x
; By mk-soft version v1.02

Import "odbccp32.lib"
  CompilerIf #PB_Compiler_Unicode
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      SQLInstallerError(iError, *pfErrorCode, *ErrorMSGBuf, cbErrorMsgMax, *ErrorMSGLen) As "_SQLInstallerErrorW@20"
      SQLConfigDataSource(Handle, Type, strDriver.s, *strAttribtues) As "_SQLConfigDataSourceW@16"
    CompilerElse
      SQLInstallerError(iError, *pfErrorCode, *ErrorMSGBuf, cbErrorMsgMax, *ErrorMSGLen) As "SQLInstallerErrorW"
      SQLConfigDataSource(Handle, Type, strDriver.s, *strAttribtues) As "SQLConfigDataSourceW"
    CompilerEndIf 
  CompilerElse
    SQLInstallerError(iError, *pfErrorCode, *ErrorMSGBuf, cbErrorMsgMax, *ErrorMSGLen)
    SQLConfigDataSource(Handle, Type, strDriver.s, *strAttribtues)
  CompilerEndIf 
EndImport

Import "odbc32.lib"
  CompilerIf #PB_Compiler_Unicode
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      SQLConnect(ConnectionHandle, ServerName.s, NameLength1, UserName.s, NameLength2, Authentication.s, NameLength3) As "_SQLConnectW@28"
      SQLTables(StatementHandle, *CatalogName, NameLength1, *SchemaName, NameLength2, *TableName, NameLength3, *TableType, NameLength4) As "_SQLTablesW@36"
    CompilerElse
      SQLConnect(ConnectionHandle, ServerName.s, NameLength1, UserName.s, NameLength2, Authentication.s, NameLength3) As "SQLConnectW"
      SQLTables(StatementHandle, *CatalogName, NameLength1, *SchemaName, NameLength2, *TableName, NameLength3, *TableType, NameLength4) As "SQLTablesW"
    CompilerEndIf
  CompilerElse
    SQLConnect(ConnectionHandle, ServerName.s, NameLength1, UserName.s, NameLength2, Authentication.s, NameLength3)
    SQLTables(StatementHandle, *CatalogName, NameLength1, *SchemaName, NameLength2, *TableName, NameLength3, *TableType, NameLength4)
  CompilerEndIf  
EndImport
; -----------------------------------------------------------------------------

#ODBC_ADD_DSN                       = 1; // Add data source
#ODBC_CONFIG_DSN                    = 2; // Configure (edit) Data source
#ODBC_REMOVE_DSN                    = 3; // Remove data source
#ODBC_ADD_SYS_DSN                   = 4; // add a system DSN
#ODBC_CONFIG_SYS_DSN                = 5; // Configure a system DSN
#ODBC_REMOVE_SYS_DSN                = 6; // remove a system DSN
#ODBC_REMOVE_DEFAULT_DSN            = 7; // remove the default DSN

#SQL_SUCCESS                        =   0
#SQL_SUCCESS_WITH_INFO              =   1
#SQL_ERROR                          =  -1
#SQL_NO_DATA                        = 100
#SQL_MAX_MESSAGE_LENGTH             = 512
#SQL_MAX_DSN_LENGTH                 =  32

#ODBC_ERROR_GENERAL_ERR             =   1
#ODBC_ERROR_INVALID_BUFF_LEN        =   2
#ODBC_ERROR_INVALID_HWND            =   3
#ODBC_ERROR_INVALID_STR             =   4
#ODBC_ERROR_INVALID_REQUEST_TYPE    =   5
#ODBC_ERROR_COMPONENT_NOT_FOUND     =   6
#ODBC_ERROR_INVALID_NAME            =   7
#ODBC_ERROR_INVALID_KEYWORD_VALUE   =   8
#ODBC_ERROR_INVALID_DSN             =   9
#ODBC_ERROR_INVALID_INF             =  10
#ODBC_ERROR_REQUEST_FAILED          =  11
#ODBC_ERROR_INVALID_PATH            =  12
#ODBC_ERROR_LOAD_LIB_FAILED         =  13
#ODBC_ERROR_INVALID_PARAM_SEQUENCE  =  14
#ODBC_ERROR_INVALID_LOG_FILE        =  15
#ODBC_ERROR_USER_CANCELED           =  16
#ODBC_ERROR_USAGE_UPDATE_FAILED     =  17
#ODBC_ERROR_CREATE_DSN_FAILED       =  18
#ODBC_ERROR_WRITING_SYSINFO_FAILED  =  19
#ODBC_ERROR_REMOVE_DSN_FAILED       =  20
#ODBC_ERROR_OUT_OF_MEM              =  21
#ODBC_ERROR_OUTPUT_STRING_TRUNCATED =  22

#SQL_NTS                            =  -3
#SQL_DROP                           =   1

#MAX_DATA                           = 100

; ***************************************************************************************

Global ___Handle.i ;for Opened sql base
Global ___MemHandle.i
Global ___MemHandle2.i

; ***************************************************************************************

Structure direxec
   rc.i                               ; RETCODE rc;        // ODBC return code
   henv.i                             ; HENV henv;         // Environment   
   hdbc.i                             ; HDBC hdbc;         // Connection ___Handle
   hstmt.i                            ; HSTMT hstmt;       // Statement ___Handle
   szData.s{#MAX_DATA}                ; unsigned char szData[MAX_DATA];   // Returned data storage
   cbData.i                           ; SDWORD cbData;     // Output length of data
   chr_ds_name.s{#SQL_MAX_DSN_LENGTH} ; unsigned char chr_ds_name[SQL_MAX_DSN_LENGTH];   // Data source name
EndStructure

Global ___x.direxec

; ***************************************************************************************

Macro MYSQLSUCCESS(rc)
  ((rc=#SQL_SUCCESS) Or (rc=#SQL_SUCCESS_WITH_INFO))
EndMacro

; ***************************************************************************************

Declare sqlconn(dsn.s, user.s, pass.s)
Declare sqldisconn()

; ***************************************************************************************

ProcedureDLL.s GetSQLInstallerError()
  
  Protected iError.l, ErrorMSGLen.l, cbErrorMsgMax, pfErrorCode.l, SQLResult.l
  Protected *ErrorMSGBuf
  Protected Errortext.s, ErrorMsg.s
  
  cbErrorMsgMax=#SQL_MAX_MESSAGE_LENGTH
  *ErrorMSGBuf=AllocateMemory(cbErrorMsgMax+1)
  If *ErrorMSGBuf = 0
    ProcedureReturn "Error AllocateMemory!"
  EndIf
    
  For iError=1 To 8
    SQLResult = SQLInstallerError(iError, @pfErrorCode, *ErrorMSGBuf, cbErrorMsgMax, @ErrorMSGLen)
    If SQLResult = #SQL_SUCCESS Or SQLResult = #SQL_SUCCESS_WITH_INFO
      ErrorMsg = PeekS(*ErrorMSGBuf, ErrorMSGLen)
      Errortext + Str(iError) + ". " + ErrorMsg + #LF$
    EndIf
  Next
  
  FreeMemory(*ErrorMSGBuf)
  
  ProcedureReturn Errortext
EndProcedure

; ***************************************************************************************

Procedure.s TrimEx(String.s, Chr.s)
  While Right(String, 1) = Chr
    String = Left(String, Len(String) - 1)
  Wend
  While Left(String, 1) = Chr
    String = Mid(String, 2, Len(String))
  Wend
  ProcedureReturn String
EndProcedure

; ***************************************************************************************

ProcedureDLL FinishTables()
  If ___MemHandle
    GlobalFree_(___MemHandle)
  EndIf
  If ___MemHandle2
    GlobalFree_(___MemHandle2)
  EndIf
  If ___x\hstmt
    sqldisconn()
  EndIf
EndProcedure

; ***************************************************************************************

ProcedureDLL ExamineTables(DSN.s, USER.s = "", PASS.s = "");Start examine the database for tables
  Protected res.l
  
  If ___MemHandle = 0
    ___MemHandle = GlobalAlloc_(#GMEM_FIXED, 4*512)
    ___MemHandle2 = GlobalAlloc_(#GMEM_FIXED, 4*8)
  EndIf
    
  ___Handle = sqlconn(dsn,user,pass)
  If ___Handle
    res = SQLTables(___Handle, 0, 0, 0, 0, 0, 0, 0, 0) & $FFFF
    If res = 0 Or res = 1 ;SQL_SUCCESS or #SQL_SUCCESS_WITH_INFO
      SQLBindCol_(___Handle, 1, 1, ___MemHandle + 0*512, 512, ___MemHandle2 + 0)
      SQLBindCol_(___Handle, 2, 1, ___MemHandle + 1*512, 512, ___MemHandle2 + 8)
      SQLBindCol_(___Handle, 3, 1, ___MemHandle + 2*512, 512, ___MemHandle2 + 16)
      SQLBindCol_(___Handle, 4, 1, ___MemHandle + 3*512, 512, ___MemHandle2 + 24)
    EndIf
  EndIf
  ProcedureReturn ___Handle
EndProcedure

; ***************************************************************************************

ProcedureDLL NextTable();get next (or first) table-information
  Protected Result.l

  If (___Handle <> 0) And (___MemHandle <> 0) And (___MemHandle2 <> 0)
    Result = SQLFetch_(___Handle)
    If Result & $FFFF = 0
      ProcedureReturn 1
    Else
      sqldisconn()
      ___Handle = 0
      ProcedureReturn 0
    EndIf

  EndIf

EndProcedure

; ***************************************************************************************

ProcedureDLL.s GetTableName();Get the Tablename
  ProcedureReturn Trim(PeekS(___MemHandle + 2*512, 256, #PB_Ascii))
EndProcedure

; ***************************************************************************************

ProcedureDLL.s GetTableType();Get the Tabletype
  ProcedureReturn Trim(PeekS(___MemHandle + 3*512, 256, #PB_Ascii))
EndProcedure

; ***************************************************************************************

Procedure.s FindAttribute(strAttribute.s, Attribute.s)

  Protected attr.s, index, find_attr.s, name_attr.s
  
  find_attr = UCase(Attribute)
  index = 0
  Repeat
    index + 1
    attr = StringField(strAttribute, index, ";")
    If attr = ""
      ProcedureReturn ""
    EndIf
    name_attr = StringField(attr, 1, "=")
    name_attr = Trim(name_attr)
    name_attr = UCase(name_attr)
    If name_attr = find_attr
      attr = StringField(attr, 2, "=")
      attr = Trim(attr)
      ProcedureReturn attr
    EndIf
  ForEver
EndProcedure

; ***************************************************************************************

Procedure.s ReplaceAttributes(strAttribute.s, Attribute.s)

  Protected pos_a, pos_e, new_attr.s, old_attr.s, new_index, old_index, tmpAttr.s
  
  tmpAttr = strAttribute
  new_index = 0
  Repeat
    new_index + 1
    new_attr = StringField(Attribute, new_index, ";")
    If new_attr = ""
      Break
    EndIf
    new_attr = StringField(new_attr, 1, "=")
    new_attr = Trim(new_attr)
    new_attr = UCase(new_attr)
    pos_e = 0
    old_index = 0
    Repeat
      old_index + 1
      old_attr = StringField(strAttribute, old_index, ";")
      If old_attr = ""
        tmpAttr + StringField(Attribute, new_index, ";") + ";"
        Break
      EndIf
      pos_a = pos_e + 1
      pos_e = FindString(tmpAttr, ";", pos_a)
      If pos_e = 0
        pos_e = Len(tmpAttr) + 1
      EndIf 
      old_attr = StringField(old_attr, 1, "=")
      old_attr = Trim(old_attr)
      old_attr = UCase(old_attr)
      If old_attr = new_attr
        tmpAttr = Left(tmpAttr, pos_a - 1) + StringField(Attribute, new_index, ";") + Mid(tmpAttr, pos_e)
        Break
      EndIf
    ForEver
  ForEver
  ProcedureReturn tmpAttr
  
EndProcedure

; ***************************************************************************************

Procedure.s Add_DSN(odbc_type.l, databasename.s, user.s, pass.s, driver.s, attributes.s)
  
  Protected dsn.s, name.s, prefix.s, server.s, serverport.s, type.s, strDriver.s, strAttributes.s
  Protected L.l, result.l, len
  Protected *buffer.Character
  
  ; Drivertype wählen
  type = GetExtensionPart(databasename)
  
  ; Prefix erzeugen
  prefix = ProgramFilename()
  prefix = GetFilePart(prefix)
  prefix = Left(prefix, Len(prefix) - (Len(type) + 1))
  
  ; Databasename erzeugen
  name = GetFilePart(databasename)
  name = Left(name, Len(name) - (Len(type) + 1))
  dsn = prefix + "_" + UCase(name)
  dsn = Right(dsn, #SQL_MAX_DSN_LENGTH)
  
  ; Datenbanktreiber auswählen
  Select UCase(type)
    Case "MYSQL"
      strDriver = "MySQL ODBC 3.51 Driver"
    Case "MSSQL"
      strDriver = "SQL Server"
    Case "MDB"
      strDriver = "Microsoft Access Driver (*.mdb)"
    Case "XLS"
      strDriver = "Microsoft Excel Driver (*.xls)"
    Case "DBF"
      strDriver = "Microsoft dBase Driver (*.dbf)"
    Case "TXT", "CSV"
      strDriver = "Microsoft Text Driver (*.txt; *.csv)"
    Case "FDB"
      strDriver = "Firebird/InterBase(r) driver"
    Case "SQLITE"
      strDriver = "SQLite ODBC Driver"
    Case "SQLITE3"
      strDriver = "SQLite3 ODBC Driver"
  EndSelect
  ; Driver wechseln
  If driver
    strDriver = driver
  EndIf
  ; Attributes erstellen
  Select UCase(type)
    Case "MYSQL"
      server = GetPathPart(databasename)
      server = TrimEx(server, "\")
      serverport = StringField(server, 2, ":")
      server = StringField(server, 1, ":")
      If server = ""
        server = "localhost"
      EndIf
      strAttributes.s = "Server=" + server
      strAttributes.s + ";Description=" + name
      strAttributes.s + ";DSN=" + dsn
      strAttributes.s + ";DATABASE=" + name
      strAttributes.s + ";UID=" + user
      strAttributes.s + ";PWD=" + pass
      If serverport
        strAttributes.s + ";PORT=" + serverport
      EndIf
      strAttributes.s + ";"
    Case "MSSQL"
      server = GetPathPart(databasename)
      server = TrimEx(server, "\")
      If server = ""
        server = "(local)\SQLEXPRESS"
      EndIf
      strAttributes.s = "DSN=" + dsn
      strAttributes.s + ";DESCRIPTION=" + name
      strAttributes.s + ";SERVER=" + server
      strAttributes.s + ";NETWORK=DBMSSOCN"
      strAttributes.s + ";DATABASE=" + name
      ;strAttributes.s + ";Trusted_Connection=Yes"
      strAttributes.s + ";"
    Case "MDB", "XLS"
      strAttributes.s = "Server=APServer;Description=" + name
      strAttributes.s + ";DSN=" + dsn
      strAttributes.s + ";DBQ=" + databasename
      strAttributes.s + ";UID=" + user
      strAttributes.s + ";PWD=" + pass
      strAttributes.s + ";"
    Case "DBF", "TXT", "CSV"
      strAttributes.s = "Server=APServer;Description=" + name
      strAttributes.s + ";DSN=" + dsn
      strAttributes.s + ";DBQ=" + GetPathPart(databasename)
      strAttributes.s + ";UID=" + user
      strAttributes.s + ";PWD=" + pass
      strAttributes.s + ";"
    Case "FDB"
      strAttributes.s + "DSN=" + dsn
      strAttributes.s + ";DESCRIPTION=" + name
      strAttributes.s + ";DATABASE=" + databasename
      strAttributes.s + ";UID=" + user
      strAttributes.s + ";PWD=" + pass
      strAttributes.s + ";"
    Case "SQLITE"
      strAttributes.s + "DSN=" + dsn
      strAttributes.s + ";DATABASE=" + Left(databasename, Len(databasename) - 7)
      strAttributes.s + ";"
    Case "SQLITE3"
      strAttributes.s + "DSN=" + dsn
      strAttributes.s + ";DATABASE=" + Left(databasename, Len(databasename) - 8)
      strAttributes.s + ";"
    Default
      strAttributes.s = "DSN=" + dsn
      strAttributes.s + ";DESCRIPTION=" + name
      strAttributes.s + ";"
      strAttributes.s = attributes
      strAttributes.s + ";"
  EndSelect
  
  ; Attributes erweitern und ersetzen
  If Attributes
    strAttributes = ReplaceAttributes(strAttributes, Attributes)
    strAttributes.s + ";"
    dsn = FindAttribute(strAttributes, "DSN")
  EndIf
   
  *buffer = @strAttributes
  len = Len(strAttributes) - 1
  For L = 0 To len
    If *buffer\c = ';'
      *buffer\c = 0
    EndIf
    *buffer + SizeOf(Character)
  Next L
  result = SQLConfigDataSource(0, odbc_type, strDriver, strAttributes)
   
  If result
    ProcedureReturn dsn
  Else
    ProcedureReturn ""
  EndIf

EndProcedure

; ***************************************************************************************

ProcedureDLL.s AddDSN(databasename.s, user.s = "", pass.s = "", driver.s = "", attributes.s = "")
  ProcedureReturn Add_DSN(#ODBC_ADD_DSN ,databasename.s, user.s, pass.s, driver.s, attributes)
EndProcedure

; ***************************************************************************************

ProcedureDLL.s AddSystemDSN(databasename.s, user.s = "", pass.s = "", driver.s = "", attributes.s = "")
  ProcedureReturn Add_DSN(#ODBC_ADD_SYS_DSN ,databasename.s, user.s, pass.s, driver.s, attributes.s)
EndProcedure

; ***************************************************************************************

Procedure Remove_DSN(odbc_type, databasename.s, driver.s)
  
  Protected dsn.s, name.s, prefix.s, type.s, strDriver.s, strAttributes.s
  Protected L.l, result.l, len.l
  Protected *buffer.Character
 
  ; Drivertype wählen
  type = GetExtensionPart(databasename)
  
  ; Prefix erzeugen
  prefix = ProgramFilename()
  prefix = GetFilePart(prefix)
  prefix = Left(prefix, Len(prefix) - (Len(type) + 1))
  
  ; Databasename erzeugen
  name = GetFilePart(databasename)
  name = Left(name, Len(name) - (Len(type) + 1))
  dsn = prefix + "_" + UCase(name)
  dsn = Right(dsn, #SQL_MAX_DSN_LENGTH)
  
  ; Datenbanktreiber auswählen
  Select UCase(type)
    Case "MYSQL"
      strDriver.s = "MySQL ODBC 3.51 Driver"
    Case "MSSQL"
      strDriver = "SQL Server"
    Case "MDB"
      strDriver = "Microsoft Access Driver (*.mdb)"
    Case "XLS"
      strDriver = "Microsoft Excel Driver (*.xls)"
    Case "DBF"
      strDriver = "Microsoft dBase Driver (*.dbf)"
    Case "TXT", "CSV"
      strDriver = "Microsoft Text Driver (*.txt; *.csv)"
    Case "FDB"
      strDriver = "Firebird/InterBase(r) driver"
    Case "SQLITE"
      strDriver = "SQLite ODBC Driver"
    Case "SQLITE3"
      strDriver = "SQLite3 ODBC Driver"
    Default
      strDriver = "Microsoft Access Driver (*.mdb)"
      dsn = databasename
      
  EndSelect
  ; Driver wechseln
  If driver
    strDriver = driver
  EndIf
  ; Attributes zustellen
  strAttributes = "DSN=" + dsn + ";"
 
  *buffer = @strAttributes
  len = Len(strAttributes) - 1
  For L = 0 To len
    If *buffer\c = ';'
      *buffer\c = 0
    EndIf
    *buffer + SizeOf(Character)
  Next L
 
  result = SQLConfigDataSource(0, odbc_type, strDriver, strAttributes)   ; Call the function you need from the ODBC library with the right details
 
  ProcedureReturn result

EndProcedure

; ***************************************************************************************

ProcedureDLL RemoveDSN(databasename.s, driver.s = "")
  ProcedureReturn Remove_DSN(#ODBC_REMOVE_DSN, databasename, driver)
EndProcedure

; ***************************************************************************************

ProcedureDLL RemoveSystemDSN(databasename.s, driver.s = "")
  ProcedureReturn Remove_DSN(#ODBC_REMOVE_SYS_DSN, databasename, driver)
EndProcedure

; ***************************************************************************************

ProcedureDLL RepairMDB(databasename.s, user.s = "", pass.s = "")
  Protected name.s, strDriver.s, strAttributes.s, L.l, result.l
  Protected *buffer.Character, len.l
  
  name = GetFilePart(databasename)
  name = Left(name, Len(name) - (Len(GetExtensionPart(name)) + 1))

  strDriver = "Microsoft Access Driver (*.mdb)"
  strAttributes + "REPAIR_DB=" + #DQUOTE$ + databasename + #DQUOTE$
  strAttributes + ";UID=" + user
  strAttributes + ";PWD=" + pass + ";"

  *buffer = @strAttributes
  len = Len(strAttributes) - 1
  For L = 0 To len
    If *buffer\c = ';'
      *buffer\c = 0
    EndIf
    *buffer + SizeOf(Character)
  Next L
 
  result = SQLConfigDataSource(0, #ODBC_ADD_DSN, strDriver, strAttributes)   ; Call the function you need from the ODBC library with the right details

  ProcedureReturn result
  
EndProcedure

; ***************************************************************************************

ProcedureDLL CompactMDB(databasename.s, user.s = "", pass.s = "")
  
  Protected strDriver.s, strAttributes.s, L.l, result.l
  Protected *buffer.Character, len.l
  
  strDriver = "Microsoft Access Driver (*.mdb)"
  strAttributes + "COMPACT_DB=" + #DQUOTE$ + databasename + #DQUOTE$ + " " + #DQUOTE$ + databasename + #DQUOTE$+ " General"
  strAttributes + ";UID=" + user
  strAttributes + ";PWD=" + pass + ";"
  
  *buffer = @strAttributes
  len = Len(strAttributes) - 1
  For L = 0 To len
    If *buffer\c = ';'
      *buffer\c = 0
    EndIf
    *buffer + SizeOf(Character)
  Next L
  
  result = SQLConfigDataSource(0, #ODBC_ADD_DSN, strDriver, strAttributes)   ; Call the function you need from the ODBC library with the right details
  
  ProcedureReturn result
  
EndProcedure

; ***************************************************************************************

ProcedureDLL CreateEmptyMDB(databasename.s, user.s = "", pass.s = "")
  Protected strDriver.s, strAttributes.s, L.l, result.l
  Protected *buffer.Character, len.l
  
  If FileSize(databasename) > 0
    DeleteFile(databasename)
  EndIf
 
  strDriver = "Microsoft Access Driver (*.mdb)"
  strAttributes + "CREATE_DB=" + #DQUOTE$ + databasename + #DQUOTE$ + " General"
  strAttributes + ";UID=" + user
  strAttributes + ";PWD=" + pass + ";"
  *buffer = @strAttributes
  len = Len(strAttributes) - 1
  For L = 0 To len
    If *buffer\c = ';'
      *buffer\c = 0
    EndIf
    *buffer + SizeOf(Character)
  Next L

  result = SQLConfigDataSource(0, #ODBC_ADD_DSN, strDriver, strAttributes)   ; Call the function you need from the ODBC library with the right details

  ProcedureReturn result
  
EndProcedure

; ***************************************************************************************

; ***************************************************************************************

; // Allocate environment Handle, allocate connection Handle,
; // connect To Data source, And allocate statement Handle.

Procedure sqlconn(dsn.s, user.s, pass.s)

  With ___x
    ; Vorhandene verbindung trennen
    If \hstmt
      sqldisconn()
    EndIf
    \chr_ds_name = dsn
    SQLAllocEnv_(@\henv);
    SQLAllocConnect_(\henv,@\hdbc);
    \rc=SQLConnect(\hdbc,\chr_ds_name,#SQL_NTS,user,Len(user),pass,Len(pass));
    \rc & $FFFF
    ;// Deallocate ___Handles, display error message, And exit.
    If Not(MYSQLSUCCESS(\rc))
      SQLFreeEnv_(\henv);
      SQLFreeConnect_(\hdbc);
      \henv = 0
      \hdbc = 0
      ProcedureReturn 0
    EndIf

    \rc = SQLAllocStmt_(\hdbc,@\hstmt);
    \rc & $FFFF
    If Not(MYSQLSUCCESS(\rc))
      SQLFreeEnv_(\henv);
      SQLFreeConnect_(\hdbc);
      \henv  = 0
      \hdbc  = 0
      \hstmt = 0
      ProcedureReturn 0
    Else
      ProcedureReturn \hstmt
    EndIf

  EndWith
  
EndProcedure
  
; ***************************************************************************************

; // Free the statement Handle, disconnect, free the connection Handle, And
; // free the environment Handle.

Procedure sqldisconn()

  With ___x
    SQLFreeStmt_(\hstmt,#SQL_DROP);
    SQLDisconnect_(\hdbc);
    SQLFreeConnect_(\hdbc);
    SQLFreeEnv_(\henv);
    \hstmt = 0
    \hdbc  = 0
    \henv  = 0
  EndWith

EndProcedure

; ***************************************************************************************

Code with examples show on my Webspace on "PBOSL" folder...

[Karbon]

I've tried (and failed) to adapt your AddDSN to my needs.. I can't seem to find a clear explanation as to what changed between 5.3 and 5.4 to cause all the trouble? I cannot use Unicode in my case..

Here are the procedure I'm currently using. Is there anything you know of that can be changed here to make them work? Unfortunately these are tied in to quite a few projects that I need to re-compile so changing the procedure arguments and such is going to be a horrible mess if I have to do that.

Code: Select all

Procedure AddODBCConnection(Driver$,Attributes$)
  While Right(Attributes$,2)<>";;"
    Attributes$+";"
  Wend
  
  ;*LPAttribMem=AllocateMemory((Len(Attributes$)+1)*SizeOf(CHARACTER))
  
  *LPAttribMem=AllocateMemory(Len(Attributes$)*SizeOf(CHARACTER)+SizeOf(CHARACTER))
  
  PokeS(*LPAttribMem,Attributes$,Len(Attributes$))
  
  
  
  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
  
  result=SQLConfigDataSource_(0,#ODBC_ADD_DSN,Driver$,*LPAttribMem)
  
  FreeMemory(*LPAttribMem)
  
  ProcedureReturn result
  
EndProcedure

Procedure RemoveODBCConnection(Driver$,DSN$)
  DSN$="DSN="+DSN$
  
  While Right(DSN$,2)<>";;"
    DSN$+";"
  Wend
  
  *LPAttribMem=AllocateMemory((Len(DSN$)+1)*SizeOf(CHARACTER))
  
  PokeS(*LPAttribMem,DSN$,Len(DSN$))
  
  For l=1 To Len(DSN$)
    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
  
  result=SQLConfigDataSource_(0,#ODBC_REMOVE_DSN,@Driver$,*LPAttribMem)
  
  FreeMemory(*LPAttribMem)
  
  ProcedureReturn result
EndProcedure

[mk-soft]

The bug is at time Purebasic use always the wide char function 'SQLConfigDataSourceW'
That not right

Use this Workaround

Code: Select all

; Bugfix ASCII, Unicode PB v5.4x
Import "odbccp32.lib"
  CompilerIf #PB_Compiler_Unicode
    SQLInstallerError(iError, *pfErrorCode, *ErrorMSGBuf, cbErrorMsgMax, *ErrorMSGLen) As "_SQLInstallerErrorW@20"
    SQLConfigDataSource(Handle, Type, strDriver.s, strAttribtues.s) As "_SQLConfigDataSourceW@16"
  CompilerElse
    SQLInstallerError(iError, *pfErrorCode, *ErrorMSGBuf, cbErrorMsgMax, *ErrorMSGLen)
    SQLConfigDataSource(Handle, Type, strDriver.s, strAttribtues.s)
  CompilerEndIf  
EndImport

[Karbon]

Ahhhhh perfect!!!

[mk-soft]

Update v1.14
- Fixed bugfix x64

Please tested...

[Karbon]

I'll grab and test it. I had to shelve the project before because though it compiled with your changes, every time I try to connect to the SQLite DB it crashed before.

[mk-soft]

I have tested now this drivers for PB v5.6x (x86 and x64)
Link drivers: http://www.ch-werner.de/sqliteodbc/

By me it´s work

ExDatabase v1.14

Code: Select all

IncludeFile "source\ExDatabase.pbi"

Define.s dbName = "d:\ablage\purebasic.db.sqlite3"
Define.s dsn =  AddDSN(dbName)
Debug "DSN: " + dsn

If ExamineTables(dsn)
  Debug "Tabellen in Database:"
  Debug ""
  While NextTable()
    Debug GetTableName() + "  <--  " + GetTableType()
  Wend
  Debug "" : Debug ""
EndIf


UseODBCDatabase()
If OpenDatabase(0, dsn, "", "")
  If DatabaseQuery(0, "select * from info")
    While NextDatabaseRow(0)
      Debug GetDatabaseString(0, 0)
    Wend
  Else
    Debug DatabaseError()
  EndIf
Else
  Debug "Error Open " + dsn
EndIf

result = RemoveDSN(dsn, "SQLite3 ODBC Driver"); DSN wieder entfernen
If Result = 0
  MessageRequester("SQLError", GetSQLInstallerError())
EndIf