Please, see the next code. I has work with this in the last year. This work fine with MySQL via ODBC.
Code: Select all
Dim DatabaseType.s(4)
DatabaseType(0) = "Desconocido"
DatabaseType(1) = "Numerico"
DatabaseType(2) = "String"
DatabaseType(3) = "Flotante"
#TextGadget1 = 1
#TextGadget2 = 2
#TextGadget3 = 3
#StringGadget1 = 4
#StringGadget2 = 5
#StringGadget3 = 6
#ButtonGadget1 = 7
#ButtonGadget2 = 8
#TextGadget4=9
#ComboBoxGadget1=11
#Database=0
Dim NombreCol$(1)
Dim Texto$(1)
#WindowHeight = 600
#WindowWidth = 667
Top=180
If OpenWindow(0,0,0, #WindowWidth, #WindowHeight, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget,"Apertura y Consulta BASES DE DATOS")
;If CreateGadgetList(WindowID())
;CONTROLS: (GADGETS)
; ------------------------------------------
If CreateGadgetList(WindowID())
TextGadget(1,30,40,98,17,"Base de Datos")
TextGadget(2,30,70,55,17,"Usuario")
TextGadget(3,30,100,80,17,"Contraseña")
StringGadget(4,130,40,105,24,"")
hwnd=StringGadget(5,130,70,115,24,"")
hwnd1=StringGadget(6,130,100,115,24,"")
ButtonGadget(7,50,130,89,25,"&Aceptar")
ButtonGadget(8,180,130,89,25,"&Salir")
EndIf
;------------------Codigo traspasado desde aki
; Comienzo del codigo anadido -----------------------------------------------------------
If InitDatabase() =0
MessageRequester("Error", "No puedo inicializar entorno ODBC (Necesario ODBC v3 o posterior)", 0)
End
EndIf
ActivateGadget(4) ; Activa el 4 que es BaseDatos$
Repeat
EventID.l = WaitWindowEvent()
If EventID = #PB_EventGadget
Select EventGadgetID()
Case 4
BaseDatos$=UCase(GetGadgetText(4)) ; Nombre Base de Datos
Case 5
Usuario$=GetGadgetText(5) ; Usuario
SendMessage_(hwnd,197,10,0) ; Solo permite 10 caracteres. FUNCIONA
;MessageRequester("Usuario",Usuario$,0)
Case 6
Password$=GetGadgetText(6) ; Password
SendMessage_(hwnd1,204,42,0); 42 = asc("*")
Case 7
If ExamineDatabaseDrivers()
While NextDatabaseDriver()
Control$=UCase(DatabaseDriverName())
If Control$=BaseDatos$
Dato=1
EndIf
Wend
EndIf
If Dato1
MessageRequester("Error "+BaseDatos$, "No Existen Drivers para esta Base de Datos. Intente Manualmente", 0)
If OpenDatabaseRequester(#Database)=0
MessageRequester("Error", "Driver NO Seleccionado manualmente para "+BaseDatos$, 0)
End
EndIf
Else
If OpenDatabase(#Database, BaseDatos$, Usuario$, Password$)
;MessageRequester(BaseDatos$+" "+Str(#Database), "A B I E R T A Correctamente", 0)
UseDatabase(#Database)
Command$="SHOW TABLES FROM "+BaseDatos$+";"
If DatabaseQuery(Command$)=0
MessageRequester("Error","QUERY mal !"+Command$,0)
End
EndIf
TextGadget(10,330,27,153,17,"Tablas Disponibles")
ListViewGadget(11,332,47,153,100)
While NextDatabaseRow()
Tabla$=GetDatabaseString(0)
AddGadgetItem(11,-1, Tabla$)
Wend
SetGadgetState(11,0)
ButtonGadget(9,500,130, 89, 25, "Seleccione")
Tabla$=GetGadgetText(11)
MessageRequester(BaseDatos$, Tabla$+" "+Str(resul) ,0)
;Command$="SHOW COLUMNS FROM "+Tabla$+";"
;Command$="SELECT * FROM "+Tabla$+";"
Gosub Fichas
Else
MessageRequester("Error", "No puedo ABRIR la Base de Datos "+BaseDatos$, 0)
End
EndIf
EndIf
Case 9
Tabla$=GetGadgetText(11)
MessageRequester(BaseDatos$, Tabla$+" "+Str(resul) ,0)
;Command$="SHOW COLUMNS FROM "+Tabla$+";"
Gosub Fichas
EndSelect
EndIf
Quit=1
Until EventID = #PB_EventCloseWindow
EndIf
End
Fichas:
ClearGadgetItemList(2)
;---------------COMIENZO DE FICHAS -----------------
PanelGadget(10, 20, Top, #WindowWidth-50, 360)
;AddGadgetItem(10, 0, "Abrir")
linea=0
AddGadgetItem(10, 1, "Descripcion")
Command$="SHOW COLUMNS FROM "+Tabla$+";"
Gosub SQL
ListIconGadget(1, 20, 20, 575, 245, NombreCol$(0), 150)
For k=1 To NbColumns-1
AddGadgetColumn(1, k, NombreCol$(k), 150)
Next
;MessageRequester("","Columnas: "+Str(NbColumns-1),0)
While NextDatabaseRow()
For k=0 To NbColumns-1
Texto.s=Texto.s+GetDatabaseString(k)+Chr(10)
;AddListIconGadgetItem(2,pos,GetDatabaseString(k),0)
;MessageRequester("","Hasta aki llega: "+GetDatabaseString(k),0)
Next
AddGadgetItem(1,linea,Texto.s,0)
linea=linea+1
Texto.s=""
Wend
linea=0
AddGadgetItem(10, 2, "Contenido")
Command$="SELECT * FROM "+Tabla$+";"
Gosub SQL
ListIconGadget(2, 20, 20, 575, 245, NombreCol$(0), 150)
For k=1 To NbColumns-1
AddGadgetColumn(2, k, NombreCol$(k), 150)
Next
;MessageRequester("","Columnas: "+Str(NbColumns-1),0)
While NextDatabaseRow()
For k=0 To NbColumns-1
Texto.s=Texto.s+GetDatabaseString(k)+Chr(10)
;AddListIconGadgetItem(2,pos,GetDatabaseString(k),0)
;MessageRequester("","Hasta aki llega: "+GetDatabaseString(k),0)
Next
AddGadgetItem(2,linea,Texto.s,0)
linea=linea+1
Texto.s=""
Wend
ClosePanelGadget()
Return
SQL:
If DatabaseQuery(Command$)
NbColumns = DatabaseColumns()
If NbColumns=0
NbColumns=1
EndIf
Dim NombreCol$(NbColumns)
Dim Texto$(NbColumns)
For k=0 To NbColumns-1
NombreCol$(k)=DatabaseColumnName(k)
; + " - " + DatabaseType(DatabaseColumnType(k)))
Next
;While NextDatabaseRow()
;PrintN(GetDatabaseString(0))
;Wend
Else
MessageRequester("Error","QUERY mal !"+Command$,0)
End
EndIf
Return