/*
// 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 ::=.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
::=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))
// 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 ::=.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
::=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))
