Sunday, May 17, 2009

Exporting DBF to MySQL

CCH : Have you ever wondered whether we can export our DBFs to MySQL ?
Well Sudip with the help of Rathinagiri (owner of HMG Forum) came out with this working version of DBF2MYSQL using Harbour+HMG as built by HMG IDE. BTW, this working prg also clearly demonstrates how we can connect to MySQL via Harbor + HMG.

BTW, the original codes for connecting to MySQL may have come from Mitja Podgornik





#Include "MiniGui.ch"
#include "DbStruct.ch"


Procedure Main()
Private Dbo := Nil
Private cHostName:= "localhost"
Private cUser:= "root"
Private cPassWord:= ""
Private cDatabase:= ""
Private cDbf:= ""
Private cTable:= ""
Private lOpened := .f.
Private lLogin:= .F.

DEFINE WINDOW frmMain ;
AT 5,5 ;
WIDTH 640 ;
HEIGHT 480;
TITLE "DBF To 'New' MySql Table (Created with help from Rathinagiri)" ;
MAIN ;
NOSIZE ;
ON INIT MySQL_Login() ;
ON RELEASE MySQL_Logout()


@ 30, 30 label lblDatabase value "Database:" ;
width 100
@ 30, 100 textbox txtDatabase ;
width 150

@ 30, 300 listbox lstDatabase width 200 height 200 ;
on dblclick { frmMain.txtDatabase.value := frmMain.lstDatabase.item(frmMain.lstDatabase.value)}


@ 200, 100 button cmdSelectDbf caption "Select &Dbf" width 150 ;
on click SelectDbf()

@ 240, 100 label lblDbf value "" width 150

@ 280, 100 button cmdExport caption "&Export to MySql" width 150 ;
on click ExportToMySql()

@ 350, 100 PROGRESSBAR pgbExport ;
VALUE 0 ;
RANGE 0 , 100 ;
WIDTH 300 ;
HEIGHT 26 ;


DEFINE STATUSBAR
STATUSITEM " "
END STATUSBAR

DEFINE MAIN MENU
POPUP "&File"
Item "E&xit" action thiswindow.release()
end popup
END MENU

END WINDOW

frmMain.pgbExport.visible := .f.
CENTER WINDOW frmMain
ACTIVATE WINDOW frmMain

Return Nil



static function MySql_login()
DEFINE WINDOW frmLogon ;
AT 0,0 ;
WIDTH 280 HEIGHT 190 ;
TITLE 'Login MySql' ;
MODAL ;
NOSYSMENU

@ 20,30 LABEL lblHostName ;
VALUE "HostName/IP" ;
WIDTH 150 ;
HEIGHT 35

@ 20,120 TEXTBOX txtHostName ;
HEIGHT 25 ;
VALUE cHostName ;
WIDTH 120 ;
ON ENTER iif( !Empty(frmLogon.txtHostName.Value), frmLogon.txtUser.SetFocus, frmLogon.txtHostName.SetFocus )

@ 50,30 LABEL lblUser ;
VALUE "User" ;
WIDTH 120 ;
HEIGHT 35

@ 50,120 TEXTBOX txtUser ;
HEIGHT 25 ;
VALUE cUser ;
WIDTH 120 ;
ON ENTER iif( !Empty(frmLogon.txtUser.Value), frmLogon.txtPassword.SetFocus, frmLogon.txtuser.SetFocus )

@ 80,30 LABEL lblPassword ;
VALUE "Password" ;
WIDTH 120 ;
HEIGHT 35

@ 80,120 TEXTBOX txtPassword ;
VALUE cPassWord ;
PASSWORD ;
ON ENTER frmLogon.cmdLogin.SetFocus

@ 120,30 BUTTON cmdLogin ;
CAPTION '&Login' ;
ACTION SQL_Connect()

@ 120,143 BUTTON cmdLogoff ;
CAPTION '&Cancel' ;
ACTION frmMain.Release

END WINDOW

CENTER WINDOW frmLogon
ACTIVATE WINDOW frmLogon

Return Nil






