PureBoard

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