I use this code from the forum and modified as my need. You can try and modify as your need.
Code: Select all
// VISOR DE BASE DE DATOS DE MYSQL
// TRASPASO DE UN DBF A MYSQL
// BENJAMIN CASARRUBIAS MORENO
// CD OBREGON, SONORA,MEXICO
// CHINO72VALE@HOTMAIL.COM
// EN MIS TIEMPOS LIBRES
#include "FiveWin.ch"
#include "fileio.ch"
#include "xbrowse.ch"
#include "slider.ch"
#include "ribbon.ch"
#include "hbcompat.ch"
#define TOPSCOPE 0
#define BOTTOMSCOPE 1
//----------------------------------------------------------------//
MEMVAR oWnd
MEMVAR TOTALSEF, TOTALFERRO, TOTALBARCA
MEMVAR GROPOSEF, GRUPOFERRO, GRUPOBARCA
MEMVAR FECHASEF, FECHAFERRO, FECHABARCA
Static oFnt
*--------------*
Function Main()
LOCAL OREGI,OBASE, CALIAS, cEstructura, entro:=.f., serbase
local cauxi, i, cuantos:=0, ocon, ctexto1, oquery, n, ctabla, ckprimary, cksegunda, oqry
LOCAL PURIN:=0, ctime1:="", ctime2:=""
local Cruta :="localHost "+space(80)
Local Cusuario:="root"+space(80)
local ccontra :=space(40)
local cpuerto :=3306
local Obtn, cantreg, aFonts, oBrush
FW_SetUnicode( .T. )
REQUEST DBFCDX, DBFFPT
extern OrdKeyCount, OrdKeyNo
rddSetDefault("DBFCDX")
sethandlecount(250)
SET( _SET_EPOCH,1950 )
SET( _SET_DATEFORMAT,"dd-mm-yyyy" )
SET _3DLOOK ON
if !file("config.dbf")
// ay que crear el archivo de configuracion
DbCreate( "config.dbf", { { "RUTA", "C", 80, 0 },;
{ "USUARIO", "C", 80, 0 },;
{ "CONTRA", "C", 40, 0 },;
{ "PUERTO", "N", 5, 0 } } )
Select(0)
Use config alias config shared new
config->(dbappend())
config->ruta:= cruta
config->usuario:=cusuario
config->contra:= ccontra
config->puerto:= cpuerto
config->(dbunlock())
Close config
else
Endif
select(0)
use config alias config shared new
// DEFINE BRUSH oBrush FILE 'BlueLight.JPG'
aFonts := { -14, 0, 0, 0, 400, .F., .F., .F., 222, 3, 2, 1, 34, 'Tahoma' }
DEFINE FONT oFnt NAME 'Tahoma' SIZE 0, -14
oFnt:hFont := CreateFont( aFonts )
DEFINE WINDOW oWnd TITLE "Imprt Dbf to MySql V.1.1" FROM 10, 10 TO 800,1000 PIXEL ;
COLOR CLR_WHITE, nRGB( 0, 192, 255) ; // BRUSH oBrush ;
Menu BuildMenu()
oWnd:SetFont( oFnt )
SetGetColorFocus(RGB(238,232,170)) // COLOR PARA TODOS LOS GET DEL SISTEMAS WWE
ACTIVATE WINDOW oWnd ;
ON INIT (Conecta() , oWnd:SetFocus())
Return nil
*----------------------------------------------------*
Function Buildmenu()
local oMenu
MENU oMenu
MENUITEM "&Connect to Mysql" action Conecta()
MENUITEM "Open Table" action ConnectDb()
MENUITEM "Exit" action oWnd:End()
// MENUITEM "Test Unicode" action ShowUni()
ENDMENU
RETURN oMenu
*------------------------*
Procedure ConnectDb
local Cruta, Cusuario, cContra, Cpuerto
select config
cruta:= config->ruta
cusuario:=config->usuario
ccontra:= config->contra
cpuerto:= config->puerto
Xconecta(Cruta, Cusuario, cContra, Cpuerto)
return
*-----------------------*
Procedure ShowxBr( oServer, cTable )
local oqry, oDlg, oBrw
oqry:=oServer:Query( "SELECT * FROM "+lower(cTable) )
IF oqry:lError
? "It could not open the database "
Return
endif
XBROWSER oqry FASTEDIT TITLE FWVERSION
/*
DEFINE DIALOG oDlg FROM 1, 1 TO 400, 600 PIXEL
@ 5, 5 XBROWSE oBrw OBJECT oQry ;
AUTOCOLS AUTOSORT PIXEL SIZE 480, 150 of oDlg
oBrw:CreateFromCode()
oDlg:oClient := oBrw
ACTIVATE DIALOG oDlg CENTER
*/
oqry:End()
return
*-----------------------*
Function ShowUni()
local cText := '\u0E17\u0E14\u0E2A\u0E2D\u0E1A'
local hfile, ctest
Msginfo( cText )
hfile := fcreate('test.txt')
cTest := HB_TRANSLATE(cText,"TIS620","UCS2")
fwrite(hfile,cTest)
fclose(hfile)
return nil
*--------------------*
Function Conecta()
local oDlg
local Cruta :="localHost "+space(80)
Local Cusuario:="root"+space(80)
local ccontra :=space(40)
local cpuerto :=3306
local Obtn[2], cantreg
//checar una base de datos para que tome los valores de configuracion okidoki a peticion de willian
//
select config
cantreg:=reccount()
if cantreg<1 // con la clase database mas rapido , pero me gusta ver la asignacion de todos _ de perdis
config->(dbappend())
config->ruta:= cruta
config->usuario:=cusuario
config->contra:= ccontra
config->puerto:= cpuerto
config->(dbunlock())
else
cruta:= config->ruta
cusuario:=config->usuario
ccontra:= config->contra
cpuerto:= config->puerto
Endif
DEFINE DIALOG oDlg FROM 1, 1 TO 200, 350 TITLE "Connect to Mysql" of Ownd PIXEL FONT oFnt
oDlg:lHelpIcon := .F.
@ 9, 10 Say "Server" Of Odlg PIXEL
@ 7, 50 Get Cruta Of Odlg Size 100,12 PIXEL
@ 24, 10 Say "User" Of Odlg PIXEL
@ 22, 50 Get cusuario OF Odlg size 100,12 PIXEL
@ 39, 10 Say "Password" Of Odlg PIXEL
@ 37, 50 Get cContra Of Odlg size 100,12 password PIXEL
@ 54, 10 Say "Port" Of Odlg PIXEL
@ 52, 50 Get cPuerto Of Odlg size 40,12 RIGHT PIXEL
@ 75, 40 BTNBMP OBTN[1] PROMPT "Connect" 2007 OF oDlg SIZE 40,15 ;
ACTION (datin(cruta, cusuario, ccontra, cpuerto),;
Xconecta(Cruta, Cusuario, cContra, Cpuerto), oDlg:End() )
@ 75,100 BTNBMP OBTN[2] PROMPT "Cancel" 2007 OF oDlg size 40,15 ;
ACTION odlg:end()
ACTIVATE DIALOG oDlg CENTER ;
ON INIT oBtn[1]:SetFocus()
datin(cruta, cusuario, ccontra, cpuerto)
Return Nil
*---------------------------------------------------*
Function Datin(Xruta, Xusuario, Xcontra, Xpuerto)
Select config
go 1 // primer registro tiene la configuracion se puede anexar variar
config->(dbrlock())
config->ruta:= xruta
config->usuario:=xusuario
config->contra:= xcontra
config->puerto:= xpuerto
config->(dbunlock())
Return NIl
*---------------------------------------------------*
Function xconecta(Xruta, Xusuario, Xcontra, Xpuerto)
local oServer
local oBrw, Obrw2
local oDlg2, oBtn
local aBases:={}, aTablas:={}
local i
// esta es con tymsql
oServer:= TMYSQLSERVER():new( alltrim(xruta), alltrim(xusuario), alltrim(xcontra), xpuerto)
IF oServer:lError
MSGALERT( "There was error connecting will check if there is connection to the server or user / password is incorrected")
Return Nil
Endif
// esta es con dolphin
abases:=oServer:ListDBs() // Obtiene la lista de las bases de datos we
if len(abases)>=1
aTablas:=Metetablas(oServer, aBases[1] )
Endif
DEFINE DIALOG oDlg2 FROM 1, 1 TO 35, 120 TITLE "Available Database and Table " FONT oFnt
oDlg2:lHelpIcon := .F.
@ 1, 1 XBROWSE oBrw OF oDlg2 ARRAY aBases size 130,210 update;
COLUMNS {1};
HEADERS {"Database"};
COLSIZES 220 LINES CELL ;
ON CHANGE (atablas:=Metetablas(oServer, aBases[ oBrw:nArrayAt] ),oBrw2:aArrayData := aTablas, obrw2:refresh() )
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:nRowDividerStyle := LINESTYLE_LIGHTGRAY
oBrw:nColDividerStyle := LINESTYLE_LIGHTGRAY
oBrw:nHeaderHeight := 26
oBrw:nRowHeight := 24
oBrw:lHScroll := .F.
oBrw:nStretchCol := STRETCHCOL_LAST
oBrw:lAllowRowSizing := .F.
oBrw:CreateFromCode()
odlg2:oClient := oBrw
@ 1, 20 XBROWSE oBrw2 OF oDlg2 ARRAY aTablas size 150,210 update;
COLUMNS {1};
HEADERS {"Table"};
COLSIZES 250 LINES CELL;
ON LEFT DBLCLICK VisorBase(oServer, aTablas[ oBrw2:nArrayAt], aBases[ oBrw:nArrayAt] )
oBrw2:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw2:nRowDividerStyle := LINESTYLE_LIGHTGRAY
oBrw2:nColDividerStyle := LINESTYLE_LIGHTGRAY
oBrw2:nHeaderHeight := 26
oBrw2:nRowHeight := 24
oBrw2:lHScroll := .F.
oBrw2:nStretchCol := STRETCHCOL_LAST
oBrw2:lAllowRowSizing := .F.
oBrw2:CreateFromCode()
odlg2:oClient := oBrw2
// botones para el primer browse para dar de altas y bajas las tablas
/*
@ 05, 30 BTNBMP OBTN PROMPT "High" TOOLTIP "Dar de alta Una Base De datos" 2007 OF oDlg2 size 25,12 ACTION (ALTBASE(oDlg2,oServer, aBases ),;
abases:=Oserver:ListDBs(), oBrw:aArrayData := aBases, obrw:refresh() )
@ 05, 70 BTNBMP OBTN PROMPT "Decline" TOOLTIP "Dar de Baja Una Base de Datos" 2007 OF oDlg2 size 25,12 ACTION (BAJBASE(oDlg2,oServer, aBases[ oBrw:nArrayAt]),;
abases:=Oserver:ListDBs(), oBrw:aArrayData := aBases, obrw:refresh() )
@ 05, 240 BTNBMP OBTN PROMPT "High" TOOLTIP "Dar de alta Una Tabla" 2007 OF oDlg2 size 25,12 ACTION (ALTTABLA(oDlg2,oServer, aBases[ oBrw:nArrayAt], aTablas ) )
*/
// @ 05, 280 BTNBMP OBTN PROMPT "Baja" Tooltip "Dar de Baja Una Tabla" 2007 OF oDlg2 size 25,12 ACTION (BAJBASE(oDlg2,oServer, aBases[ oBrw:nArrayAt]),;
// abases:=Oserver:ListDBs(), oBrw:aArrayData := aBases, obrw:refresh() )
@ 80, 360 BTNBMP OBTN PROMPT "Browse Database Mysql" TOOLTIP "Browse Database from MYSQL" 2007 OF oDlg2 size 80,14 ;
ACTION (ShowXbr(oServer,aTablas[oBrw2:nArrayAt]))
@ 100, 360 BTNBMP OBTN PROMPT "Import Dbf/Mysql" TOOLTIP "Transfer a Database DBF to MYSQL" 2007 OF oDlg2 size 80,14 ;
ACTION (Diatras(oServer, aBases[ oBrw:nArrayAt] ),;
atablas:=Metetablas(oServer, aBases[ oBrw:nArrayAt] ),oBrw2:aArrayData := aTablas, obrw2:refresh())
@ 120, 360 BTNBMP OBTN PROMPT "Drop Mysql Table" TOOLTIP "Drop Table in MYSQL" 2007 OF oDlg2 size 80,14 ;
ACTION (DropTable(oServer, aTablas, oBrw2 ))
@ 140, 360 BTNBMP OBTN PROMPT "Export to Excel" 2007 TOOLTIP "Mandar reporte a Excel" OF oDlg2 size 80,14 ;
ACTION MsgMeter( { |oMeter, oText, oDlg2, lEnd | ;
Expexcel( oBrw2, oMeter, oText, oDlg2, @lEnd ) } )
@ 160, 360 BTNBMP OBTN PROMPT "Cancel" 2007 OF oDlg2 size 80,14 ACTION odlg2:end()
ACTIVATE DIALOG ODLG2 CENTER
oServer:end() // finaliza la seccion
Return Nil
*------------------------------------*
Function DropTable(oServer, aTablas, oBrw2 )
local cSql, oQry, cTable
local nSkip := iif(oBrw2:nArrayAt=1,1,-1)
cTable := aTablas[oBrw2:nArrayAt]
if MsgYesNo("Drop Table : "+rtrim(cTable) )
cSql := "DROP TABLE "+rtrim(lower(cTable))
oQry := oServer:Query( cSql )
IF oQry:lError
MsgAlert( "It could not drop table : "+cTable )
else
Adel( aTablas, oBrw2:nArrayAt)
Asize( aTablas, len(aTablas)-1 )
oBrw2:Skip(nSkip)
oBrw2:Refresh()
end
end
return nil
*--------------------------------------------------*
Function AltTabla(xOdlg, Xserver, Xbase, xbases )
local Odlg
local oBtn
local oBrw
local acampos:={{"","","",0,0}}
local ctabla:=space(80)
local cdonde:=0
local cinge:=space(120)
adel(aCampos,1)
aSize(aCampos,len(aCampos)-1)
DEFINE DIALOG oDlg TITLE "Add To Table "+xbase size 650,500 of xOdlg FONT oFnt
oDlg:lHelpIcon := .F.
@ 0.9, 1 Say "Table Name" Of Odlg
@ 1,7 Get Ctabla Of Odlg Size 120,10 valid ( chebase(ctabla, xbases) ) // checar si ya existe una tabla de datos parecida
@ 1.7, 1 Say "Type of Engineer" Of Odlg
@ 2,7 Get Cinge Of Odlg Size 120,10
@ 2.8, 1 XBROWSE oBrw OF oDlg ARRAY aCampos size 220,180 update;
COLUMNS {1,2,3,4,5};
HEADERS {"Field","Type","SubType","Size","Decimal"};
COLSIZES 100,70,70,75,75;
ON LEFT DBLCLICK ( cdonde:=obrw:nArrayAt, Acampos:=modcampo(OdLG,acampos,oBrw:nArrayAt,obrw), oBrw:SetArray( acampos ), obrw:nArrayAt:=cdonde,obrw:refresh() )
oBrw:CreateFromCode()
odlg:oClient := oBrw
@ 20, 240 BTNBMP obtn PROMPT "Insert" 2007 OF oDlg size 40,12 ACTION ;
( Acampos:=inscampo(oDlg, acampos,oBrw:nrowsel), oBrw:SetArray( acampos ), obrw:refresh() )
@ 40, 240 BTNBMP oBtn PROMPT "Modify" 2007 OF oDlg size 40,12 ACTION ;
( cdonde:=obrw:nArrayAt,Acampos:=modcampo(OdLG,acampos,oBrw:nArrayAt, Obrw) , oBrw:SetArray( acampos ), obrw:nArrayAt:=cdonde,obrw:refresh())
@ 60, 240 BTNBMP oBtn PROMPT "Delete" 2007 OF oDlg size 40,12 ACTION ;
( Acampos:=delcampo(acampos,obrw:nArrayAt), oBrw:SetArray( acampos ), obrw:refresh() )
@ 180,240 BTNBMP oBtn PROMPT "Create" 2007 OF oDlg size 40,12 ACTION ( grabawey(xServer,cTabla, Acampos) )
@ 200,240 BTNBMP oBtn PROMPT "Cancel" 2007 OF oDlg size 40,12 ACTION odlg:end()
ACTIVATE DIALOG oDlg CENTERED
Return Nil
*-------------------------------------------*
Function Grabawey(xServer,Xtabla, Xcampos)
LOCAL CALIAS, cEstructura, entro:=.f., serbase
local cauxi, i, ctexto1, oquery, n, mete:=","
cEstructura := "CREATE TABLE "+alltrim(xtabla)+" ( "
for i:=1 to len(xcampos)
if n=len(xcampos)
mete:=" "
endif
IF SUBSTR(xcampos[i][2],1,1)="C"
cEstructura:=Cestructura+alltrim(xcampos[i][1])+" "+alltrim(xcampos[i][3])+"("+alltrim(str(xcampos[i][4]))+") default ' '"+mete
Endif
IF SUBSTR(xcampos[i][2],1,1)="N"
// PUROS ENTEROS
if alltrim(xcampos[i][3])="Int"
cEstructura:=Cestructura+alltrim(xcampos[i][1])+" "+alltrim(xcampos[i][3])+"("+alltrim(str(xcampos[i][4]))+") default 0"+mete
Endif
// CON DECIMALES
if alltrim(xcampos[i][3])="Decimal"
cEstructura:=Cestructura+alltrim(xcampos[i][1])+" "+alltrim(xcampos[i][3])+"("+alltrim(str(xcampos[i][4]))+","+alltrim(str(xcampos[i][5]))+" ) default 0"+mete
Endif
Endif
IF SUBSTR(xcampos[i][2],1,1)="F"
cEstructura:=Cestructura+alltrim(xcampos[i][1])+" "+alltrim(xcampos[i][3])+" default '2000-12-02' "+mete
Endif
Next i
cEstructura += "PRIMARY KEY ("+alltrim(xcampos[1][1])+" ) )"
cEstructura += " ENGINE=InnoDB DEFAULT CHARSET=utf8"
// ? cestructura
xServer:Query( cEstructura )
IF xServer:lError
MSGALERT( "There was no mistake was discharged ,, Check Data")
xServer:lError:=.F. // PORQUE SI SE GENERA DE VUELTA COMO QUE NO LO INICIALIZA
else
? " si se dio we "
ENDIF
return nil
*--------------------------------------*
Function Inscampo(xOdlg,xcampos, xitem) //Insertar campo a la base de datos seleccionada
local cCampo:=space(10), Ctipo:={"Character","Numeric","Date"} , ctamano:=0, cdecimal:=0
local aSub1, Asub2, aSub3
local ocampo, otipo, otamano, odecimal, citem:="Caracter", oitem, lsalir:=.f., lsino:=.f.
local ltama:=.t.,ldeci:=.t., ctama:=""
local Odlg3, Obtn, csub:=space(10), oSub, aparte
aSub1:={"Int","Decimal","Tinyint","Mediumint","Bigint","Float","Double","Real","Bit","Boolean","Serial" } // aquie le podemos agregar los diferentes tipos
aSub2:={"Date","Datetime","Timestamp","Time","Year"}
asub3:={"Varchar","Char","text","tinyText","Mediumtext","Longttext"}
aparte:=asub3
csub:="Varchar"
DEFINE DIALOG oDlg3 TITLE "Insertar campo a la Estructura del Archivo " of xOdlg size 400,230
oDlg3:lHelpIcon := .F.
@ 0.9, 1 say "Field" size 60,12 of odlg3
@ 1.9, 1 Say "Type" size 60,12 of odlg3
@ 2.8, 1 Say "Subtype" size 60,12 of odlg3
@ 3.7, 1 say "Size" size 60,12 of odlg3
@ 4.5, 1 say "Decimal" size 60,12 of odlg3
@ 1,5 get ocampo var ccampo size 100,12 of odlg3 valid ( lsino:=checalo(ccampo, xcampos,1,xitem), lsino ) update
@ 2,5 COMBOBOX oitem var cItem OF odlg3 ITEMS ctipo size 100,60 On change ( aParte:=ponsub(citem,1), osub:setitems(aparte),csub:=ponsub(citem,2),;
osub:refresh() )
@ 3,5 COMBOBOX osub var csub OF odlg3 ITEMS aParte size 100,60 update
@ 4.3,5 get otamano var ctamano size 40,12 of odlg3 picture "999" when .t. update RIGHT
@ 5.3,5 get odecimal var cdecimal of odlg3 size 40,12 picture "99" when .t. update RIGHT
@ 89,50 BTNBMP oBtn PROMPT "Agree" 2007 OF oDlg3 size 40,12 ACTION (lsalir:=.t.,odlg3:end() )
@ 89,100 BTNBMP oBtn PROMPT "Cancel" 2007 OF oDlg3 size 40,12 ACTION (lsalir:=.f.,odlg3:End() )
ACTIVATE DIALOG oDlg3 CENTERED
if lsalir // si dio agregar a que meterlo okidoki
if ctamano>0 .or. substr(citem,1,1)="L" .or. substr(citem,1,1)="D" .OR. SUBSTR(CITEM,1,1)="M" //que tenga informacion we de perdis
// poner aqui las validaciones de los valor que deben de tener maximo ajustandolos ok mientras corrigo lo de la validacion
if substr(citem,1,1)="C"
cdecimal:=0
if ctamano>254
ctamano:=254
endif
endif
if substr(citem,1,1)="D"
cdecimal:=0
ctamano:=8
endif
if substr(citem,1,1)="N"
if Ctamano>19
Ctamano:=19
ENDIF
if Cdecimal>15
Cdecimal:=15
Endif
Endif
aadd(xcampos,{ccampo,citem,cSub,ctamano, cdecimal,ccampo,citem,ctamano,cdecimal,"A"})
endif
Endif
Return xcampos
*-----------------------------*
Function Ponsub(xCampo,xtipo)
local dev
local aSub1:={"Int","Decimal","Tinyint","Mediumint","Bigint","Float","Double","Real","Bit","Boolean","Serial" }
local ASub2:={"Date","Datetime","Timestamp","Time","Year"}
local asub3:={"Varchar","Char","text","tinyText","Mediumtext","Longttext"}
if xtipo=1
if substr(xcampo,1,1)="C"
dev:=asub3
Endif
if substr(xcampo,1,1)="N"
dev:=asub1
Endif
if substr(xcampo,1,1)="F"
dev:=asub2
Endif
else
if substr(xcampo,1,1)="C"
dev:="Varchar"
Endif
if substr(xcampo,1,1)="N"
dev:="Int"
Endif
if substr(xcampo,1,1)="F"
dev:="Date"
Endif
Endif
Return Dev
*---------------------------------------------*
Function modcampo(xOdlg, xcampos, xitem, xobrw) //Modificar campo a la base de datos seleccionada
local cCampo:=space(10), Ctipo:={"Character","Numeric","Date"} , ctamano:=0, cdecimal:=0
local ocampo, otipo, otamano, odecimal, citem:="Caracter", oitem, lsalir:=.f., lsino:=.f.
local ltama:=.t.,ldeci:=.t., ctama:=""
local odlg3
local oBtn, aParte, csub, osub
local aSub1, aSub2, aSub3
aSub1:={"Int","Decimal","Tinyint","Mediumint","Bigint","Float","Double","Real","Bit","Boolean","Serial" } // aquie le podemos agregar los diferentes tipos
ASub2:={"Date","Datetime","Timestamp","Time","Year"}
asub3:={"Varchar","Char","text","tinyText","Mediumtext","Longttext"}
aparte:=asub3
xitem:=xobrw:narrayat
ccampo:=xcampos[xitem][1]
citem :=xcampos[xitem][2]
Csub :=xcampos[xitem][3]
ctamano:=xcampos[xitem][4]
cdecimal:=xcampos[xitem][5]
if substr(citem,1,1)="C"
aParte:=asub3
endif
if substr(citem,1,1)="N"
aParte:=asub1
endif
if substr(citem,1,1)="D"
aParte:=asub2
endif
DEFINE DIALOG oDlg3 TITLE "Modify Field" of xOdlg size 400,230
oDlg3:lHelpIcon := .F.
@ 0.9, 1 say "Field" size 60,12 of odlg3
@ 1.9, 1 Say "Type" size 60,12 of odlg3
@ 2.8, 1 Say "Subtype" size 60,12 of odlg3
@ 3.7, 1 say "Size" size 60,12 of odlg3
@ 4.5, 1 say "Decimales" size 60,12 of odlg3
@ 1,5 get ocampo var ccampo size 100,12 of odlg3 valid ( lsino:=checalo(ccampo, xcampos,2,xitem), lsino ) update
@ 2,5 COMBOBOX oitem var cItem OF odlg3 ITEMS ctipo size 100,60 On change ( aParte:=ponsub(citem,1), osub:setitems(aparte),csub:=ponsub(citem,2),;
osub:refresh() )
@ 3,5 COMBOBOX osub var csub OF odlg3 ITEMS aParte size 100,60 update
@ 4.3,5 get otamano var ctamano size 40,12 of odlg3 picture "999" when .t. update RIGHT
@ 5.3,5 get odecimal var cdecimal of odlg3 size 40,12 picture "99" when .t. update RIGHT
@ 89,050 BTNBMP oBtn PROMPT "Change" 2007 OF oDlg3 size 40,12 ACTION (lsalir:=.t.,odlg3:end() )
@ 89,100 BTNBMP oBtn PROMPT "Cancel" 2007 OF oDlg3 size 40,12 ACTION (lsalir:=.f.,odlg3:End() )
ACTIVATE DIALOG oDlg3 CENTERED
if lsalir // si dio agregar a que meterlo okidoki
if ctamano>0 //que tenga informacion we de perdis
// poner aqui las validaciones de los valor que deben de tener maximo ajustandolos ok mientras corrigo lo de la validacion
if substr(citem,1,1)="C"
cdecimal:=0
if ctamano>254
ctamano:=254
endif
endif
if substr(citem,1,1)="D"
cdecimal:=0
ctamano:=8
endif
if substr(citem,1,1)="N"
if Ctamano>19
Ctamano:=19
ENDIF
if Cdecimal>15
Cdecimal:=15
Endif
Endif
xcampos[xitem][1]:=ccampo
xcampos[xitem][2]:=citem
xcampos[xitem][3]:=csub
xcampos[xitem][4]:=ctamano
xcampos[xitem][5]:=cdecimal
endif
Endif
Return xcampos
*--------------------------------------------*
Function checalo(xcampo, xxcampos,xtipo,xpos) /// checa que no existe el mismo campo en la tabla we
local dev:=.t., i
for i:=1 to len(xxcampos)
if ALLTRIM(xxcampos[i][1])==ALLTRIM(xcampo)
if xtipo=1 //alta
msginfo("This field is exist")
dev:=.f.
else
if !xpos=i // con esto checa si es el campo mismo que esta comparando que no lo tome en cuenta ok
msginfo("This field is exist")
dev:=.f.
endif
endif
endif
next i
Return dev
*----------------------------------*
Function delcampo(xcampos,xitem) //borrado de campo de la Tabla de datos selecionada
if xitem>0 .and. len(xcampos)>0
if msgyesno("Clear Field "+xcampos[xitem][1],"Delete it.")
adel(xcampos,xitem)
asize(xcampos,len(xcampos)-1)
Endif
Endif
Return xcampos
*--------------------------------------*
Function BajBase(xOdlg, Xserver, Xbase)
Local Odlg
local Cbase:=xbase
local oBtn
local cacepta:=.f.
DEFINE DIALOG oDlg FROM 1, 1 TO 15, 65 TITLE "Delete a database Mysql : "+xbase of xOdlg
@ 1.3, 1 Say "Base de Datos a borrar " Of Odlg
@ 1.5, 9 Get CBase Of Odlg Size 120,10 when .f.
@ 80, 050 BTNBMP OBTN PROMPT "Confirm" 2007 OF oDlg SIZE 30,12 ACTION (BorraBase(xserver, Xbase),odlg:end() )
@ 80, 120 BTNBMP OBTN PROMPT "Exit" 2007 OF oDlg size 40,12 ACTION (odlg:end() )
ACTIVATE DIALOG oDlg CENTER
Return Nil
*-----------------------------------*
Function BorraBase(xserver, Xbase)
if msgyesno("Do you want to Delete "+alltrim(xbase)+",, It will delete all in Database ","Confirm Delete")
xserver:query( "DROP DATABASE "+ALLTRIM(XBASE)) // BORRA LA BASE DE DATOS WE
IF xserver:lError
? "It Could not delete the database."
else
? "The Database was removed."
Endif
endif
Return Nil
*-----------------------------------------*
Function AltBase(xOdlg, Xserver, Xbases)
Local Odlg
local Cbase:=space(80)
local oBtn
local cacepta:=.f.
DEFINE DIALOG oDlg FROM 1, 1 TO 15, 65 TITLE "Alta a una Base de datos a Mysql" of xOdlg
@ 1.3, 1 Say "Base de Datos " Of Odlg
@ 1.5, 7 Get CBase Of Odlg Size 120,10 valid ( chebase(cbase, xbases) ) // checar si ya existe una base de datos parecida
@ 80, 050 BTNBMP OBTN PROMPT "Confirm" 2007 OF oDlg SIZE 30,12 ACTION baltbase(xserver, cbase )
@ 80, 120 BTNBMP OBTN PROMPT "Exit" 2007 OF oDlg size 40,12 ACTION odlg:end()
ACTIVATE DIALOG oDlg CENTER
Return Nil
*------------------------------------*
Function Baltbase(xServer, Cbase) // funcion que da alta una nueva base de datos en el servidor
local dev:=.t.
xserver:query( "CREATE DATABASE IF NOT EXISTS "+alltrim(cbase)) // crea la base de datos vamos a checar
IF xserver:lError
? "Error could not connect to Server."
dev:=.f.
xserver:lError:=.f. // dos veces me marca error que pedo we jijiji si doy uno de alta tras el error del otro
else
// ? "si se dio de alta we"
dev:=.t.
Endif
Return Dev
*----------------------------------*
Function Chebase(cbase, xbases)
local dev:=.t.
local i
for i:=1 to len(xbases)
if alltrim(upper(cbase))==alltrim(upper(xbases[i])) // sino le pongo == si un pedazo del texto se parece lo toma como que es el mismo
dev:=.f.
endif
Next I
if !dev // si ya ay una we
? "Database name is existed."
endif
Return dev
*-----------------------------------------------------*
Function Expexcel( oBrw, oMeter, oText, oDlg, lEnd )
oBrw:ToExcel( { |n,t| oMeter:nTotal := t, ;
oMeter:Set( n ), ;
oText:SetText( Str(n) + '/' + Str(t) ), ;
oDlg:Update(), .t. } )
return nil
*-------------------------------*
Function Diatras(xServer, xBase)
local Odlg2
local oBrw3
local oQry
local oBtn[2]
local cFile, ctraspa:="traspa"
local oMeter, nVal := 0, cantreg:=0 //reccount()
local aFiles, n
aFiles := GetFiles()
if len(aFiles)=0
// msgstop("No selected files ")
return nil
endif
MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
StartTransfer(oMeter, oText, aFiles, xServer, xBase) }, ;
'','Transfer Database to MySql' )
/*
cFile:=cGetFile("*.dbf" ,"Select the file to transfer dbf")
?cFile
if !File( cFile)
msginfo("No such file "+cFile)
return nil
Endif
if !filedbf(cFile) // TOMA DIFERENTE EL ARCHIVO ya sea mayusculas o minusculas
msginfo("You must be a file with dbf extesion "+cFile)
return nil
Endif
SELECT(0)
TRY
USE (CFile) VIA "DBFCDX" SHARED NEW
CATCH
? "Error opening file "+cfile
return nil
END
ctraspa:=alias()
(ctraspa)->(dbgotop())
cantreg:=reccount()
DEFINE DIALOG oDlg2 FROM 1, 1 TO 35, 110 TITLE "The transfer of DBF Databases "+Xbase FONT oFnt
@ 0.1, 1 Say "Archive "+cFile+' Records : '+str(cantreg,10) Of Odlg2
@ 14,1 XBROWSE obRW3 OF oDlg2 size 425,180;
ALIAS ctraspa AUTOCOLS AUTOSORT PIXEL LINES
oBrw3:CreateFromCode()
@ 200,120 BTNBMP OBTN[1] PROMPT "Run Transfer" 2007 OF oDlg2 size 70,15 ACTION (suave(xServer, Xbase, Ometer), odlg2:End()) // obrw3:refresh() )
@ 200,240 BTNBMP OBTN[2] PROMPT "Cancel" 2007 OF oDlg2 size 70,15 ACTION odlg2:end()
@ 16, 10 METER oMeter VAR nVal TOTAL cantreg OF oDlg2 SIZE 250, 20
ACTIVATE DIALOG ODLG2 CENTER ;
ON INIT oBtn[1]:SetFocus()
close (cfile)
*/
Return NIl
*------------------------------------------------------*
Function StartTransfer( XMeter, oText, aFiles, xServer, xBase )
local cFile, n, ctraspa, cantreg
for n := 1 to len(aFiles)
cFile := aFiles[n]
if !empty(cFile) .and. file(cFile)
SELECT(0)
TRY
USE (cFile) VIA "DBFCDX" SHARED NEW
CATCH
? "Error opening file "+cfile
return nil
END
oText:settext( 'Transfer Table : '+cFile )
ctraspa:=alias()
(ctraspa)->(dbgotop())
cantreg:=reccount()
XMeter:nTotal := cantreg
suave(Xserver, Xbase, Xmeter)
close (ctraspa)
end
next
return nil
*-------------------------------------*
Function suave(Xserver, Xbase, Xmeter)
local cTraspa, Oregi, calias, Obase, Cuantos
local dev
ctraspa:=alias()
SELECT (ctraspa)
(ctraspa)->(dbgotop())
DATABASE Oregi
CALIAS:=ALIAS()
OBASE:=DBSTRUCT() /// copia la estructura
cuantos:=Oregi:fcount() ///numero de campos
dev:=Creatable(xServer, CALIAS, cuantos, oregi, obase,"folio", "cosecha") //cuantos son _ tiene la tabla dbf a traspasar
if !dev
? "It cannot create new table."
Return Nil
endif
//seguir con la metida de datos de la tabla seleccionada we
savesql(Xserver, Oregi, calias, cuantos, Xbase, xmeter) //funcaion que da el ombre del archivo y prepara la alta en mysql we
SELECT (ctraspa)
(ctraspa)->(dbgotop())
return Nil
*--------------------------------------------*
Function VisorBase(Xserver, xbase, Xgrupo)
local Odlg2
local oBrw3
local oQry, Oqry2, n:=0
local oBtn, Obrw4, i, oStru, acampos, aaux, aHeader
oqry:=Xserver:Query( "SELECT * FROM "+alltrim(xbase) )
IF oqry:lError
? "It could not open the database "+xbase
Return nil
endif
oStru:=Xserver:tablestruct(xbase)
oqry2:=Xserver:Query( "SHOW INDEX FROM "+alltrim(xbase) ) // esto llama la estructura de la base de datos xbase que facil ya tiene todo la clase
IF oqry2:lError
? "It could not open the indexes of the database "+xbase
endif
acampos:=basesql(oQry2,1) // uno es la base de datos completa
aHeader:=basesql(oQry2,2) // dos son los encabezados we
DEFINE DIALOG oDlg2 FROM 1, 1 TO 38, 140 TITLE "Databases and Indexes "+Xbase+" and "+Xgrupo FONT oFnt
@ 5, 5 XBROWSE oBrw3 OBJECT oQry ;
AUTOCOLS AUTOSORT PIXEL SIZE 480, 150 of oDlg2
oBrw3:CreateFromCode()
@ 10.5,1 Say "Index of the table" of oDlg2
@ 12.5,1 XBROWSE oBrw4 OF oDlg2 ARRAY aCampos SIZE 480,80 UPDATE;
HEADERS aHeader;
FIELDSIZES 150, 100, 150, 100, 200, 80, 80, 80, 80, 80, 120, 120 ;
AUTOCOLS AUTOSORT
/*
@ 170, 5 XBROWSE oBrw4 OBJECT oQry2 ;
AUTOCOLS AUTOSORT PIXEL SIZE 480, 80 of oDlg2
*/
oBrw4:CreateFromCode()
@ 45, 490 BTNBMP OBTN PROMPT "structure" 2007 OF oDlg2 size 50,12 ACTION odlg2:end()
@ 190, 490 BTNBMP OBTN PROMPT "Create Index" 2007 OF oDlg2 size 50,12 ACTION (creaindex(oDlg2,xserver, Xbase, xgrupo, oStru),;
oqry2:=Xserver:Query( "SHOW INDEX FROM "+alltrim(xbase) ), acampos:=basesql(oQry2,1),;
oBrw4:SetArray( acampos ), oBrw4:refresh() )
@ 210, 490 BTNBMP OBTN PROMPT "Modify Index" 2007 OF oDlg2 size 50,12 ACTION odlg2:end()
@ 230, 490 BTNBMP OBTN PROMPT "Delete Index" 2007 OF oDlg2 size 50,12 ACTION (delindex(xserver,xbase,oqry2:Key_name), ;
oqry2:=Xserver:Query( "SHOW INDEX FROM "+alltrim(xbase) ), acampos:=basesql(oQry2,1),;
oBrw4:SetArray( acampos ),oBrw4:refresh() )
@ 260, 170 BTNBMP OBTN PROMPT "a Excel" 2007 OF oDlg2 size 40,12 ACTION;
MsgMeter( { |oMeter, oText, oDlg2, lEnd | ;
Expexcel( oBrw3, oMeter, oText, oDlg2, @lEnd ) } )
@ 260, 230 BTNBMP OBTN PROMPT "Exit " 2007 OF oDlg2 size 40,12 ACTION odlg2:end()
ACTIVATE DIALOG ODLG2 CENTER
Return NIl
*------------------------------*
Function basesql(xbase, xtipo) // pasa toda la informacion de la tabla a un arreglo we
local acampos:={}, aaux:={}
local n, i, cuantos
cuantos:=xbase:fCount()
if xtipo=1 //regresa toda la base de datos we
xbase:GoTop()
Do While ! xbase:Eof()
aAux := {}
for i := 1 to cuantos
AADD( aAux, xbase:fieldGet( i ) )
next
AADD( acampos, aAux )
xbase:Skip()
end do
ELSE
FOR I:=1 TO cuantos
AADD( acampos, xbase:FieldName( i ) )
Next i
Endif
Return acampos
*--------------------------------------------------------*
Function creaIndex(xoDlg, xserver, Xbase, xgrupo, Xstru)
Local oBtn, odlg3
Local oIndice, cIndice:=space(80), lsalir
local oitem, Citem:="PRIMARY", Ctipo:={"PRIMARY","INDEX","UNIQUE","FULLTEXT"}
local oBrw4, otexto, cTexto:=space(180)
DEFINE DIALOG oDlg3 TITLE "Create index on the table "+alltrim(Xbase) of xOdlg size 500,390 FONT oFnt
@ 0.9, 1 say "Index Name" size 60,12 of odlg3
@ 1,7 get oIndice var cIndice size 100,12 of odlg3 Update
@ 1.8, 1 say "Index Type" size 60,12 of odlg3
@ 2,7 COMBOBOX oitem var cItem OF odlg3 ITEMS ctipo size 100,60
@ 2.8, 1 say "Condition" size 60,12 of odlg3
@ 3.2,7 get otexto var ctexto size 180,12 of odlg3 Update
@ 4.5, 1 XBROWSE oBrw4 OF oDlg3 ARRAY xstru size 160,110;
COLUMNS {1,2,3,4};
HEADERS {"Fields","Type","Size","Decimal"};
COLSIZES 120,40,50,60 LINES CELL;
ON LEFT DBLCLICK (CTEXTO:= alltrim(CTEXTO)+"`"+xstru[ oBrw4:nArrayAt] [1]+"`,"+space(30), otexto:refresh() )
oBrw4:CreateFromCode()
odlg3:oClient := oBrw4
@ 175,050 BTNBMP oBtn PROMPT "Generate" 2007 OF oDlg3 size 40,12 ACTION (lsalir:=genindex(xserver, xbase, xgrupo, cindice, citem, ctexto), if(lsalir,odlg3:end(), .t.) )
@ 175,100 BTNBMP oBtn PROMPT "Exit" 2007 OF oDlg3 size 40,12 ACTION (lsalir:=.f.,odlg3:End() )
ACTIVATE DIALOG oDlg3 CENTERED
Return Nil
*----------------------------------------------------------------------*
Function Genindex(xserver, xbase, xgrupo, xindice, xtype, xtexto)
local dev:=.F.
local oqry2, xitem
local cquery:="ALTER TABLE "+"`"+ALLTRIM(xgrupo)+"`.`"+ALLTRIM(xbase)+"` ADD "+xtype+" `"+ALLTRIM(xindice)+"` "
// local cquery:="ALTER TABLE "+"`"+ALLTRIM(xgrupo)+"`.`"+ALLTRIM(xbase)+"` ADD UNIQUE `"+ALLTRIM(xindice)+"` "
xitem:=alltrim(xtexto)
if len(xitem)>2
if substr(xitem,len(xitem),1)="," // es para quitar la ultima , del texto del indice
xitem:=substr(xitem,1,len(xitem)-1)
Endif
Endif
cQuery:=cquery+" ("+xitem+")"
if MsgYesNo( cquery )
oqry2:=Xserver:Query( CQUERY ) // esto llama la estructura de la base de datos xbase que facil ya tiene todo la clase
IF oqry2:lError
? "It failed to generate the index,, check"+xtexto
Else
? "Index has generated successful."
dev:=.t.
endif
end
Return dev
*---------------------------------------------*
Function delindex(Xserver, xtabla, Xindice)
local oQry3
if alltrim(xindice)==""
Return NIl
Endif
if msgyesno("You want to drop the index "+alltrim(xindice),"Delete Confirmation index")
oQry3:=Xserver:Query( "DROP INDEX "+alltrim(xindice)+" ON "+alltrim(xTabla) ) // esto llama la estructura de la base de datos xbase que facil ya tiene todo la clase
IF oQry3:lError
? "Could not delete index "+xindice
Else
? "Index has deleted successful. "
endif
Endif
Return Nil
*---------------------------------*
Function MeteTablas(xServer,xBase)
Local atablas:={}, oServer2
oServer2:=Xserver:selectdb(alltrim(xbase)) // regresa verdadero si se hizo la machaca o falso si no se hizo
if !oServer2 // si hubo error we
atablas:={}
else
atablas:=xserver:ListTables() // lista las tablas de la base de datos seleccionada
Endif
Return atablas
*--------------------------------------------------------------*
Function SaveSql(ocon, xoregi, xcalias, xcuantos, xbase, xmeter) // esta funcion traspasa la informacion del dbf a mysql
LOCAL oqry, opalo, n, i, puro, VAN:=0
LOCAL J:=0, m1:=0, m2:=0, XCAMPO:="", tin:=0
LOCAL CINSERT:="", CCAMPOS:="", METE:=",", CVALOR:="", CDATO:="", cinser2, cval2
LOCAL CCTA1:=0, CCTA2:=0
LOCAL hFile
hFile := FCREATE(lower(alltrim(xcalias)) + ".sql")
ocon:Query( "set names utf8;")
xbase:=alltrim(xbase)
oqry:=ocon:Query( "SELECT * FROM "+lower(xcalias) )
IF oqry:lError
? "It could not open the database : "+xcalias
return .f.
endif
opalo := __objclone( oQry ) // pasa los dato de oqry a apalo
select (xcalias)
xoregi:gotop()
n:=0
J:=0
CINSERT:="INSERT INTO `"+xbase+"`.`"+lower(alltrim(xcalias))+"` ("
CCAMPOS:="" // TOMARA LOS DATOS DE _ OK
VAN:=1
METE:="," // ele
CCAMPOS:='' // +"`"+lower(subs(xcalias,3,3))+"_id"+"`"+METE //CAMPO MAESTRO WE
FOR I:=1 TO XCUANTOS
IF VAN=XCUANTOS
METE:=" " /// PARA NO METER MA CAMPOS NO LE PONES LA COMA WE
ENDIF
CCAMPOS:=CCAMPOS+"`"+lower(fieldname(i))+"`"+METE
VAN:=VAN+1
NEXT I
CINSERT:=CINSERT+CCAMPOS+")"
CVALOR:=" VALUES ("
VAN:=1
METE:=","
cinser2:=cinsert
cval2:=cvalor
tin:=1
do while .not. xoregi:eof()
CDATO:=""
mete:=","
cinsert:=cinser2
cvalor:=cval2
van:=1
cdato:='' // +"'"+alltrim(str(tin,10))+"'"+METE // este es el primer campo we el maestro consecutivo de los registros
For i:= 1 to xcuantos //namda mas 10 registro para probar
IF i=XCUANTOS //1 por el campo clave
METE:=" " /// PARA NO METER MA CAMPOS NO LE PONES LA COMA WE
ENDIF
puro:=fieldname(i)
puro:=(xcalias)->&puro // aqui esta tomando el valo del campo la & es una macro que pega el el valor y lo toma como instruccion
IF Xoregi:fieldtype(i)="C"
puro:=quicara(puro) //quita los posibles " o ' que hayga de valores en _ porque si no no se da de alta ok
Endif
IF Xoregi:fieldtype(i)="M" // sepse
puro:=quicara(puro) //quita los posibles " o ' que hayga de valores en _ porque si no no se da de alta ok
Endif
IF Xoregi:fieldtype(i)="L"
//QUIRE DECIR QUE EL CAMPOS ES LOGICO WE
PURO:=CAMTIPOL(PURO) // convierte el valor logico en f o t para el campo en sql
ENDIF
IF Xoregi:fieldtype(i)="D"
//QUIRE DECIR QUE EL CAMPOS ES FECHA WE
if !empty(Xoregi:fieldget(i))
PURO:= rtrim(dtos(puro)) // 'NULL' // str(year(puro),4)+"-"+strzero(month(puro),2)+"-"+strzero(day(puro),2) // "2008-12-12" // convierte el valor logico en f o t para el campo en sql
else
PURO:= '00000000'
end
ENDIF
IF Xoregi:fieldtype(i)="N"
//QUIRE DECIR QUE ES CAMPO NUMERICO AY QUE CHECAR LOS ENTEROS Y LOS DECIMALES
PURO:=ALLTRIM(STR(PURO)) // convierte el valor logico en f o t para el campo en sql
ENDIF
CDATO:=CDATO+"'"+puro+"'"+METE
Next i /// pasa los datos del objecto de la clase database
cvalor:=cvalor+cdato+")"
cinsert:=cinsert+cvalor
FWRITE(hFile, cinsert + ';' + CRLF)
TRY
// oqry:=ocon:Query(cinsert) // regresa error si no se da de alta correctamente por x causas mayores
oqry:=ocon:Query(TIS620toUTF8(cinsert)) // regresa error si no se da de alta correctamente por x causas mayores
CATCH
? "Error connection fails check systems "+cinsert // aqui se puede validar con do while en espera asta que aya conexicon o salirse
return .f.
END
IF oqry:lError
CCTA1:=CCTA1+1
if !msgyesno("error "+cinsert,"you want to continue ") // condicion que imprime el insert y pregunta si desea seguir
// con esta impresion checamos posibles validaciones que hagan falta para agregarselas okidoki
LogFile('d:\sqlerr.txt',{cinsert})
return .f.
endif
else
// ? "no hay error we"
CCTA2:=CCTA2+1
endif
SELECT (xcalias)
xoregi:skip()
if (tin % 10) = 0
xMeter:Set( tin)
SysRefresh()
end
van :=van+1
tin :=tin+1
n :=n+1
Enddo // hace todo el recorrido
// ? "They were discharged "+alltrim(str(CCTA2))+" error "+alltrim(str(ccta1))+" and "+alltrim(str(tin-1))+" records transferred"
FCLOSE(hFile)
RETURN .t.
*---------------------------*
Function quicara(xdatos) // quita los posibles " o '
local dev:=""
local i:=0
for i:=1 to len(xdatos)
if substr(xdatos,i,1)="'" .or. substr(xdatos,i,1)=chr(34) // que son las comillas
dev:=dev+" "
else
dev:=dev+substr(xdatos,i,1)
endif
Next i
Return rtrim(dev)
*---------------------------*
function Abre(tocon, ctabla)
local oqq:="",oda
oda:=tocon:Query( "SELECT * FROM "+ctabla )
Return oda
*---------------------------*
Function SeleData(osql,Cdata)
//osql:query( "CREATE DATABASE IF NOT EXISTS "+cdata)
// Coloca en uso la Base de _
// si no se pudo hacer uso de la base de datos, coloca lError a verdadero y cierra
// la conexi\u0E53n a MYSQLSERVER
osql:selectdb(cdata)
// Verifica que no haya error al seleccionar la base de datos en MYSQLSERVER
Return Osql
*-------------------------------------------------------------------------*
Function Creatable(osql, cdata, cuantos, oregi, obase, kprimary, ksegunda)
LOCAL CALIAS, cEstructura, entro:=.f., serbase
local cauxi, i, ctexto1, oquery, n
local cId, cDel, lCreate
local nDel, nId
lCreate := .F.
cId := lower(strtoken(obase[1][1],1,"_"))+'_id'
cDel:= lower(strtoken(obase[1][1],1,"_"))+'_delete'
if (nId := ascan( obase, {|x| x[1]==cId } )) = 0 .and. (nDel := ascan( obase, {|x| x[1]==cDel } )) = 0
lCreate := .T.
cEstructura := "CREATE TABLE IF NOT EXISTS "+lower(alltrim(alias()))+" ( " // branch varchar(2) default '.',
ctexto1 := cId+" integer(8) NOT NULL AUTO_INCREMENT, " // es un campo clave para agregarselo y poder de dar de alta todos los registros
ctexto1 += cDel+" tinyint(1) DEFAULT 0, "
// CTEXTO1:="ID integer default 0, " // es un campo clave para agregarselo y poder de dar de alta todos los registros
// cEstructura := cEstructura+ctexto1
cEstructura += ctexto1
for i:=1 to cuantos // son _ que tiene la base de _ la que se selecciono
entro:=.f.
if oregi:fieldtype(i)="C"
if obase[i][3] = 1
CTEXTO1:="char("+alltrim(str(obase[i][3]))+") default '',"
else
CTEXTO1:="varchar("+alltrim(str(obase[i][3]))+") default '',"
end
entro:=.t.
endif
if oregi:fieldtype(i)="D"
CTEXTO1:="date default NULL,"
entro:=.t.
endif
if oregi:fieldtype(i)="N"
entro:=.t.
IF OBASE[I][4]>0 //QUIERE DECIR QUE TIENE DECIMALES WE
CTEXTO1:="decimal("+alltrim(str(obase[i][3]))+","+alltrim(str(obase[i][4]))+") default 0, "
ELSE
CTEXTO1:="integer("+alltrim(str(obase[i][3]))+") default 0,"
endif
endif
if oregi:fieldtype(i)="L"
CTEXTO1:="boolean default 0," // varchar(1) default ' '," "tinyint(1) default 0," //
entro:=.t.
endif
if oregi:fieldtype(i)="M" // que longitud le puedo poner a esta madre ay levariamos a nuestro gusto o ay un tipo de datos especial
// CTEXTO1:="varchar(500) default ' ',"
CTEXTO1:="text ,"
entro:=.t.
endif
if entro
ctexto1:=lower(oregi:fieldname(i))+" "+ctexto1 // Modify upper by Dutch
cEstructura:=cestructura + ctexto1
endif
next i // con esto son todos _ de la base de datos
//cEstructura += " ) "
cEstructura += "PRIMARY KEY ("+cId+") ) "
// cEstructura += "KEY prodi ( nombre ) )" //ay que checar con willian que es prodi y si no hay key prodi como terminamos el primary key we
// cEstructura += " ENGINE=InnoDB DEFAULT CHARSET=utf8" // latin1
cEstructura += " ENGINE=InnoDB DEFAULT CHARACTER SET utf8 COLLATE utf8_unicode_ci" // CHARSET=utf8
// Ejecuta query para creaci\u0E53n de la tabla
// osql:Query( cEstructura )
// logfile('d:\sqlerr.txt',{cEstructura} )
osql:Execute( cEstructura )
IF osql:lError
MSGALERT( "There was an error when selecting the database, check...")
osql:end()
// si no hay error aqui podemos llamar el traspaso de la informacion o se hace depues lo weno que ya quedo generado la estructura al sql
return .f.
else
ENDIF
else
MsgStop('Please modify your existing field ('+cId+' or '+cDel+') before import')
end
Return lCreate // dar de alta efectuado verdadero we
*-------------------------*
FUNCTION CAMTIPOL(XTIPO)
// LOCAL DEV:="F"
LOCAL DEV:='0'
IF XTIPO
// DEV:="T"
DEV:='1'
ENDIF
RETURN DEV
*----------------*
FUNCTION BFILTRO()
LOCAL ARCHI:=ALIAS()
(ARCHI)->( OrdScope(TOPSCOPE, NIL ) )
(ARCHI)->( OrdScope(BOTTOMSCOPE, NIL ) )
(archi)->(dbgotop())
RETURN NIL
*----------------------------------------*
FUNCTION hFILTRO(cLimInf,cLimSup, Memin)
local ARCHI:=alias()
DEFAULT cLimInf := NIL
DEFAULT cLimSup := cLimInf
DEFAULT Memin := 1
select (ARCHI)
bfiltro()
(ARCHI)->(ordsetfocus(memin))
(ARCHI)->(OrdScope(TOPSCOPE,CLIMINF))
(ARCHI)->(OrdScope(BOTTOMSCOPE,CLIMSUP))
(ARCHI)->(dbgotop())
RETURN (.T.)
*------------------------*
Function desbloque(oPENTE)
MsgRun( "Impresora ",;
"Buscando",;
{ | oPENTE | UpdCaption( oPENTE ) } )
Return NIl
*-----------------------------*
function UpdCaption( oPENTE )
local nFor, nStart
for nFor := 1 to 0 step -1
nStart = GetTickCount()
while ( GetTickCount() - nStart ) < 1000
end
oPENTE:cMsg := "Cargando "+;
LTrim( Str( nFor ) ) + " second" + ;
If( nFor > 1, "s", "" )
oPENTE:Refresh()
SysRefresh()
next
return nil
*-----------------*
FUNCTION TATUS(CTE)
LOCAL DEV:="F"
IF CTE
DEV:="T"
ENDIF
RETURN DEV
*-----------------------*
Function filedbf(xalias)
local dev:=.f., ctam:=len(alltrim(xalias))
local i:=0
xalias:=upper(xalias)
if ctam>4
// msginfo("No existe el archivo "+substr(xalias,ctam-3,4))
if substr(xalias,ctam-3,4)=".DBF" .or. substr(xalias,ctam-3,4)=".RES"
dev:=.t.
endif
else
dev:=.f. // no alcanza ni siquiera el .dbf we jijij fuera fuera
endif
return dev // devuelve verdadero si es un archivo con estension dbf ok ,,, si no es pues checamos con el try jijijij
*------------------------------*
Function TIS620toUTF8(tis620)
local i, count, res, offset, c
res := ""
count := LEN(tis620)
FOR i=1 TO count
c := CHR(tis620[i])
IF (c > 0xA0)
offset := 3584 + (c - 160)
res := res + HB_UTF8CHR(offset)
ELSE
res := res + HB_UTF8CHR(c)
ENDIF
NEXT
RETURN res
*-----------------*
Function GetFiles()
local oDlg, oBrw, oBtn[2]
local nLen, aNames, n, aFileName
local cGetDir, aSelected
local lSelect := .F.
Private aFiles := {}
aSelected := {}
cGetDir := cGetDir32('Select Import Folder')
if !Empty(cGetDir)
nLen := ADIR(cGetDir+"\*.dbf")
aNames := array(nLen)
ADIR(cGetDir+"\*.dbf", aNames)
for n := 1 to nLen
aadd( aFiles, {cGetDir+'\'+lower(aNames[n]),'' } )
next
DEFINE DIALOG oDlg FROM 0, 0 TO 600, 620 TITLE 'Select Files' PIXEL FONT oFnt
oDlg:lHelpIcon := .F.
@ 1, 1 XBROWSE oBrw ARRAY aFiles OF oDlg SIZE 308, 268 PIXEL UPDATE ;
COLUMNS { 1, 2 } ;
HEADERS {'File Name','Selected'} ;
COLSIZES 500, 85 ;
LINES CELL ;
ON DBLCLICK (MarkItem( @aSelected, oBrw:nArrayAt ), oBrw:Refresh())
oBrw:nMarqueeStyle := MARQSTYLE_HIGHLROW
oBrw:nRowDividerStyle := LINESTYLE_LIGHTGRAY
oBrw:nColDividerStyle := LINESTYLE_LIGHTGRAY
oBrw:nHeaderHeight := 26
oBrw:nRowHeight := 24
oBrw:lHScroll := .F.
oBrw:nStretchCol := STRETCHCOL_LAST
oBrw:lAllowRowSizing := .F.
oBrw:aCols[2]:bStrData := { || iif(ascan( aSelected, {|x| x=aFiles[oBrw:nArrayAt][1]} ) > 0, 'X', '') }
oBrw:aCols[2]:nDataStrAlign := AL_CENTER
oBrw:CreateFromCode()
@ 271, 80 BTNBMP oBtn[1] PROMPT 'Transfer'+CRLF+'Marked' OF oDlg SIZE 45, 25 PIXEL 2007 ;
ACTION (lSelect := .T., oDlg:End())
@ 271,158 BTNBMP oBtn[1] PROMPT 'Mark'+CRLF+'All' OF oDlg SIZE 40, 25 PIXEL 2007 ;
ACTION (MarkAll( @aSelected ), oBrw:Refresh())
ACTIVATE DIALOG oDlg CENTER
end
return iif(lSelect,aSelected,{})
*----------------------------*
Function MarkAll( aSelected )
local n
for n := 1 to len(MEMVAR->aFiles)
MarkItem( @aSelected, n )
next
return .T.
*----------------------------------*
Function MarkItem( aSelected, nMark )
local nSel
if (nSel := ascan( aSelected, {|x| x=MEMVAR->aFiles[nMark][1]} )) > 0
// ?aSelected[nSel]
adel (aSelected, nSel )
asize( aSelected, len(aSelected)-1 )
else
aadd( aSelected, MEMVAR->aFiles[nMark][1] )
end
return .T.
