rqamin 2005-05-31 01:58

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

     $INCLUDE "RAPIDQ.INC"
     $INCLUDE "MYSQL.INC"
     DECLARE SUB GoExport

     CREATE Form AS QFORM
      CAPTION = "Export From Mysql to Dbase"
      Width = 642
      Height = 403
      Center
      CREATE LblHost AS QLABEL
       CAPTION = "Host"
       Left = 30
       Top = 11
       Width = 72
       Height = 21
       Transparent = 1
      END CREATE
      CREATE LblUser AS QLABEL
       CAPTION = "User"
       Left = 30
       Top = 59
       Transparent = 1
      END CREATE
      CREATE LblPass AS QLABEL
       CAPTION = "PassWord"
       Left = 30
       Top = 109
       Transparent = 1
      END CREATE
      CREATE Lbldbname AS QLABEL
       CAPTION = "database"
       Left = 30
       Top = 160
       Transparent = 1
      END CREATE

      CREATE LblQuery AS QLABEL
       CAPTION = "Query"
       Left = 30
       Top = 249
       Transparent = 1
      END CREATE

      CREATE Lblperc AS QLABEL
       CAPTION = ""
       Left = 30
       Top = 300
       Transparent = 1
      END CREATE

      CREATE Button1 AS QBUTTON
       CAPTION = "Export"
       Left = 503
       Top = 69
       OnClick = GoExport
      END CREATE
      CREATE EdtHost AS QEDIT
       Text = ""
       Left = 124
       Top = 9
       Width = 119
       TabOrder = 1
      END CREATE
      CREATE EdtUser AS QEDIT
       Text = ""
       Left = 124
       Top = 57
       Width = 119
       TabOrder = 2
      END CREATE
      CREATE EdtPass AS QEDIT
       Text = ""
       Left = 124
       Top = 107
       Width = 119
       passwordchar="*"
       TabOrder = 3
      END CREATE
      CREATE EdtDb AS QEDIT
       Text = ""
       Left = 124
       Top = 158
       Width = 119
       TabOrder = 4
      END CREATE
      CREATE EdtQry AS QEDIT
       Text = ""
       Left = 124
       Top = 247
       Width = 463
       TabOrder = 5
      END CREATE
     END CREATE

     Form.SHOWMODAL

     SUB GoExport
      DIM MySQL AS QMYSQL
      DIM dbhost AS STRING
      DIM dbuser AS STRING
      DIM dbpass AS STRING

      DIM dbname AS STRING

      DIM dbquery AS STRING
      DIM Dbf AS STRING
      DIM temp$ AS STRING

      dbhost = EdtHost.Text
      dbUser = EdtUser.Text
      dbPass = EdtPass.Text
      dbname = EdtDb.Text
      dbquery = EdtQry.Text

      Dbf = "out.dbf"



      IF MySQL.Connect(dbhost, dbuser, dbpass) = 0 THEN
       Lblperc.CAPTION = "Failed to connect to MySQL Server"
       EXIT SUB

      END IF


      IF MySQL.SelectDB(dbname) = 0 THEN
       Lblperc.CAPTION = "Could not open "+dbname
       EXIT SUB
      END IF

      IF MySQL.Query(dbquery) = 0 THEN
       Lblperc.CAPTION = "Could not query "+dbquery
       EXIT SUB
      END IF


      DIM ColNam(0 TO MySQL.FieldCount-1) AS STRING*10
      DIM ColLen(0 TO MySQL.FieldCount-1) AS INTEGER
      DIM ColTyp(0 TO MySQL.FieldCount-1) AS STRING*1
      DIM ColDec(0 TO MySQL.FieldCount-1) AS INTEGER

      RecLen% = 0
      i = 0
      WHILE MySQL.FetchField

       ColNam(i)= LEFT$(MySQL.Field.Name,9)+CHR$(0)

       SELECT CASE MySQL.Field.TYPE
       CASE 0 TO 6
        temp$= "N" 'numeric
       CASE 7, 8
        temp$ = "C" 'character
       CASE 9, 10
        temp$ = "N" 'numeric
       CASE 11 TO 15
        temp$ = "C" 'character
       CASE 247
        temp$ = "N" 'numeric"
       CASE 248 TO 255
        temp$ = "C" 'character
       CASE ELSE
        temp$ = "C" 'character
       END SELECT

       ColTyp(i) = temp$
       ColLen(i) = MySQL.Field.Length
       ColDec(i) = MySQL.Field.Decimals

       RecLen% = RecLen% + ColLen(i)
       I++
      WEND

      RecLen% = RecLen% + 1
