Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post Reply
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

/*
// Clase Ttable
// Creado por Juan Navas jnavas@datapronet.com
// Objetivo: Insertar/Modificar Registros en Base de datos SQL mediante Objeto
// Lee todos los archivos del directorio y los guarda en la tabla MYTABLE, por ahora solo inserta registros.
// Un proximo release incluira la funcionalidad para modificar y eliminación registros
// Requiere eagle1.lib , tambien se puede utilizar Otro gestor de base de datos u Odbc
*/

#include "FiveWin.ch"

STATIC oServer,oDb,bSqlDate,cTypeBD

FUNCTION MAIN()
LOCAL cIp :="localhost"
LOCAL cLogin:="root"
LOCAL cPass :=""
LOCAL oTable
LOCAL aFiles:=DIRECTORY("*.*"),I

SET DATE FREN
SET CENTURY ON

cTypeBD:="MYSQL"

IF !CONECTAR(cIp,cLogin,cPass)
SALIR()
RETURN NIL
ENDIF

// Conversion de Date Hacia Caracter
bSqlDate:={|nD,nM,nA|STRZERO(nA,4)+""+STRZERO(nM,2)+""+STRZERO(nD,2)}

SETDB("PRUEBAS") // Crea la BD PRUEBAS
ISTABLAS() // Verifica la Existencia de las Tablas

oTable:=OpenTable("SELECT * FROM MYTABLA",.F.) // Abre objeto Tabla

FOR I=1 TO LEN(aFiles)

oTable:AppendBlank() // Utilizara Insert INTO
oTable:Replace("FILE",aFiles[I,1]) // Asigna Valores
oTable:Replace("DATE",aFiles[I,3])
oTable:Replace("SIZE",aFiles[I,2])
oTable:Replace("LOGICO",.T.)

IF !oTable:Commit() // Ejecutar INSERT INTO
EXIT
ENDIF

NEXT I

oTable:End()

? oTable:cSqlExec,LSTR(LEN(aFiles))+CRLF+"Archivos registrados en tabla MYTABLA"

RETURN NIL

FUNCTION OpenTable(cSql,lLoad,oDataBase)

DEFAULT oDataBase:=oDb

RETURN TTable():New(cSql,lLoad,oDataBase)

CLASS Ttable

DATA oDataBase
DATA oCursor

DATA lAppend INIT .T.
DATA aBuffer INIT {}

DATA cWhere INIT ""
DATA cTable
DATA cSql
DATA cSqlExec INIT ""

METHOD New(cSql,lLoad,oDataBase) CONSTRUCTOR
METHOD Replace(cField,uValue)
METHOD Commit(cWhere)
METHOD AppendBlank() INLINE ::lAppend:=.T.
METHOD InsertInto()
METHOD HandleEvent(nMsg, nWParam, nLParam ) EXTERN ;
WndHandleEvent( Self, nMsg, nWParam, nLParam )

METHOD End()

ENDCLASS

METHOD New( cSql,lLoad, oDataBase) CLASS Ttable

DEFAULT lLoad:=.T.

::oDatabase:=oDataBase
::cTable :=SQLTABLENAME(cSql)

? cSql,::cTable

RETURN SELF

METHOD Replace(cField,uValue) CLASS TTABLE
LOCAL nAt

cField:=UPPE(ALLTRIM(cField))
nAt:=ASCAN(::aBuffer,{|a,n|a[1]=cField})

IF nAt=0
AADD(::aBuffer,{cField,uValue})
ELSE
::aBuffer[nAt,2]:=uValue
ENDIF

RETURN NIL

METHOD COMMIT(cWhere) CLASS TTABLE

IF ::lAppend
RETURN ::INSERTINTO()
ENDIF

RETURN .T.

METHOD INSERTINTO() CLASS TTABLE
LOCAL uValue,cField,cType,nLen,I,cSql
LOCAL cFields:="",cValues:=""

FOR I := 1 TO LEN( ::aBuffer )

cField := ::aBuffer[I,1]
uValue := ::aBuffer[I,2]
uValue :=CTOSQL(uValue)
cFields:=cFields+IF(Empty(cFields),"",",")+cField
cValues:=cValues+IF(Empty(cValues),"",",")+uValue

NEXT

cSql := "INSERT INTO " + ::cTable + " ("+cFields+") VALUES ("+cValues+")"

// Esta ejecución Clase TMSCONNET de Eagle
IF ("TMS"$oServer:Classname()) .AND. !oDb:ExecSQL(cSql)
MsgAlert("Sentencia Rechazada "+cSql)
RETURN .F.
ENDIF

::cSqlExec:=cSql

RETURN .T.

METHOD End()
RETURN NIL

EXIT PROCEDURE SALIR()

IF ValType(oDb)="O"
oDb:Close()
ENDIF

IF ValType(oServer)="O"
oServer:Close()
ENDIF

RETURN

STATIC FUNCTION CONECTAR(cIp,cLogin,cPass,nPort,lError)

cIp := ALLTRIM(cIp )
cLogin := ALLTRIM(cLogin)
cPass := ALLTRIM(cPass )

DEFAULT nPort :=3306,;
lError:=.F.

CursorWait()


IF cTypeBD="MYSQL"

oServer:= TMSConnect():New() // Inicia el objeto Conexion Mediante la clase Eagle

oServer:SetAutoError( lError )

IF oServer:Connect( cIp, cLogin , cPass , NIL, nPort )
oServer:Reconnect()
ELSE
oServer:Close()
MsgAlert( "No hay conexión con "+cIp )
RETURN .F.
ENDIF

ENDIF

RETURN .T.

STATIC FUNCTION SETDB(cDataBase)

IF "TMS"$oServer:Classname()

IF !oServer:ExistDb(cDataBase)
oServer:CreateDB(cDataBase)
ENDIF

oDb:=TMSDataBase():New( oServer, cDataBase, .t. )
oDb:Use()
oDb:Select()

ENDIF

RETURN .T.


FUNCTION ISTABLAS()
LOCAL aStruct:={}
LOCAL cTable:="MYTABLA"

IF "TMS"$oServer:Classname() .AND. !oDb:ExistTable(cTable)
AADD(aStruct,{"FILE", "C",250,0})
AADD(aStruct,{"DATE", "D",8 ,0})
AADD(aStruct,{"SIZE", "N",12 ,0})
AADD(aStruct,{"LOGICO","N",1 ,0}) // Sera Logico Un Digito
oDb:CreateTable( cTable, aStruct, NIL )
ENDIF

RETURN .T.

STATIC FUNCTION STRSQL(uValue) // Quita el slash por Chr(28)

IF ValType(uValue)="D" // Fecha en SQL
RETURN SQLDATE(uValue)
ENDIF

