#include "Fivewin.ch"
#include "tdolphin.ch"
#include "xbrowse.ch"
#include "slider.ch"
#include "sql.ch"
#include "ado.ch"
#include "xml.ch"
STATIC oDbf,oDlg,oSay,oGet,oBtn,oBmp,oWnd,oBrw,oError
STATIC oSlid,oTmrRta,oTmrAsk,oTmr
STATIC oFont,oFbold,oIcon
STATIC aProdu:={}
STATIC aFinal:={}
STATIC aFiles:={}
STATIC aActivo:={}
STATIC aRtaItem:={"","","",""}
STATIC cFechaTrx,cHoraTrx,cCodFar,cCodOs,cNroAfi,cFechaRec,cFechaDis,cFechaFor
STATIC cNroRec,cIDMsg,cVersion,cTpoMatr,cPcia,cMatr,cTpoPres,cPlan,cProlon
STATIC cTpoMsg,cCodAct,cWorkPath,cNroTrx,nNroTrx,cCausa,cNomAfi,cNomFar,cNomOs
STATIC nVar:=0
STATIC oRs,oCon,lOk,cCadena
MEMVAR oP,aRta
REQUEST DBFCDX
///////////////////
Function Main()
local oGet[8],oSay[9],oBtnTmr,oTray
local cHost,nTimeAsk,nTimeRta
local nTotAcos,nTotAcaf,nTotal
local oServer
local cServer, cUser, cPassword, nPort, cDBName,nFlags
local oErr,oQry,nFld
PUBLIC oP:=TVarPub()
SET DATE BRITISH
SET DELETED ON
SET EXCLUSIVE OFF
SET SOFTSEEK ON
SET WRAP ON
SET _3DLOOK ON
SET EPOCH TO YEAR(date()) - 50
SET MULTIPLE ON
SetHandleCount( 100 )
BWCCRegister(Getresources())
SET RESOURCES TO "cfrncomc.dll"
RDDSetDefault( "DBFCDX" )
DEFINE ICON oIcon RESOURCE "system"
DEFINE FONT oFont NAME "MS SANS SERIF" SIZE 0,8
DEFINE FONT oFbold NAME "MS SANS SERIF" SIZE 0,8 BOLD
/* conexion al mysql servidor con tdolphin.lib */
oServer := NIL
cServer := "localhost"
cUser := "root"
cPassword := "trident"
nPort := "3306"
cDBName := "mysqlpro"
nFlags := "0"
TRY
CONNECT oServer HOST cServer ;
USER cUser ;
PASSWORD cPassword ;
PORT nPort ;
FLAGS nFlags;
DATABASE cDBName
msginfo("Conectado...")
CATCH oErr
msgInfo("error...")
RETURN NIL
END
oQry = TDolphinQry():New( "SELECT * FROM productos", oServer )
nFld := oQry:FCount() // Total de campos
WHILE !oQry:Eof()
? oQry:FieldGet( 1 ), oQry:FieldGet( 2 ), oQry:FieldGet( 3 ), oQry:FieldGet( 4 ), oQry:FieldGet( 5 ), oQry:FieldGet( 6 )
// for n := 1 to nFld
// ? oQry:FieldGet( n )
// next
oQry:Skip()
END WHILE
oServer:end()
***ACA SE PRODUCE EL ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! y se cuelga todo
#include "Fivewin.ch"
#include "tdolphin.ch"
#include "xbrowse.ch"
#include "slider.ch"
#include "sql.ch"
#include "ado.ch"
#include "xml.ch"
STATIC oDbf,oDlg,oSay,oGet,oBtn,oBmp,oWnd,oBrw,oError
STATIC oSlid,oTmrRta,oTmrAsk,oTmr
STATIC oFont,oFbold,oIcon
STATIC aProdu:={}
STATIC aFinal:={}
STATIC aFiles:={}
STATIC aActivo:={}
STATIC aRtaItem:={"","","",""}
STATIC cFechaTrx,cHoraTrx,cCodFar,cCodOs,cNroAfi,cFechaRec,cFechaDis,cFechaFor
STATIC cNroRec,cIDMsg,cVersion,cTpoMatr,cPcia,cMatr,cTpoPres,cPlan,cProlon
STATIC cTpoMsg,cCodAct,cWorkPath,cNroTrx,nNroTrx,cCausa,cNomAfi,cNomFar,cNomOs
STATIC nVar:=0
STATIC oRs,oCon,lOk,cCadena
MEMVAR oP,aRta
REQUEST DBFCDX
///////////////////
Function Main()
local oGet[8],oSay[9],oBtnTmr,oTray
local cHost,nTimeAsk,nTimeRta
local nTotAcos,nTotAcaf,nTotal
local oServer
local cServer, cUser, cPassword, nPort, cDBName,nFlags
local oErr,oQry,nFld
PUBLIC oP:=TVarPub()
SET DATE BRITISH
SET DELETED ON
SET EXCLUSIVE OFF
SET SOFTSEEK ON
SET WRAP ON
SET _3DLOOK ON
SET EPOCH TO YEAR(date()) - 50
SET MULTIPLE ON
SetHandleCount( 100 )
BWCCRegister(Getresources())
SET RESOURCES TO "cfrncomc.dll"
RDDSetDefault( "DBFCDX" )
DEFINE ICON oIcon RESOURCE "system"
DEFINE FONT oFont NAME "MS SANS SERIF" SIZE 0,8
DEFINE FONT oFbold NAME "MS SANS SERIF" SIZE 0,8 BOLD
/* conexion al mysql servidor con tdolphin.lib */
oServer := NIL
cServer := "localhost"
cUser := "root"
cPassword := "trident"
nPort := "3306"
cDBName := "mysqlpro"
nFlags := "0"
TRY
CONNECT oServer HOST cServer ;
USER cUser ;
PASSWORD cPassword ;
PORT nPort ;
FLAGS nFlags;
DATABASE cDBName
msginfo("Conectado...")
CATCH oErr
msgInfo("error...")
RETURN NIL
END
oQry = TDolphinQry():New( "SELECT * FROM productos", oServer )
nFld := oQry:FCount() // Total de campos
WHILE !oQry:Eof()
? oQry:FieldGet( 1 ), oQry:FieldGet( 2 ), oQry:FieldGet( 3 ), oQry:FieldGet( 4 ), oQry:FieldGet( 5 ), oQry:FieldGet( 6 )
// for n := 1 to nFld
// ? oQry:FieldGet( n )
// next
oQry:Skip()
END WHILE
// aqui el cierre del objeto oQry
oQry:end()
oServer:end()
***ACA SE PRODUCE EL ERROR !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! y se cuelga todo
wmormar wrote:Solo veo que necesitar terminar el objeto query, siempre es necesario para evitar ese tipo de GPF.
#include "Fivewin.ch"
#include "tdolphin.ch"
#include "xbrowse.ch"
#include "slider.ch"
STATIC oDbf,oDlg,oSay,oGet,oBtn,oBmp,oWnd,oBrw,oError,oServer
STATIC oSlid
STATIC oFont,oFbold,oIcon
STATIC oRs,oCon,lOk,cCadena,oQry
STATIC cServer, cUser, cPassword, nPort, cDBName,nFlags,hIni,nServ
MEMVAR oP
REQUEST DBFCDX
///////////////////
Function Main()
local oSay[10],oBar,oIco,oMsg,oMsgOpe,cTitle
local oErr,nFld,n
// PUBLIC oP:=TVarPub()
SET DATE BRITISH
SET DELETED ON
SET EXCLUSIVE OFF
SET SOFTSEEK ON
SET WRAP ON
SET _3DLOOK ON
SET EPOCH TO YEAR(date()) - 50
SET MULTIPLE ON
SetHandleCount( 100 )
* BWCCRegister(Getresources())
SET RESOURCES TO "testmsql.dll"
RDDSetDefault( "DBFCDX" )
DEFINE ICON oIcon RESOURCE "system"
DEFINE FONT oFont NAME "MS SANS SERIF" SIZE 0,8
DEFINE FONT oFbold NAME "MS SANS SERIF" SIZE 0,8 BOLD
DEFINE BITMAP oBmp FILE "\testdol\senior.bmp"
* SetGetColorFocus(CLR_2)
* cHost:=Winexec("PING pharma-co.no-ip.org")
* ? cHost
cTitle:=" MySQL CONSULTAS"
DEFINE WINDOW oWnd FROM 8,30 TO 30,110 ;
TITLE cTitle ;
ICON oIco
DEFINE BUTTONBAR oBar OF oWnd 3D SIZE 40,40
DEFINE BUTTON RESOURCE "creden" OF oBar ;
ACTION (sound(),Conectar()) ;
FLAT ;
TOOLTIP OemToAnsi("Inicia la conexionn con el Servidor")
DEFINE BUTTON RESOURCE "stock" OF oBar ;
ACTION (sound()) ;
FLAT ;
TOOLTIP OemToAnsi("Consulta de Existencias"+CRLF+"y Precios de Productos")
DEFINE BUTTON RESOURCE "afiliados" OF oBar ;
ACTION (sound() ) ;
FLAT GROUP ;
TOOLTIP "Cuenta Corriente"+CRLF+"Saldo y Limite"
DEFINE BUTTON RESOURCE "cuentas" OF oBar ;
ACTION (sound()) ;
FLAT ;
TOOLTIP OemToAnsi("Cuenta Corriente"+CRLF+"Ultimos 10 Movimientos")
DEFINE BUTTON RESOURCE "phone" OF oBar ;
ACTION (sound()) ;
FLAT GROUP ;
TOOLTIP oemtoansi("ABM y Selecci¢n de IP para el FTP")
DEFINE BUTTON RESOURCE "tools" OF oBar ;
ACTION (sound()) ;
FLAT ;
TOOLTIP "Reordenamiento de Archivos"
DEFINE BUTTON RESOURCE "exit" OF oBar ;
ACTION (sound(),oWnd:end()) ;
FLAT GROUP ;
TOOLTIP OemToAnsi("SALIR")
SET MESSAGE OF oWnd TO "TESTDOLPHIN"
DEFINE MSGITEM oMsg SIZE 180 OF oWnd:oMsgBar FONT oFbold COLOR CLR_HRED
DEFINE MSGITEM oMsgOpe OF oWnd:oMsgBar SIZE 150 BITMAP "B_FACES","B_FACES" ;
PROMPT "OFF LINE " FONT oFbold
oWnd:oMsgBar:dateOn()
oWnd:oMsgBar:ClockOn()
oWnd:oFont := oFont
oWnd:bPainted := { | hDC | PalBmpDraw( hDC,0,0,oBmp:hBitmap ) }
ACTIVATE WINDOW oWnd
if(oServer != NIL)
oServer:end()
endif
dbcloseall()
set resources to
set 3dlook off
Release objects oFont,oFbold,oSlid
Sound()
return nil
//...............................
Function Conectar()
//..Identificador para el ini
local c:="mysql"
local oGet[7]
local cText,nFld
local nCount:=0
hIni := HB_ReadIni( "testmsql.ini" )
oServer := NIL
cServer := hIni[ c ]["host"]
cUser := hIni[ c ]["user"]
cPassword := hIni[ c ]["psw"]
nPort := val(hIni[ c ]["port"])
cDBName := hIni[ c ]["dbname"]
nFlags := val(hIni[ c ]["flags"])
nServ := val(hIni[ c ]["nServ"])
DEFINE DIALOG oDlg RESOURCE "ServerConect"
REDEFINE BITMAP RESOURCE "pcvert" ID 4007 OF oDlg
REDEFINE GET oGet[1] VAR cServer ID 4008 OF oDlg UPDATE
REDEFINE GET oGet[2] VAR cUser ID 4009 OF oDlg UPDATE
REDEFINE GET oGet[3] VAR cPassword ID 4010 OF oDlg UPDATE
REDEFINE GET oGet[4] VAR nPort ID 4011 OF oDlg UPDATE
REDEFINE GET oGet[5] VAR cDbname ID 4012 OF oDlg UPDATE
REDEFINE GET oGet[6] VAR nFlags ID 4013 OF oDlg UPDATE
REDEFINE GET oGet[7] VAR nServ ID 4018 OF oDlg UPDATE
REDEFINE BUTTON ID 4015 OF oDlg ACTION (sound())
REDEFINE BUTTON ID 4016 OF oDlg ACTION (sound(),oDlg:end()) // sale del oDlg y se conecta -->
ACTIVATE DIALOG oDlg CENTERED
TRY
CONNECT oServer HOST cServer ;
USER cUser ;
PASSWORD cPassword ;
PORT nPort ;
FLAGS nFlags;
DATABASE cDBName
CATCH oErr
msgInfo("Se ha producido un error"+CRLF+;
"en la conexion con el Servidor"+CRLF+;
"Reintente...","Error de Conexion...")
RETURN NIL
END
IF !oServer:lError
cText :=""
cText += "Conexion OK" + CRLF
cText += "Host: " + oServer:cHost +CRLF
cText += "Database: " +oServer:cDBName + CRLF
cText += oServer:GetServerInfo() + CRLF
cText += oServer:GetClientInfo() + CRLF
MsgInfo( cText,"informacion...")
ENDIF
oQry = TDolphinQry():New( "SELECT first_name,Last_name FROM president", oServer )
nFld := oQry:FCount() // Total de campos
While !oQry:EOF()
nCount++
? oQry:First_name, oQry:Last_name
oQry:skip()
if nCount >= 10
exit
endif
Enddo
///// HACE TODO EL QUERY Y ME MUESTRA LOS REGISTROS SIN PROBLEMAS
oQry:end()
oServer:end()
//// CUANDO TERMINA LA FUNCION Y RETORNA A LA VENTANA DE INICIO SE PRODUCE EL ERROR Y SE CUELGA TODO
RETURN NIL
//..............
FUNCTION sound()
SndPlaySound("click.wav")
Return Nil
#Borland make sample, (c) FiveTech Software 2005-2009
HBDIR=c:\harbour
BCDIR=c:\bcc55
FWDIR=c:\fwh
#change these paths as needed
.path.OBJ = .\obj
.path.PRG = .\
.path.CH = $(FWDIR)\include;$(HBDIR)\include
.path.C = .\
.path.rc = .\
#important: Use Uppercase for filenames extensions, in the next two rules!
PRG = \
TESTMSQL.PRG \
C = \
PROJECT : TESTMSQL.exe
Testmsql.exe : $(PRG:.PRG=.OBJ) $(C:.C=.OBJ) Testmsql.res
echo off
echo $(BCDIR)\lib\c0w32.obj + > b32.bc
echo obj\testmsql.obj, + >> b32.bc
echo testmsql.exe, + >> b32.bc
echo testmsql.map, + >> b32.bc
echo $(FWDIR)\lib\FiveH.lib $(FWDIR)\lib\FiveHC.lib + >> b32.bc
echo $(FWDIR)\lib\dolphin.lib $(FWDIR)\lib\libmysql.lib + >> b32.bc
echo $(HBDIR)\lib\hbrtl.lib + >> b32.bc
echo $(HBDIR)\lib\hbvm.lib + >> b32.bc
echo $(HBDIR)\lib\gtgui.lib + >> b32.bc
echo $(HBDIR)\lib\hblang.lib + >> b32.bc
echo $(HBDIR)\lib\hbmacro.lib + >> b32.bc
echo $(HBDIR)\lib\hbrdd.lib + >> b32.bc
echo $(HBDIR)\lib\rddntx.lib + >> b32.bc
echo $(HBDIR)\lib\rddcdx.lib + >> b32.bc
echo $(HBDIR)\lib\rddfpt.lib + >> b32.bc
echo $(HBDIR)\lib\hbsix.lib + >> b32.bc
echo $(HBDIR)\lib\hbdebug.lib + >> b32.bc
echo $(HBDIR)\lib\hbcommon.lib + >> b32.bc
echo $(HBDIR)\lib\hbpp.lib + >> b32.bc
echo $(HBDIR)\lib\hbwin.lib + >> b32.bc
echo $(HBDIR)\lib\hbpcre.lib + >> b32.bc
echo $(HBDIR)\lib\hbct.lib + >> b32.bc
echo $(HBDIR)\lib\hbcpage.lib + >> b32.bc
rem Uncomment these two lines to use Advantage RDD
rem echo $(HBDIR)\lib\rddads.lib + >> b32.bc
rem echo $(HBDIR)\lib\Ace32.lib + >> b32.bc
echo $(BCDIR)\lib\cw32.lib + >> b32.bc
echo $(BCDIR)\lib\import32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\odbc32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\nddeapi.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\iphlpapi.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\msimg32.lib + >> b32.bc
echo $(BCDIR)\lib\psdk\rasapi32.lib, >> b32.bc
IF EXIST testmsql.res echo testmsql.res >> b32.bc
$(BCDIR)\bin\ilink32 -Gn -aa -Tpe -s @b32.bc
del b32.bc
.PRG.OBJ:
$(HBDIR)\bin\harbour $< /L /N /W /Oobj\ /I$(FWDIR)\include;$(HBDIR)\include
$(BCDIR)\bin\bcc32 -c -tWM -I$(HBDIR)\include -oobj\$& obj\$&.c
.C.OBJ:
echo -c -tWM -D__HARBOUR__ -DHB_API_MACROS > tmp
echo -I$(HBDIR)\include;$(FWDIR)\include >> tmp
$(BCDIR)\bin\bcc32 -oobj\$& @tmp $&.c
del tmp
testmsql.res : testmsql.rc
$(BCDIR)\bin\brc32.exe -r Testmsql.rc
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 55 guests