CSV IMPORT PART II

EXAMPLE:
aa=[abc,"22""Taxi",hello kitty,",","ord"]
?chk_csvfld(aa)

Result:
5

afld[1]=”abc”
afld[2]=”22”Taxi”
afld[3]=”hello kitty”
afld[4]=”,”
afld[5]=”ord”

*green 2010/5/26
FUNCTION chk_csvfld
Lparameters p_str
LOCAL fldnum
*if start is not " then find ,
*if start is " then find ",
*依傳入之字串分解欄位,傳回欄位數
fldnum=0
*Start ....
p_str=ALLTRIM(p_str) &&去除前後空白
is_end=.F.
DO WHILE !is_end
    *->由左向右找
    *         1         2
    *12345678901234567890
    *This,is,a,Book   
    *"This","is","a","book"
    fld_end=IIF(LEFT(p_str,1)='"','"','')+"," &&欄位結尾 若第一個字為["],則欄位結尾為[",] 若為空白,則為[,]
    endpos=ATC(fld_end,p_str) &&注意,第一個字元不可包含在serach裏,以免重覆找到同一組字元,例如[",",Orz]應得3,但會得1
    IF endpos=1 &&若找到第一個,則往下找第2個
        endpos=ATC(fld_end,p_str,2)
    ENDIF
    *
    IF endpos=0 &&找不到啦-表示為最後一欄  
        wfld=SUBSTR(p_str,LEN(fld_end),len(p_str)-len(fld_end)+(2-len(fld_end))) 
        p_str=''
        is_end=.T.   
    ELSE
        wfld=SUBSTR(p_str,LEN(fld_end),endpos-LEN(fld_end))
        p_str=SUBSTR(p_str,endpos+LEN(fld_end))   
    ENDIF
    fldnum=fldnum+1
    DIMENSION afld[fldnum]
    afld[fldnum]=STRTRAN(wfld,[""],["])    &&置換Escape String [""] -> ["]   
ENDDO
*
RETURN fldnum
ENDFUNC

*2010/5/26 by Green

PS:
本示範函式可正確轉換約98%的CSV檔

若您需要100%CSV轉檔程式,可洽我的email:greencwi@gmail.com,可轉MSSQL,DBF…等
當然這部分是需要費用的,謝謝您

CSV IMPORT

自己寫的CSV IMPORT
取代FOXPRO 之 Append From xxx.CSV TYPE CSV
原因:使用內建之IMPORT指令,會出現line is too long (列過長)之錯誤

注意:本版本無法辨識由EXCEL轉存之 CSV 檔

可辨識的格式為: “abc”,”123”,”we”…. 所有欄位皆以””包括

*green 2010/05/23
*傳入cvs檔案,轉換存入cAlias,錯誤記錄轉入cCSVErrFile
*傳回轉換筆數
Function CSVTRAN2
    Lparameters cCSVfile,cAlias,cCSVErrFile
    Local handle, lcCommand,esckey,nRecord
    If !File(cCSVfile)
        Return .F.
    Endif
    handle = Fopen(cCSVfile)
    If handle <=0
        Return .F.
    Endif
    *
    Fseek(m.handle,0) && Go Top
    nRecord=0
    nn=0
    rec1pos=0
    rr=0
    Do While !Feof(m.handle)
        *!*            esckey=Inkey()
        *!*            If esckey=27
        *!*                Cancel
        *!*            Endif
        lcCommand = Fread(m.handle, 8192)
        haveRecEnd=Occurs(Chr(10),lcCommand)
        If haveRecEnd>0
            ii=1
            Do While ii<=haveRecEnd
                If ii>1
                    rec1pos=Atc(Chr(10),lcCommand,ii-1)
                Else
                    rec1pos=0
                Endif
                rec2pos=Atc(Chr(10),lcCommand,ii)
                rr=rr+1
                Dimension RecStr[rr]
                RecStr[rr]=Substr(lcCommand,rec1pos+1,rec2pos-rec1pos)
                nn=nn+1
                If nn=1
                    *記錄結尾
                    Wait '匯入中-'+cCSVfile+':'+Str(nRecord) Windows Nowait
                    pstr=''
                    For jj=1 To rr
                        pstr=pstr+RecStr[jj]
                    Next jj
                    *大於最大限制
                    *nRecord=nRecord+1
                    *IF ck_fld(cAlias,pstr,cCSVErrFile,nRecord)    &&填入值
                    IF ck_csvfld(cAlias,pstr,cCSVErrFile,nRecord)    &&填入值
                        nRecord=nRecord+1
                    Endif
                    nn=0
                    rr=0
                Endif
                ii=ii+1
            Enddo
            *
            lastPOS=Ratc(Chr(10),lcCommand,1)
            rr=rr+1
            Dimension RecStr[rr]
            RecStr[rr]=Substr(lcCommand,lastPOS+1) &&取最後段之字串
        Else
            *一定大於8192
            rr=rr+1
            Dimension RecStr[rr]
            RecStr[rr]=lcCommand
        Endif
    Enddo
    Fclose(m.handle)
    Wait Clear
    Return nRecord
ENDFUNC

*Green 2010/5/23
*CSVTRAN的子程式,分解單筆CSV記錄(p_str),存入cAlias
Function ck_fld
    Lparameters cAlias,p_str,cCSVErrFile,nRecord
    is_Debug=.F.
    *IF nRecord>=6568   
    *    SET STEP ON
    *ENDIF    
    op_str=p_str
    *先清空
    p_str='(start)'+ALLTRIM(STRTRAN(p_str,CHR(10),[]))+'(End)'   
    *先替換原內含欄分隔字元[',']為[(NotFldDiv)]   
    p_str=STRTRAN(p_str,[','],[(NotFldDiv)])
*-----------------------------------------------------------樣版替換(注意:有先後順序)
    *1. [,"""] --> [,"(->Inch<-)]
    DO WHILE !Occurs([,""","],p_str)=0
        p_str=STRTRAN(p_str,[,""","],[,(->Inch<-)","])
    ENDDO       
    DO WHILE !Occurs([,"""],p_str)=0
        p_str=STRTRAN(p_str,[,"""],[,"(->Inch<-)])
    ENDDO
    *2. [""",] --> [(->Inch<-)",]
    DO WHILE !Occurs([""",],p_str)=0
        p_str=STRTRAN(p_str,[""",],[(->Inch<-)",])
    ENDDO   
*-----------------------------------------------------------樣版替換(注意:有先後順序)
    *3. [,"",] --> [,'',]
    DO WHILE !Occurs([,"",],p_str)=0
        p_str=STRTRAN(p_str,[,"",],[,'',])
    ENDDO
    *4start and end
    p_str=STRTRAN(p_str,[(start)"",],[(start)'',])
    p_str=STRTRAN(p_str,[,""(End)],[,''(End)])
    p_str=STRTRAN(p_str,[(start)],[])
    p_str=STRTRAN(p_str,[(End)],[])   
    *5. [""] --> [(->Inch<-)]
    DO WHILE !Occurs([""],p_str)=0
        p_str=STRTRAN(p_str,[""],[(->Inch<-)])
    ENDDO   
    *6. ["]--> [']
    p_str=STRTRAN(p_str,["],['])   
    *7. [(->Inch<-)] --> ["]
    p_str=STRTRAN(p_str,[(->Inch<-)],["])
    *8.修正錯誤
    p_str=STRTRAN(p_str,[',',','],[','.','])
    *9. FIND [',']
    Fldnum=Occurs([','],p_str)
    *Fldnum=Occurs('","',p_str)
    *p_str=STRTRAN(p_str,'",",","','",".","')
    *取得各欄
    If Fcount(cAlias)=Fldnum+1
        Select (cAlias)
        Append Blank
        For fnum=1 To Fldnum+1
            If fnum>1
                *fld1pos=Atc('","',p_str,fnum-1)+1
                fld1pos=Atc([','],p_str,fnum-1)+1
            Else
                fld1pos=0
            Endif
            *fld2pos=Atc('","',p_str,fnum)
            fld2pos=Atc([','],p_str,fnum)
            fldna = Fields[fnum]
            Select IMPORT_TMP
            If fld2pos=0
                wfldna = Substr(p_str,fld1pos+2,Len(p_str)-fld1pos-3)
                wfldna = STRTRAN(wfldna,[(NotFldDiv)],[',']) &&還原
            Else
                wfldna = Substr(p_str,fld1pos+2,fld2pos-fld1pos-2)
                wfldna = STRTRAN(wfldna,[(NotFldDiv)],[','])    &&還原
            Endif
            Replace &fldna With wfldna
            *            Fwrite(gnErrFile ,'['+STR(fnum)+']'+wfldna+CHR(10))
        Next
    Else
        *? 'Field Count Error'
        IF !EMPTY(cCSVErrFile)
            If File(cCSVErrFile)  && 檔案是否存在？
                gnErrFile = Fopen(cCSVErrFile,12)     && 如果存在，以讀寫方式開啟
            Else
                gnErrFile = Fcreate(cCSVErrFile)  && 如果不存在，就建立它
            ENDIF
            FSEEK(gnErrFile ,0,2) && 移至檔尾
            If gnErrFile < 0      && 檢查開啟檔案錯誤
                Wait '不能開啟或建立輸出檔案' Window
            ELSE
                *Fwrite(gnErrFile,'['+STR(nRecord)+']'+p_str)
                Fwrite(gnErrFile,op_str)
                IF is_Debug
                    Fwrite(gnErrFile,p_str)
                ENDIF    
                FCLOSE(gnErrFile)
            ENDIF
        ENDIF    
        RETURN .F.
    ENDIF
    RETURN .T.
Endfunc

*Green 2010/05/23
*傳入CSV,計算筆數
Function CSVRECCOUNT
    Lparameters cCSVfile
    Local handle,nRet
    If !File(cCSVfile)
        Return .F.
    Endif
    handle = Fopen(cCSVfile)
    If handle <=0
        Return .F.
    Endif
    *
    Fseek(m.handle,0) && Go Top
    nRet=0
    Do While !Feof(handle)
        nRet=nRet+Occurs(Chr(10),Fread(handle,8192))
    Enddo
    Fclose(handle)
    Return nRet
Endfunc

*Green 2010/05/23
*傳入CSV,計算筆數 (2) 另一方式計算CSV筆數
Function CSVRECCOUNT2
    Lparameters cCSVfile 
    cFile = FILETOSTR(cCSVfile)
    nLines = ALINES(aFile,cFile)
    Return nLines
EndFunc

如何檢查檔案是否為正確的DBF檔

在開發系統時,可能會有需求於作業時匯入DBF檔,但如何判斷使用者選擇的檔案是否為正確的DBF檔?
這裏提供我函式庫裏的一個函式給大家參考

使用方式:

nRet=chk_dbf(傳入要判斷的DBF檔含路徑,顯示錯誤訊息) &&

******************
*傳入要測試的dbf檔,測試是否可開啟,可傳回>0之筆數,否傳回-1
Function chk_dbf
    Lparameters p_bf,p_no_show_msg
    Local ret,walias,OERR
    ret=-1
    If !Empty(p_bf)
        If !File(p_bf)
            If At(p_bf,'\')>0    &&有路徑
                If Empty(p_no_show_msg)
                    =chk_err(p_bf+" 不存在!")
                Endif
                Return ret
            Endif
        Endif
        Try
            Select 0
            Use (p_bf) Shar Again
            walias=Alias()
        Catch To OERR
            If Empty(p_no_show_msg)
                =chk_err(p_bf+" 不是資料庫,或已損壞")
            Endif
        Endtry
        If Type("oErr")<>'O'
            If Used(walias)
                Select &walias
                ret=Reccount()
                Use
            Endif
        Endif
    Endif
    Return ret
Endfunc
*********************

*顯示錯誤訊息,可設定顯示時間(秒)
Function chk_err
    Para  Msg,p_Timeout
    Local nDialogType
    nDialogType = 0 + 16 + 0

    If !Empty(p_Timeout)
        =Messagebox(Msg,nDialogType, '錯誤!',p_Timeout*1000)
    Else
        =Messagebox(Msg,nDialogType, '錯誤!')
    Endif
    Return
Endfunc