IF ValType(uValue)="L"
RETURN IIF(uValue,"1","0")
ENDIF

IF ValType(uValue)="N"
uValue:=ALLTRIM(STR(uValue))
ENDIF

RETURN uValue

STATIC FUNCTION SQLDATE(dFecha)
LOCAL nD,nM,nA

IF !Empty(bSqlDate) .AND. ValType(dFecha)="D"
nD:=DAY(dFecha)
nM:=MONTH(dFecha)
nA:=YEAR(dFecha)
dFecha:=EVAL(bSqlDate,nD,nM,nA)
RETURN dFecha
ENDIF

RETURN DTOS(dFecha)

STATIC FUNCTION SQLTABLENAME(cSql)
LOCAL cTable
cTable :=ALLTRIM(SUBS(cSql,AT(" FROM ",UPPE(cSql))+5,LEN(cSql)))
cTable :=IIF(" " $cTable,LEFT(cTable,AT(" " ,cTable)),cTable)
cTable :=IIF(CRLF$cTable,LEFT(cTable,AT(CRLF,cTable)),cTable)
RETURN cTable

/*
// Genera WHERE, Entre Campos y Valores
*/
FUNCTION GetWhere(cSigno,uValue,cValtype,lAlltrim)
LOCAL cWhere:=""

DEFAULT cValType:=ValType(uValue)
DEFAULT cSigno :="=",lAlltrim:=.T.

IF EMPTY(uValue).AND.LEN(cSigno)="="
uValue:=cSigno
cSigno:="="
ENDIF

IF ValType(uValue)="C"
uValue:=STRSQL(ALLTRIM(uValue))
ENDIF

DO CASE

CASE cValType="N" .OR. cValType="L"

cWhere:=cSigno+STRSQL(uValue)

CASE cValType="D"

cWhere:=cSigno+CTOSQL(uValue)

IF cTypeBD="MSSQL" .AND. "NULL"$cWhere
cWhere:=STRTRAN(cWhere,"="," IS ")
ENDIF

IF cTypeBD="MSSQL" .AND. "NULL"$cWhere
cWhere:=STRTRAN(cWhere,"<>"," IS NOT ")
ENDIF

OTHE

uValue:=IIF( ValType(uValue)="C",ALLTRIM(uValue) , uValue )
uValue:=IIF( ValType(uValue)="C",STRSQLOFF(uValue),STRSQL(uValue))


IF "LIKE["$cSigno

cSigno:=STRTRAN(cSigno,"X",uValue)
cSigno:=STRTRAN(cSigno,"["," '")
cSigno:=STRTRAN(cSigno,"]","'")

IF "NOT_LIKE"$cSigno
cSigno:=STRTRAN(cSigno,"NOT_LIKE"," NOT LIKE")
ENDIF

cWhere:=" "+cSigno+" "

ELSE

cWhere:=cSigno+"'"+uValue+"'"

ENDIF

ENDCASE

RETURN cWhere

FUNCTION CTOSQL(uValue)

DO CASE

CASE ValType(uValue)="C"
uValue:=STRSQL(uValue)
CASE ValType(uValue)="N"
uValue:=ALLTRIM(STR(uValue))
RETURN uValue
CASE ValType(uValue)="L"
RETURN IIF( uValue,"1","0")
CASE ValType(uValue)="D"
IF EMPTY(uValue) .AND. cTypeBD="MSSQL"
RETURN 'NULL'
ENDIF
uValue:=SQLDATE(uValue)

ENDCASE

RETURN "'"+ALLTRIM(uValue)+"'"

FUNCTION STRSQLOFF(uValue)
// Quita el slash por Chr(28)

IF ValType(uValue)="C" .AND. cTypeBD="MSSQL" .AND. CHR(250)$uValue
uValue:=STRTRAN(uValue,CHR(250),"'")
RETURN uValue
ENDIF

IF ValType(uValue)="C".AND. CHR(29)$uValue
uValue:=STRTRAN(uValue,CHR(29),"'") // "CUALQUIER COSA SDFSDFSDFD "+CRLF //+MEMOREAD("\DWH\PRG\WINDOW.PRG")
ENDIF

