rqamin 2004-12-22 17:46

' feel free but no waranty to any damages
' tested on dbase 3 or 4 with non memo

     $INCLUDE "RAPIDQ.INC"
     $INCLUDE "MYSQL.INC"
     $INCLUDE "Dbt.inc"
     $INCLUDE "Dbase3.inc"


     DECLARE FUNCTION conv_str(str AS STRING) AS STRING
     DECLARE SUB Button1Click (Sender AS QBUTTON)
     DECLARE SUB Migre (Sender AS QBUTTON)
     DECLARE SUB DBListBoxClick (Sender AS QLISTBOX)
     DECLARE SUB TableListBoxClick (Sender AS QLISTBOX)


     DIM MySQL AS QMYSQL
'DIM I AS INTEGER
'DIM J AS INTEGER
'DIM K AS INTEGER

     DIM DBFNAME$ AS STRING
     DIM TblMysql AS STRING
     DIM DbMysql AS STRING

     TblMysql=""


     DIM File AS QFILESTREAM

     DIM row$ AS STRING

     CREATE SQLForm AS QFORM
      CAPTION = "Connected"
      Width = 330
      Height = 300
      Center
      CREATE DBLabel AS QLABEL
       CAPTION = "Select a database:"
      END CREATE
      CREATE DBListBox AS QLISTBOX
       Top = 20
       Width = 150
       Height = 100
       OnClick = DBListBoxClick
      END CREATE
      CREATE TableListBox AS QLISTBOX
       Top = 20
       Left = 165
       Width = 150
       Height = 100
       OnClick = TableListBoxClick
      END CREATE
      CREATE BtnMigre AS QBUTTON
       CAPTION = "Migration"
       Enabled = False
       Top = 140
       Left = 140
       OnClick = Migre
      END CREATE
     END CREATE


     CREATE Form AS QFORM
      CAPTION = "Connection"
      Width = 230
      Height = 174
      Center
      CREATE Label1 AS QLABEL
       CAPTION = "Host:"
       Left = 44
       Top = 23
      END CREATE
      CREATE Label2 AS QLABEL
       CAPTION = "User name:"
       Left = 16
       Top = 50
       Width = 57
      END CREATE
      CREATE Label3 AS QLABEL
       CAPTION = "Password:"
       Left = 21
       Top = 79
       Width = 54
      END CREATE
      CREATE Edit1 AS QEDIT
       Text = ""
       Left = 83
       Top = 18
       passwordchar="*"
      END CREATE
      CREATE Edit2 AS QEDIT
       Text = ""
       Left = 83
       Top = 46
       passwordchar="*"
      END CREATE
      CREATE Edit3 AS QEDIT
       Text = ""
       Left = 83
       Top = 74
       PassWordChar = "*"
      END CREATE
      CREATE Button1 AS QBUTTON
       CAPTION = "&Ok"
       Left = 32
       Top = 112
       Kind = 1
       Default = 1
       NumBMPs = 2
       OnClick = Button1Click
      END CREATE
      CREATE Button2 AS QBUTTON
       CAPTION = "E&xit"
       Left = 118
       Top = 112
       Kind = 6
       NumBMPs = 2
      END CREATE

     END CREATE
     Form.SHOWMODAL

     SUB Button1Click

      IF MySQL.Connect(Edit1.Text, Edit2.Text, Edit3.Text) = 0 THEN
       SHOWMESSAGE("Failed to connect to MySQL Server")
       EXIT SUB

      END IF
      SHOWMESSAGE("Connected to MySQL Server")


      FOR I = 0 TO MySQL.DBCount-1
       DBListBox.AddItems(MySQL.DB(I))
      NEXT

      SQLForm.SHOWMODAL
     END SUB

     SUB DBListBoxClick (Sender AS QLISTBOX)

      IF Sender.ItemIndex < 0 THEN EXIT SUB
      IF MySQL.SelectDB(Sender.Item(Sender.ItemIndex)) = 0 THEN
       SHOWMESSAGE("Could not open "+Sender.Item(Sender.ItemIndex))
       EXIT SUB
      END IF
      dbmysql = Sender.Item(Sender.ItemIndex)
      TableListBox.Clear
      FOR I = 0 TO MySQL.TableCount-1
       TableListBox.AddItems(MySQL.Table(I))
      NEXT
     END SUB

     SUB TableListBoxClick (Sender AS QLISTBOX)

      IF MySQL.Query("show columns from "+Sender.Item(Sender.ItemIndex)) = 0 THEN
       SHOWMESSAGE("Could not query "+Sender.Item(Sender.ItemIndex))
       EXIT SUB
      END IF

      IF MySQL.RowCount=0 THEN
       EXIT SUB
      END IF
      I = 0
      row$="|"

      DIM FldName(MySQL.RowCount) AS STRING
      DIM FldType(MySQL.RowCount) AS STRING
      DIM p1 AS INTEGER
      DIM p2 AS INTEGER
      DIM pv AS INTEGER
      DIM intpart(MySQL.RowCount) AS STRING
      DIM decimalpart(MySQL.RowCount) AS STRING

          'creation of DBFNAME$
      tblMysql= Sender.Item(Sender.ItemIndex)
      DBFNAME$ = Sender.Item(Sender.ItemIndex) & ".dbf"

      dbopen(DBFNAME$, fmOpenReadWrite)
      'dbZap           'Empty the table (wipes out data..)


      WHILE MySQL.FetchRow

              'FldName
       IF LEN(FldName(I))>10 THEN
        FldName(I) = LEFT$(MySQL.Row(0),10)
       ELSE
        FldName(I) = MySQL.Row(0)
       END IF
              'position of the open parentheese
       p1 = INSTR(MySQL.Row(1),"(")
              'position of the close parentheese
       p2 = INSTR(MySQL.Row(1),")")
              'position of the comma
       pv = INSTR(MySQL.Row(1),",")

              'FldType
       IF p1 = 0 THEN ' field like DATE et DATETIME
        FldType(I) = MySQL.Row(1)
       ELSE
        FldType(I) = LEFT$(MySQL.Row(1),p1-1)
       END IF

               'decimal part and int part
       IF p1 = 0 THEN
        decimalpart(I)=""
        intpart(I) = "10"
       ELSE
        IF pv = 0 THEN
         decimalpart(I) = ""
         intpart(I) = MID$(MySQL.Row(1),p1+1,p2-p1-1)
        ELSE
         decimalpart(I) = MID$(MySQL.Row(1),pv+1,p2-pv-1)
         intpart(I) = MID$(MySQL.Row(1),p1+1,pv-p1-1)
        END IF
       END IF

              'correction of field's names there lengh > 10 characters
       IF LEN(FldName(I))>10 THEN
        FldName(I) = LEFT$(FldName(I),10)
       END IF

              'conversion of field's types
       IF UCASE$(FldType(I))="INT" OR UCASE$(FldType(I))="DECIMAL" THEN
        FldType(I) = "N"
       ELSEIF UCASE$(FldType(I))="CHAR" OR UCASE$(FldType(I))="VARCHAR" OR UCASE$(FldType(I))="DATE"  OR UCASE$(FldType(I))="DATETIME" THEN
        FldType(I) = "C"
       END IF

       PRINT "create field ",STR$(I),"-> ",FldName(I)," ",FldType(I)," ",intpart(I)," ",decimalpart(I)
       struinfo(FldName(I),FldType(I),VAL(intpart(I)),VAL(decimalpart(I)))
       I++
      WEND

      IF dbcreate(DBFNAME$) THEN
       SHOWMESSAGE "Empty " & DBFNAME$ & " is Created "
       BtnMigre.Enabled = True
      ELSE
       SHOWMESSAGE "Dbf is Not created" & DBFNAME$ & "..perhaps it's already created"
       END
      END IF
     END SUB

     SUB Migre
