ich habe arbeite gerade einen CodeSchnippsel durch, den ich anfüge.
Ist das O.K. das ich den Anfüge und noch Fragen dazu stelle, wenn
in dem Forum. Habe es so aufgefasst, dass ich den Code verwenden darf!!??
funktionierte. Warum?? Könntest Du da noch mal drüber sehen?
sql.s = Tabelle()\Suchstring ; !!!!! Hier erscheind ein Fehler: The linked list doesn't have a current element
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 : v1.03 / v1.02 / v1.01 / v1.00
; 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
; Sprache : Purebasic 4.10 Beta 2 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 ()
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$ = "," : WriteStringN(37, "DecimalSymbol=.") : EndIf
WriteStringN(37, "Format=Delimited("+Tabstring$+")")
CloseFile(37)
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 + ";"
Trennzeichen (databasename)
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(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
AddElement(Tabelle())
result = RemoveString(PeekS(*buffer, len), "'")
Tabelle()\Tabellenname.s = Left(result,Len(result)-1)
Tabelle()\Suchstring.s="Select * From ["+PeekS(*buffer, len)+"]"
Wend
FreeMemory(*buffer)
EndIf
EndIf
;result = RemoveString(result, "'")
ProcedureReturn result
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
#Datenbank = 0
Benutzer$ = ""
Passwort$ = ""
; InitDatabase()
UseODBCDatabase() ; !!! Von mir angepasst (anscheinend Befehlsänderung)
Path.s = OpenFileRequester("Bitte Datenbank zum Öffnen auswählen", "", "Datenbank Datei (*.xls;*.mdb;*.dbf;*.txt;*.csv)|*.xls;*.mdb;*.dbf;*.txt;*.csv",0)
Debug UCase(GetExtensionPart(Path.s))
Passwort:
If Passwortfound : PasswortBox(0,Benutzer$,Passwort$) : EndIf
; DSN anlegen
Base.s = AddDSN(Path,Benutzer$,Passwort$)
If Base
If OpenDatabase(#Datenbank, Base, Benutzer$, Passwort$)
; Anpassung der SQL Abfrage
x1.s = UCase(GetExtensionPart(Path.s)) ; !!!! Von mir eingefügt, damit die Select-Anweisung funkitoniert. Verstehe das Problem mit der Select-Anweisung nicht.
Select x1.s
; Select UCase(GetExtensionPart(Path.s)) ; !!!! Von mir auskommentiert, da dies anscheinend nicht funktionierte?? Warum??
Case "ACCESS", "MDB", "EXCEL", "XLS"
GetTables(#Datenbank) ; !!!! Problem evtl. Befehlsänderung?? s. Fehler in Zeile sql.s = Tabelle()\Suchstring
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 ; !!!!! Hier erscheind ein Fehler: The linked list doesn't have a current element
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))
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)
For Spalte = 0 To Spalten ; Überschrift erstellen
AddGadgetColumn(n,1,DatabaseColumnName(#Datenbank, Spalten-Spalte),80)
Next
index = 1
While NextDatabaseRow(#Datenbank) ; alle Einträge durchlaufen
temp.s = Str(index) + Chr(10)
For Spalte = 0 To Spalten
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
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$)
den Zugriff für die Firebird-Datenbank umzusetzen.