'--- creation of dbf file

      FieldNum% = MySQL.FieldCount

      DIM DbfFile AS QFILESTREAM

      DbfFile.OPEN(Dbf,fmCreate)

      Str1% = 3 'version
      DbfFile.seek(1-1,0)
      DbfFile.Write(Str1%)

      Str1% = 5 'year
      DbfFile.seek(2-1,0)
      DbfFile.Write(Str1%)

      Str1% = 5 'month
      DbfFile.seek(3-1,0)
      DbfFile.Write(Str1%)

      Str1% = 9 'day
      DbfFile.seek(4-1,0)
      DbfFile.Write(Str1%)

      Str1% = 0 'number of records
      DbfFile.seek(5-1,0)
      DbfFile.Write(Str1%)

      Str1% = 32*FieldNum% + 33 ' header length = 32*nbr champs + 33
      DbfFile.seek(9-1,0)
      DbfFile.Write(Str1%)

      Str1% = RecLen%  'length of one data record including delete flag
      DbfFile.seek(11-1,0)
      DbfFile.Write(Str1%)

      Str1% = &h00 'reserved
      DbfFile.seek(13-1,0)
      DbfFile.Write(Str1%)

      Str1% = 0 'encryption flag
      DbfFile.seek(16-1,0)
      DbfFile.Write(Str1%)

      Str1% = &h00 'MDX file flag; 01H if there is an MDX, 00H if not.
      DbfFile.seek(29-1,0)
      DbfFile.Write(Str1%)

      Str1% = &h00 'Reserved; fill with 0.
      DbfFile.seek(31-1,0)
      DbfFile.Write(Str1%)

      FOR i = 0 TO FieldNum% - 1
       Str1$ = ColNam(i)+CHR$(0)
       DbfFile.seek(32*(i+1)+1-1,0)
       DbfFile.Write(Str1$)

       Str1$ = ColTyp(i)
       DbfFile.seek(32*(i+1)+12-1,0)
       DbfFile.Write(Str1$)

       Str1% = 0
       DbfFile.seek(32*(i+1)+13-1,0)
       DbfFile.Write(Str1%)

       Str1% = ColLen(i)
       DbfFile.seek(32*(i+1)+17-1,0)
       DbfFile.Write(Str1%)

       Str1% = ColDec(i)
       DbfFile.seek(32*(i+1)+18-1,0)
       DbfFile.Write(Str1%)

       Str1% = &H00
       DbfFile.seek(32*(i+1)+19-1,0)
       DbfFile.Write(Str1%)

       Str1% = &H00
       DbfFile.seek(32*(i+1)+32-1,0)
       DbfFile.Write(Str1%)

      NEXT

      Str1% = &H00D 'CHR$(13)
      DbfFile.seek(32*FieldNum%+33-1,0)
      DbfFile.Write(Str1%)
      RecNum% = 0
      DIM rowstr AS STRING

      i = 0
      WHILE MySQL.FetchRow
       str2$ = ""
       temp$ = ""

       FOR k =  0 TO MySQL.FieldCount - 1
        rowstr = MySQL.Row(k)


        IF ColTyp(k)="N" THEN
         temp$ = LTRIM$(rowstr)
         IF ColLen(k)- LEN(temp$)>=0 THEN
          temp$ = SPACE$(ColLen(k)- LEN(temp$)) + temp$
         ELSE
          temp$ = LEFT$(temp$,ColLen(k))
         END IF

        ELSE
         IF ColLen(k)- LEN(rowstr)>=0 THEN
          temp$ = rowstr + SPACE$(ColLen(k)- LEN(rowstr))
         ELSE
          temp$ = LEFT$(rowstr,ColLen(k))
         END IF
        END IF

        str2$ = str2$ + temp$
       NEXT

      'record 1
       RecNum% = RecNum% + 1
       Str1% = RecNum%
       DbfFile.seek(5-1,0)
       DbfFile.Write(Str1%)

       Str2$ = " "+LEFT$(str2$,RecLen%-1)
       DbfFile.seek(32*FieldNum%+33+RecLen%*(RecNum%-1)-1+1,0)
       DbfFile.Write(Str2$)

       Lblperc.CAPTION = STR$(CINT(i/MySQL.RowCount *100)) + " %"
       i++
      WEND

      'end of file
      RecNum% = RecNum% + 1
      DbfFile.seek(32*FieldNum%+33+RecLen%*(RecNum%-1)-1+1,0)
      DbfFile.Write(CHR$(13))

      Str1% = &H1A 'CHR$(26)
      DbfFile.seek(32*FieldNum%+33+RecLen%*(RecNum%-1)-1+1,0)
      DbfFile.Write(&H1A)

      DbfFile.CLOSE
      Lblperc.CAPTION = "out.dbf Created"

     END SUB

rqamin 2005-05-31 01:58