'---detail of DBFNAME$
      IF MySQL.SelectDB(DbMySQL) = 0 THEN
       SHOWMESSAGE("Could not open "+DbMySQL)
       EXIT SUB
      END IF

      DIM rq AS STRING
      rq = "SELECT * FROM "+tblMysql
      IF MySQL.Query(rq)=0 THEN
       SHOWMESSAGE "Error Query"
       EXIT SUB
      END IF

      IF MySQL.RowCount=0 THEN
       SHOWMESSAGE tblmysql & " is Empty"
       EXIT SUB
      END IF

'showmessage "migration of data of the table " & tblmysql & " for the BD " & DbMySQL
      tablename$ = tblMysql & ".dbf"
      dbopen(DBFNAME$, fmOpenReadWrite)
      dbzap
      J=1
      K= MySQL.RowCount
      FOR J = 0 TO MySQL.RowCount-1
       dbAppend
       MySQL.FetchRow
       row$="|"
       I=0
       FOR I=0 TO MySQL.NumFields - 1

        SELECT CASE typeOf(i+1)
        CASE "C"
'            row$ = conv_str(MySQL.Row(I))
         row$ = MySQL.Row(I)
        CASE "D"
         row$ = LTRIM$(RTRIM$((MySQL.Row(I))))
        CASE "N"
         row$ = LTRIM$(RTRIM$((MySQL.Row(I))))
        CASE ELSE
         row$ = MySQL.Row(I)
        END SELECT
        fieldput(I+1,row$, 0)
       NEXT I
       LOCATE 10,45
       PRINT "Working: ",INT((J*100)/K),"%"

       SQLForm.CAPTION = STR$(INT(J*100/K)) & " %"
      NEXT J
      dbclose
      BtnMigre.Enabled = False
      SQLForm.CAPTION = SQLForm.CAPTION & " End of Program "
     END SUB

     FUNCTION conv_str(str AS STRING) AS STRING
      DIM i AS INTEGER, nlstr AS STRING, rstr AS VARIANT

      nlstr = ""
      rstr = Null
      i = 1
      WHILE i <= LEN(str)
       SELECT CASE MID$(str, i, 1)
       CASE CHR$(176)  ' °
        nlstr = SPACE$(1)
        rstr = SPACE$(1)
       CASE CHR$(94) '^
        nlstr = SPACE$(1)
        rstr = SPACE$(1)
       CASE CHR$(47) '/
        nlstr = SPACE$(1)
        rstr = SPACE$(1)
