PureBoard

Code: Alles auswählen

;-TOP
; Kommentar : Excel Tabelle lesen über SQL
; Version   : v1.01
; Author    : Michael Kastner
; Datei     : FcDatabase.pb
; Erstellt  : 28.09.2006
; Geändert  :
; ***************************************************************************************
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 AddDSN(databasename.s, user.s = "", pass.s = "", driver.s = "") ; Result DSN
  Protected name.s, strDriver.s, strAttributes.s
  Protected L.l, result.l
  Protected *buffer.Character
  
  ; Databasename erzeugen (DSN)
  name.s = GetFilePart(databasename)
  name = Left(name.s, Len(name.s) - 4)
  name = "Pure" + name
  ; Bei fehlenden driver automatisch wählen
  If driver = ""
    driver = GetExtensionPart(databasename)
  EndIf
  ; Datenbanktreiber auswählen
  Select UCase(driver)
    Case "ACCESS", "MDB"
      strDriver.s = "Microsoft Access Driver (*.mdb)"
    Case "EXCEL", "XLS"
      strDriver.s = "Microsoft Excel Driver (*.xls)"
    Case "DBASE", "DBF"
      strDriver.s = "Microsoft dBase Driver (*.dbf)"
    Case "TEXT", "TXT", "CSV"
      strDriver.s = "Microsoft Text Driver (*.txt; *.csv)"
    Default
      strDriver.s = driver
  EndSelect
  ; Attributes zustellen
  strAttributes.s = "Server=APServer;Description=" + name
  strAttributes.s + ";DSN=" + name
  strAttributes.s + ";DBQ=" + databasename
  strAttributes.s + ";UID=" + user
  strAttributes.s + ";PWD=" + pass + ";" 
 
  *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 RemoveDSN(databasename.s, user.s = "", pass.s = "", driver.s = "")
  Protected name.s, strDriver.s, strAttributes.s
  Protected L.l, result.l
  Protected *buffer.Character
  
  ; Databasename erzeugen
  name = GetFilePart(databasename)
  name = Left(name, Len(name) - 4)
  name = "Pure" + name
  ; Bei fehlenden driver automatisch wählen
  If driver = ""
    driver = GetExtensionPart(databasename)
  EndIf
  ; Datenbanktreiber auswählen
  Select UCase(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                                                        ; Check the next byte
 
  result = SQLConfigDataSource_(0, #ODBC_REMOVE_DSN, strDriver, @strAttributes)   ; Call the function you need from the ODBC library with the right details

  ProcedureReturn result

EndProcedure
 
; ***************************************************************************************

;- Test
#Datenbank = 0

InitDatabase()

Path.s = "E:\Eigene Dateien\PureBasic4\Libs\ScriptControl\Examples\Telefon.xls"
; DSN anlegen
Base.s = AddDSN(Path)

If Base
  Debug "DSN=" + Base
  If OpenDatabase(#Datenbank, Base, "", "")
    sql.s = "Select * From [Tabelle1$]"
    If DatabaseQuery(#Datenbank, sql) ; Ermittelt alle Einträge in der 'employee' Tabelle
      Spalten = DatabaseColumns(#Datenbank) - 1
      temp.s = ""
      For Spalte = 0 To Spalten
        temp + DatabaseColumnName(#Datenbank, Spalte) + ";"
      Next
      Debug temp
      While NextDatabaseRow(#Datenbank)  ; alle Einträge durchlaufen
        temp.s = ""
        For Spalte = 0 To Spalten
          temp + GetDatabaseString(#Datenbank, Spalte) + ";"
        Next
        Debug temp
      Wend

    EndIf
  EndIf
EndIf
; DSN am Ende entfernen
RemoveDSN(path, "", "")

Code: Alles auswählen

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
    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

Debug GetTables(#Datenbank)

Code: Alles auswählen

Procedure.s GetTables(Datenbank, Seperator.s = ";")

  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
    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) + Seperator
      Wend
      FreeMemory(*buffer)
    EndIf
  EndIf
  ProcedureReturn result
 
EndProcedure