IF ValType(uValue)="C" .AND. (CHR(28)$uValue .OR. CHR(29)$uValue)
uValue:=STRTRAN(uValue,CHR(28),"\")
uValue:=STRTRAN(uValue,CHR(29),"'")
ENDIF

RETURN uValue

FUNCTION lstr(nValue)
RETURN ALLTRIM(STR(nValue))
Top
User avatar
joseluisysturiz
Posts: 2064
Joined: Fri Jan 06, 2006 9:28 pm
Location: Guatire - Caracas - Venezuela
Contact:
Contact joseluisysturiz

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by joseluisysturiz »

Saludos Juan, tendras algo para hacer backup-restore de tablas mysql.? gracias, saludos... :shock:
Dios no está muerto...

Gracias a mi Dios ante todo!
Top
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

joseluisysturiz wrote:Saludos Juan, tendras algo para hacer backup-restore de tablas mysql.? gracias, saludos... :shock:

Jose Luis
Gracias por la confianza
Con respecto a los respaldos de bases de datos recomiendo "MySQL Administrator", desde hace años implemente MYSQLDUMP no era facil recuperar los respaldos.
Te enviare un archivo.bat que se ejecuta desde tareas automáticas, luego se comprime con pkzip y finalmente se sube a un servidor FTP. En mi caso utilizo tablas mediante INNODB con integridad referencial donde no existe la figura de tablas sino un solo repositorio.
Top
User avatar
joseluisysturiz
Posts: 2064
Joined: Fri Jan 06, 2006 9:28 pm
Location: Guatire - Caracas - Venezuela
Contact:
Contact joseluisysturiz

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by joseluisysturiz »

jnavas wrote:
joseluisysturiz wrote:Saludos Juan, tendras algo para hacer backup-restore de tablas mysql.? gracias, saludos... :shock:

Jose Luis
Gracias por la confianza
Con respecto a los respaldos de bases de datos recomiendo "MySQL Administrator", desde hace años implemente MYSQLDUMP no era facil recuperar los respaldos.
Te enviare un archivo.bat que se ejecuta desde tareas automáticas, luego se comprime con pkzip y finalmente se sube a un servidor FTP. En mi caso utilizo tablas mediante INNODB con integridad referencial donde no existe la figura de tablas sino un solo repositorio.

Juan, nos conocemos, hemos conversado y hasta trabaje para datapro hace años, con Joel en la hoyada y un tiempo en los dos caminos, disculpa si sone con mucha confianza, se que no te acuerdas de todos los que hemos pasado por datapro y como trabaje mas con Joel(proandsys) y en sabana grande, que contigo, menos me recordaras...hace bastante tiempo hablamos en tu oficina. Estoy haciendo pruebas directamente con mysqldump, tambien probe con la clase de Daniel TDolphin que hace muy bien el respaldo y restauracion, pero ahorita presenta un detalle que no he podido resolver, lo comente aca pero parece a nadie le pasa o usan otros metodos para respaldo-restaurar, igual gracias, saludos... :shock:
Dios no está muerto...

Gracias a mi Dios ante todo!
Top
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

joseluisysturiz wrote:
jnavas wrote:
joseluisysturiz wrote:Saludos Juan, tendras algo para hacer backup-restore de tablas mysql.? gracias, saludos... :shock:

Jose Luis
Gracias por la confianza
Con respecto a los respaldos de bases de datos recomiendo "MySQL Administrator", desde hace años implemente MYSQLDUMP no era facil recuperar los respaldos.
Te enviare un archivo.bat que se ejecuta desde tareas automáticas, luego se comprime con pkzip y finalmente se sube a un servidor FTP. En mi caso utilizo tablas mediante INNODB con integridad referencial donde no existe la figura de tablas sino un solo repositorio.

Juan, nos conocemos, hemos conversado y hasta trabaje para datapro hace años, con Joel en la hoyada y un tiempo en los dos caminos, disculpa si sone con mucha confianza, se que no te acuerdas de todos los que hemos pasado por datapro y como trabaje mas con Joel(proandsys) y en sabana grande, que contigo, menos me recordaras...hace bastante tiempo hablamos en tu oficina. Estoy haciendo pruebas directamente con mysqldump, tambien probe con la clase de Daniel TDolphin que hace muy bien el respaldo y restauracion, pero ahorita presenta un detalle que no he podido resolver, lo comente aca pero parece a nadie le pasa o usan otros metodos para respaldo-restaurar, igual gracias, saludos... :shock:

José Luis,

Gracias por tu comunicado y por la confianza para escribirme y darme detalles de la experiencia.
En AdaptaPro contamos con diversos consultores buscando personas con experiencia en proyectos de implementación y Programación.
Sobre los respaldos con MySQL ya tenemos mas de 10 años trabajando con MYSQL desde la Version 3,x y nuestros consultores ya han madurado experiencia con diversas aplicaciones para los respaldos y recuperacion de datos, aun cuando hacen respaldos en servidores Windows y luego lo recuperar en Linux (Con previa definicion de Idiomas), versiones, integridad referencial, entre otras experiencias.

Hoy cuando llegue Horacio "tecnico y DBA" le pedire los script de los bat que hacen los respaldos de las bases de datos. Hemos probado varias opciones y los tiempos de respuestas debe ser optimos y es aqui donde "MySQL Administrator tiene la ventaja", elgunos respaldos tardan horas en ser recuperados.

puedes escribirme a jnavas@datapronet.com mi tel 0414-3000518 0414-2931707
Cualquier pregunta sobre programacion, podras hacerlo en este excelente foro.
Top
User avatar
Compuin
Posts: 1251
Joined: Tue Dec 28, 2010 1:29 pm
Location: Quebec, Canada
Has thanked: 7 times
Been thanked: 3 times

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by Compuin »

jnavas wrote:/*
// Clase Ttable
// Creado por Juan Navas jnavas@datapronet.com
// Objetivo: Insertar/Modificar Registros en Base de datos SQL mediante Objeto
// Lee todos los archivos del directorio y los guarda en la tabla MYTABLE, por ahora solo inserta registros.
// Un proximo release incluira la funcionalidad para modificar y eliminación registros
// Requiere eagle1.lib , tambien se puede utilizar Otro gestor de base de datos u Odbc
*/

#include "FiveWin.ch"

STATIC oServer,oDb,bSqlDate,cTypeBD

FUNCTION MAIN()
LOCAL cIp :="localhost"
LOCAL cLogin:="root"
LOCAL cPass :=""
LOCAL oTable
LOCAL aFiles:=DIRECTORY("*.*"),I

SET DATE FREN
SET CENTURY ON

cTypeBD:="MYSQL"

IF !CONECTAR(cIp,cLogin,cPass)
SALIR()
RETURN NIL
ENDIF

// Conversion de Date Hacia Caracter
bSqlDate:={|nD,nM,nA|STRZERO(nA,4)+""+STRZERO(nM,2)+""+STRZERO(nD,2)}

SETDB("PRUEBAS") // Crea la BD PRUEBAS
ISTABLAS() // Verifica la Existencia de las Tablas

oTable:=OpenTable("SELECT * FROM MYTABLA",.F.) // Abre objeto Tabla

FOR I=1 TO LEN(aFiles)

oTable:AppendBlank() // Utilizara Insert INTO
oTable:Replace("FILE",aFiles[I,1]) // Asigna Valores
oTable:Replace("DATE",aFiles[I,3])
oTable:Replace("SIZE",aFiles[I,2])
oTable:Replace("LOGICO",.T.)

IF !oTable:Commit() // Ejecutar INSERT INTO
EXIT
ENDIF

NEXT I

oTable:End()

? oTable:cSqlExec,LSTR(LEN(aFiles))+CRLF+"Archivos registrados en tabla MYTABLA"

RETURN NIL

FUNCTION OpenTable(cSql,lLoad,oDataBase)

DEFAULT oDataBase:=oDb

RETURN TTable():New(cSql,lLoad,oDataBase)

CLASS Ttable

DATA oDataBase
DATA oCursor

DATA lAppend INIT .T.
DATA aBuffer INIT {}

DATA cWhere INIT ""
DATA cTable
DATA cSql
DATA cSqlExec INIT ""

METHOD New(cSql,lLoad,oDataBase) CONSTRUCTOR
METHOD Replace(cField,uValue)
METHOD Commit(cWhere)
METHOD AppendBlank() INLINE ::lAppend:=.T.
METHOD InsertInto()
METHOD HandleEvent(nMsg, nWParam, nLParam ) EXTERN ;
WndHandleEvent( Self, nMsg, nWParam, nLParam )

METHOD End()

ENDCLASS

METHOD New( cSql,lLoad, oDataBase) CLASS Ttable

DEFAULT lLoad:=.T.

::oDatabase:=oDataBase
::cTable :=SQLTABLENAME(cSql)

? cSql,::cTable

RETURN SELF

METHOD Replace(cField,uValue) CLASS TTABLE
LOCAL nAt

cField:=UPPE(ALLTRIM(cField))
nAt:=ASCAN(::aBuffer,{|a,n|a[1]=cField})

IF nAt=0
AADD(::aBuffer,{cField,uValue})
ELSE
::aBuffer[nAt,2]:=uValue
ENDIF

RETURN NIL

METHOD COMMIT(cWhere) CLASS TTABLE

IF ::lAppend
RETURN ::INSERTINTO()
ENDIF

RETURN .T.

METHOD INSERTINTO() CLASS TTABLE
LOCAL uValue,cField,cType,nLen,I,cSql
LOCAL cFields:="",cValues:=""

FOR I := 1 TO LEN( ::aBuffer )

cField := ::aBuffer[I,1]
uValue := ::aBuffer[I,2]
uValue :=CTOSQL(uValue)
cFields:=cFields+IF(Empty(cFields),"",",")+cField
cValues:=cValues+IF(Empty(cValues),"",",")+uValue

NEXT

cSql := "INSERT INTO " + ::cTable + " ("+cFields+") VALUES ("+cValues+")"

// Esta ejecución Clase TMSCONNET de Eagle
IF ("TMS"$oServer:Classname()) .AND. !oDb:ExecSQL(cSql)
MsgAlert("Sentencia Rechazada "+cSql)
RETURN .F.
ENDIF

::cSqlExec:=cSql

RETURN .T.

METHOD End()
RETURN NIL

EXIT PROCEDURE SALIR()

IF ValType(oDb)="O"
oDb:Close()
ENDIF

IF ValType(oServer)="O"
oServer:Close()
ENDIF

RETURN

STATIC FUNCTION CONECTAR(cIp,cLogin,cPass,nPort,lError)

cIp := ALLTRIM(cIp )
cLogin := ALLTRIM(cLogin)
cPass := ALLTRIM(cPass )

DEFAULT nPort :=3306,;
lError:=.F.

CursorWait()


IF cTypeBD="MYSQL"

oServer:= TMSConnect():New() // Inicia el objeto Conexion Mediante la clase Eagle

oServer:SetAutoError( lError )

IF oServer:Connect( cIp, cLogin , cPass , NIL, nPort )
oServer:Reconnect()
ELSE
oServer:Close()
MsgAlert( "No hay conexión con "+cIp )
RETURN .F.
ENDIF

ENDIF

RETURN .T.

STATIC FUNCTION SETDB(cDataBase)

IF "TMS"$oServer:Classname()

IF !oServer:ExistDb(cDataBase)
oServer:CreateDB(cDataBase)
ENDIF

oDb:=TMSDataBase():New( oServer, cDataBase, .t. )
oDb:Use()
oDb:Select()

ENDIF

RETURN .T.


FUNCTION ISTABLAS()
LOCAL aStruct:={}
LOCAL cTable:="MYTABLA"

IF "TMS"$oServer:Classname() .AND. !oDb:ExistTable(cTable)
AADD(aStruct,{"FILE", "C",250,0})
AADD(aStruct,{"DATE", "D",8 ,0})
AADD(aStruct,{"SIZE", "N",12 ,0})
AADD(aStruct,{"LOGICO","N",1 ,0}) // Sera Logico Un Digito
oDb:CreateTable( cTable, aStruct, NIL )
ENDIF

RETURN .T.

STATIC FUNCTION STRSQL(uValue) // Quita el slash por Chr(28)

IF ValType(uValue)="D" // Fecha en SQL
RETURN SQLDATE(uValue)
ENDIF

IF ValType(uValue)="L"
RETURN IIF(uValue,"1","0")
ENDIF

IF ValType(uValue)="N"
uValue:=ALLTRIM(STR(uValue))
ENDIF

RETURN uValue

STATIC FUNCTION SQLDATE(dFecha)
LOCAL nD,nM,nA

IF !Empty(bSqlDate) .AND. ValType(dFecha)="D"
nD:=DAY(dFecha)
nM:=MONTH(dFecha)
nA:=YEAR(dFecha)
dFecha:=EVAL(bSqlDate,nD,nM,nA)
RETURN dFecha
ENDIF

RETURN DTOS(dFecha)

STATIC FUNCTION SQLTABLENAME(cSql)
LOCAL cTable
cTable :=ALLTRIM(SUBS(cSql,AT(" FROM ",UPPE(cSql))+5,LEN(cSql)))
cTable :=IIF(" " $cTable,LEFT(cTable,AT(" " ,cTable)),cTable)
cTable :=IIF(CRLF$cTable,LEFT(cTable,AT(CRLF,cTable)),cTable)
RETURN cTable

/*
// Genera WHERE, Entre Campos y Valores
*/
FUNCTION GetWhere(cSigno,uValue,cValtype,lAlltrim)
LOCAL cWhere:=""

DEFAULT cValType:=ValType(uValue)
DEFAULT cSigno :="=",lAlltrim:=.T.

IF EMPTY(uValue).AND.LEN(cSigno)="="
uValue:=cSigno
cSigno:="="
ENDIF

IF ValType(uValue)="C"
uValue:=STRSQL(ALLTRIM(uValue))
ENDIF

DO CASE

CASE cValType="N" .OR. cValType="L"

cWhere:=cSigno+STRSQL(uValue)

CASE cValType="D"

cWhere:=cSigno+CTOSQL(uValue)

IF cTypeBD="MSSQL" .AND. "NULL"$cWhere
cWhere:=STRTRAN(cWhere,"="," IS ")
ENDIF

IF cTypeBD="MSSQL" .AND. "NULL"$cWhere
cWhere:=STRTRAN(cWhere,"<>"," IS NOT ")
ENDIF

OTHE

uValue:=IIF( ValType(uValue)="C",ALLTRIM(uValue) , uValue )
uValue:=IIF( ValType(uValue)="C",STRSQLOFF(uValue),STRSQL(uValue))


IF "LIKE["$cSigno

cSigno:=STRTRAN(cSigno,"X",uValue)
cSigno:=STRTRAN(cSigno,"["," '")
cSigno:=STRTRAN(cSigno,"]","'")

IF "NOT_LIKE"$cSigno
cSigno:=STRTRAN(cSigno,"NOT_LIKE"," NOT LIKE")
ENDIF

cWhere:=" "+cSigno+" "

ELSE

cWhere:=cSigno+"'"+uValue+"'"

ENDIF

ENDCASE

RETURN cWhere

FUNCTION CTOSQL(uValue)

DO CASE

CASE ValType(uValue)="C"
uValue:=STRSQL(uValue)
CASE ValType(uValue)="N"
uValue:=ALLTRIM(STR(uValue))
RETURN uValue
CASE ValType(uValue)="L"
RETURN IIF( uValue,"1","0")
CASE ValType(uValue)="D"
IF EMPTY(uValue) .AND. cTypeBD="MSSQL"
RETURN 'NULL'
ENDIF
uValue:=SQLDATE(uValue)

ENDCASE

RETURN "'"+ALLTRIM(uValue)+"'"

FUNCTION STRSQLOFF(uValue)
// Quita el slash por Chr(28)

IF ValType(uValue)="C" .AND. cTypeBD="MSSQL" .AND. CHR(250)$uValue
uValue:=STRTRAN(uValue,CHR(250),"'")
RETURN uValue
ENDIF

IF ValType(uValue)="C".AND. CHR(29)$uValue
uValue:=STRTRAN(uValue,CHR(29),"'") // "CUALQUIER COSA SDFSDFSDFD "+CRLF //+MEMOREAD("\DWH\PRG\WINDOW.PRG")
ENDIF

IF ValType(uValue)="C" .AND. (CHR(28)$uValue .OR. CHR(29)$uValue)
uValue:=STRTRAN(uValue,CHR(28),"\")
uValue:=STRTRAN(uValue,CHR(29),"'")
ENDIF

RETURN uValue

FUNCTION lstr(nValue)
RETURN ALLTRIM(STR(nValue))


Hola Juan, como te va?

Ya tienes un release para este programa que permita Modificar y Eliminar ?

Gracias
FWH 20.12
Hbmk2 32/64 Bits (Build 19.29.30133)
Microsoft Visual C 32 Bits
MySql 8.0.24 32/64 Bits
VS Code
Top
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

Saludos
Afirmativo
La clase realiza UPDATE si tiene registros,

oTable:=OpenTable(cSql)

IF oTable:RecCount()=0
oTable:AppendBlank()
ENDIF

oTable:Replace("CAMPO1,nValor)
oTable:Commit(oTable:cWhere) // Si oTable:cWhere esta vacio, INSERT INTO FIELDS,VALUES, caso contrario UPDATE TABLE SET
oTable:End()
Top
User avatar
Compuin
Posts: 1251
Joined: Tue Dec 28, 2010 1:29 pm
Location: Quebec, Canada
Has thanked: 7 times
Been thanked: 3 times

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by Compuin »

jnavas wrote:Saludos
Afirmativo
La clase realiza UPDATE si tiene registros,

oTable:=OpenTable(cSql)

IF oTable:RecCount()=0
oTable:AppendBlank()
ENDIF

oTable:Replace("CAMPO1,nValor)
oTable:Commit(oTable:cWhere) // Si oTable:cWhere esta vacio, INSERT INTO FIELDS,VALUES, caso contrario UPDATE TABLE SET
oTable:End()


La acabo de compilar y genero error por esto

Code: Select all | Expand

oServer:= TMSConnect():New() // Inicia el objeto Conexion Mediante la clase Eagle

oServer:SetAutoError( lError )

IF oServer:Connect( cIp, cLogin , cPass , NIL, nPort )
//oServer:Reconnect()   // SE DEBE COMENTAR PARA QUE FUNCIONE

ELSE
oServer:Close()
MsgAlert( "No hay conexion con "+cIp )
RETURN .F.
ENDIF



Comenta
oServer:Reconnect()

para que funcione
FWH 20.12
Hbmk2 32/64 Bits (Build 19.29.30133)
Microsoft Visual C 32 Bits
MySql 8.0.24 32/64 Bits
VS Code
Top
User avatar
Compuin
Posts: 1251
Joined: Tue Dec 28, 2010 1:29 pm
Location: Quebec, Canada
Has thanked: 7 times
Been thanked: 3 times

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by Compuin »

jnavas wrote:Saludos
Afirmativo
La clase realiza UPDATE si tiene registros,

oTable:=OpenTable(cSql)

IF oTable:RecCount()=0
oTable:AppendBlank()
ENDIF

oTable:Replace("CAMPO1,nValor)
oTable:Commit(oTable:cWhere) // Si oTable:cWhere esta vacio, INSERT INTO FIELDS,VALUES, caso contrario UPDATE TABLE SET
oTable:End()


En la clase no aparece este metodo

Tendras la clase actualizada con los metodos faltantes (UPDATE y DELETE ) ?

Gracias
FWH 20.12
Hbmk2 32/64 Bits (Build 19.29.30133)
Microsoft Visual C 32 Bits
MySql 8.0.24 32/64 Bits
VS Code
Top
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

Compin,
Puedes ver el metodo Commit
METHOD Commit(cWhere)

Para eliminar registros utilizo función SQLDELETE(cTable,cInner,cWhere,oDb)
Top
xmanuel
Posts: 768
Joined: Sun Jun 15, 2008 7:47 pm
Location: Sevilla
Been thanked: 5 times
Contact:
Contact xmanuel

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by xmanuel »

Hola Juan, me alegro mucho de lo contento que estás con la vieja Eagle1...
E1 tiene un metodo para hacer copias/restauracio de una bases de datos:
Mira este ejemplo y el metod export():

Code: Select all | Expand


//----------------------------------------------------------------------------//
//  AUTOR.....: Manuel Expósito Suárez   Soft4U 2002-2012                     //
//  eMail.....: messof@gmail.com                                        //
//  CLASE.....: Pt15.prg                                                      //
//  FECHA MOD.: 01/10/2012                                                    //
//  VERSION...: 7.00                                                          //
//  PROPOSITO.: Ejemplo de mantenimiento simple de una tabla                  //
//----------------------------------------------------------------------------//

//-- Definiciones ------------------------------------------------------------//

#define B_BOX ( CHR( 218 ) + CHR( 196 ) + CHR( 191 ) + CHR( 179 ) + ;
                CHR( 217 ) + CHR( 196 ) + CHR( 192 ) + CHR( 179 ) + " " )

#define ID_CONSUTA  0
#define ID_MODIFICA 1
#define ID_ALTA     2
#define ID_BORRA    3

//-- Includes ----------------------------------------------------------------//

#include "InKey.ch"
#include "Eagle1.ch"

//-- Fuerza el enlazado -----------------------------------------------------//

REQUEST HB_GT_WIN

//-- Modulo principal --------------------------------------------------------//

procedure main()

    local cHost := space( 20 )
    local cUser := space( 20 )
    local cPwd := space( 20 )
    local cDb := space( 20 )
    local cTable := space( 20 )
    local oCon, oDb
    local aCargo, nCargo
    local GetList := {}

    SET DATE FORMAT TO "DD/MM/YYYY"

    cls

    @ 10, 10 SAY "Host..........:" GET cHost
    @ 11, 10 SAY "User..........:" GET cUser
    @ 12, 10 SAY "Password......:" GET cPwd
    READ

    cls

    cHost := AllTrim( cHost )
    cUser := AllTrim( cUser )
    cPwd := AllTrim( cPwd )
    cDb := AllTrim( cDb )

    oCon := TMSConnect():New()

    oCon:SetAutoError( .f. )

    // Intentamos la conexion
    if oCon:Connect( cHost, cUser, cPwd )
        aCargo := oCon:ListDataBases()
        @ 2, 9 SAY "Elige una Bases de Dato para exportar"
        DispBox( 3, 9, 21, 40 )
        nCargo := AChoice( 4, 10, 20, 39, aCargo )
        cDb := aCargo[ nCargo ]
        @ 23, 09 SAY "La Bases de Datos selecionada es " + cDb
        oCon:SelectDataBase( cDb )
        oCon:oDataBase:Export()
        Alert( "La copia se ha efectuado con el nombre: " + ;
                oCon:oDataBase:cBakFileName )
    else
        Alert( "No se pudo conectar..." )
    endif

    // Liberamos la memoria de la conexion
    oCon:Free()

return

 
Last edited by xmanuel on Wed Nov 14, 2018 10:34 pm, edited 1 time in total.
______________________________________________________________________________
Sevilla - Andalucía
Top
xmanuel
Posts: 768
Joined: Sun Jun 15, 2008 7:47 pm
Location: Sevilla
Been thanked: 5 times
Contact:
Contact xmanuel

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by xmanuel »

Juan en Eagle1 hay una RDD para usar los camandos DB...() de las dbf directamente en MySQL
E1RDD
mira este ejemplo:

Code: Select all | Expand


//---------------------------------------------------------------------------//
//  AUTOR.....: Manuel Expósito Suárez   Soft4U 2002-2010                    //
//  eMail.....: messoft@gmail.com                                            //
//  CLASE.....: TMyTable                                                     //
//  FECHA MOD.: 11/05/2010                                                   //
//  VERSION...: 6.00                                                         //
//  PROPOSITO.: Ejemplo uso E1RDD de Egle1 + FW con Browse de FW             //
//---------------------------------------------------------------------------//

#include "Eagle1.ch"
#include "FiveWin.ch"
#include "dtpicker.ch"
#include "calendar.ch"

//---------------------------------------------------------------------------//
// Son estaticas para que sean visibles desde todo el PRG un poco por
// comodidad

static oConnect     // Objeto conexion
static nWA := 0     // Arera de trabajo

static oWnd         // Objetos de FWH

//---------------------------------------------------------------------------//

function main()

    SET DATE FORMAT TO "DD/MM/YYYY"

    if AbrirTodo()

        DEFINE WINDOW oWnd FROM 4, 4 TO 40, 120 ;
            TITLE "Ejemplo de manteniento de una tabla con Eagle1 y FWH" ;
            MENU BuildMenu()

            SET MESSAGE OF oWnd NOINSET;
                TO oConnect:cVersion + " por " + oConnect:cAuthor ;
                CLOCK DATE

        ACTIVATE WINDOW oWnd

    else

        Salir()

    endif

return( nil )

//----------------------------------------------------------------------------//

function BuildMenu()

   local oMenu

   MENU oMenu

      MENUITEM "&Mantenimiento" ACTION Mantenimiento()

      MENUITEM "&Utilities"
      MENU
         MENUITEM "&Calculadora" ACTION WinExec( "Calc" ) ;
            MESSAGE "Lamando a la calculadora de Windows"

         SEPARATOR

         MENUITEM "&Escribir"    ACTION WinExec( "Write" ) ;
            MESSAGE "Llamando a Write de Windows"
      ENDMENU

      MENUITEM "&Salir"
      MENU
         MENUITEM "&Acerca de..." ;
            ACTION MsgAbout( oConnect:cAuthor, oConnect:cVersion ) ;
            MESSAGE "Informa sobre la versión de Eagle1"
         SEPARATOR
         MENUITEM "&Salir";
            ACTION Salir();
            MESSAGE "Salir del ejemplo de Eagle1 y FWH"
      ENDMENU


   ENDMENU

return oMenu

//----------------------------------------------------------------------------//
//

static function AbrirTodo()
/*
    local cHost :=      "127.0.0.1           "
    local cUser :=      "root                "
    local cPassword :=  "root                "
    local cDbName :=    "E1Prueba            "
    local lRet, oDlg

    DEFINE DIALOG oDlg FROM 2, 2 TO 14, 35;
        TITLE "Datos de conexión" ;
        STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )

        @ 01, 01 SAY "Host:" OF oDlg
        @ 01, 05 GET cHost PICTURE "@K" UPDATE OF oDlg

        @ 1.8, 01 SAY "Usuario:" OF oDlg
        @ 02, 05 GET cUser PICTURE "@K" UPDATE OF oDlg

        @ 2.6, 01 SAY "Password:" OF oDlg
        @ 03, 05 GET cPassword PICTURE "@K" UPDATE OF oDlg

        @ 3.4, 01 SAY "Base datos:" OF oDlg
        @ 04, 05 GET cDbName PICTURE "@K" UPDATE OF oDlg

        @ 4, 7 BUTTON "&Acptar" ACTION oDlg:End() OF oDlg

    ACTIVATE DIALOG oDlg CENTERED

    cHost := trim( cHost )
    cUser := trim( cUser )
    cPassword := trim( cPassword )
    cDbName := trim( cDbName )

    // Creamos el objeto "connexion"
    oConnect := TMSConnect():New()

    // Nos conectamos al servidor
    lRet := oConnect:Connect( cHost, cUser, cPassword, cDbName )
*/

    local cDbName :=    "E1Prueba            "
    local cTabla := "Test"
    local lRet

// Con sistema empotrado:
#ifdef E1_EMBEDDED

    local aOptions := { "Prueba E1 con FWH", "--defaults-file=./test.cnf" }
    local aGroup := { "op_servidor", "op_cliente" }

    oConnect := TMSEConnect():New( )
    lRet := oConnect:Connect(  aOptions, aGroup, AllTrim( cDbName ) )

// Con sistema cliente/servidor:
#else

    local cHost :=      "127.0.0.1           "
    local cUser :=      "root                "
    local cPassword :=  "root                "
    local oDlg

    DEFINE DIALOG oDlg FROM 2, 2 TO 14, 35;
        TITLE "Datos de conexión" ;
        STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )

        @ 01, 01 SAY "Host:" OF oDlg
        @ 01, 05 GET cHost PICTURE "@K" UPDATE OF oDlg

        @ 1.8, 01 SAY "Usuario:" OF oDlg
        @ 02, 05 GET cUser PICTURE "@K" UPDATE OF oDlg

        @ 2.6, 01 SAY "Password:" OF oDlg
        @ 03, 05 GET cPassword PICTURE "@K" UPDATE OF oDlg

        @ 3.4, 01 SAY "Base datos:" OF oDlg
        @ 04, 05 GET cDbName PICTURE "@K" UPDATE OF oDlg

        @ 4, 7 BUTTON "&Acptar" ACTION oDlg:End() OF oDlg

    ACTIVATE DIALOG oDlg CENTERED

    cHost := trim( cHost )
    cUser := trim( cUser )
    cPassword := trim( cPassword )
    cDbName := trim( cDbName )

    // Creamos el objeto "connexion"
    oConnect := TMSConnect():New()

    // Nos conectamos al servidor
    lRet := oConnect:Connect( cHost, cUser, cPassword, cDbName )

#endif



    if !lRet
        MsgInfo( "No hay conexión con el servidor", "Operación Cancelada" )
    else

//----------------------------------------------------------------------------//
// Aqui empieza E1RDD
//----------------------------------------------------------------------------//

        // Se inicia el sistema E1RDD
        InitE1RDD( oConnect )

        // A partir de aquí como una DBF
        USE test NEW ALIAS test VIA "E1RDD"
        nWA := Select( "test" )

 //----------------------------------------------------------------------------//

    endif

return( lRet )

//----------------------------------------------------------------------------//
//

static procedure Salir()

    if nWA > 0
        ( nWA )->( DbCloseArea() )
    endif

    if ValType( oConnect ) == "O"
        oConnect:Free()
    endif

    if ValType( oWnd ) == "O"
        oWnd:End()
    endif

return

//----------------------------------------------------------------------------//

static procedure Mantenimiento()

    local oDlg, oBrw, oCol

    DEFINE DIALOG oDlg FROM 3, 3 TO 40, 100 TITLE "Mantenimiento tabla TEST"

        @ 00, 01 SAY " &Datos tabla..."  OF oDlg

        oBrw := TXBrowse():New( oDlg )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || hb_ValToStr( ( nWA )->( FieldGet( 1 ) ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 1 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 2 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 2 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 3 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 3 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 4 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 4 ) )
        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 5 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 5 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 6 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 6 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 7 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 7 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || DToC( ( nWA )->( FieldGet( 8 ) ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 8 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || hb_ValToStr( ( nWA )->( FieldGet( 9 ) ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 9 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || hb_ValToStr( ( nWA )->( FieldGet( 10 ) ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 10 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || hb_ValToStr( ( nWA )->( FieldGet( 11 ) ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 11 ) )

        oCol := oBrw:AddCol()
        oCol:bStrData  := { || ( nWA )->( FieldGet( 12 ) ) }
        oCol:cHeader   := ( nWA )->( FieldName( 12 ) )

        WITH OBJECT oBrw
            :nTop      := 10
            :nLeft     := 10
            :nBottom   := 240
            :nRight    := 370
            :nColDividerStyle := 2
            :bKeyNo    := { | n | iif( n == nil, ( nWA )->( RecNo() ), ( nWA )->( DbGoto( n ) ) ) }
            :bKeyCount := {|| ( nWA )->( RecCount() ) }
            :bSkip := { | n | GetTableObject( nWA ):Skipper( n ) }
            :SetRDD()
            :cAlias    := "Test"
            :CreateFromCode()
        END

        @ 14, 01 BUTTON "&Añadir"       OF oDlg SIZE 35, 12;
                    ACTION CtrDatos( oBrw, .t. )
        @ 14, 08 BUTTON "&Modificar"    OF oDlg SIZE 35, 12;
                    ACTION CtrDatos( oBrw, .f. )
        @ 14, 15 BUTTON "&Borrar"       OF oDlg SIZE 35, 12;
                    ACTION Borrar( oBrw )
        @ 14, 22 BUTTON "&Ordenar"      OF oDlg SIZE 35, 12;
                    ACTION Ordernar( oBrw )
        @ 14, 29 BUTTON "B&uscar"       OF oDlg SIZE 35, 12;
                    ACTION Buscar( oBrw )
        @ 14, 36 BUTTON "Listar"        OF oDlg SIZE 35, 12;
                    ACTION ( oBrw:Report( "Listado de la tabla", .t. ), ( nWA )->( DbGoTop() ) )
        @ 14, 43 BUTTON "<<" OF oDlg ACTION oBrw:GoTop() SIZE 35, 12
        @ 14, 50 BUTTON ">>" OF oDlg ACTION oBrw:GoBottom() SIZE 35, 12
        @ 14, 57 BUTTON "&Salir"        OF oDlg ;
                    ACTION oDlg:End() SIZE 35, 12


   ACTIVATE DIALOG oDlg CENTERED

return

//----------------------------------------------------------------------------//
// Borra la fila actual

static procedure Borrar( oBrw )

    local nRecNo := ( nWA )->( RecNo() )

    if MsgYesNo( "Realmente quiere borrar el registro " + StrNum( ( nWA )->( RecNo() ) ) + "?" )
        ( nWA )->( DbDelete() )
        MyMsgInfo( "Borrado en el servidor" )
        ( nWA )->( DbGoTo( nRecNo ) )
        oBrw:Refresh()
    else
        MyMsgInfo( "No se ha borrado..." )
    endif

return

//----------------------------------------------------------------------------//
// Establece un nuevo orden de visualizacion

static procedure Ordernar( oLbxPrincipal )

    local oDlg, oLbx

    // Así se obtiene el objeto que maneja el WA, así de facíl se puede trabajar
    // con clases y RDD
    local oDs := GetTableObject( nWA )

    local i := ( nWA )->( FCount() )
    local aFld := Array( i )
    local n, cValue

    FOR n := 1 TO i
        aFld[ n ] := ( nWA )->( FieldName( n ) )
    NEXT

    n := 0

    DEFINE DIALOG oDlg FROM 2, 2 TO 18, 30;
        TITLE "Eagle1, FW y ListBox" ;
        STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )

    @ 1, 02 LISTBOX oLbx;
            VAR cValue;
            ITEMS aFld;
            SIZE 80, 70;
            OF oDlg

    @ 5, 02 BUTTON "&Seleccionar";
            OF oDlg;
            SIZE 40, 12;
            DEFAULT;
            ACTION ( MyMsgInfo( "Orden: " + Str( n := oLbx:GetPos() ) + ;
                                 + CRLF + "Nombre del campo: " + cValue, "Has elegido" ), ;
                     oDlg:End() )

    @ 5, 10 BUTTON "&Salir";
            OF oDlg;
            SIZE 40, 12;
            ACTION oDlg:End()

    ACTIVATE DIALOG oDlg CENTERED

    if n != 0 .and. oDS:SetOrderBy( n,, .t. )
        oLbxPrincipal:GoTop()
        oLbxPrincipal:Refresh()
    else
        MyMsgInfo( "No se ha establacido otro orden..." )
    endif

return

//----------------------------------------------------------------------------//

static procedure Buscar( oLb )

    local oDlg
    local i := ( nWA )->( FCount() )
    local n := 1
    local oSay, cSay := "&Valor campo "
    local oGet, uVal
    local oDs := GetTableObject( nWA )

    DEFINE DIALOG oDlg FROM 2, 2 TO 12, 70;
        TITLE "Búsqueda de valores en el DataSet" ;
        STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )

        @ 01, 01 SAY "&Numero de columna ( 1 - " + StrNum( i ) + " ):" OF oDlg
        @ 01, 10 GET n PICTURE "999" ;
                 VALID ( uVal := ( nWA )->( FieldGet( n ) ), oGet:Refresh(), ;
                 oSay:SetText( cSay + ( nWA )->( FieldName( n ) ) ), n > 0 .and. n <= i ) ;
                 OF oDlg

        @ 02, 01 SAY oSay VAR cSay SIZE 50, 13  OF oDlg
        @ 02, 10 GET oGet VAR uVal SIZE 160, 13 OF oDlg


    @ 3, 02 BUTTON "&Buscar";
            OF oDlg;
            SIZE 40, 12;
            ACTION ( if( oDS:Find( n, uVal, .t. ), ;
                        MyMsgInfo( "Valor encontrado" ), ;
                        MyMsgInfo( "Valor no encontrado" ) ), oLb:Refresh() )

    @ 3, 10 BUTTON "S&iguiente";
            OF oDlg;
            SIZE 40, 12;
            ACTION ( if( !oDS:FindNext(), MyMsgInfo( "No hay más. Se llegó al final" ), ), ;
                     oLb:Refresh() )

    @ 3, 18 BUTTON "&Salir";
            OF oDlg;
            SIZE 40, 12;
            ACTION oDlg:End()

    ACTIVATE DIALOG oDlg

return

//----------------------------------------------------------------------------//

static procedure CtrDatos( oLb, lNuevo )

    local oDlg, cQueHago, nRec

    if lNuevo
        cQueHago := "Altas"
        ( nWA )->( DbAppend() )
    else
        cQueHago := "Modificación"
    endif

    nRec := ( nWA )->( RecNo() )

    DEFINE DIALOG oDlg FROM 2, 2 TO 30, 77;
        TITLE "Mantenimiento de la tabla Test - " + cQueHago;
        STYLE nOr( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, 4 )

        @ 01, 02 SAY "First"        OF oDlg
        @ 02, 1.5 GET ( nWA )->First    PICTURE "@K"                UPDATE OF oDlg

        @ 01, 26.6 SAY "Last"       OF oDlg
        @ 02, 20 GET ( nWA )->Last      PICTURE "@K"                UPDATE OF oDlg

        @ 2.8, 02 SAY "Street"      OF oDlg
        @ 4, 1.5 GET ( nWA )->Street    PICTURE "@K"                UPDATE OF oDlg

        @ 2.8, 26.6 SAY "City"      OF oDlg
        @ 4, 20 GET ( nWA )->City        PICTURE "@K"                UPDATE OF oDlg

        @ 4.6, 02 SAY "State"       OF oDlg
        @ 6, 1.5 GET ( nWA )->State     PICTURE "@K XX"             UPDATE OF oDlg

        @ 4.6, 5.5 SAY "Zip"        OF oDlg
        @ 6, 4 GET ( nWA )->Zip          PICTURE "@K 99999-9999"     UPDATE OF oDlg

        @ 4.6, 13.9 SAY "Hiredate"  OF oDlg
        @ 78, 83 DTPICKER ( nWA )->Hiredate   PIXEL SIZE 50, 11      UPDATE OF oDlg

        @ 5.7, 22 CHECKBOX ( nWA )->Married PROMPT "Married"        UPDATE OF oDlg

        @ 4.6, 33 SAY "Age"         OF oDlg
        @ 6, 24.5 GET ( nWA )->Age      PICTURE "@K 999"            UPDATE OF oDlg

        @ 4.6, 37.5 SAY "Salary"    OF oDlg
        @ 6, 28 GET ( nWA )->Salary     PICTURE "@KE 9,999,999.999" UPDATE OF oDlg

//..................... El campo MEMO...............................................
        @ 6.4, 02 SAY "Notes"       OF oDlg
        @ 8.1, 1.5 GET ( nWA )->Notes   MEMO SIZE 270, 65            UPDATE OF oDlg
//..................................................................................

        @ 10, 02 BUTTON "&Guardar";
                 OF oDlg;
                 SIZE 40, 12;
                 ACTION ( ( nWA )->( DbCommit() ), ( nWA )->( DBGoTo( nRec ) ), ;
                            oLb:Refresh(), oDlg:End() )

        @ 10, 18 BUTTON "&Salir";
                 OF oDlg;
                 SIZE 40, 12;
                 ACTION oDlg:End()

    ACTIVATE DIALOG oDlg

return

//----------------------------------------------------------------------------//

 
______________________________________________________________________________
Sevilla - Andalucía
Top
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

Manuel
Gracias,
En mi caso, utilizo tablas enlazadas con inner, vistas, subconsultas, en una consulta , desconozco si podré utilizarlo con la sintaxis que publicase.
Top
User avatar
Compuin
Posts: 1251
Joined: Tue Dec 28, 2010 1:29 pm
Location: Quebec, Canada
Has thanked: 7 times
Been thanked: 3 times

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by Compuin »

jnavas wrote:Manuel
Gracias,
En mi caso, utilizo tablas enlazadas con inner, vistas, subconsultas, en una consulta , desconozco si podré utilizarlo con la sintaxis que publicase.


Saludos Sr Juan,

Gracias por sus ejemplos.

Su clase tiene algun metodo para la lectura de tablas mediante SELECT ?

De ser asi, algun ejemplo ?
FWH 20.12
Hbmk2 32/64 Bits (Build 19.29.30133)
Microsoft Visual C 32 Bits
MySql 8.0.24 32/64 Bits
VS Code
Top
User avatar
jnavas
Posts: 482
Joined: Wed Nov 16, 2005 12:03 pm
Location: Caracas - Venezuela
Been thanked: 2 times
Contact:
Contact jnavas

Re: Clase TTABLE insertar Registros en Tablas SQL Lexico XBASE

Post by jnavas »

Saludos
Gracias por la pregunta,
Para la lectura de datos, realice una clase llamada TTABLE clonada desde la clase tdbodbcd, utilizando un arreglo reemplazando el uso de tablas DBF, tambien la utilizo de manera general para MySQL , SQL SERVER sin tener que realizar ningun cambio,
Si necesitas puedo crear un ejemplo para uso con FW,
Top
Post Reply

Return to “FiveWin para Harbour/xHarbour”