'            Case Chr$(0)  ' ASCII NUL
'                nlstr = ""
'                rstr = "\0"
'            Case Chr$(8)  ' backspace
'                nlstr = ""
'                rstr = "\b"
'            Case Chr$(9)  ' tab
'                nlstr = ""
'                rstr = "\t"
'            Case "'"
'                nlstr = ""
'                rstr = "\'"
'            Case """"
'                nlstr = ""
'                rstr = "\"""
       CASE "\"
        nlstr = SPACE$(1)
        rstr = SPACE$(1)
'            Case Chr$(10), Chr$(13)  ' line feed and carriage return
'                If nlstr <> "" And nlstr <> Mid$(str, i, 1) Then
'                    ' there was a previous newline and this is its pair: eat it
'                    rstr = ""
'                    nlstr = ""
'                Else
'                    ' this is a fresh newline
'                    rstr = LINE_BREAK
'                    nlstr = Mid$(str, i, 1)
'                End If
       CASE ELSE
        nlstr = SPACE$(1)
        rstr = SPACE$(1)
       END SELECT
       IF NOT IsNull(rstr) THEN
        str = LEFT$(str, i - 1) & rstr & RIGHT$(str, LEN(str) - i)
        i = i + LEN(rstr)
        rstr = Null
       ELSE
        i = i + 1
       END IF
      WEND
      conv_str = str
     END FUNCTION


'IF MySQL.Connected THEN MySQL.Close
     END

rqamin 2004-12-22 17:46