Function SQL_Connect()
cHostName:= AllTrim( frmLogon.txtHostName.Value )
cUser:= AllTrim( frmLogon.txtUser.Value )
cPassWord:= AllTrim( frmLogon.txtpassword.Value )

Dbo := TMySQLServer():New(cHostName, cUser, cPassWord )
If Dbo:NetErr()
MsGInfo("Error connecting to SQL server: " + Dbo:Error() )
Release Window ALL
Quit
Endif
lLogin := .T.
frmLogon.Release
frmMain.StatusBar.Item(1) := "MySql Server Connected!!!"

frmMain.lstDatabase.DeleteAllItems()
AEVAL( dbo:ListDbs(), { | a | frmMain.lstDatabase.AddItem( a ) } )

Return Nil




Function SelectDbf()
cDbf := alltrim(GetFile({{"DBF Files","*.dbf"}},"Select a dbf file",,.f.,.f.))
frmMain.lblDbf.caption := cDbf
if len(alltrim(cDbf)) > 0
if file(cDbf)
use &cDbf
lOpened := .t.
endif
endif
RETURN NIL



Function ExportToMySql()
local aStruct := {}, cSql, i, mFldNm, mFldtype, mFldLen, mFldDec, mSql

cDatabase := frmMain.txtDatabase.value
if empty(cDatabase)
MsgInfo("Please specify Database name")
frmMain.txtDatabase.setfocus
return nil
endif

if !DbExist(dbo, cDatabase)
if !miscsql(dbo, "CREATE DATABASE "+cDatabase)
return nil
endif
endif

if !miscsql(dbo, "USE "+cDatabase)
return nil
endif

if empty(cDbf)
MsgInfo("Please select a Dbf table")
frmMain.cmdSelectDbf.setfocus
return nil
endif

