romfast/vfp_roaauto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
656d98697fc4da3437a508fdfc855a290ac9eda5
vfp_roaauto/COMUN/programe/importfromxlsx.prg

1394 lines
48 KiB
Plaintext
Raw Blame History

* Version 5.0
LPARAMETERS lcFileName,lnStartRows,lcSheet,llCursor,llEmptyCells,lnHeader,lcTableName
* Parameters
* lcFileName name of the xlsx
* nom de xlsx
* numele xlsx-ului
* lnStartRows starting row (the first lnStartRows - 1 rows are skipped) ; optional ; default 1 (all rows)
* a partir rangée (les premiers lnStartRows - 1 lignes sont passées) ; optionnel ; défaut 1 (tous les champs lignes)
* primul rand (primele lnStartRows - 1 randuri ale tabelului din docx sunt omise); optional; implicit 1 (toate randurile)
* lcSheet sheet name | number ; optional ; default ''
* nom | nomber de la feuille ; optionnel ; défaut ''
* numele |numarul foii ; optional ; implicit ''
* llCursor when .T., the result is a cursor instead of a DBF ; optional ; default .F.
* lorsque .T, le résultat est un cursor au lieu d'un DBF; optionnel; défaut .F.
* cand este .T., rezultatul este un cursor si nu un DBF; optional; implicit .F.
* llEmptyCells when .T., the source contains empty cells (slower import); optional ; default .F.
* lorsque .T., la source contient des cellules vides (d'importation plus lent); optionnel ; défaut .F.
* cand este .T., documentul sursa contine celule goale (importul este mai lent); optional; implicit .F.
* lnHeader the row that contains column headers (lnHeader < lnStartRows); optional ; default 0
* nombre de la ligne d'en-tête (lnHeader < lnStartRows); optionnel ; défaut 0
* linia care contine antetele coloanelor (lnHeader < lnStartRows); optional; implicit 0
* lcTableName name of the dbf / cursor; optional ; default '' (? for SaveAs - only for table)
* nom de dbf / cursor ; optionnel ; défaut '' (? pour SaveAs)
* numele dbf-ului / cursor; optional ; implicit '' (? pentru SaveAs - doar pentru tabele)
DECLARE Sleep IN WIN32API INTEGER
DECLARE INTEGER ShellExecute IN shell32.dll INTEGER , STRING , STRING , STRING , STRING , INTEGER
#DEFINE ERRLANG "Ro"
#IF ERRLANG = "Ro"
#DEFINE ERRMESS0 "Eroare"
#DEFINE ERRMESS1 "Nimic de importat"
#DEFINE ERRMESS3 "Foaie inexistenta"
#DEFINE ERRMESS4 "Eroare la deschiderea"
#DEFINE ERRMESS5 "Prea multe coloane"
#ELIF ERRLANG = "Fr"
#DEFINE ERRMESS0 "Erreur"
#DEFINE ERRMESS1 "Rien a ajouter"
#DEFINE ERRMESS3 "Feuille introuvable"
#DEFINE ERRMESS4 "Erreur d'ouverture"
#DEFINE ERRMESS5 "Trop de collones"
#ELIF ERRLANG = "Nl" && Koen Piller
#DEFINE ERRMESS0 "Fout"
#DEFINE ERRMESS1 "Niets te importeren"
#DEFINE ERRMESS3 "Blad niet gevonden"
#DEFINE ERRMESS4 "Fout bij openen"
#DEFINE ERRMESS5 "Te veel kolommen"
#ELSE
#DEFINE ERRMESS0 "Error"
#DEFINE ERRMESS1 "Nothing to append"
#DEFINE ERRMESS3 "Sheet not found"
#DEFINE ERRMESS4 "Error opening"
#DEFINE ERRMESS5 "Too many columns"
#ENDIF
***************************************************************
* If you prefer to extract files with Winrar, uncomment this
***************************************************************
*#DEFINE archiveWinRar .T.
LOCAL lcDir,cCurStr,lSetTalk,lnColsNo,laFields[1],laEmptyCells[1],llChars,lnSelect,lcDBF,laFiles[1],cCurStyle,lcCur,laDimRef[2,2],lcStrBad,llServer
lcStrBad = ''
llServer = OS(11) > '1'
FOR lni = 0 TO 31
IF !INLIST(m.lni,9,10,13)
lcStrBad = m.lcStrBad + CHR(m.lni)
ENDIF
NEXT
lnSelect = SELECT(0)
IF PCOUNT() < 1
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN
ELSE
IF VARTYPE(m.lcFileName) $ "CV"
lcFileName = FORCEEXT(m.lcFileName,"xlsx")
IF !FILE(m.lcFileName)
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN
ENDIF
ELSE
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN
ENDIF
ENDIF
IF PCOUNT() < 2
lnStartRows = 1
ELSE
IF VARTYPE(m.lnStartRows) <> "N"
lnStartRows = 1
ENDIF
ENDIF
IF PCOUNT()<3
lcSheet = ""
ELSE
IF NOT (VARTYPE(m.lcSheet) $ "CN")
lcSheet = ""
ENDIF
ENDIF
IF PCOUNT() < 4
llCursor = .F.
ELSE
IF VARTYPE(m.llCursor) <> "L"
llCursor = .F.
ENDIF
ENDIF
IF PCOUNT() < 5
llEmptyCells = .F.
ELSE
IF VARTYPE(m.llEmptyCells) <> "L"
llEmptyCells = .F.
ENDIF
ENDIF
IF PCOUNT() < 6
lnHeader = 0
ELSE
IF VARTYPE(m.lnHeader) <> "N"
lnHeader = 0
ENDIF
ENDIF
IF m.lnHeader >= m.lnStartRows
lnHeader = 0
ENDIF
IF PCOUNT() < 7
lcTableName = ''
ELSE
IF NOT VARTYPE(m.lcFileName) $ "CV"
lcTableName = ''
ENDIF
ENDIF
lSetTalk = SET("Talk")
SET TALK OFF
lcDir = extract(m.lcFileName,m.llServer)
lcDBF = ""
lcSheet = get_sheet(ADDBS(m.lcDir) + "workbook.xml",m.lcSheet)
IF EMPTY(m.lcSheet)
MESSAGEBOX(ERRMESS3,16,'Error')
cleanup(m.lcDir,m.llServer)
SET TALK &lSetTalk
SELECT (m.lnSelect)
RETURN m.lcDBF
ENDIF
llChars = ADIR(laFiles,ADDBS(m.lcDir) + "sharedStrings.xml") > 0
IF m.llChars
cCurStr = get_strings(ADDBS(m.lcDir) + "sharedStrings.xml")
IF EMPTY(m.cCurStr)
cleanup(m.lcDir,m.llServer)
SET TALK &lSetTalk
SELECT (m.lnSelect)
RETURN m.lcDBF
ENDIF
ELSE
cCurStr = ''
ENDIF
cCurStyle = get_styles(ADDBS(m.lcDir) + "styles.xml")
IF EMPTY(m.cCurStyle)
cleanup(m.lcDir,m.llServer)
IF USED(m.cCurStr)
USE IN (m.cCurStr)
ENDIF
SET TALK &lSetTalk
SELECT (m.lnSelect)
RETURN m.lcDBF
ENDIF
IF m.llServer
lcCur = gen_table(ADDBS(ADDBS(m.lcDir) + 'worksheets') + FORCEEXT(m.lcSheet,"xml"),@lnStartRows,m.lcSheet,@lnColsNo,@laFields,m.cCurStyle,m.llEmptyCells,@laEmptyCells,m.lnHeader,m.cCurStr,m.llCursor,@laDimRef)
ELSE
lcCur = gen_table(ADDBS(m.lcDir) + FORCEEXT(m.lcSheet,"xml"),@lnStartRows,m.lcSheet,@lnColsNo,@laFields,m.cCurStyle,m.llEmptyCells,@laEmptyCells,m.lnHeader,m.cCurStr,m.llCursor,@laDimRef)
ENDIF
IF EMPTY(m.lcCur)
cleanup(m.lcDir,m.llServer)
IF USED(m.cCurStr)
USE IN (m.cCurStr)
ENDIF
IF USED(m.cCurStyle)
USE IN (m.cCurStyle)
ENDIF
SET TALK &lSetTalk
SELECT (m.lnSelect)
RETURN m.lcDBF
ENDIF
IF m.llServer
lcDBF = get_cells(ADDBS(ADDBS(m.lcDir) + 'worksheets') + FORCEEXT(m.lcSheet,"xml"),@lcCur,m.cCurStr,m.lnColsNo,@laFields,m.lnStartRows,m.lcFileName,m.llCursor,m.llEmptyCells,m.cCurStyle,@laEmptyCells,@laDimRef,m.lcTableName)
ELSE
lcDBF = get_cells(ADDBS(m.lcDir) + FORCEEXT(m.lcSheet,"xml"),@lcCur,m.cCurStr,m.lnColsNo,@laFields,m.lnStartRows,m.lcFileName,m.llCursor,m.llEmptyCells,m.cCurStyle,@laEmptyCells,@laDimRef,m.lcTableName)
ENDIF
cleanup(m.lcDir,m.llServer)
SET TALK &lSetTalk
SELECT (m.lnSelect)
IF USED(m.cCurStr)
USE IN (m.cCurStr)
ENDIF
IF USED(m.cCurStyle)
USE IN (m.cCurStyle)
ENDIF
IF USED(m.lcCur)
USE IN (m.lcCur)
ENDIF
RETURN m.lcDBF
*********************
* Extract xml files *
*********************
FUNCTION extract
LPARAMETERS lcFileName,llServer
LOCAL lcDir,lcZip,oShell,ofile,loErr as Exception,lcSetSaf,lni,lnFF,laDir[1],lnDir,lnDir0
lcDir = ADDBS(SYS(2023)) + SYS(2015)
lcZip = FORCEEXT(m.lcDir,'.zip')
COPY FILE (m.lcFileName) TO (m.lcZip)
MD (m.lcDir)
***************************
* Use Winrar
***************************
#IFDEF archiveWinRar
ShellExecute(0,"open","WinRAR.exe","E " + m.lcZip + " xl\sharedStrings.xml " + m.lcDir,"",1)
IF ADIR(laDir,ADDBS(m.lcDir) + "sharedStrings*.xml") > 0
lnFF = FOPEN(ADDBS(m.lcDir) + "sharedStrings.xml")
DO WHILE m.lnFF < 0
sleep(50)
lnFF = FOPEN(ADDBS(m.lcDir) + "sharedStrings.xml")
ENDDO
FCLOSE(m.lnFF)
ENDIF
ShellExecute(0,"open","WinRAR.exe","E " + m.lcZip + " xl\workbook.xml " + m.lcDir,"",1)
lnFF = FOPEN(ADDBS(m.lcDir) + "workbook.xml")
DO WHILE m.lnFF < 0
sleep(50)
lnFF = FOPEN(ADDBS(m.lcDir) + "workbook.xml")
ENDDO
FCLOSE(m.lnFF)
ShellExecute(0,"open","WinRAR.exe","E " + m.lcZip + " xl\styles.xml " + m.lcDir,"",1)
lnFF = FOPEN(ADDBS(m.lcDir) + "styles.xml")
DO WHILE m.lnFF < 0
sleep(50)
lnFF = FOPEN(ADDBS(m.lcDir) + "styles.xml")
ENDDO
FCLOSE(m.lnFF)
ShellExecute(0,"open","WinRAR.exe","E " + m.lcZip + " xl\worksheets\sheet*.xml " + m.lcDir,"",1)
lnDir0 = 0
lnDir = ADIR(laDir,ADDBS(m.lcDir ) + "sheet*.xml")
DO WHILE (m.lnDir <> m.lnDir0) OR (m.lnDir = 0)
FOR lni = 1 TO m.lnDir
lnFF = FOPEN(ADDBS(m.lcDir) + m.laDir[m.lni,1])
DO WHILE m.lnFF < 0
sleep(50)
lnFF = FOPEN(ADDBS(m.lcDir) + m.laDir[m.lni,1])
ENDDO
FCLOSE(m.lnFF)
NEXT
lnDir0 = m.lnDir
lnDir = ADIR(laDir,ADDBS(m.lcDir ) + "sheet*.xml")
ENDDO
***************************
* Use Explorer
***************************
#ELSE
oShell = CREATEOBJECT("shell.application")
TRY
FOR lni = 0 TO m.oShell.NameSpace(ADDBS(m.lcZip)+'xl').items.count - 1
ofile = m.oShell.NameSpace(ADDBS(m.lcZip)+'xl').items.item(m.lni)
lcFileName = JUSTFNAME(m.ofile.path)
IF INLIST(LOWER(m.lcFileName),'sharedstrings.xml','workbook.xml','styles.xml')
oShell.NameSpace( m.lcDir).copyhere( m.ofile)
lnFF = FOPEN(ADDBS(m.lcDir) + m.lcFileName)
DO WHILE m.lnFF < 0
sleep(50)
lnFF = FOPEN(ADDBS(m.lcDir) + m.lcFileName)
ENDDO
FCLOSE(m.lnFF)
ENDIF
ENDFOR
IF m.llServer
FOR lni = 0 TO m.oShell.NameSpace(ADDBS(m.lcZip)+'xl').items.count - 1
ofile = m.oShell.NameSpace(ADDBS(m.lcZip)+'xl').items.item(m.lni)
lcFileName = JUSTFNAME(m.ofile.path)
IF INLIST(JUSTSTEM(m.lcFileName),'worksheets')
oShell.NameSpace( m.lcDir).copyhere( m.ofile)
sleep(500)
EXIT
ENDIF
ENDFOR
ELSE
FOR lni = 0 TO m.oShell.NameSpace(ADDBS(m.lcZip)+'xl\worksheets').items.count - 1
ofile = m.oShell.NameSpace(ADDBS(m.lcZip)+'xl\worksheets').items.item(m.lni)
IF LOWER(LEFT(m.ofile.name,5)) == 'sheet'
oShell.NameSpace( m.lcDir).copyhere( m.ofile)
lcFileName = JUSTFNAME(m.ofile.path)
lnFF = FOPEN(ADDBS(m.lcDir) + m.lcFileName)
DO WHILE m.lnFF < 0
sleep(50)
lnFF = FOPEN(ADDBS(m.lcDir) + m.lcFileName)
ENDDO
FCLOSE(m.lnFF)
ENDIF
ENDFOR
ENDIF
CATCH TO loErr
ENDTRY
#ENDIF
RETURN lcDir
****************
* Read strings *
****************
FUNCTION get_strings
LPARAMETERS lcStr
LOCAL cCurStr,lnF,lnPosSiSeek,lcBuff,lnPosSi,lnPosSi2,lcMemo,lcReturn,lnTextPiece,lcTextPiece,lcVal
STORE SYS(2015) TO lcReturn, cCurStr
CREATE CURSOR (m.cCurStr) (cStr M)
lnF = FOPEN(m.lcStr)
IF m.lnF >= 0
lnPosSiSeek = 0
DO WHILE !FEOF(m.lnF)
lcBuff = FREAD(m.lnF,8192)
lnPosSi = AT('<si>',m.lcBuff)
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi + 3
= FSEEK(m.lnF,m.lnPosSiSeek)
lcBuff = FREAD(m.lnF,8192)
lnPosSi2 = AT('</si>',m.lcBuff)
lcMemo = ''
DO WHILE !FEOF(m.lnF) AND m.lnPosSi2 = 0
lcMemo = m.lcMemo + m.lcBuff
lcBuff = FREAD(m.lnF,8192)
lnPosSi2 = AT('</si>',m.lcMemo)
ENDDO
IF m.lnPosSi2 != 0
lcMemo = m.lcMemo + LEFT(m.lcBuff,m.lnPosSi2 - 1)
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi2 + 4
lnPosSi = FSEEK(m.lnF,m.lnPosSiSeek)
lcVal = ""
STORE 1 TO lnTextPiece
lcTextPiece = STREXTRACT(m.lcMemo,'<t','</t>')
DO WHILE !EMPTY(m.lcTextPiece)
lcVal = m.lcVal + STREXTRACT(m.lcTextPiece,[>])
lnTextPiece = m.lnTextPiece + 1
lcTextPiece = STREXTRACT(m.lcMemo,'<t','</t>',m.lnTextPiece)
ENDDO
INSERT INTO (m.cCurStr) (cStr) VALUES (htmspec(m.lcVal))
ELSE
lcMemo = m.lcMemo + m.lcBuff
EXIT
ENDIF
ENDDO
ELSE
lcReturn = ''
MESSAGEBOX(ERRMESS4 + ' sharedStrings.xml',16,'Error')
ENDIF
FCLOSE(m.lnF)
RETURN m.lcReturn
***************
* Read styles *
***************
FUNCTION get_styles
LPARAMETERS lcStr
LOCAL cCurStr,lcBuff,lcMemo,lcReturn,lcTextPiece,lnTextPiece,lcVal,llDate,lcMemo2,lcTextPiece2,lnTextPiece2,lcVal2,lcVal3
STORE SYS(2015) TO lcReturn, cCurStyle
CREATE CURSOR (m.cCurStyle) (iIndex I AUTOINC NEXTVALUE 0,iFmt I,lDate L)
INDEX on iIndex TAG iIndex
lcBuff = FILETOSTR(m.lcStr)
lcMemo = STREXTRACT(m.lcBuff,'<cellXfs','</cellXfs>')
lcMemo2 = STREXTRACT(m.lcBuff,'<numFmts','</numFmts>')
lnTextPiece = 1
lcTextPiece = STREXTRACT(m.lcMemo,'<xf ','<xf ')
DO WHILE !EMPTY(m.lcTextPiece)
lcVal = STREXTRACT(m.lcTextPiece,'numFmtId="','"')
llDate = BETWEEN(VAL(m.lcVal),14,22) or BETWEEN(VAL(m.lcVal),45,47) or BETWEEN(VAL(m.lcVal),27,36) or BETWEEN(VAL(m.lcVal),50,58) or BETWEEN(VAL(m.lcVal),71,81);
or (EMPTY(m.lcMemo2) and !BETWEEN(VAL(m.lcVal),0,13) and !BETWEEN(VAL(m.lcVal),37,44) and !INLIST(VAL(m.lcVal),48,59,60,61,62,67,68,69,70))
IF !m.llDate &&AND VAL(lcVal) >= 164
lnTextPiece2 = 1
lcTextPiece2 = STREXTRACT(m.lcMemo2,'<numFmt ','/>')
DO WHILE !EMPTY(m.lcTextPiece2)
lcVal2 = STREXTRACT(m.lcTextPiece2,'numFmtId="','"')
IF m.lcVal2 == m.lcVal
lcVal3 = STREXTRACT(m.lcTextPiece2,'formatCode="','"')
llDate = AT("0.",m.lcVal3) + AT(".0",m.lcVal3) + AT("0,",m.lcVal3) + AT(",0",m.lcVal3) + AT("#",m.lcVal3) = 0 and m.lcVal3<>[General]
EXIT
ENDIF
lnTextPiece2 = m.lnTextPiece2 + 1
lcTextPiece2 = STREXTRACT(m.lcMemo2,'<numFmt ','/>',m.lnTextPiece2)
ENDDO
ENDIF
INSERT INTO (m.cCurStyle) (iFmt,lDate) VALUES (VAL(m.lcVal),m.llDate)
lnTextPiece = m.lnTextPiece + 1
lcTextPiece = STREXTRACT(m.lcMemo,'<xf ','<xf ',m.lnTextPiece)
IF EMPTY(m.lcTextPiece)
lcTextPiece = STREXTRACT(m.lcMemo,'<xf ','',m.lnTextPiece)
ENDIF
ENDDO
RETURN m.lcReturn
**********************************************
* Read first row and determine the data type *
**********************************************
FUNCTION gen_table
LPARAMETERS lcStr,lnStartRows,lcSheet,lnField,laFieldGat,cCurStyle,llEmptyCells,laEmptyCells,lnHeader,cCurStr,llCursor,laDimRef
LOCAL lcCell,lnCurRow,lnStartRows0,lnCurRow0,lcShCol,lnShCol,lnShField,lnCurCol,lcTable,lcWholeTable,lcWholeRow,llDate,llTime,llBool,llMemo,llNumber,lnStyle
LOCAL lnCurRowF,lnCurRow0F,lnStartRows0F,lnFieldF,lcShCol,ldDat01,ldDat02,lnDat,lcVal,lnTim,lnName,lcName,lnLeftName,lcDimRef,lnDimRef,lcDimRef1
LOCAL llEmptyVal
ldDat01 = DATE(1900,3,1) - 61
ldDat02 = DATE(1900,1,1) - 1
lcTable = SYS(2015)
lcWholeTable = FILETOSTR(m.lcStr)
*****************
STORE STREXTRACT(m.lcWholeTable,[<dimension ref="],["]) TO lcDimRef, lcDimRef1
laDimRef = 0
lnDimRef = AT(":", m.lcDimRef)
IF m.lnDimRef > 0
lcDimRef1 = LEFT(m.lcDimRef, m.lnDimRef - 1)
laDimRef[1,1] = VAL(CHRTRAN(m.lcDimRef1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',''))
lcDimRef1 = CHRTRAN(m.lcDimRef1,'0123456789','')
IF LEN(m.lcDimRef1) = 1
laDimRef[1,2] = ASC(m.lcDimRef1) - 64
ELSE
IF LEN(m.lcDimRef1) = 2
laDimRef[1,2] = ASC(RIGHT(m.lcDimRef1,1)) - 64 + 26 * (ASC(LEFT(m.lcDimRef1,1)) - 64)
ELSE && LEN(m.lcDimRef1) = 3
laDimRef[1,2] = ASC(RIGHT(m.lcDimRef1,1)) - 64 + 26 * (ASC(SUBSTR(m.lcDimRef1,1,1)) - 64) + 676 * (ASC(LEFT(m.lcDimRef1,1)) - 64)
ENDIF
ENDIF
lcDimRef1 = SUBSTR(m.lcDimRef, m.lnDimRef + 1)
laDimRef[2,1] = VAL(CHRTRAN(m.lcDimRef1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',''))
lcDimRef1 = CHRTRAN(m.lcDimRef1,'0123456789','')
IF LEN(m.lcDimRef1) = 1
laDimRef[2,2] = ASC(m.lcDimRef1) - 64
ELSE
IF LEN(m.lcDimRef1) = 2
laDimRef[2,2] = ASC(RIGHT(m.lcDimRef1,1)) - 64 + 26 * (ASC(LEFT(m.lcDimRef1,1)) - 64)
ELSE && LEN(m.lcDimRef1) = 3
laDimRef[2,2] = ASC(RIGHT(m.lcDimRef1,1)) - 64 + 26 * (ASC(SUBSTR(m.lcDimRef1,1,1)) - 64) + 676 * (ASC(LEFT(m.lcDimRef1,1)) - 64)
ENDIF
ENDIF
ELSE
laDimRef[1,1] = VAL(CHRTRAN(m.lcDimRef1,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',''))
lcDimRef1 = CHRTRAN(m.lcDimRef1,'0123456789','')
IF LEN(m.lcDimRef1) = 1
laDimRef[1,2] = ASC(m.lcDimRef1) - 64
ELSE
IF LEN(m.lcDimRef1) = 2
laDimRef[1,2] = ASC(RIGHT(m.lcDimRef1,1)) - 64 + 26 * (ASC(LEFT(m.lcDimRef1,1)) - 64)
ELSE && LEN(m.lcDimRef1) = 3
laDimRef[1,2] = ASC(RIGHT(m.lcDimRef1,1)) - 64 + 26 * (ASC(SUBSTR(m.lcDimRef1,1,1)) - 64) + 676 * (ASC(LEFT(m.lcDimRef1,1)) - 64)
ENDIF
ENDIF
ENDIF
ACTIVATE SCREEN
*******************
lnCurRow = 1 &&m.lnStartRows
lnCurRow0 = 1
lnStartRows0 = m.lnStartRows
lnFieldF = 0
lnField = 1
**************
lcWholeRow = STREXTRACT(m.lcWholeTable,"<row ","</row>")
IF EMPTY(m.lcWholeRow)
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN ''
ENDIF
**************
IF m.lnHeader > 0
lnCurRowF = 1 &&m.lnStartRows
lnCurRow0F = 1
lnStartRows0F = m.lnHeader
* lnFieldF = 1
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
IF "inlineStr" $ m.lcCell
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
ELSE
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
ENDIF
DO WHILE !EMPTY(m.lcWholeRow) AND (lnCurRowF < m.lnStartRows0F OR EMPTY(m.lcCell) OR m.llEmptyVal) && EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
lnCurRow0F = m.lnCurRow0F + 1
IF !EMPTY(m.lcCell) AND !m.llEmptyVal && !EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
lnCurRowF = m.lnCurRowF + 1
ENDIF
lcWholeRow = STREXTRACT(m.lcWholeTable,"<row ","</row>",m.lnCurRow0F)
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>])
IF "inlineStr" $ m.lcCell
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
ELSE
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
ENDIF
ENDDO
IF EMPTY(m.lcWholeRow)
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN ''
ENDIF
DO WHILE !EMPTY(m.lcCell)
lcShCol = CHRTRAN(STREXTRACT(m.lcCell,'r="','"'),'0123456789','')
IF LEN(m.lcShCol) = 1
lnShCol = ASC(m.lcShCol) - 64
ELSE
IF LEN(m.lcShCol) = 2
lnShCol = ASC(RIGHT(m.lcShCol,1)) - 64 + 26 * (ASC(LEFT(m.lcShCol,1)) - 64)
ELSE && LEN(m.lcShCol) = 3
lnShCol = ASC(RIGHT(m.lcShCol,1)) - 64 + 26 * (ASC(SUBSTR(m.lcShCol,1,1)) - 64) + 676 * (ASC(LEFT(m.lcShCol,1)) - 64)
ENDIF
ENDIF
lnShCol = m.lnShCol - laDimRef[1,2] + 1
DIMENSION laFieldGat[m.lnShCol,18],laEmptyCells[m.lnShCol]
FOR lnj = m.lnFieldF + 1 TO m.lnShCol
STORE 0 TO laFieldGat[m.lnj,17],laFieldGat[m.lnj,18],laFieldGat[m.lnj,4]
STORE .T. TO laFieldGat[m.lnj,5],laEmptyCells[m.lnj]
STORE .F. TO laFieldGat[m.lnj,6],laFieldGat[m.lnj,5]
STORE '' TO laFieldGat[m.lnj,7],laFieldGat[m.lnj,8],laFieldGat[m.lnj,9],laFieldGat[m.lnj,10],laFieldGat[m.lnj,11],laFieldGat[m.lnj,12],laFieldGat[m.lnj,13],laFieldGat[m.lnj,14],laFieldGat[m.lnj,15],laFieldGat[m.lnj,16]
laFieldGat[m.lnj,2] = "M"
laFieldGat[m.lnj,3] = 4
IF m.lnj < m.lnShCol
laFieldGat[m.lnj,1] = "MFIELD"+TRANSFORM(m.lnj)
ELSE
* lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
IF "inlineStr" $ m.lcCell
lcVal = STREXTRACT(m.lcCell,[<t])
lcVal = STREXTRACT(m.lcVal,[">],[</t>])
ELSE
lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
ENDIF
llBool = 't="b"' $ m.lcCell
llMemo = 't="s"' $ m.lcCell or [t="inlineStr] $ m.lcCell
llNumber = !m.llBool AND !m.llMemo AND not ('s="' $ m.lcCell)
STORE .F. TO llDate, llTime
IF !llBool AND !llMemo AND !llNumber
lnStyle = VAL(STREXTRACT(m.lcCell,[s="],["]))
IF SEEK(m.lnStyle,m.cCurStyle,"iIndex")
llDate = &cCurStyle..lDate and VAL(STREXTRACT(m.lcCell,[<v>],[</v>])) = FLOOR(VAL(STREXTRACT(m.lcCell,[<v>],[</v>])))
llTime = &cCurStyle..lDate and !m.llDate
llNumber = !m.llDate and !m.llTime
ENDIF
ENDIF
DO CASE
CASE m.llNumber
laFieldGat[m.lnShCol,1] = "_" + CHRTRAN(m.lcVal,'.,+-','')
CASE m.llDate
lnDat = VAL(m.lcVal)
IF m.lnDat >= 61
laFieldGat[m.lnShCol,1] = "_" + DTOS(m.ldDat01 + m.lnDat)
ELSE
laFieldGat[m.lnShCol,1] = "_" + DTOS(m.ldDat02 + m.lnDat)
ENDIF
CASE m.llTime
lnTim = VAL(m.lcVal)
lnDat = FLOOR(m.lnTim)
laFieldGat[m.lnShCol,1] = "_" + TTOC(DTOT(m.ldDat01 + m.lnDat) + INT(86400.0 * (m.lnTim - m.lnDat)),1)
CASE m.llBool
laFieldGat[m.lnShCol,1] = IIF(m.lcVal == "1","TRUE","FALSE")
OTHERWISE
IF "inlineStr" $ m.lcCell
laFieldGat[m.lnShCol,1] = m.lcVal
ELSE
TRY
IF [t="s"] $ m.lcCell
SELECT (m.cCurStr)
GO VAL(m.lcVal) + 1 IN (m.cCurStr)
laFieldGat[m.lnShCol,1] = cStr
ELSE
laFieldGat[m.lnShCol,1] = m.lcVal
ENDIF
CATCH TO loErr
laFieldGat[m.lnShCol,1] = m.lcVal
ENDTRY
ENDIF
laFieldGat[m.lnShCol,1] = UPPER(ALLTRIM(laFieldGat[m.lnShCol,1]))
laFieldGat[m.lnShCol,1] = CHRTRAN(laFieldGat[m.lnShCol,1],CHRTRAN(laFieldGat[m.lnShCol,1],"_0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",""),"")
IF !ISALPHA(laFieldGat[m.lnShCol,1])
laFieldGat[m.lnShCol,1] = "_" + laFieldGat[m.lnShCol,1]
ENDIF
ENDCASE
laFieldGat[m.lnShCol,1] = LEFT(laFieldGat[m.lnShCol,1],IIF(m.llCursor,31,10)) && 31
lnName = 0
lcName = laFieldGat[m.lnShCol,1]
DO WHILE BETWEEN(ASCAN(laFieldGat,m.lcName,1,-1,1,1+2+4+8), 1, m.lnShCol - 1)
lnName = m.lnName + 1
lcName = laFieldGat[m.lnShCol,1]
lnLeftName = MIN(LEN(laFieldGat[m.lnShCol,1]) , IIF(m.llCursor,31,10) - LEN(TRANSFORM(m.lnName))) && 31
lcName = LEFT(laFieldGat[m.lnShCol,1], m.lnLeftName) + TRANSFORM(m.lnName)
ENDDO
laFieldGat[m.lnShCol,1] = m.lcName
ENDIF
NEXT
lnFieldF = m.lnShCol
lnField = m.lnField + 1
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
ENDDO
lnField = m.lnField - 1
ENDIF
**************
IF !m.llEmptyCells && simple case : the sheet does not contain empty cells
* lnField = 1
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
IF "inlineStr" $ m.lcCell
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
ELSE
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
ENDIF
DO WHILE !EMPTY(m.lcWholeRow) AND (lnCurRow < m.lnStartRows0 OR EMPTY(m.lcCell) OR m.llEmptyVal) && EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
lnCurRow0 = m.lnCurRow0 + 1
IF !EMPTY(m.lcCell) AND !llEmptyVal && !EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
lnCurRow = m.lnCurRow + 1
ENDIF
lcWholeRow = STREXTRACT(m.lcWholeTable,"<row ","</row>",m.lnCurRow0)
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>])
IF "inlineStr" $ m.lcCell
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
ELSE
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
ENDIF
ENDDO
lnStartRows = lnCurRow0
IF EMPTY(m.lcWholeRow)
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN ''
ENDIF
DO WHILE !EMPTY(m.lcCell)
IF m.lnFieldF < m.lnField
DIMENSION laFieldGat[m.lnField,18],laEmptyCells[m.lnField]
STORE 0 TO laFieldGat[m.lnField,17],laFieldGat[m.lnField,18],laFieldGat[m.lnField,4]
STORE .T. TO laFieldGat[m.lnField,5],laEmptyCells[m.lnField]
STORE .F. TO laFieldGat[m.lnField,6],laFieldGat[m.lnField,5]
STORE '' TO laFieldGat[m.lnField,7],laFieldGat[m.lnField,8],laFieldGat[m.lnField,9],laFieldGat[m.lnField,10],laFieldGat[m.lnField,11],laFieldGat[m.lnField,12],laFieldGat[m.lnField,13],laFieldGat[m.lnField,14],laFieldGat[m.lnField,15],laFieldGat[m.lnField,16]
ENDIF
llBool = 't="b"' $ m.lcCell
llMemo = 't="s"' $ m.lcCell or [t="inlineStr] $ m.lcCell
llNumber = !m.llBool AND !m.llMemo AND not ('s="' $ m.lcCell)
STORE .F. TO llDate, llTime
IF !llBool AND !llMemo AND !llNumber
lnStyle = VAL(STREXTRACT(m.lcCell,[s="],["]))
IF SEEK(m.lnStyle,m.cCurStyle,"iIndex")
llDate = &cCurStyle..lDate and VAL(STREXTRACT(m.lcCell,[<v>],[</v>])) = FLOOR(VAL(STREXTRACT(m.lcCell,[<v>],[</v>])))
llTime = &cCurStyle..lDate and !m.llDate
llNumber = !m.llDate and !m.llTime
ENDIF
ENDIF
IF m.lnFieldF < m.lnField
laFieldGat[m.lnField,1] = "MFIELD"+TRANSFORM(m.lnField)
ENDIF
laEmptyCells[m.lnField] = !m.llDate AND !m.llTime AND !m.llMemo AND !m.llBool AND !m.llNumber
DO CASE
CASE m.llNumber
laFieldGat[m.lnField,2] = "B"
laFieldGat[m.lnField,3] = 8
laFieldGat[m.lnField,4] = 15
CASE m.llDate
laFieldGat[m.lnField,2] = "D"
laFieldGat[m.lnField,3] = 8
CASE m.llTime
laFieldGat[m.lnField,2] = "T"
laFieldGat[m.lnField,3] = 8
CASE m.llBool
laFieldGat[m.lnField,2] = "L"
laFieldGat[m.lnField,3] = 1
OTHERWISE
laFieldGat[m.lnField,2] = "M"
laFieldGat[m.lnField,3] = 4
ENDCASE
lnField = m.lnField + 1
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
ENDDO
lnField = m.lnField - 1
ELSE && complicated : check empty cells
lnField = 1
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
IF AT([<c ],m.lcCell) > 0
lcCell = LEFT(m.lcCell , AT([<c ],m.lcCell) - 1)
ENDIF
IF "inlineStr" $ m.lcCell
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
ELSE
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
ENDIF
DO WHILE !EMPTY(m.lcWholeRow) AND (lnCurRow < m.lnStartRows0 OR EMPTY(m.lcCell) OR m.llEmptyVal) && EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>])))
lnCurRow0 = m.lnCurRow0 + 1
IF !EMPTY(m.lcCell) AND !m.llEmptyVal &&!EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
lnCurRow = m.lnCurRow + 1
ENDIF
lcWholeRow = STREXTRACT(m.lcWholeTable,"<row ","</row>",m.lnCurRow0)
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>])
IF AT([<c ],m.lcCell) > 0
lcCell = LEFT(m.lcCell , AT([<c ],m.lcCell) - 1)
ENDIF
IF "inlineStr" $ m.lcCell
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
ELSE
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
ENDIF
ENDDO
lnStartRows = lnCurRow0
IF EMPTY(m.lcWholeRow)
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
RETURN ''
ENDIF
lnShField = 0
DO WHILE !EMPTY(m.lcCell)
lnShCol = lnShField
lcShCol = CHRTRAN(STREXTRACT(m.lcCell,'r="','"'),'0123456789','')
DO CASE
CASE LEN(m.lcShCol) = 1
lnShCol = ASC(m.lcShCol) - 64
CASE LEN(m.lcShCol) = 2
lnShCol = ASC(RIGHT(m.lcShCol,1)) - 64 + 26 * (ASC(LEFT(m.lcShCol,1)) - 64)
CASE LEN(m.lcShCol) = 3
lnShCol = ASC(RIGHT(m.lcShCol,1)) - 64 + 26 * (ASC(SUBSTR(m.lcShCol,1,1)) - 64) + 676 * (ASC(LEFT(m.lcShCol,1)) - 64)
ENDCASE
lnShCol = m.lnShCol - laDimRef[1,2] + 1
IF m.lnFieldF < m.lnShCol
DIMENSION laFieldGat[m.lnShCol,18],laEmptyCells[m.lnShCol]
FOR lnCurCol = MAX(m.lnShField,m.lnFieldF) + 1 TO m.lnShCol
STORE 0 TO laFieldGat[m.lnCurCol,17],laFieldGat[m.lnCurCol,18],laFieldGat[m.lnCurCol,4]
STORE .T. TO laFieldGat[m.lnCurCol,5],laEmptyCells[m.lnCurCol]
STORE .F. TO laFieldGat[m.lnCurCol,6],laFieldGat[m.lnCurCol,5]
STORE '' TO laFieldGat[m.lnCurCol,7],laFieldGat[m.lnCurCol,8],laFieldGat[m.lnCurCol,9],laFieldGat[m.lnCurCol,10],laFieldGat[m.lnCurCol,11],laFieldGat[m.lnCurCol,12],laFieldGat[m.lnCurCol,13],laFieldGat[m.lnCurCol,14],laFieldGat[m.lnCurCol,15],laFieldGat[m.lnCurCol,16]
laFieldGat[m.lnCurCol,1] = "MFIELD"+TRANSFORM(m.lnCurCol)
NEXT
FOR lnCurCol = MAX(m.lnShField,m.lnFieldF) + 1 TO m.lnShCol - 1 && empty cells
laFieldGat[m.lnCurCol,2] = "M"
laFieldGat[m.lnCurCol,3] = 4
NEXT
ENDIF
IF AT([<v>],m.lcCell) = 0 && empty cells
laFieldGat[m.lnShCol,2] = "M"
laFieldGat[m.lnShCol,3] = 4
ELSE
llBool = 't="b"' $ m.lcCell
llMemo = 't="s"' $ m.lcCell or [t="inlineStr] $ m.lcCell
llNumber = !llBool AND !llMemo AND not ('s="' $ m.lcCell)
STORE .F. TO llDate, llTime
IF !llBool AND !llMemo AND !llNumber
lnStyle = VAL(STREXTRACT(m.lcCell,[s="],["]))
IF SEEK(m.lnStyle,m.cCurStyle,"iIndex")
llDate = &cCurStyle..lDate and VAL(STREXTRACT(m.lcCell,[<v>],[</v>])) = FLOOR(VAL(STREXTRACT(m.lcCell,[<v>],[</v>])))
llTime = &cCurStyle..lDate and !llDate
llNumber = !llDate and !llTime
ENDIF
ENDIF
* laFieldGat[m.lnShCol,1] = "MFIELD"+TRANSFORM(m.lnShCol)
laEmptyCells[m.lnShCol] = !m.llDate AND !m.llTime AND !m.llMemo AND !m.llBool AND !m.llNumber
DO CASE
CASE m.llNumber
laFieldGat[m.lnShCol,2] = "B"
laFieldGat[m.lnShCol,3] = 8
laFieldGat[m.lnShCol,4] = 15
CASE m.llDate
laFieldGat[m.lnShCol,2] = "D"
laFieldGat[m.lnShCol,3] = 8
CASE m.llTime
laFieldGat[m.lnShCol,2] = "T"
laFieldGat[m.lnShCol,3] = 8
CASE m.llBool
laFieldGat[m.lnShCol,2] = "L"
laFieldGat[m.lnShCol,3] = 1
OTHERWISE
laFieldGat[m.lnShCol,2] = "M"
laFieldGat[m.lnShCol,3] = 4
ENDCASE
ENDIF
lnField = m.lnField + 1
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
IF AT([<c ],m.lcCell) > 0
lcCell = LEFT(m.lcCell , AT([<c ],m.lcCell) - 1)
ENDIF
lnShField = m.lnShCol
ENDDO
lnField = MAX(m.lnShCol,m.lnFieldF) &&m.lnField - 1
ENDIF
IF m.lnField > 254
MESSAGEBOX(ERRMESS5,16,ERRMESS0)
RETURN ''
ELSE
CREATE CURSOR (m.lcTable) FROM ARRAY laFieldGat
ENDIF
RETURN m.lcTable
**************
* Read sheet *
**************
FUNCTION get_cells
LPARAMETERS lcStr,cCurSheet,cCurStr,lnField,laField,lnStartRows,lcFileName,llCursor,llEmptyCells,cCurStyle,laEmptyCells,laDimRef,lcTable
LOCAL lnField,ldDat01,ldDat02,lcSetDec,lnF,lnPosSiSeek,lcBuff,lnPosSi,lnPosSi2,lcMemo,laFieldGat[1],lni,lcCell,lcVal,lnDat,lnTim,lnCurRow,laFieldPrec[m.lnField,2],loErr as Exception,lcPoint
LOCAL lcShCol,lnShCol,llDate,llTime,llBool,llMemo,llNumber,lnStyle,lcAlterCol,lnCurCell,lnj,llExtend,cCurSheet1,lcMySql,lcMySql0
IF m.llCursor
IF EMPTY(m.lcTable) OR m.lcTable == '?'
lcTable = SYS(2015)
ELSE
lcTable = CHRTRAN(m.lcTable,CHRTRAN(m.lcTable,'_1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXUZ',''),'')
IF ISDIGIT(m.lcTable)
lcTable = '_' + m.lcTable
ENDIF
ENDIF
ELSE
IF EMPTY(m.lcTable)
lcTable = FORCEEXT(m.lcFileName,"DBF")
ELSE
IF m.lcTable == '?'
lcTable = PUTFILE('',FORCEEXT(m.lcFileName,"DBF"),'DBF')
IF EMPTY(m.lcTable)
lcTable = FORCEEXT(m.lcFileName,"DBF")
ELSE
lcTable = FORCEEXT(m.lcTable,'DBF')
ENDIF
ELSE
lcTable = FORCEEXT(m.lcTable,'DBF')
ENDIF
ENDIF
lcTable = CHRTRAN(m.lcTable,[<>:"/\|?*],'')
ENDIF
lcTable = LEFT(m.lcTable,31)
lnField = ALEN(laField,1)
ldDat01 = DATE(1900,3,1) - 61
ldDat02 = DATE(1900,1,1) - 1
lcPoint = SET("Point")
lcSetDec = SET("Decimals")
laFieldPrec = 0
SET DECIMALS TO 10
lnF = FOPEN(m.lcStr)
lnCurRow = 0
IF m.lnF >= 0
IF !llEmptyCells && simple : table without empty celss
lnPosSiSeek = 0
DO WHILE !FEOF(m.lnF)
lcBuff = FREAD(m.lnF,8192)
lnPosSi = AT('<row r="',m.lcBuff)
lcMemo = ''
DO WHILE !FEOF(m.lnF) AND m.lnPosSi = 0
lcMemo = m.lcMemo + m.lcBuff
lcBuff = FREAD(m.lnF,8192)
lnPosSi = AT('<row r="',m.lcMemo)
ENDDO
IF m.lnPosSi != 0
lcMemo = m.lcMemo + LEFT(m.lcBuff,m.lnPosSi - 1)
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi + 7
lnPosSi = FSEEK(m.lnF,m.lnPosSiSeek)
ELSE
EXIT
ENDIF
= FSEEK(m.lnF,m.lnPosSiSeek)
lcBuff = FREAD(m.lnF,8192)
lnPosSi2 = AT('</row>',m.lcBuff)
lcMemo = ''
DO WHILE !FEOF(m.lnF) AND m.lnPosSi2 = 0
lcMemo = m.lcMemo + m.lcBuff
lcBuff = FREAD(m.lnF,8192)
lnPosSi2 = AT('</row>',m.lcMemo)
ENDDO
IF m.lnPosSi2 != 0
lcMemo = m.lcMemo + LEFT(m.lcBuff,m.lnPosSi2 - 1)
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi2 + 5
lnPosSi = FSEEK(m.lnF,m.lnPosSiSeek)
lnCurRow = m.lnCurRow + 1
IF m.lnStartRows > m.lnCurRow
LOOP
ENDIF
SELECT (m.cCurSheet)
APPEND BLANK
SCATTER MEMO TO laFieldGat
FOR lni = 1 TO lnField
lcCell = STREXTRACT(m.lcMemo,[<c ],[</c>],m.lni)
* lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
IF "inlineStr" $ m.lcCell
lcVal = STREXTRACT(m.lcCell,[<t])
lcVal = STREXTRACT(m.lcVal,[">],[</t>])
ELSE
lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
ENDIF
IF EMPTY(m.lcVal)
LOOP
ENDIF
IF laField[m.lni,2] $ "CVM"
IF "inlineStr" $ m.lcCell
laFieldGat[m.lni] = m.lcVal
ELSE
TRY
IF [t="s"] $ m.lcCell
SELECT (m.cCurStr)
GO VAL(m.lcVal) + 1 IN (m.cCurStr)
laFieldGat[m.lni] = cStr
ELSE
laFieldGat[m.lni] = m.lcVal
ENDIF
CATCH TO loErr
laFieldGat[m.lni] = m.lcVal
ENDTRY
ENDIF
laFieldPrec[m.lni,1] = MAX(laFieldPrec[m.lni,1],LEN(laFieldGat[m.lni]))
laFieldPrec[m.lni,2] = MAX(laFieldPrec[m.lni,2],OCCURS(CHR(13),laFieldGat[m.lni]))
ELSE
IF laField[m.lni,2] $ "NFBYI"
laFieldGat[m.lni] = VAL(m.lcVal)
laFieldPrec[m.lni,1] = MAX(laFieldPrec[m.lni,1],LEN(ALLTRIM(m.lcVal)))
IF AT(m.lcPoint,ALLTRIM(m.lcVal)) > 0
laFieldPrec[m.lni,2] = MAX(laFieldPrec[m.lni,2],LEN(ALLTRIM(m.lcVal)) - AT(m.lcPoint,ALLTRIM(m.lcVal)))
ENDIF
ELSE
IF laField[m.lni,2] $ "D"
lnDat = VAL(m.lcVal)
IF m.lnDat >= 61
laFieldGat[m.lni] = m.ldDat01 + m.lnDat
ELSE
laFieldGat[m.lni] = m.ldDat02 + m.lnDat
ENDIF
ELSE
IF laField[m.lni,2] $ "T"
lnTim = VAL(m.lcVal)
lnDat = FLOOR(m.lnTim)
laFieldGat[m.lni] = DTOT(m.ldDat01 + m.lnDat) + INT(86400.0 * (m.lnTim - m.lnDat))
ELSE
IF laField[m.lni,2] $ "L"
laFieldGat[m.lni] = m.lcVal == "1"
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
SELECT (m.cCurSheet)
GATHER FROM laFieldGat MEMO
ELSE
lcMemo = m.lcMemo + m.lcBuff
EXIT
ENDIF
ENDDO
ELSE && complicated : column check
lnPosSiSeek = 0
DO WHILE !FEOF(m.lnF)
lcBuff = FREAD(m.lnF,8192)
lnPosSi = AT('<row r="',m.lcBuff)
lcMemo = ''
DO WHILE !FEOF(m.lnF) AND m.lnPosSi = 0
lcMemo = m.lcMemo + m.lcBuff
lcBuff = FREAD(m.lnF,8192)
lnPosSi = AT('<row r="',m.lcMemo)
ENDDO
IF m.lnPosSi != 0
lcMemo = m.lcMemo + LEFT(m.lcBuff,m.lnPosSi - 1)
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi + 7
lnPosSi = FSEEK(m.lnF,m.lnPosSiSeek)
ELSE
EXIT
ENDIF
= FSEEK(m.lnF,m.lnPosSiSeek)
lcBuff = FREAD(m.lnF,8192)
lnPosSi2 = AT('</row>',m.lcBuff)
lcMemo = ''
DO WHILE !FEOF(m.lnF) AND m.lnPosSi2 = 0
lcMemo = m.lcMemo + m.lcBuff
lcBuff = FREAD(m.lnF,8192)
lnPosSi2 = AT('</row>',m.lcMemo)
ENDDO
IF m.lnPosSi2 != 0
lcMemo = m.lcMemo + LEFT(m.lcBuff,m.lnPosSi2 - 1)
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi2 + 5
lnPosSi = FSEEK(m.lnF,m.lnPosSiSeek)
lnCurRow = m.lnCurRow + 1
IF m.lnStartRows > m.lnCurRow
LOOP
ENDIF
SELECT (m.cCurSheet)
APPEND BLANK
SCATTER MEMO TO laFieldGat
lnCurCell = 1
lni = 1
llExtend = .F.
DO WHILE m.lni <= m.lnField OR m.llExtend
* FOR lni=1 TO lnField
llExtend = .F.
lcCell = STREXTRACT(m.lcMemo,[<c ],[</c>],m.lnCurCell)
IF AT([<c ],m.lcCell) > 0
lcCell = LEFT(m.lcCell , AT([<c ],m.lcCell) - 1)
ENDIF
lcShCol = CHRTRAN(STREXTRACT(m.lcCell,'r="','"'),'0123456789','')
IF LEN(m.lcShCol) = 1
lnShCol = ASC(m.lcShCol) - 64
ELSE
IF LEN(m.lcShCol) = 2
lnShCol = ASC(RIGHT(m.lcShCol,1)) - 64 + 26 * (ASC(LEFT(m.lcShCol,1)) - 64)
ELSE && LEN(m.lcShCol) = 3
lnShCol = ASC(RIGHT(m.lcShCol,1)) - 64 + 26 * (ASC(SUBSTR(m.lcShCol,1,1)) - 64) + 676 * (ASC(LEFT(m.lcShCol,1)) - 64)
ENDIF
ENDIF
lnShCol = m.lnShCol - laDimRef[1,2] + 1
IF m.lnShCol > m.lnField
llExtend = .T.
DIMENSION laField[m.lnShCol,ALEN(laField,2)],laEmptyCells[m.lnShCol],laFieldPrec[m.lnShCol,2],laFieldGat[m.lnShCol]
lcMySql = ''
FOR lnj = 1 TO m.lnField
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcMySql = RTRIM(m.lcMySql,1,',')
FOR lnj = m.lnField + 1 TO m.lnShCol
STORE 0 TO laField[m.lnj,17],laField[m.lnj,18],laField[m.lnj,4]
STORE .T. TO laField[m.lnj,5],laEmptyCells[m.lnj]
STORE .F. TO laField[m.lnj,6],laField[m.lnj,5]
STORE '' TO laField[m.lnj,7],laField[m.lnj,8],laField[m.lnj,9],laField[m.lnj,10],laField[m.lnj,11],laField[m.lnj,12],laField[m.lnj,13],laField[m.lnj,14],laField[m.lnj,15],laField[m.lnj,16]
laField[m.lnj,2] = "M"
laField[m.lnj,3] = 4
laEmptyCells[m.lnj] = .T.
STORE 0 TO laFieldPrec[m.lnj,1],laFieldPrec[m.lnj,2]
lcAlterCol = "MFIELD"+TRANSFORM(m.lnj)
laField[m.lnj,1] = m.lcAlterCol
NEXT
lnField = m.lnShCol
cCurSheet1 = SYS(2015)
CREATE CURSOR (m.cCurSheet1) FROM ARRAY laField
lcMySql = "INSERT INTO " + m.cCurSheet1 + "(" + m.lcMySql + ") SELECT " + m.lcMySql + " FROM " + m.cCurSheet
&lcMySql
USE IN (m.cCurSheet)
cCurSheet = m.cCurSheet1
GO BOTTOM IN (m.cCurSheet)
ENDIF
IF lni < m.lnShCol
lni = m.lnShCol
ENDIF
lnCurCell = m.lnCurCell + 1
* lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
IF "inlineStr" $ m.lcCell
lcVal = STREXTRACT(m.lcCell,[<t])
lcVal = STREXTRACT(m.lcVal,[">],[</t>])
ELSE
lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
ENDIF
IF EMPTY(m.lcVal)
lni = m.lni + 1
LOOP
ELSE
STORE .F. TO llBool,llMemo,llNumber,llDate,llTime
llBool = 't="b"' $ m.lcCell
llMemo = 't="s"' $ m.lcCell or [t="inlineStr] $ m.lcCell
llNumber = !llBool AND !llMemo AND not ('s="' $ m.lcCell)
STORE .F. TO llDate, llTime
IF !llBool AND !llMemo AND !llNumber
lnStyle = VAL(STREXTRACT(m.lcCell,[s="],["]))
IF SEEK(m.lnStyle,m.cCurStyle,"iIndex")
llDate = &cCurStyle..lDate and VAL(STREXTRACT(m.lcCell,[<v>],[</v>])) = FLOOR(VAL(STREXTRACT(m.lcCell,[<v>],[</v>])))
llTime = &cCurStyle..lDate and !llDate
llNumber = !llDate and !llTime
ENDIF
ENDIF
ENDIF
lcMySql0 = ''
FOR lnj = 1 TO m.lnField
lcMySql0 = m.lcMySql0 + laField[m.lnj,1] + ','
NEXT
lcMySql0 = RTRIM(m.lcMySql0,1,',')
lcMySql = ''
FOR lnj = 1 TO m.lni - 1
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcAlterCol = laField[m.lni,1]
IF laField[m.lni,2] == "D" AND m.llTime OR laField[m.lni,2] == "M" AND m.llTime AND m.laEmptyCells[m.lni]
laField[m.lni,2] = "T"
laEmptyCells[m.lni] = .F.
lcMySql = m.lcMySql + "CAST(" + m.laField[m.lni,1] + " AS T) AS " + m.laField[m.lni,1] + ","
FOR lnj = m.lni + 1 TO ALEN(laField,1)
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcMySql = RTRIM(m.lcMySql,1,',')
cCurSheet1 = SYS(2015)
CREATE CURSOR (m.cCurSheet1) FROM ARRAY laField
lcMySql = "INSERT INTO " + m.cCurSheet1 + "(" + m.lcMySql0 + ") SELECT " + m.lcMySql + " FROM " + m.cCurSheet
&lcMySql
USE IN (m.cCurSheet)
cCurSheet = m.cCurSheet1
GO BOTTOM IN (m.cCurSheet)
ELSE
IF laField[m.lni,2] == "M" AND m.llDate AND m.laEmptyCells[m.lni]
laField[m.lni,2] = "D"
laEmptyCells[m.lni] = .F.
lcMySql = m.lcMySql + "CAST(" + m.laField[m.lni,1] + " AS D) AS " + m.laField[m.lni,1] + ","
FOR lnj = m.lni + 1 TO ALEN(laField,1)
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcMySql = RTRIM(m.lcMySql,1,',')
cCurSheet1 = SYS(2015)
CREATE CURSOR (m.cCurSheet1) FROM ARRAY laField
lcMySql = "INSERT INTO " + m.cCurSheet1 + "(" + m.lcMySql0 + ") SELECT " + m.lcMySql + " FROM " + m.cCurSheet
&lcMySql
USE IN (m.cCurSheet)
cCurSheet = m.cCurSheet1
GO BOTTOM IN (m.cCurSheet)
ELSE
IF laField[m.lni,2] == "M" AND m.llBool AND m.laEmptyCells[m.lni]
laField[m.lni,2] = "L"
laEmptyCells[m.lni] = .F.
lcMySql = m.lcMySql + "CAST(" + m.laField[m.lni,1] + " AS L) AS " + m.laField[m.lni,1] + ","
FOR lnj = m.lni + 1 TO ALEN(laField,1)
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcMySql = RTRIM(m.lcMySql,1,',')
cCurSheet1 = SYS(2015)
CREATE CURSOR (m.cCurSheet1) FROM ARRAY laField
lcMySql = "INSERT INTO " + m.cCurSheet1 + "(" + m.lcMySql0 + ") SELECT " + m.lcMySql + " FROM " + m.cCurSheet
&lcMySql
USE IN (m.cCurSheet)
cCurSheet = m.cCurSheet1
GO BOTTOM IN (m.cCurSheet)
ELSE
IF laField[m.lni,2] == "M" AND m.llNumber AND m.laEmptyCells[m.lni]
laField[m.lni,2] = "B"
laField[m.lni,3] = 8
laField[m.lni,4] = 15
laEmptyCells[m.lni] = .F.
lcMySql = m.lcMySql + "CAST(" + m.laField[m.lni,1] + " AS B(15)) AS " + m.laField[m.lni,1] + ","
FOR lnj = m.lni + 1 TO ALEN(laField,1)
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcMySql = RTRIM(m.lcMySql,1,',')
cCurSheet1 = SYS(2015)
CREATE CURSOR (m.cCurSheet1) FROM ARRAY laField
lcMySql = "INSERT INTO " + m.cCurSheet1 + "(" + m.lcMySql0 + ") SELECT " + m.lcMySql + " FROM " + m.cCurSheet
&lcMySql
USE IN (m.cCurSheet)
cCurSheet = m.cCurSheet1
GO BOTTOM IN (m.cCurSheet)
ELSE
IF laField[m.lni,2] $ "BDT" AND m.llBool OR ;
laField[m.lni,2] $ "BDTL" AND m.llMemo OR ;
laField[m.lni,2] $ "DTL" AND m.llNumber OR ;
laField[m.lni,2] $ "BL" AND m.llDate OR ;
laField[m.lni,2] $ "BLD" AND m.llTime
laField[m.lni,2] = "M"
laField[m.lni,3] = 4
laField[m.lni,4] = 0
lcMySql = m.lcMySql + "CAST(" + m.laField[m.lni,1] + " AS M) AS " + m.laField[m.lni,1] + ","
FOR lnj = m.lni + 1 TO ALEN(laField,1)
lcMySql = m.lcMySql + laField[m.lnj,1] + ','
NEXT
lcMySql = RTRIM(m.lcMySql,1,',')
cCurSheet1 = SYS(2015)
CREATE CURSOR (m.cCurSheet1) FROM ARRAY laField
lcMySql = "INSERT INTO " + m.cCurSheet1 + "(" + m.lcMySql0 + ") SELECT " + m.lcMySql + " FROM " + m.cCurSheet
&lcMySql
USE IN (m.cCurSheet)
cCurSheet = m.cCurSheet1
GO TOP IN (m.cCurSheet)
CALCULATE MAX(LEN(ALLTRIM(&lcAlterCol))) TO m.laFieldPrec[m.lni,1] IN (m.cCurSheet)
GO TOP IN (m.cCurSheet)
CALCULATE MAX(OCCURS(CHR(13),&lcAlterCol)) TO m.laFieldPrec[m.lni,2] IN (m.cCurSheet)
GO BOTTOM IN (m.cCurSheet)
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
IF laField[m.lni,2] $ "CVM"
IF m.llMemo
IF "inlineStr" $ m.lcCell
laFieldGat[m.lni] = m.lcVal
ELSE
TRY
IF [t="s"] $ m.lcCell
SELECT (m.cCurStr)
GO VAL(m.lcVal) + 1 IN (m.cCurStr)
laFieldGat[m.lni] = cStr
ELSE
laFieldGat[m.lni] = m.lcVal
ENDIF
CATCH TO loErr
laFieldGat[m.lni] = m.lcVal
ENDTRY
ENDIF
ELSE
IF m.llNumber
laFieldGat[m.lni] = m.lcVal
ELSE
IF m.llDate
lnDat = VAL(m.lcVal)
IF m.lnDat >= 61
laFieldGat[m.lni] = TRANSFORM(m.ldDat01 + m.lnDat)
ELSE
laFieldGat[m.lni] = TRANSFORM(m.ldDat02 + m.lnDat)
ENDIF
ELSE
IF m.llTime
lnTim = VAL(m.lcVal)
lnDat = FLOOR(m.lnTim)
laFieldGat[m.lni] = TRANSFORM(DTOT(m.ldDat01 + m.lnDat) + INT(86400.0 * (m.lnTim - m.lnDat)))
ELSE && m.llBool
laFieldGat[m.lni] = IIF(m.lcVal == "1",'.T.','.F.')
ENDIF
ENDIF
ENDIF
ENDIF
laFieldPrec[m.lni,1] = MAX(laFieldPrec[m.lni,1],LEN(laFieldGat[m.lni]))
laFieldPrec[m.lni,2] = MAX(laFieldPrec[m.lni,2],OCCURS(CHR(13),laFieldGat[m.lni]))
ELSE
IF laField[m.lni,2] $ "NFBYI"
laFieldGat[m.lni] = VAL(m.lcVal)
laFieldPrec[m.lni,1] = MAX(laFieldPrec[m.lni,1],LEN(ALLTRIM(m.lcVal)))
IF AT(m.lcPoint,ALLTRIM(m.lcVal)) > 0
laFieldPrec[m.lni,2] = MAX(laFieldPrec[m.lni,2],LEN(ALLTRIM(m.lcVal)) - AT(m.lcPoint,ALLTRIM(m.lcVal)))
ENDIF
ELSE
IF laField[m.lni,2] == "D"
lnDat = VAL(m.lcVal)
IF m.lnDat >= 61
laFieldGat[m.lni] = m.ldDat01 + m.lnDat
ELSE
laFieldGat[m.lni] = m.ldDat02 + m.lnDat
ENDIF
ELSE
IF laField[m.lni,2] == "T"
lnTim = VAL(m.lcVal)
lnDat = FLOOR(m.lnTim)
laFieldGat[m.lni] = DTOT(m.ldDat01 + m.lnDat) + INT(86400.0 * (m.lnTim - m.lnDat))
ELSE
IF laField[m.lni,2] $ "L"
laFieldGat[m.lni] = m.lcVal == "1"
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
* NEXT
lni = m.lni + 1
ENDDO
SELECT (m.cCurSheet)
GATHER FROM laFieldGat MEMO
ELSE
lcMemo = m.lcMemo + m.lcBuff
EXIT
ENDIF
ENDDO
ENDIF
ELSE
MESSAGEBOX(ERRMESS4,16,'Error')
ENDIF
FCLOSE(m.lnF)
SET DECIMALS TO &lcSetDec
lcSql = "LPARAMETERS lcTable" + CHR(13) + "INSERT INTO (m.lcTable) SELECT "
FOR lni = 1 TO lnField
IF laField[m.lni,2] == "M" AND BETWEEN(laFieldPrec[m.lni,1],1,254) AND laFieldPrec[m.lni,2] = 0
laField[m.lni,2] = "C"
laField[m.lni,3] = laFieldPrec[m.lni,1]
lcSql = m.lcSql + "LEFT(" + laField[m.lni,1] + "," + TRANSFORM(laFieldPrec[m.lni,1]) + ") AS " + laField[m.lni,1] + ","
ELSE
lcSql = m.lcSql + laField[m.lni,1] + ","
IF laField[m.lni,2] == "B" AND BETWEEN(laFieldPrec[m.lni,1],1,20)
IF laFieldPrec[m.lni,2] = 0 AND BETWEEN(laFieldPrec[m.lni,1],1,9)
laField[m.lni,2] = "I"
laField[m.lni,3] = 4
laField[m.lni,4] = 0
ELSE
laField[m.lni,2] = "N"
laField[m.lni,3] = laFieldPrec[m.lni,1]
laField[m.lni,4] = laFieldPrec[m.lni,2]
ENDIF
ELSE
ENDIF
ENDIF
NEXT
IF m.llCursor
*lcTable = SYS(2015) && CHRTRAN(JUSTSTEM(m.lcTable)," ","_")
CREATE CURSOR (m.lcTable) FROM ARRAY laField
lcSql = LEFT(m.lcSql,LEN(m.lcSql) - 1) + " FROM " + m.cCurSheet
EXECSCRIPT(m.lcSql,m.lcTable)
ELSE
CREATE TABLE (m.lcTable) FREE FROM ARRAY laField
lcSql = LEFT(m.lcSql,LEN(m.lcSql) - 1) + " FROM " + m.cCurSheet + CHR(13) + "RETURN ALIAS()"
USE IN (EXECSCRIPT(m.lcSql,m.lcTable))
ENDIF
USE IN (m.cCurSheet)
RETURN m.lcTable
**********************
* Special characters *
**********************
FUNCTION htmspec
LPARAMETERS cStr
LOCAL lni,lcStrF,lcChar,lnChar
lcStrF = m.cStr
IF AT('&gt;',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'&gt;','>')
ENDIF
IF AT('&lt;',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'&lt;','<')
ENDIF
IF AT('&quot;',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'&quot;','"')
ENDIF
IF AT("&apos;",m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'&apos;',"'")
ENDIF
IF AT([&#],m.lcStrF)>0
FOR lnChar = 0 TO 255
lcChar = [&#]+STR(m.lnChar,3)+[;]
IF AT(m.lcChar,m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,m.lcChar,CHR(lnChar))
ENDIF
NEXT
ENDIF
IF AT([&#x],m.lcStrF)>0
FOR lnChar = 0 TO 255
lcChar = [&#x]+RIGHT(TRANSFORM(m.lnChar,"@0"),2)+[;]
IF AT(m.lcChar,m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,m.lcChar,CHR(lnChar))
ENDIF
NEXT
ENDIF
IF AT('&amp;',m.lcStrF)>0
lcStrF = STRTRAN(m.lcStrF,'&amp;',CHR(38))
ENDIF
* suggested by Koen Piller
lcStrF = STRCONV(m.lcStrF,11)
RETURN m.lcStrF
ENDFUNC
*****************
* Cleanup
******************
FUNCTION cleanup
LPARAMETERS lcDir,llServer
LOCAL lcZip,lcSetSaf,loErr as Exception
lcZip = FORCEEXT(m.lcDir,'zip')
lcSetSaf = SET("Safety")
SET SAFETY OFF
TRY
IF m.llServer
ERASE (ADDBS(ADDBS(m.lcDir)+'worksheets\_rels')+'*.*')
RD (ADDBS(m.lcDir)+'worksheets\_rels'))
ERASE (ADDBS(ADDBS(m.lcDir)+'worksheets')+'*.*')
RD (ADDBS(m.lcDir)+'worksheets'))
ENDIF
ERASE (ADDBS(m.lcDir)+'*.*')
RD (m.lcDir)
CATCH TO loErr
THROW m.loErr
ENDTRY
ERASE (m.lcZip)
SET SAFETY &lcSetSaf
RETURN .T.
*****************
* Read workbook *
*****************
FUNCTION get_sheet
LPARAMETERS lcStr,lcSheet
LOCAL lnF,lcRealSheet,lcBuff,lcMemo,lni,lcRealSheet,lcCurSheet
lnF = FOPEN(m.lcStr)
lcRealSheet = ''
IF m.lnF >= 0
lcBuff = FREAD(m.lnf,8192)
lcMemo = STREXTRACT(m.lcBuff,[<sheets>],[</sheets>])
IF VARTYPE(m.lcSheet) == "N"
IF BETWEEN(m.lcSheet,1,OCCURS([name="],m.lcMemo))
lcRealSheet = 'sheet' + LTRIM(STR(m.lcSheet))
ENDIF
ELSE
IF EMPTY(m.lcSheet)
lcRealSheet = 'sheet1'
ELSE
FOR lni = 1 TO OCCURS([name="],m.lcMemo)
lcCurSheet = STREXTRACT(m.lcMemo,[name="],["],m.lni)
IF LOWER(ALLTRIM(m.lcCurSheet)) == LOWER(ALLTRIM(m.lcSheet))
lcRealSheet = 'sheet' + TRANSFORM(m.lni)
EXIT
ENDIF
NEXT
ENDIF
ENDIF
ELSE
MESSAGEBOX(ERRMESS4 + ' workbook.xml',16,'Error')
ENDIF
FCLOSE(m.lnF)
RETURN m.lcRealSheet
Reference in New Issue View Git Blame Copy Permalink