635 lines
18 KiB
Plaintext
635 lines
18 KiB
Plaintext
* Version 5.0
|
|
* Support for inline strings
|
|
LPARAMETERS lcFileName,cCur,lcFFields,lnStartRows,lcSheet,llEmptyCells
|
|
* Parameters
|
|
* lcFileName name of the xlsx
|
|
* nom de xlsx
|
|
* numele xlsx-ului
|
|
* cCur name of the table / cursor ; optional ; default ALIAS()
|
|
* lcFFields list of fields to be outputed ; optional ; default all fields
|
|
* 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 ''
|
|
* 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.
|
|
DECLARE Sleep IN WIN32API INTEGER
|
|
DECLARE INTEGER ShellExecute IN shell32.dll INTEGER , STRING , STRING , STRING , STRING , INTEGER
|
|
#DEFINE ERRLANG "En"
|
|
#IF ERRLANG = "Ro"
|
|
#DEFINE ERRMESS0 "Eroare"
|
|
#DEFINE ERRMESS1 "Nimic de importat"
|
|
#DEFINE ERRMESS2 "Deschideti, va rog, tabelul / cursorul"
|
|
#DEFINE ERRMESS3 "Foaie inexistenta"
|
|
#DEFINE ERRMESS4 "Eroare la deschiderea"
|
|
#ELIF ERRLANG = "Fr"
|
|
#DEFINE ERRMESS0 "Erreur"
|
|
#DEFINE ERRMESS1 "Rien a ajouter"
|
|
#DEFINE ERRMESS2 "S'il vous plaît ouvrir la table / curseur"
|
|
#DEFINE ERRMESS3 "Feuille introuvable"
|
|
#DEFINE ERRMESS4 "Erreur d'ouverture"
|
|
#ELIF ERRLANG = "Nl" && Koen Piller
|
|
#DEFINE ERRMESS0 "Fout"
|
|
#DEFINE ERRMESS1 "Niets te importeren"
|
|
#DEFINE ERRMESS2 "Open s.v.p. tabel / cursor"
|
|
#DEFINE ERRMESS3 "Blad niet gevonden"
|
|
#DEFINE ERRMESS4 "Fout bij openen"
|
|
#ELSE
|
|
#DEFINE ERRMESS0 "Error"
|
|
#DEFINE ERRMESS1 "Nothing to append"
|
|
#DEFINE ERRMESS2 "Please open table / cursor"
|
|
#DEFINE ERRMESS3 "Sheet not found"
|
|
#DEFINE ERRMESS4 "Error opening"
|
|
#ENDIF
|
|
***************************************************************
|
|
* If you prefer to extract files with Winrar, uncomment this
|
|
***************************************************************
|
|
*#DEFINE archiveWinRar .T.
|
|
|
|
|
|
LOCAL lcDir,cCurStr,cCurSheet,lSetTalk,lnFFields,laFFields[1],lnColsNoAll,laFieldsAll[1],lnColsNo,laFields[1],lnCurCol,llMemos,llChars,lnSelect
|
|
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
|
|
IF VARTYPE(m.cCur) $ "CV"
|
|
IF USED(m.cCur)
|
|
SELECT (m.cCur)
|
|
ELSE
|
|
MESSAGEBOX(ERRMESS2,16,ERRMESS0)
|
|
RETURN
|
|
ENDIF
|
|
ELSE
|
|
cCur = ALIAS()
|
|
ENDIF
|
|
ELSE
|
|
cCur = ALIAS()
|
|
ENDIF
|
|
IF PCOUNT()<3
|
|
lcFFields = ""
|
|
ELSE
|
|
IF VARTYPE(m.lcFFields) <> "C"
|
|
lcFFields = ""
|
|
ELSE
|
|
lnFFields = ALINES(laFFields,m.lcFFields,1+4,",")
|
|
ENDIF
|
|
ENDIF
|
|
IF PCOUNT() < 4
|
|
lnStartRows = 1
|
|
ELSE
|
|
IF VARTYPE(m.lnStartRows) <> "N"
|
|
lnStartRows = 1
|
|
ENDIF
|
|
ENDIF
|
|
IF PCOUNT()<5
|
|
lcSheet = ""
|
|
ELSE
|
|
IF NOT (VARTYPE(m.lcSheet) $ "CN")
|
|
lcSheet = ""
|
|
ENDIF
|
|
ENDIF
|
|
|
|
lSetTalk = SET("Talk")
|
|
SET TALK OFF
|
|
lnColsNoAll = AFIELDS(m.laFieldsAll,m.cCur)
|
|
STORE .F. TO llChars,llMemos
|
|
lnColsNo = 0
|
|
FOR lnCurCol = 1 TO m.lnColsNoAll
|
|
IF m.laFieldsAll[m.lnCurCol,2] $ "NFYBIDTLCVM"
|
|
IF !EMPTY(m.lcFFields)
|
|
IF ASCAN(m.laFFields,laFieldsAll[m.lnCurCol,1],1,-1,-1,1+2+4)=0
|
|
LOOP
|
|
ENDIF
|
|
ENDIF
|
|
lnColsNo = m.lnColsNo + 1
|
|
DIMENSION laFields[m.lnColsNo,3]
|
|
laFields[m.lnColsNo,1] = laFieldsAll[m.lnCurCol,1]
|
|
laFields[m.lnColsNo,2] = laFieldsAll[m.lnCurCol,2]
|
|
laFields[m.lnColsNo,3] = m.lnCurCol
|
|
IF laFields[m.lnColsNo,2] == "M"
|
|
llMemos = .T.
|
|
ENDIF
|
|
IF laFields[m.lnColsNo,2] $ "MCV"
|
|
llChars = .T.
|
|
ENDIF
|
|
ELSE
|
|
LOOP
|
|
ENDIF
|
|
NEXT
|
|
lcDir = extract(m.lcFileName)
|
|
|
|
lcSheet = get_sheet(ADDBS(m.lcDir) + "workbook.xml",m.lcSheet)
|
|
IF EMPTY(m.lcSheet)
|
|
MESSAGEBOX(ERRMESS3,16,'Error')
|
|
cleanup(m.lcDir)
|
|
SET TALK &lSetTalk
|
|
SELECT (m.lnSelect)
|
|
RETURN m.lcDBF
|
|
ENDIF
|
|
|
|
IF ADIR(laFiles,ADDBS(m.lcDir) + "sharedStrings.xml") = 0
|
|
llChars = .F.
|
|
ENDIF
|
|
IF m.llChars
|
|
cCurStr = get_strings(ADDBS(m.lcDir) + "sharedStrings.xml",m.llMemos)
|
|
IF EMPTY(m.cCurStr)
|
|
cleanup(m.lcDir)
|
|
SET TALK &lSetTalk
|
|
SELECT (m.lnSelect)
|
|
IF USED(m.cCurStr)
|
|
USE IN (m.cCurStr)
|
|
ENDIF
|
|
RETURN .F.
|
|
ENDIF
|
|
ELSE
|
|
cCurStr = ''
|
|
ENDIF
|
|
|
|
cCurSheet = get_cells(ADDBS(m.lcDir) + FORCEEXT(m.lcSheet,"xml"),m.cCur,m.cCurStr,@laFields,m.lnStartRows,m.llEmptyCells)
|
|
cleanup(m.lcDir)
|
|
SET TALK &lSetTalk
|
|
SELECT (m.lnSelect)
|
|
IF USED(m.cCurStr)
|
|
USE IN (m.cCurStr)
|
|
ENDIF
|
|
RETURN .T.
|
|
|
|
*********************
|
|
* Extract xml files *
|
|
*********************
|
|
FUNCTION extract
|
|
LPARAMETERS lcFileName
|
|
LOCAL lcDir,lcZip,oShell,ofile,loErr as Exception,lcSetSaf,lni,lnFF,llRetry,laDir[1],lnDir,lnDir0, lcFileName
|
|
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
|
|
ENDIF
|
|
FCLOSE(m.lnFF)
|
|
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\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
|
|
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
|
|
CATCH TO loErr
|
|
ENDTRY
|
|
#ENDIF
|
|
RETURN lcDir
|
|
|
|
****************
|
|
* Read strings *
|
|
****************
|
|
FUNCTION get_strings
|
|
LPARAMETERS lcStr,llMemos
|
|
LOCAL cCurStr,lnF,lnPosSiSeek,lcBuff,lnPosSi,lnPosSi2,lcMemo,lcReturn,lnTextPiece,lnTextPiece2,lcTextPiece,lcVal
|
|
STORE SYS(2015) TO lcReturn, cCurStr
|
|
IF m.llMemos
|
|
CREATE CURSOR (m.cCurStr) (cStr M)
|
|
ELSE
|
|
CREATE CURSOR (m.cCurStr) (cStr c(254))
|
|
ENDIF
|
|
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 = m.lcBuff && ''
|
|
DO WHILE !FEOF(m.lnF) AND m.lnPosSi2 = 0
|
|
lcBuff = FREAD(m.lnF,8192)
|
|
lnPosSi2 = AT('</si>',m.lcMemo)
|
|
lcMemo = m.lcMemo + m.lcBuff
|
|
ENDDO
|
|
|
|
IF FEOF(m.lnF) AND m.lnPosSi2 = 0
|
|
lnPosSi2 = AT('</si>',m.lcMemo)
|
|
ENDIF
|
|
|
|
|
|
IF m.lnPosSi2 != 0
|
|
|
|
* lcMemo = m.lcMemo + LEFT(m.lcBuff,m.lnPosSi2 - 1)
|
|
lcMemo = LEFT(m.lcMemo,m.lnPosSi2 - 1)
|
|
lnPosSiSeek = m.lnPosSiSeek + m.lnPosSi2 + 4
|
|
lnPosSi = FSEEK(m.lnF,m.lnPosSiSeek)
|
|
lcVal = ""
|
|
STORE 1 TO lnTextPiece, lnTextPiece2
|
|
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 sheet *
|
|
**************
|
|
FUNCTION get_cells
|
|
LPARAMETERS lcStr,cCurSheet,cCurStr,laField,lnStartRows,llEmptyCells
|
|
LOCAL cCurSheet,lnField,ldDat01,ldDat02,lcSetDec,lcReturn,lnF,lnPosSiSeek,lcBuff,lnPosSi,lnPosSi2,lcMemo,laFieldGat[1],lni,lcCell,lcVal,lnDat,lnTim,lnCurRow,lnCurRow0,lnStartRows0,lcWholeRow,lcWholeTable
|
|
LOCAL lnFirstCol,lnShCol,lnRealI
|
|
LOCAL llEmptyVal,lcEmptyval,lala[1]
|
|
lcWholeTable = FILETOSTR(m.lcStr)
|
|
lnCurRow = 1 &&m.lnStartRows
|
|
lnCurRow0 = 1
|
|
lnStartRows0 = lnStartRows
|
|
**************
|
|
lcWholeRow = STREXTRACT(m.lcWholeTable,"<row ","</row>")
|
|
IF EMPTY(m.lcWholeRow)
|
|
MESSAGEBOX(ERRMESS1,16,ERRMESS0)
|
|
RETURN ''
|
|
ENDIF
|
|
|
|
lnField = 1
|
|
lcCell = STREXTRACT(m.lcWholeRow,[<c ],[</c>],m.lnField)
|
|
IF '"inlineStr' $ m.lcCell
|
|
lcEmptyval = STREXTRACT(m.lcCell,[<t],[</t>])
|
|
IF LEFT(m.lcEmptyval,1) = ">"
|
|
lcEmptyval = EMPTY(STREXTRACT(m.lcCell,[<t>],[</t>]))
|
|
ELSE
|
|
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
|
|
ENDIF
|
|
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 '"inlineStr' $ m.lcCell
|
|
lcEmptyval = STREXTRACT(m.lcCell,[<t],[</t>])
|
|
IF LEFT(m.lcEmptyval,1) = ">"
|
|
lcEmptyval = EMPTY(STREXTRACT(m.lcCell,[<t>],[</t>]))
|
|
ELSE
|
|
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<t],[</t>]))
|
|
ENDIF
|
|
ELSE
|
|
llEmptyVal = EMPTY(STREXTRACT(m.lcCell,[<v>],[</v>]))
|
|
ENDIF
|
|
ENDDO
|
|
lnStartRows = lnCurRow0
|
|
lnField = ALEN(laField,1)
|
|
ldDat01 = DATE(1900,3,1) - 61
|
|
ldDat02 = DATE(1900,1,1) - 1
|
|
lcSetDec = SET("Decimals")
|
|
lnFirstCol = 0
|
|
SET DECIMALS TO 10
|
|
lcReturn = ''
|
|
lnF = FOPEN(m.lcStr)
|
|
lnCurRow = 0
|
|
IF m.lnF >= 0
|
|
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
|
|
lnRealI = 1
|
|
FOR lni = 1 TO lnField
|
|
lcCell = STREXTRACT(m.lcMemo,[<c ],[</c>],m.lnRealI)
|
|
IF AT([<c ],m.lcCell) > 0
|
|
lcCell = LEFT(m.lcCell , AT([<c ],m.lcCell) - 1)
|
|
ENDIF
|
|
|
|
IF m.llEmptyCells
|
|
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
|
|
IF lni < m.lnShCol
|
|
lni = m.lnShCol
|
|
ENDIF
|
|
*!* IF m.lni = 1 AND m.lnCurRow = m.lnStartRows
|
|
*!* lnFirstCol = m.lnShCol
|
|
*!* ENDIF
|
|
IF m.lni > m.lnField
|
|
SELECT (m.cCurSheet)
|
|
GATHER FROM laFieldGat MEMO
|
|
EXIT
|
|
ENDIF
|
|
ENDIF
|
|
|
|
IF '"inlineStr' $ m.lcCell
|
|
lcVal = STREXTRACT(m.lcCell,[<t])
|
|
IF LEFT(m.lcVal,1) = ">"
|
|
lcVal = STREXTRACT(m.lcVal,[>],[</t>])
|
|
ELSE
|
|
lcVal = STREXTRACT(m.lcVal,[">],[</t>])
|
|
ENDIF
|
|
ELSE
|
|
lcVal = STREXTRACT(m.lcCell,[<v>],[</v>])
|
|
ENDIF
|
|
|
|
lnRealI = m.lnRealI + 1
|
|
IF EMPTY(m.lcVal)
|
|
LOOP
|
|
ENDIF
|
|
IF laField[m.lni,2] $ "CVM"
|
|
IF [t="inlineStr] $ m.lcCell or EMPTY(m.cCurStr)
|
|
laFieldGat[m.lni] = m.lcVal
|
|
ELSE
|
|
SELECT (m.cCurStr)
|
|
TRY
|
|
IF [t="s"] $ m.lcCell
|
|
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 laField[m.lni,2] $ "NFBYI"
|
|
IF [t="inlineStr] $ m.lcCell or EMPTY(m.cCurStr)
|
|
laFieldGat[m.lni] = m.lcVal
|
|
ELSE
|
|
TRY
|
|
IF [t="s"] $ m.lcCell
|
|
GO VAL(m.lcVal) + 1 IN (m.cCurStr)
|
|
laFieldGat[m.lni] = VAL(cStr)
|
|
ELSE
|
|
laFieldGat[laField[m.lni,3]] = VAL(m.lcVal)
|
|
ENDIF
|
|
CATCH TO loErr
|
|
laFieldGat[m.lni] = m.lcVal
|
|
ENDTRY
|
|
ENDIF
|
|
ELSE
|
|
IF laField[m.lni,2] $ "D"
|
|
lnDat = VAL(m.lcVal)
|
|
IF [t="inlineStr] $ m.lcCell and ALINES(lala,m.lcVal,0,'-','.',' ','/',':') > 1
|
|
laFieldGat[laField[m.lni,3]] = CTOD(m.lcVal)
|
|
ELSE
|
|
IF m.lnDat >= 61
|
|
laFieldGat[laField[m.lni,3]] = m.ldDat01 + m.lnDat
|
|
ELSE
|
|
laFieldGat[laField[m.lni,3]] = m.ldDat02 + m.lnDat
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
IF laField[m.lni,2] $ "T"
|
|
lnTim = VAL(m.lcVal)
|
|
IF [t="inlineStr] $ m.lcCell and ALINES(lala,m.lcVal,0,'-','.',' ','/',':') > 1
|
|
laFieldGat[laField[m.lni,3]] = CTOT(m.lcVal)
|
|
ELSE
|
|
lnDat = FLOOR(m.lnTim)
|
|
laFieldGat[laField[m.lni,3]] = DTOT(m.ldDat01 + m.lnDat) + INT(86400.0 * (m.lnTim - m.lnDat))
|
|
ENDIF
|
|
ELSE
|
|
IF laField[m.lni,2] $ "L"
|
|
laFieldGat[laField[m.lni,3]] = 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
|
|
lcReturn = m.cCurSheet
|
|
ELSE
|
|
MESSAGEBOX(ERRMESS4,16,'Error')
|
|
ENDIF
|
|
FCLOSE(m.lnF)
|
|
SET DECIMALS TO &lcSetDec
|
|
RETURN m.lcReturn
|
|
|
|
**********************
|
|
* Special characters *
|
|
**********************
|
|
FUNCTION htmspec
|
|
LPARAMETERS cStr
|
|
LOCAL lni,lcStrF,lcChar,lnChar
|
|
lcStrF = m.cStr
|
|
IF AT('>',m.lcStrF)>0
|
|
lcStrF = STRTRAN(m.lcStrF,'>','>')
|
|
ENDIF
|
|
IF AT('<',m.lcStrF)>0
|
|
lcStrF = STRTRAN(m.lcStrF,'<','<')
|
|
ENDIF
|
|
IF AT('"',m.lcStrF)>0
|
|
lcStrF = STRTRAN(m.lcStrF,'"','"')
|
|
ENDIF
|
|
IF AT("'",m.lcStrF)>0
|
|
lcStrF = STRTRAN(m.lcStrF,''',"'")
|
|
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('&',m.lcStrF)>0
|
|
lcStrF = STRTRAN(m.lcStrF,'&',CHR(38))
|
|
ENDIF
|
|
|
|
* suggested by Koen Piller
|
|
lcStrF = STRCONV(m.lcStrF,11)
|
|
RETURN m.lcStrF
|
|
ENDFUNC
|
|
|
|
*****************
|
|
* Cleanup
|
|
******************
|
|
FUNCTION cleanup
|
|
LPARAMETERS lcDir
|
|
LOCAL lcZip,lcSetSaf
|
|
lcZip = FORCEEXT(m.lcDir,'zip')
|
|
lcSetSaf = SET("Safety")
|
|
SET SAFETY OFF
|
|
TRY
|
|
ERASE (ADDBS(m.lcDir)+'*.*')
|
|
RD (m.lcDir)
|
|
CATCH TO 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
|