cTable := ALLTRIM(substr(cDbf,Rat('\',cDbf)+1))
cTable :=substr(cTable,1,len(cTable)-4)

select &cTable
aStruct = DbStruct()

mSql := "CREATE TABLE IF NOT EXISTS "+cTable+" ("

for i := 1 to len(aStruct)
mFldNm := aStruct[i, DBS_NAME]
mFldType := aStruct[i, DBS_TYPE]
mFldLen := aStruct[i, DBS_LEN]
mFldDec := aStruct[i, DBS_DEC]

if i > 1
mSql += ", "
endif
mSql += alltrim(mFldnm)+" "

do case
case mFldType = "C"
mSql += "CHAR("+LTRIM(STR(mFldLen))+")"
case mFldType = "D"
mSql += "DATE"
case mFldType = "T"
mSql += "DATETIME"
case mFldType = "N"
mSql += "DECIMAL("+LTRIM(STR(mFldLen))+", "+LTRIM(STR(mFldDec))+")"
case mFldType = "F"
mSql += "FLOAT"
case mFldType = "I"
mSql += "INTEGER"
case mFldType = "B"
mSql += "DOUBLE"
case mFldType = "Y"
mSql += "DECIMAL(20, 4)"
case mFldType = "L"
mSql += "SMALLINT(1)"
case mFldType = "M"
mSql += "TEXT"
case mFldType = "G"
mSql += "BLOB"
otherwise
msginfo("Invalid Field Type: "+mFldType)
return nil
endcase
next

mSql += ")"

//msginfo(mSql)

if !miscsql(dbo, mSql)
return nil
endif

frmMain.pgbExport.value := 0
frmMain.pgbExport.visible := .t.
select &cTable
go top
do while !eof()
do events
frmMain.pgbExport.value := recno()/reccount()*100

mSql := "INSERT INTO "+cTable+" VALUES ("

for i := 1 to len(aStruct)
mFldNm := aStruct[i, DBS_NAME]

if i > 1
mSql += ", "
endif

mSql += c2sql(&mFldNm)
next

mSql += ")"

if !miscsql(dbo, mSql)
msgbox("Problem in Query: "+mSql)
return nil
endif

select &cTable
skip
enddo
frmMain.pgbExport.value := 0
frmMain.pgbExport.visible := .f.

return nil










Function MySQL_Logout()
if Dbo != Nil
Dbo:Destroy()
Dbo := Nil
EndIf
Return Nil



Function MySQL_Connect()
If Dbo != Nil
Return Nil
Endif
Dbo := TMySQLServer():New(cHostName, cUser, cPassWord )
If Dbo:NetErr()
MsGInfo("Error connecting to SQL server: " + Dbo:Error() )
Release Window ALL
Quit
Endif
return nil



Function DbExist(dbo, cDatabase)
local aDbList := {}
cDatabase := lower(cDatabase)
aDbList := dbo:ListDbs()
if dbo:neterr()
msginfo("Error in varifying database list: "+dbo:error())
return .f.
endif
return (ascan(aDbList, {|x| lower(x) == lower(cDatabase)}) > 0)



Function TableExist(dbo, cTable)
local aTableList := {}
cTable = lower(cTable)
aTableList := dbo:ListTables()
if dbo:neterr()
msginfo("Error in varifying table list: "+dbo:error())
return .f.
endif
return (ascan(aTableList, {|x| lower(x) == lower(cTable)}) > 0)



//dbo is a public variable holding the database object
FUNCTION connect2db(host,user,password,dbname)
dbo := tmysqlserver():new(AllTrim(host),AllTrim(user),AllTrim(password))
IF dbo:NetErr()
msginfo(dbo:ERROR())
RETURN .f.
ENDIF
dbo:selectdb(dbname)
IF dbo:NetErr()
msginfo(dbo:ERROR())
RETURN .f.
ENDIF
//msginfo("Successfully Connected to the MySQL Server")
RETURN .t.



function sql(dbo1,qstr)
local i, j
local table := nil
local currow := nil
local tablearr := {}
local rowarr := {}
local curdateformat := set(_SET_DATEFORMAT)
set date ansi
table := dbo1:query(qstr)
set(_SET_DATEFORMAT,curdateformat)
if table:neterr()
msgstop(table:error())
table:destroy()
return tablearr
else
if table:lastrec() > 0
asize(tablearr,0)
for i := 1 to table:lastrec()
asize(rowarr,0)
currow := table:getrow(i)
for j := 1 to table:fcount()
aadd(rowarr,currow:fieldget(j))
next j
aadd(tablearr,aclone(rowarr))
next i
endif
table:destroy()
return tablearr
endif
return tablearr



function miscsql(dbo,qstr)
local curdateformat := set( _SET_DATEFORMAT)
set date ansi
table := dbo:query(qstr)
set( _SET_DATEFORMAT,curdateformat)
if table:NetErr()
msgstop(table:ERROR())
table:destroy()
return .f.
endif
table:destroy()
return .t.



function C2SQL(Value)

local cValue := ""
local cFormatoDaData := set(4)
do case
case Valtype(Value) == "N"
cValue := AllTrim(Str(Value))

case Valtype(Value) == "D"
if !empty(Value)
cValue := "'"+DTOS(value)+"'"
else
cValue := "'00000000'"
endif
case Valtype(Value) $ "CM"
IF Empty( Value)
cValue="''"
ELSE
cValue := "'"
Value:=DATATOSQL(value)
cValue+= value+ "'"
ENDIF

case Valtype(Value) == "L"
cValue := AllTrim(Str(iif(Value == .F., 0, 1)))

otherwise
cValue := "''" // NOTE: Here we lose values we cannot convert

endcase

return cValue


/*
So, our insert query may be like this.
qsuccess := miscsql(dbo,"insert into table1 (name, address1,city) values ("+c2sql(form1.name1.value)+","+c2sql(form1.address1.value)+","+c2sql(form1.city.value)+")")
*/


/*
Select query may be like this.
tablearray := sql(dbo,"select * from table1 where city = "+c2sql(form1.city.value))
*/

No comments:

Post a Comment

Welcome to Clipper... Clipper... Clipper


In 1997, then using Delphi 3, I had already created 32-bits Windows applications for HRIS, ERP and CRM. In 2007, using Ruby on Rails, an AJAX powered CRM site running on Apache & MySQL was created and I am now using Visual Studio .Net 2008 to create web-based projects and Delphi 7 for Win32 applications using SQL2005 & DBFCDX.

So, why then am I reviving the Original Clipper... Clipper... Clipper via a Blog as CA-Clipper is a programming language for the DOS world ? Believe it or not, there are still some clients using my mission-critical CA-Clipper applications for DOS installed in the late 80's and up to the mid 90's. This is testimony to CA-Clipper's robustness as a language :-)

With the widespread introduction of Windows 7 64-bits as the standard O/S for new Windows based PCs & Notebooks, CA-Clipper EXE simply will not work and it has become imperative for Clipper programmers to migrate immediately to Harbour to build 32/64 bits EXEs

Since 28th January 2009, this blog has been read by 134,389 (10/3/11 - 39,277) unique visitors (of which 45,151 (10/3/11 - 13,929) are returning visitors) from 103 countries and 1,574 cities & towns in Europe (37; 764 cities), North America (3; 373 cities) , Central America & Caribeans (6; 13 cities), South America(10; 226 cities), Africa & Middle-East (12; 44 cities) , Asia-Pacific (21; 175 cities). So, obviously Clipper is Alive & Well : -)


TIA & Enjoy ! (10th October 2012, 11:05; 13th November 2015)


Original Welcome Page for Clipper... Clipper... Clipper

This is the original Welcome Page for Clipper... Clipper... Clipper, which I am republishing for historical and sentimental reasons. The only changes that I have made was to fix all the broken links. BTW, the counter from counter.digits.com is still working :-)

Welcome to Chee Chong Hwa's Malaysian WWW web site which is dedicated to Clipperheads throughout the world.

This site started out as a teeny-weeny section of Who the heck is Chee Chong Hwa ? and has graduated into a full blown web site of more than 140 pages (actually hundreds of A4 size pages) ! This is due to its growing popularity and tremendous encouragements from visiting Clipperheads from 100 countries worldwide, from North America, Central America, Caribbean, South America, Europe, Middle-East, Africa and Asia-Pacific. Thanx Clipperheads, you all made this happen !


What is Clipper ?

You may ask, what is this Clipper stuff ? Could Clipper be something to do with sailing as it is the name of a very fast sailing American ship in the 19th century ?

Well, Clipper or to be precise, CA-Clipper is the premier PC-Software development tool for DOS. It was first developed by Nantucket Corporation initially as a compiler for dBase3+ programs. Since then, CA-Clipper has evolved away from its x-base roots with the introduction of lexical scoping & pre-defined objects like TBrowse. As at today, the most stable version ofClipper is 5.2e while the latest version, 5.3a was introduced on 21 May 1996.

As at 11th November, 1996, an unofficial 5.3a fixes file was made available by Jo French. See the About CA-Clipper 5.3a section for more details. BTW, Jo French uploaded the revised 5.3a fixes file on 20th November, 1996.

Latest News

The latest news is that CA has finally released the long-awaited 5.3b patch on 21 May, 1997.

For 5.3b users, you must a take a look at Jo French's comments on unfixed bugs in 5.3b.

BTW, have you used Click ? If you're a serious Clipperprogrammer and need an excellent code formatter, Click is a natural choice. How to get it ? Simple, access Phil Barnett's site via my Cool Clipper Sites.

32-bits Clipper for Windows ?

Have you tried Xbase ++ ? Well, I have and compared to Delphi (my current Windows programming tool of choice), I'm still sticking to Delphi.

Anyway, you should visit the Alaska Home Page. Give it a chance and then draw your own conclusions !.

The Harbour Project

Is this the future of Xbase ? Take a look at at the Harbour Project

You are Visitor # ...

According to counter.digits.com, you are visitor since 3 June 1996.

If you like or dislike what you see on this website, please drop me a line by clicking the email button at the bottom of this page or better still, by filling out the form in my guest book. If you are not sure what to write,click here to take a look at what other Clipperheads have to say.