Ich muss arbeitstechnisch mit zwei Exceltabellen arbeiten, die ich vergleiche um eine Ergebnisdatei zu erzeugen. Bisher habe ich die Bibliothek XLTable.dll verwendet, was nicht schön ist, aber leidlich funktioniert.
Die aber wesendlichen Nachteile:
Das Einlesen einer großen Datenbank dauert laaaannnge.
Das Auslesen von "Double" und anderen Variablen ist unmöglich, alleine eine Datumsangabe wird zu eine interessanten Zifferfolge, von Umlauten ganz zu schweigen!
Jetzt habe ich mich einmal mit dem ODBC Dateisystem und SQL beschäftigt und das Ergebnis ist ein Datenbank Anzeiger für Access, Excel, Dbase und Text Dateien. Den will ich Euch nicht vorenthalten, insbesondere da ich hemmungslos Quelltexte aus dem Forum geplündert habe. Das man alle vorhandenen Tabellen sieht und das Anzeigefenster auch in der Größe ändern kann ist selbstverständlich. Fehlermeldungen könnt Ihr mir gerne weitergeben, da ich das Programm noch nicht 100%tig auf Herz und Nieren getestet habe. Ich hoffe, dass es den einen oder anderen weiterhilft.
Neu: Das Programm wurde um die Funktion der Passworteingabe erweitert.
Super Neu: Eingabe eines Tabellentrennungszeichens bei TXT Dateien
Hyper Neu: Abfrage ob Überschrift vorhanden ist
Gruß Michael
Code: Alles auswählen
;-TOP
; Kommentar : Datenbank Anzeiger über SQL für ACCESS, EXCEL, DBASE und TEXT
; : Variables Fenster und Anzeige aller vorhandenen Tabellen
; Version : v.1.05 vom 01.06.2008
; Author : Michael Paulwitz
; : Nur Mithilfe vieler anderer Authoren insbesondere Michael Kastner
;
; Datei : Datenbank Viewer.pb
; Erstellt : 11.04.2007
; Geändert : 19.04.2007 ; Eingabe von Benutzernamen und Passwort
; Geändert : 17.07.2007 ; Eingabe eines Tabellentrennungszeichens bei TXT Dateien
; Geändert : 11.12.2007 ; Anpassung an PB 4.10, Einlesen von Leerfelden bei TXT Dateien angepasst
; Geändert : 01.06.2008 ; Abfrage ob Überschrift vorhanden ist
; Sprache : Purebasic 4.10/4.20 Windows
; ***************************************************************************************
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
; ***************************************************************************************
Structure Tabelle
Tabellenname.s
Suchstring.s
EndStructure
Global NewList Tabelle.Tabelle () , IsText.b , Base.s
#Datenbank = 0
Benutzer$ = ""
Passwort$ = ""
Procedure Trennzeichen (databasename.s)
Enumeration
#Window_0
#Radio_1
#Radio_2
#Radio_3
#Radio_4
#Text_0
#Button_0
#String_0
EndEnumeration
If OpenWindow(#Window_0, 257, 83, 306, 160, "Tabellentrennzeichen der ASCII Tabelle", #PB_Window_SystemMenu); | #PB_Window_SizeGadget | #PB_Window_TitleBar )
If CreateGadgetList(WindowID(#Window_0))
OptionGadget(#Radio_1, 60, 50, 80, 30, "Tabulator")
OptionGadget(#Radio_2, 60, 80, 80, 30, "Komma")
OptionGadget(#Radio_3, 60, 110, 80, 30, "Semikolon")
OptionGadget(#Radio_4, 140, 50, 60, 30, "Zeichen")
SetGadgetState(#Radio_1, 1)
Tabstring$=Chr(9)
TextGadget(#Text_0, 20, 20, 280, 20, "Welches Tabellentrennzeichen soll verwendet werden?")
ButtonGadget(#Button_0, 210, 110, 70, 30, "Okay")
StringGadget(#String_0, 210, 50, 20, 20, "?")
SendMessage_(GadgetID(#String_0), #EM_LIMITTEXT, 1, 0)
EndIf
Repeat ; Start of the event loop
Event = WaitWindowEvent() ; This line waits until an event is received from Windows
GadgetID = EventGadget() ; Is it a gadget event?
If Event = #PB_Event_Gadget
If GadgetID = #Radio_1
Tabstring$ = Chr(9)
ElseIf GadgetID = #Radio_2
Tabstring$ = ","
ElseIf GadgetID = #Radio_3
Tabstring$ = ";"
ElseIf GadgetID = #Button_0
If GetGadgetState(#Radio_4)
Tabstring$ = GetGadgetText(#String_0)
EndIf
Event = #PB_Event_CloseWindow
EndIf
EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop
CreateFile (37,GetPathPart(databasename)+"schema.ini")
WriteStringN(37, "["+GetFilePart(databasename)+"]")
If Tabstring$ = Chr(9)
WriteStringN(37, "Format=TabDelimited")
ElseIf Tabstring$ = ","
WriteStringN(37, "DecimalSymbol=.")
WriteStringN(37, "Format=CSVDelimited")
Else
WriteStringN(37, "Format=Delimited("+Tabstring$+")")
EndIf
CloseFile(37)
If OpenDatabase(#Datenbank, Base, Benutzer$, Passwort$)
sql.s = "Select * From "+databasename
If DatabaseQuery(#Datenbank, sql) ; Ermittelt alle Einträge in der 'employee' Tabelle
OpenFile (37,GetPathPart(databasename)+"schema.ini")
FileSeek(37, Lof(37))
Spalten = DatabaseColumns(#Datenbank) - 1
For Spalte = 0 To Spalten ; Überschrift erstellen
WriteStringN(37, "Col"+Str(Spalte+1)+"="+Chr(34)+DatabaseColumnName(#Datenbank, Spalte)+Chr(34)+" Text")
Next
CloseFile(37)
EndIf
CloseDatabase(#Datenbank)
EndIf
EndIf
EndProcedure
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 = "Pure_Viewer"
; 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)"
; 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 + ";"
IsText = #True
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 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
name.s = "Pure_Viewer"
; 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)"
DeleteFile(GetPathPart(databasename)+"schema.ini")
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
Procedure.s GetTables(Database)
SQLCancel_(PeekL(PeekL(IsDatabase(Database)+4)+4))
res.w=SQLTables_(PeekL(PeekL(IsDatabase(Database)+4)+4),0,"%",0,0,0,0,0,0)
If res = 0 Or res = 1 ; #SQL_SUCCESS / #SQL_SUCCESS_WITH_INFO
While NextDatabaseRow(Database)
AddElement(Tabelle())
result.s = RemoveString(GetDatabaseString(Database,2), "'")
Tabelle()\Tabellenname.s = Left(result,Len(result)-1)
Tabelle()\Suchstring.s="Select * From ["+result.s+"]"
Wend
EndIf
EndProcedure
Procedure.s PasswortBox(CallerID.l,def$,def2$)
Shared Benutzer$,Passwort$
;
; Remember which window (if any) called this InputBox.
;
If CallerID<>0 : CallerNum=EventWindow() : EndIf
;
box=OpenWindow(999,0,0,357,120,"Eingabe von Benutzernamen und Passwort",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
If box=0 Or CreateGadgetList(box)=0 : ProcedureReturn "" : EndIf
;
TextGadget(996,10,8,265,20,"Bitte Text eingeben:")
ButtonGadget(997,218,8,60,23,"OK",#PB_Button_Default)
ButtonGadget(998,288,8,60,23,"Cancel")
TextGadget(995,10,36,265,20,"Benutzername?")
StringGadget(999,9,52,339,20,def$,#ES_MULTILINE|#ES_AUTOVSCROLL) ; Flags stop "ding" sounds.
TextGadget(994,10,76,265,20,"Passwort?")
StringGadget(1000,9,92,339,20,def2$,#ES_MULTILINE|#ES_AUTOVSCROLL) ; Flags stop "ding" sounds.
SendMessage_(GadgetID(999),#EM_SETSEL,0,Len(def$)) ; Select all of def$ (if declared).
SendMessage_(GadgetID(1000),#EM_SETSEL,0,Len(def2$)) ; Select all of def$ (if declared).
;
If CallerID<>0
EnableWindow_(CallerID,#False) ; Disable caller until our InputBox closes ("modal" effect).
EndIf
SetWindowPos_(WindowID(999),#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE) ; InputBox always on top.
;
GetAsyncKeyState_(#VK_RETURN)
GetAsyncKeyState_(#VK_ESCAPE) ; Clear key buffers before loop.
SetForegroundWindow_(WindowID(999)) : SetActiveGadget(999) ; Activate InputBox and its StringGadget.
MessageBeep_(#MB_ICONQUESTION) ; Play a sound prompt for the user (not supported on Win XP!).
;
Repeat
Sleep_(1) : ev=WindowEvent() : id=EventGadget() : where=GetForegroundWindow_()
ret=GetAsyncKeyState_(#VK_RETURN)
esc=GetAsyncKeyState_(#VK_ESCAPE)
Until where=box And ((ev=#PB_Event_Gadget And (id=997 Or id=998)) Or ret=-32767 Or esc=-32767 Or ev=#PB_Event_CloseWindow)
;2
If id=997 Or ret=-32767 : Benutzer$=GetGadgetText(999): Passwort$=GetGadgetText(1000) : EndIf ; OK clicked or Return key pressed.
;
CloseWindow(999) ; Close InputBox.
;
If CallerID<>0
EnableWindow_(CallerID,#True) ; Re-enable caller again.
SetForegroundWindow_(CallerID) ; Give focus back to caller.
; And give event control back to caller.
While WindowEvent() : Wend ; Clear events from caller (necessary!).
EndIf
ProcedureReturn def$;text$
EndProcedure
; ***************************************************************************************
;- Start
UseODBCDatabase()
Path.s = OpenFileRequester("Bitte Datenbank zum Öffnen auswählen", "", "Datenbank Datei (*.xls;*.mdb;*.dbf;*.txt;*.csv)|*.xls;*.mdb;*.dbf;*.txt;*.csv",0)
Passwort:
If Passwortfound : PasswortBox(0,Benutzer$,Passwort$) : EndIf
; DSN anlegen
Base.s = AddDSN_(Path,Benutzer$,Passwort$)
If isText
Trennzeichen (Path)
EndIf
If Base
If OpenDatabase(#Datenbank, Base, Benutzer$, Passwort$)
; Anpassung der SQL Abfrage
Select UCase(GetExtensionPart(Path.s))
Case "ACCESS", "MDB", "EXCEL", "XLS"
GetTables(#Datenbank)
FirstElement(Tabelle())
Case "DBASE", "DBF", "TEXT", "TXT", "CSV"
AddElement(Tabelle())
Tabelle()\Tabellenname.s = GetFilePart(Path.s)
Tabelle()\Suchstring.s = "Select * From "+Path.s
EndSelect
sql.s = Tabelle()\Suchstring
Tabelle.s = Tabelle()\Tabellenname.s
If DatabaseQuery(#Datenbank, sql) ; Ermittelt alle Einträge in der 'employee' Tabelle
Spalten = DatabaseColumns(#Datenbank) - 1
If OpenWindow(0,0,0,600,400,Path.s ,#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget) And CreateGadgetList(WindowID(0))
Result = MessageRequester("Datenbanküberschrift", "Enthält die Datenbank eine Überschrift?", #PB_MessageRequester_YesNo)
PanelGadget (0, 8, 8,WindowWidth(0)-20, WindowHeight(0)-20)
; Tabellen, seit Ihr alle da?
For n = 1 To CountList (Tabelle())
AddGadgetItem (0, -1, Tabelle.s)
ListIconGadget(n,1,1,WindowWidth(0)-27, WindowHeight(0)-48,"",44,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_MultiSelect|#PB_ListIcon_HeaderDragDrop)
If Result = #PB_MessageRequester_Yes
index = 1
For Spalte = 0 To Spalten ; Überschrift erstellen
AddGadgetColumn(n,1,DatabaseColumnName(#Datenbank, Spalten-Spalte),80)
Next
Else
index = 2
temp.s = "1" + Chr(10)
For Spalte = 0 To Spalten ; Überschrift erstellen
temp.s = temp.s + DatabaseColumnName(#Datenbank, Spalten-Spalte) + Chr(10)
AddGadgetColumn(n,1,"Spalte("+Str(Spalten-Spalte)+")",80)
Next
AddGadgetItem(n,-1,temp)
EndIf
While NextDatabaseRow(#Datenbank) ; alle Einträge durchlaufen
temp.s = Str(index) + Chr(10)
For Spalte = 0 To Spalten
If IsText
temp.s = temp.s + GetDatabaseString(#Datenbank,Spalte) + Chr(10)
Else
Select DatabaseColumnType(#Datenbank,Spalte)
Case 1
temp.s = temp.s + Str(GetDatabaseLong(#Datenbank,Spalte)) + Chr(10)
Case 2
temp.s = temp.s + GetDatabaseString(#Datenbank,Spalte) + Chr(10)
Case 3
temp.s = temp.s + Str(GetDatabaseFloat(#Datenbank,Spalte)) + Chr(10)
Case 4
temp.s = temp.s + Str(GetDatabaseDouble(#Datenbank,Spalte)) + Chr(10)
Case 5
temp.s = temp.s + Str(GetDatabaseQuad(#Datenbank,Spalte)) + Chr(10)
Default
temp.s = temp.s + "unknown information/" + Chr(10)
EndSelect
EndIf
Next Spalte
AddGadgetItem(n,-1,temp)
index + 1
Wend
NextElement(Tabelle())
sql.s = Tabelle()\Suchstring
Tabelle.s = Tabelle()\Tabellenname.s
DatabaseQuery(#Datenbank, sql)
Spalten = DatabaseColumns(#Datenbank) - 1
Next n
Repeat
ev.l= WaitWindowEvent()
If ev = #PB_Event_SizeWindow
; Fenster ich verändere mich
ResizeGadget(0, #PB_Ignore, #PB_Ignore,WindowWidth(0)-20, WindowHeight(0)-20)
For n = 1 To CountList (Tabelle())
ResizeGadget(n, #PB_Ignore, #PB_Ignore,WindowWidth(0)-27, WindowHeight(0)-48)
Next n
EndIf
Until ev = #PB_Event_CloseWindow
EndIf
Else
MessageRequester("Achtung", "Datenbank konnte nicht ausgelesen werden, Fehler: "+DatabaseError(), #PB_MessageRequester_Ok)
EndIf
Else
If Right(DatabaseError(),25) = "Kein zulässiges Kennwort."
Passwortfound + 1
If Passwortfound = 2
MessageRequester("Achtung", "Datenbank konnte nicht geöffnet werden da das Passwort falsch ist", #PB_MessageRequester_Ok)
Else
Goto Passwort
EndIf
Else
MessageRequester("Achtung", "Datenbank konnte nicht geöffnet werden, Fehler: "+DatabaseError(), #PB_MessageRequester_Ok)
EndIf
EndIf
EndIf
; DSN am Ende entfernen
RemoveDSN_(Path,Benutzer$,Passwort$)