Cuate, xHarbour 1.2.1.
ccc_3_ccc@hotmail.co SKYPE
saludos..
#include "FiveWin.ch"
#include "xbrowse.ch"
FUNCTION Main()
CreaMDB()
AbreMDB()
RETURN Nil
STATIC FUNCTION CreaMDB()
LOCAL oCn,CatNewDB,cProvider,cSource,cConnect,cSQL,cTabla
cTabla:= "CLIENTES"
cSource:= ".\DANIEL.MDB"
cProvider:= "Microsoft.Jet.OLEDB.4.0"
cConnect:= 'Provider='+cProvider+';Data Source='+cSource
IF FILE(cSource)
FERASE(cSource)
ENDIF
TRY
CatNewDB:= CreateObject("ADOX.Catalog")
CATCH
MSGInfo("No se puede crear objeto Adox")
RETURN(.F.)
END TRY
TRY
CatNewDB:CREATE('Provider='+cProvider+';Data Source='+cSource+';Jet OLEDB:Engine Type=5' )
CATCH
MSGInfo("No se puede crear la tabla "+cSource )
RETURN(.F.)
END TRY
TRY
oCn:= CREATEOBJECT("ADODB.Connection")
CATCH
MSGInfo( "No se puede crear connección con ADO")
END TRY
TRY
oCn:Open(cConnect)
CATCH
MSGInfo( "No se puede abrir la conección a la Base de Datos "+cSource )
RETURN(.F.)
END TRY
cSQL := "CREATE TABLE "+cTabla
cSQL += "( "
cSQL += "[APODO] char(18) NOT NULL, "
cSQL += "[NOMBRE] char(30) NULL, "
cSQL += "[APELLIDO] char(30) NULL, "
cSQL += "[DIRECCION] char(30) NULL, "
cSQL += "[TELEFONO] char(30) NULL, "
cSQL += "[CIUDAD] char(30) NULL, "
cSQL += "[ESTADO] char(30) NULL, "
cSQL += "CONSTRAINT PK_USERINFO PRIMARY KEY ( APODO )"
cSQL += " )"
TRY
oCn:Execute(cSQL)
CATCH
MSGInfo( "Fallo en la Tabla "+cTabla )
RETURN(.F.)
END TRY
oCn:CLOSE()
oCn:= Nil
RETURN Nil
STATIC FUNCTION AbreMDB()
LOCAL cTable,oRs,oCon,aTokens,nAt,oError,cConnection,cFileName
LOCAL oWnd,oBrw,N,cClrBack,cAlias
cFileName:= ".\DANIEL.MDB"
IF FILE(cFileName)
cConnection:= "Provider='Microsoft.Jet.OLEDB.4.0'; Data Source='" + cFileName + "';"
TRY
IF !EMPTY( cConnection )
oCon:= FW_OPenAdoConnection( cConnection )
aTokens:= hb_ATokens( cConnection, ";" )
IF EMPTY( cFileName ) .OR. cFileName == "."
IF ( nAt := ASCAN( aTokens, { | c | "data source" $ LOWER( c ) .OR. ;
"data source" $ LOWER( c ) .OR. "database" $ LOWER( c ) } ) ) != 0
cFileName:= hb_TokenGet( aTokens[ nAt ], 2, "=" )
ENDIF
ENDIF
ENDIF
CATCH oError
MSGInfo( oError:Description )
END
oRs:= oCon:OpenSchema( 20 )
oRs:FILTER = "TABLE_TYPE='TABLE'"
XBROWSER oRS TITLE "Select a table" ;
COLUMNS { "TABLE_NAME" };
SELECT cTable:= oBrw:aCols[ 1 ]:Value
oRs:CLOSE()
oRs:= TOleAuto():New( "ADODB.Recordset" )
oRs:CursorType = 1
oRs:CursorLocation = 3
oRs:LockType = 3
IF EMPTY( cTable )
RETURN Nil
ENDIF
TRY
oRs:Open( "SELECT * FROM " + cTable, oCon )
CATCH oError
MSGInfo( oError:Description )
END
DEFINE WINDOW oWnd TITLE "Browse " + cTable
oWnd:bCopy = { || MSGInfo( "copy" ) }
@ 0, 0 xBROWSE oBrw OF oWnd LINES ;
AUTOCOLS RECORDSET oRs AUTOSORT
FOR n := 1 TO LEN( oBrw:aCols )
IF oBrw:aCols[ n ]:cDataType == 'M'
oBrw:aCols[ n ]:bStrData = GenLocalBlock( oBrw:aCols, n )
ENDIF
NEXT
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:bClrStd = { || IF( oBrw:KeyNo() % 2 == 0, ;
{ IF( ( oBrw:cAlias )->( DELETED() ), CLR_HRED, CLR_BLACK ),;
RGB( 198, 255, 198 ) }, ;
{ IF( ( oBrw:cAlias )->( DELETED() ), CLR_HRED, CLR_BLACK ),;
RGB( 232, 255, 232 ) } ) }
oBrw:bClrSel = { || { IF( ( oBrw:cAlias )->( DELETED() ), CLR_HRED, CLR_WHITE ),;
RGB( 0x33, 0x66, 0xCC ) } }
cClrBack = EVAL( oBrw:bClrSelFocus )[ 2 ]
oBrw:bClrSelFocus = { || { IF( ( oBrw:cAlias )->( DELETED() ), CLR_HRED, CLR_WHITE ),;
cClrBack } }
oBrw:SETCOLOR( CLR_BLACK, RGB( 232, 255, 232 ) )
oBrw:CreateFromCode()
oBrw:SetFocus()
oWnd:oClient = oBrw
ACTIVATE WINDOW oWnd ;
VALID ( ( cAlias )->( DBCLOSEAREA() ), oBrw:cAlias := "", .T. )
ELSE
MSGStop(cFileName,"No Existe")
ENDIF
RETURN Nil
//----------------------------------------------------------------------------//
FUNCTION GenLocalBlock( aCols, n )
RETURN { || EVAL( aCols[ n ]:bEditValue ) }
#include "tdolphin.ch"
#include "fivewin.ch"
FUNCTION Connect( )
LOCAL oServer
LOCAL oErr
TRY
CONNECT oServer HOST "localhost" ;
USER "root" ;
PASSWORD "1234";
PORT 3306 ;
FLAGS 0;
DATABASE "MiDataBase"
CATCH oErr
RETURN NIL
END
RETURN oServer
#include "Fivewin.ch"
#include "xbrowse.ch"
#include "Tdolphin.ch"
PROCEDURE Consulta()
LOCAL oQry, oDlg
oQry := oServer:Query( "SELECT * FROM clientes ORDER BY nombre")
DEFINE DIALOG oDlg RESOURCE "ABMCliente" OF oWnd
REDEFINE XBROWSE oBrw DATASOURCE oQry;
COLUMNS "Codigo","Nombre";
SIZES 50,350;
ID 111 OF oDlg AUTOSORT
REDEFINE SAY oBrw:oSeek PROMPT "" ID 113 OF oDlg
ACTIVATE DIALOG oDlg CENTER
STATIC FUNCTION Formu ( lAlta)
LOCAL oGet := ARRAY(4), oBot := ARRAY(2), oForm, lRta := .f., base, oError
// Base es una variable donde dejo un objeto fila, un registro de la tabla
IF lAlta
base := oQry:GetBlankRow() // Lo que seria un append blank
base:codigo := oServer:GetAutoIncrement("clientes") // Esto es si tu tabla es autoincremental en el codigo
ELSE
base := oQry:GetRowObj()
ENDIF
DO WHILE .T.
DEFINE DIALOG oForm TITLE IF(lAlta,"Alta","Modificacion") + " de Clientes";
FROM 05,15 TO 15,65 OF oWnd
@ 05, 05 SAY "Codigo:" OF oForm PIXEL
@ 20, 05 SAY "Nombre:" OF oForm PIXEL
@ 05, 75 GET oGet[1] VAR base:codigo PICTURE "99999" OF oForm PIXEL RIGHT WHEN(.F.)
@ 20, 75 GET oGet[2] VAR base:nombre PICTURE "@!" OF oForm PIXEL VALID(base:nombre<>SPACE(30))
@ 35,05 BUTTON oBot[1] PROMPT "&Grabar" OF oForm SIZE 30,10 ACTION ((lRta := .t.), oForm:End() ) PIXEL
@ 50,05 BUTTON oBot[2] PROMPT "&Cancelar" OF oForm SIZE 30,10 ACTION ((lRta := .f.), oForm:End() ) PIXEL CANCEL
ACTIVATE DIALOG oForm CENTER
IF !lRta
RETURN nil
ENDIF
oQry:oRow := base
TRY
oQry:Save()
oQry:Refresh(.t.)
CATCH oError
MsgStop("Error al grabar"+CHR(10)+oError:description,"Error")
LOOP
END TRY
EXIT
ENDDO
RETURN nil
STATIC FUNCTION Baja ( )
LOCAL lRta := .f., oError
lRta := MsgNoYes("Seguro de eliminar el Registro?","Atencion")
IF !lRta
RETURN nil
ENDIF
TRY
oQry:Delete()
oQry:Refresh(.t.)
CATCH oError
MsgStop("Error al borrar"+CHR(10)+oError:description,"Error")
END TRY
RETURN nil
#include "report.ch"
#include "FiveWin.ch"
#include "tdolphin.ch"
FUNCTION LisCli()
LOCAL oRep
REPORT oRep TITLE "Reporte de Clientes";
HEADER "Clientes";
FOOTER "Hoja:" + STR(oRep:npage,3) + SPACE(40)+"Fecha:"+DTOC(DATE());
PREVIEW
COLUMN TITLE "N° Cliente" DATA oQry:codigo SIZE 10
COLUMN TITLE "Razón social" DATA oQry:nombre SIZE 12
oRep:bInit := {|| oQry:GoTop() }
oRep:bSkip := {|| oQry:Skip() }
END REPORT
ACTIVATE REPORT oRep
RETURN NIL
@ECHO OFF
CLS
if A%1 == A GOTO :SINTAX
if NOT EXIST %1.prg GOTO :NOEXIST
ECHO Compiling...
set hdir=c:\harbour
set bcdir=c:\bcc582
SET INCLUDE=C:\FWH\INCLUDE
%hdir%\bin\harbour %1 /n /i..\include;%hdir%\include /w /p %2 %3 > clip.log
@type clip.log
IF ERRORLEVEL 1 PAUSE
IF ERRORLEVEL 1 GOTO EXIT
echo -O2 -e%1.exe -I%hdir%\include %1.c > b32.bc
%bcdir%\bin\bcc32 -M -c @b32.bc
:ENDCOMPILE
@ECHO OFF
CLS
set hdir=c:\harbour
set bcdir=c:\bcc582
SET LIB=C:\FWH\LIB
echo -O2 -eMIEXE.exe -I%hdir%\include MIEXE.c > b32.bc
%bcdir%\bin\bcc32 -M -c @b32.bc
:ENDCOMPILE
IF EXIST MIEXE.rc %bcdir%\bin\brc32 -r MIEXE
echo c0w32.obj + > b32.bc
echo MIEXE.obj + >> b32.bc
echo abmcli.obj liscli.obj + >> b32.bc
echo conectar.obj, + >> b32.bc
echo MIEXE.exe, + >> b32.bc
echo MIEXE.map, + >> b32.bc
echo %LIB%\dolphin.lib + >> b32.bc
echo %LIB%\\FiveH.lib %LIB%\\FiveHC.lib + >> b32.bc
echo %LIB%\\libmysql.lib + >> b32.bc
echo %LIB%\\libmysqld.lib + >> b32.bc
echo %hdir%\lib\hbrtl.lib + >> b32.bc
echo %hdir%\lib\xhb.lib + >> b32.bc
echo %hdir%\lib\hbvm.lib + >> b32.bc
echo %hdir%\lib\gtgui.lib + >> b32.bc
echo %hdir%\lib\gtstd.lib + >> b32.bc
echo %hdir%\lib\hblang.lib + >> b32.bc
echo %hdir%\lib\hbmacro.lib + >> b32.bc
echo %hdir%\lib\hbrdd.lib + >> b32.bc
echo %hdir%\lib\rddntx.lib + >> b32.bc
echo %hdir%\lib\rddcdx.lib + >> b32.bc
echo %hdir%\lib\rddfpt.lib + >> b32.bc
echo %hdir%\lib\hbsix.lib + >> b32.bc
echo %hdir%\lib\hbdebug.lib + >> b32.bc
echo %hdir%\lib\hbcommon.lib + >> b32.bc
echo %hdir%\lib\hbpp.lib + >> b32.bc
echo %hdir%\lib\hbusrrdd.lib + >> b32.bc
echo %hdir%\lib\hbwin.lib + >> b32.bc
echo %hdir%\lib\hbcplr.lib + >> b32.bc
echo %hdir%\lib\hbct.lib + >> b32.bc
echo %hdir%\lib\hbcpage.lib + >> b32.bc
echo %hdir%\lib\hbhsx.lib + >> b32.bc
echo %hdir%\lib\hbmisc.lib + >> b32.bc
echo %hdir%\lib\hbmzip.lib + >> b32.bc
echo %hdir%\lib\hbnf.lib + >> b32.bc
echo %hdir%\lib\hbpcre.lib + >> b32.bc
echo %hdir%\lib\hbtip.lib + >> b32.bc
echo %bcdir%\lib\cw32.lib + >> b32.bc
echo %bcdir%\lib\uuid.lib + >> b32.bc
echo %bcdir%\lib\import32.lib + >> b32.bc
echo %bcdir%\lib\ws2_32.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\psapi.lib + >> b32.bc
echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc
echo %bcdir%\lib\psdk\gdiplus.lib + >> b32.bc
echo %bcdir%\lib\psdk\shell32.lib, >> b32.bc
IF EXIST MIEXE.res echo MIEXE.res >> b32.bc
%bcdir%\bin\ilink32 -Gn -aa -Tpe -s @b32.bc
IF ERRORLEVEL 1 GOTO LINKERROR
ECHO * Application successfully built
@del *.c
@del *.PPO
@del *.MAP
GOTO EXIT
ECHO
@del *.c
@del *.PPO
@del *.MAP
:LINKERROR
ECHO * There are errors
GOTO EXIT
:SINTAX
ECHO SYNTAX: Build [Program] {-- No especifiques la extensi¢n PRG
ECHO {-- Don't specify .PRG extension
GOTO EXIT
:NOEXIST
ECHO The specified PRG %1 does not exist
:EXIT
//-- 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 cDb := "E1Prueba"
local cTable := "Test"
local oCon, oTb, n
//----------------------------------------------------------------------------
// Desde aquÝ se decide si el sistema usado es el C/S o el embebido
#ifdef E1_EMBEDDED
// Sistema embebido.
// El primer elemento del array de opciones deberÝa ser el nombre
// del programa, actualmente E1 hace lo mismo que MySQL y lo ignora.
// Ojo!!! s¾lo se procesa a partir del segundo.
local aOptions := { "PT05.PRG", "--defaults-file=./test.cnf" }
// El array de grupos contiene los nombres de los grupos que queramos
// procesar dentro del fichero ini declarado
local aGroup := { "op_servidor", "op_cliente" }
//-----------------------------------------------------
// Creamos el objeto Connect e intentamos la conexi¾n:
oCon := TMSEConnect():New( )
oCon:Connect( aOptions, aGroup, cDb )
#else
// Sistema Cliente/Servidor
local cHost := "127.0.0.1"
local cUser := "root"
local cPwd := "root"
local port := 3306
//-----------------------------------------------------
// Creamos el objeto Connect e intentamos la conexi¾n:
oCon := TMSConnect():New()
oCon:Connect( cHost, cUser, cPwd, cDb, port,, CLIENT_MULTI_STATEMENTS )
#endif
// Hasta aquÝ. A paritir de aquÝ no se cambia ni una lÝnea de c¾digo
//----------------------------------------------------------------------------
SET DATE FORMAT TO "DD/MM/YYYY"
SET EXACT on // Afecta a las b·squedas con los metodos Find y FindLike
cls
if oCon:lConnected
// Control de errores automßtico
oCon:SetAutoError( .t. )
// Creo el objeto Tabla con DataField
oTb := TMyTable( cTable ):New( oCon, cTable )
// Establezco el relleno de espacios (menos optimo)
oTb:SetReadPADAll( .t. )
// Prueba de tiny como logicos:
oTb:SetTinyAsLogical( .t. )
// Abro la tabla
if oTb:Open()
MyMsgInfo( oCon:oDataBase:ShowCreate(), "Creaci¾n de " + oCon:oDataBase:cName )
MyMsgInfo( oTb:ShowCreate(), "Estructura de " + oTb:cName )
Alert( "Estado actual de la conexion...;-------------------------------;;";
+ oCon:GetStat() )
// Abrimos el Browse
GestBrw( oTb )
else
// Esta es la manera de poner un mensaje de error propio y
// del generado po r Eagle1 cuando ponemos SetAutoError( .f. )
Alert( ";Mi mensaje de error:;No se pudo abrir la tabla " + oTb:cName + ;
";;Y el devuelto por Eagle1:;" + oTb:oError:GetError() )
endif
// Prueba de FieldName y FieldPos
n := 6
Alert( "Nombre de la columna " + StrNum( n ) + ": " +;
oTb:FieldName( n ) + ;
";Orden de la columna ZIP: " + ;
StrNum( oTb:FieldPos( "zip" ) ) + " Valor " + ;
oTb:FieldGetByName( "zip" ) + " - " + ;
oTb:FieldGet( oTb:FieldPos( "zip" ) ) )
Alert( "oTb:FieldName( oTb:FieldPos( 'zip' ) ) " + oTb:FieldName( oTb:FieldPos( "zip" ) ) )
// Prueba de setWhere
oTb:SetWhere( "first = 'Homer'", .t. ) // Asigna la condici¾n y refresca el reultado
Alert( oTb:cStatement )
// Abrimos el Browse
GestBrw( oTb )
//------------------------------
// Ejemplo SELECT escalar o sea que retorna un valor unico que puede ser
// numerico o alfanumerico
cls
Alert( "Numero de registros hallados con la funcion COUNT( * ): " + ;
StrNum( oCon:GetScalarQuery( "SELECT count( * ) FROM test" ) ) )
Alert( "Ahora la columna NOTES de la primera fila : " + ;
oCon:GetScalarQuery( "SELECT notes FROM test" ) )
// Liberamos la memoria ocupada por el objeto tabla
oTb:Free()
//------------------------------
// METHOD Export( cBakFileName, lCreate, aTables, lDropTable )
// Prueba de backup:
n := Seconds()
oCon:oDataBase:Export() // "MiCopia.sql", .t. )
Alert( "La copia se ha realizado con el nombre: " + ;
oCon:oDataBase:cBakFileName + ";;en " + ;
StrNum( Seconds() - n ) + " segundos" )
//------------------------------
// Este es el restore
//
if oCon:oDataBase:Import( oCon:oDataBase:cBakFileName )
Alert( "La restauracion de la copia se ejecuto ok" )
else
Alert( "Error en la restauracion de la copia..." )
endif
//------------------------------
else
Alert( "No se pudo conectar..." )
endif
// Liberamos la memoria de la conexion
oCon:Free()
return
//-- Modulos auxiliares ------------------------------------------------------//
//----------------------------------------------------------------------------//
// Gestion completa de una tabla MySQL
static procedure GestBrw( oTb )
local oBrw, oCol
local lEnd := .f.
local nKey, n, nFld, nRecNo
oBrw := TBrowseNew( 1, 0, MaxRow() - 1, MaxCol() )
oBrw:colorSpec := "W+/B, N/BG"
oBrw:ColSep := " │ "
oBrw:HeadSep := "─┼─"
oBrw:FootSep := "─┴─"
// Asignamos los bloques de codigo de movimientos del cursor
// de datos
MySetBrowse( oBrw, oTb )
nFld := oTb:FieldCount()
FOR n := 1 TO nFld
oBrw:AddColumn( TBColumnNew( PADL( n, 2, "0" ) + "-" + ;
oTb:FieldType( n ) + "-" + oTb:FieldName( n ), ;
GenCB( oTb, n ) ) )
NEXT
cls
@ 0, 0 SAY PadC( "Ojeando la tabla: " + ;
upper( oTb:cName ), MaxCol() + 1, " " ) COLOR "W+/G+"
@ MaxRow(), 0 SAY "INS" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Altas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ENTER" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Mod." COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "SUPR" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Bajas" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F1" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Ayuda" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F4" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Orden" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F5" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Busca" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "F6" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Busca ->" COLOR "W+/R+"
@ MaxRow(), Col() + 1 SAY "ESC" COLOR "GR+/R+"
@ MaxRow(), Col() + 1 SAY "Salir" COLOR "W+/R+"
while !lEnd
oBrw:forceStable()
nKey = InKey( 0 )
do case
case nKey == K_ESC // Salir
SetPos( MaxRow(), 0 )
lEnd = .t.
case nKey == K_DOWN // Fila siguiente
oBrw:Down()
case nKey == K_F3
oTb:SetReadPADAll( !oTb:SetReadPADAll() )
oBrw:Configure()
case nKey == K_F4 // Establece el orden
if ElOrden( oTb )
oBrw:goTop()
endif
case nKey == K_F5 // Busca valor en columna
if BuscaValor( oTb )
Alert( "Valor encontrado..." )
else
Alert( "Valor no encontrado..." )
endif
oBrw:RefreshAll()
case nKey == K_F6 // Busca siguiente columna
// Busqueda blanda
//if !oTb:FindLikeNext()
// Busqueda exacta
nRecNo := oTb:RecNo()
if oTb:findNext()
Alert( "Valor encontrado..." )
else
oTb:goTo( nRecNo )
Alert( "Valor no encontrado..." )
endif
oBrw:RefreshAll()
case nKey == K_UP // Fila anterior
oBrw:Up()
case nKey == K_LEFT // Va a la columna antrior
oBrw:Left()
case nKey == K_RIGHT // Va a la columna siguiente
oBrw:Right()
case nKey = K_PGDN // Va a la pagina siguiente
oBrw:pageDown()
case nKey = K_PGUP // Va a la pagina antrior
oBrw:pageUp()
case nKey = K_CTRL_PGUP // Va al principio
oBrw:goTop()
case nKey = K_CTRL_PGDN // Va al final
oBrw:goBottom()
case nKey = K_HOME // Va a la primera columna visible
oBrw:home()
case nKey = K_END // Va a la ultima columna visible
oBrw:end()
case nKey = K_CTRL_LEFT // Va a la primera columna
oBrw:panLeft()
case nKey = K_CTRL_RIGHT // Va a la ultima columna
oBrw:panRight()
case nKey = K_CTRL_HOME // Va a la primera pßgina
oBrw:panHome()
case nKey = K_CTRL_END // Va a la ·ltima pßgina
oBrw:panEnd()
case nKey = K_DEL // Borra fila
Borrar( oTb, oBrw )
case nKey = K_INS // Inserta columna
Insertar( oTb, oBrw )
case nKey = K_ENTER // Modifica columna
Modificar( oTb, oBrw )
case nKey == K_F1 // Algunos datos
Alert( "Datos de la tabla " + oTb:cName + ";" + ;
";Registro actual......: " + Str( oTb:RecNo() ) + ;
";Total de registros...: " + Str( oTb:RecCount() ) + ;
";Total de columnas....: " + Str( oTb:FieldCount() ) )
Muestra( oTb:GetRowAsString() )
endcase
end
return
//----------------------------------------------------------------------------//
// Crea los codeblock SETGET de las columnas del browse
static function GenCB( oTb, n )
return( { || oTb:FieldGet( n ) } )
//----------------------------------------------------------------------------//
// Pantalla de datos de la tabla
static function PantMuestra( oTb, nTipo )
local GetList := {}
local cTipo, cId
do case
case nTipo == ID_ALTA
cTipo := "Insertando"
cId := "nuevo"
case nTipo == ID_BORRA
case nTipo == ID_CONSUTA
case nTipo == ID_MODIFICA
cTipo := "Modificando"
cId := StrNum( oTb:Id )
end
SET CURSOR ON
DispBox( 3, 2, 18, 74, B_BOX )
@ 04, 03 SAY cTipo + " registro en tabla " + oTb:cName + " - Numero: " + cId
@ 06, 03 SAY "First....:" GET oTb:First PICTURE "@K"
@ 07, 03 SAY "Last.....:" GET oTb:Last PICTURE "@K"
@ 08, 03 SAY "Street...:" GET oTb:Street PICTURE "@K"
@ 09, 03 SAY "City.....:" GET oTb:City PICTURE "@K"
@ 10, 03 SAY "State....:" GET oTb:State PICTURE "@K"
@ 11, 03 SAY "Zip......:" GET oTb:Zip PICTURE "@K"
@ 12, 03 SAY "Hiredate.:" GET oTb:Hiredate PICTURE "@K"
@ 13, 03 SAY "Married..:" GET oTb:Married PICTURE "@K"
@ 14, 03 SAY "Age......:" GET oTb:Age PICTURE "@K"
@ 15, 03 SAY "Salary...:" GET oTb:Salary PICTURE "@K"
@ 16, 03 SAY "Notes:"
@ 17, 03 GET oTb:Notes PICTURE "@K"
return( GetList )
//----------------------------------------------------------------------------//
// Inserta una fila
static procedure Insertar( oTb, oBrw )
local GetList := {}
local cPant := SaveScreen( 3, 2, 18, 74 )
oTb:Blank()
GetList := PantMuestra( oTb, ID_ALTA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if oTb:Insert()
Alert( "Tupla insertada" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oBrw:goBottom()
oBrw:RefreshAll()
endif
endif
endif
return
//----------------------------------------------------------------------------//
// Modifica la fila actual
static procedure Modificar(oTb,oBrw )
local GetList := {}
local nRecNo := oTb:RecNo()
local cPant := SaveScreen( 3, 2, 18, 74 )
oTb:Load()
GetList := PantMuestra( oTb, ID_MODIFICA )
READ
set cursor off
RestScreen( 3, 2, 18, 74, cPant )
if LastKey() != K_ESC .and. Updated()
if oTb:Update()
Alert( StrNum( oTb:AffectedRows() ) + " - tuplas modificadas" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
endif
return
//----------------------------------------------------------------------------//
// Borra la fila actual
static procedure Borrar( oTb, oBrw )
local nRecNo := oTb:RecNo()
if Alert( "Realmente quieres borrar el registro?", { "Si", "No" } ) == 1
if oTb:Delete( , 1 )
Alert( "Borrado en el servidor" )
if Alert( "Refresca el Browse?", { "Si", "No" } ) == 1
oTb:Refresh()
oTb:GoTo( nRecNo )
oBrw:RefreshAll()
endif
endif
else
Alert( "No se ha borrado..." )
endif
return
//----------------------------------------------------------------------------//
// Establece un nuevo orden de visualizacion
static function ElOrden( oTb )
local i := oTb:FieldCount()
local aFld := Array( i )
local n, lRet
FOR n := 1 TO i
aFld[ n ] := oTb:FieldName( n )
NEXT
DispBox( 5, 9, 10, 25, B_BOX )
i := 0
i := AChoice( 6, 10, 9, 24, aFld )
if lRet := ( i > 0 )
Alert( "Ordenado por la columna: " + StrNum( i ) + " " + oTb:FieldName( i ) )
oTb:SetOrderBy( i,, .t. )
endif
return( lRet )
//----------------------------------------------------------------------------//
// Busca un valor de una columna
static function BuscaValor( oTb )
local GetList := {}
local nCol := 0
local lRet, uVal
DispBox( 5, 5, 8, 75, B_BOX )
@ 6, 10 SAY "Entre numero de columna:" GET nCol PICTURE "@K"
READ
if nCol > 0 .and. nCol <= oTb:FieldCount()
uVal := oTb:FieldGet( nCol )
@ 7, 10 SAY "Entre valor buscado:" GET uVal PICTURE "@K"
READ
// Ojo cuando es tipo caracter (x)Harbour mete espacios hasta el final
// del ancho del campo
uVal := if( ValType( uVal ) == "C", AllTrim( uVal ), uVal )
// Busqueda blanda
// lRet := oTb:FindLike( nCol, uVal, .t. )
// Busqueda exacta
lRet := oTb:Find( nCol, uVal, .t. )
else
lRet := .f.
Alert( "Emtre un n·mero de columna correcto" )
endif
return( lRet )
//----------------------------------------------------------------------------//
El principal problema que creo que tienes es que sigues pensando en DBF y eso es un error muy grande. El mundo SQL no tiene nada que ver con DBF salvo en que se guarda informacion y se recupera.
te envíe un correo a
danyleon82 @ hotmail. com con la alternativa garantizada, y no necesitas nada extra, ni compilar
librería alguna, con lo que tienes puedes pasar a SQL vía FWH y ADO.
1.- En DBFs muchos asumimos que un archivo ARCHIVOX.DBF es una base de datos pero
2,. En SQL el equivalente a un ARCHIVOX.DBF es una tabla, en SQL sí se maneja el concepto
DATABASE que, en palabras simples, es un contenedor de una o varias TABLAS (DBFs), lo que
no ocurre con DBFs
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 44 guests