;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisdbf3",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfisdbf3
#DefineFunction udfIsDBF3 (sFilename)
; Note: Make sure that the DBF file is accessible and not locked by another transaction.
; Read some header bytes.
hBB = BinaryAlloc(12)
iResult = (12 == BinaryReadEx(hBB,0,sFilename,0,12))
If !iResult Then Goto label
; Check version III/plus.
iResult = (3 == (BinaryPeek(hBB,0) & 3))
If !iResult Then Goto label
; Check record count.
iDBFRecCount = BinaryPeek4(hBB,4)
iResult = (0 <= iDBFRecCount)
If !iResult Then Goto label
; Check record length.
iDBFRecLen = BinaryPeek2(hBB,10)
iResult = (1 < iDBFRecLen)
If !iResult Then Goto label
iResult = (4000 >= iDBFRecLen)
If !iResult Then Goto label
; Check file size.
iDBFHeadLen = BinaryPeek2(hBB,8)
iResult = (1 == BinaryReadEx(hBB,0,sFilename,iDBFHeadLen+(iDBFRecCount*iDBFRecLen),1))
If !iResult Then Goto label
; Check eof marker 1Ah.
iResult = (26 == BinaryPeek(hBB,0))
If !iResult Then Goto label
; Check field count.
iDBFFieldMax = 255 ; Max field count.
iDBFFieldLen = 32 ; Length of field description.
iDBFFieldEOT = 13 ; End of table marker 0Dh.
hBBField = BinaryAlloc(iDBFFieldLen)
iOffset = 32
iFieldCount = 0
While @TRUE
BinaryReadEx(hBBField,0,sFilename,iOffset,iDBFFieldLen)
If (iDBFFieldEOT == BinaryPeek(hBBField,0)) Then Break ; End of table.
iFieldCount = iFieldCount + 1
If (iDBFFieldMax < iFieldCount) Then Break ; Too much fields.
iOffset = iOffset + iDBFFieldLen
EndWhile
BinaryFree(hBBField)
iResult = (1 <= iFieldCount)
If !iResult Then Goto label
iResult = (iDBFFieldMax >= iFieldCount)
If !iResult Then Goto label
:label
BinaryFree(hBB)
Return (iResult)
;------------------------------------------------------------------------------------------------------------------------------------------
; This function udfIsDBF3() checks DBF file version and format integrity.
; Returns @TRUE if filename seems to be a valid DBF III file, otherwise @FALSE.
;
; Detlev Dalitz.20020510
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfisdbf3
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfdbf3tocsv",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfdbf3tocsv
#DefineFunction udfDBF3ToCSV (sFilenameIn, sFilenameOut, iDelMode, iTrimMode)
If !FileExist(sFilenameIn) Then Return (@FALSE) ; No input file.
If (sFilenameOut == "") Then Return (@FALSE) ; No output file.
iTrimMode = Min(2,Max(0,iTrimMode))
iDelMode = Min(1,Max(0,iDelMode))
; Read dbf field table.
sFieldNameList = ""
sFieldTypeList = ""
sFieldLenList = ""
iDBFFieldLen = 32 ; Length of field description.
iDBFFieldEOT = 13 ; End of table marker 0Dh.
hBBField = BinaryAlloc(iDBFFieldLen)
iOffset = 32
While @TRUE
BinaryReadEx(hBBField,0,sFilenameIn,iOffset,iDBFFieldLen)
If (iDBFFieldEOT == BinaryPeek(hBBField,0)) Then Break ; End of table.
sFieldName = BinaryPeekStr(hBBField,0,10)
sFieldType = BinaryPeekStr(hBBField,11,1)
iFieldLen = BinaryPeek(hBBField,16)
sFieldNameList = ItemInsert(sFieldName,-1,sFieldNameList,@TAB)
sFieldTypeList = ItemInsert(sFieldType,-1,sFieldTypeList,@TAB)
sFieldLenList = ItemInsert(iFieldLen,-1,sFieldLenList,@TAB)
iOffset = iOffset + iDBFFieldLen
EndWhile
BinaryFree(hBBField)
iFieldCount = ItemCount(sFieldNameList,@TAB)
; Read dbf info.
hBBInfo = BinaryAlloc(12)
BinaryReadEx(hBBInfo,0,sFilenameIn,0,12)
iDBFRecCount = BinaryPeek4(hBBInfo,4)
iDBFHeadLen = BinaryPeek2(hBBInfo,8)
iDBFRecLen = BinaryPeek2(hBBInfo,10)
BinaryFree(hBBInfo)
; Create output file.
IntControl(53,0,0,0,0) ; Set no line terminator.
hFW = FileOpen(sFilenameOut,"WRITE")
; Write header record.
For iField=1 To iFieldCount
sFieldName = ItemExtract(iField,sFieldNameList,@TAB)
FileWrite(hFW,'"')
FileWrite(hFW,sFieldName)
FileWrite(hFW,'"')
If (iField < iFieldCount) Then FileWrite(hFW,",")
Next
FileWrite(hFW,@CRLF)
; Read dbf records, write out to textfile.
hBBRecord = BinaryAlloc(iDBFRecLen)
iOffset = iDBFHeadLen
For iCount=1 To iDBFRecCount
If (iDBFRecLen <> BinaryReadEx(hBBRecord,0,sFilenameIn,iOffset,iDBFRecLen)) Then Break
iOffset = iOffset + iDBFRecLen ; Calculate next record.
; Leading byte 2Ah if record is deleted, 20h if record is not deleted.
If (0 == iDelMode) Then If (42 == BinaryPeek(hBBRecord,0)) Then Continue ; Skip over deleted record.
iRecOffset = 1
For iField=1 To iFieldCount
sFieldType = ItemExtract(iField, sFieldTypeList,@TAB)
iFieldLen = ItemExtract(iField, sFieldLenList,@TAB)
sData = BinaryPeekStr(hBBRecord,iRecOffset,iFieldLen)
; Trim sData.
Select iTrimMode
Case 2
sData = StrTrim(sData)
Break
Case 1
sData = ItemExtract(2,StrTrim(StrCat(@LF,sData)),@LF)
Break
Case 0
Break
EndSelect
; Quote sData.
Select @TRUE
Case (sFieldType == 'N')
FileWrite(hFW,sData)
Break
Case (sFieldType == 'M')
FileWrite(hFW,'"MEMO"')
Break
Case 1 ; 'C', 'D', 'L'
FileWrite(hFW,'"')
FileWrite(hFW,sData)
FileWrite(hFW,'"')
Break
EndSelect
If (iField < iFieldCount) Then FileWrite(hFW,",")
iRecOffset = iRecOffset + iFieldLen
Next
FileWrite(hFW,@CRLF)
Next
BinaryFree(hBBRecord)
FileClose(hFW)
Return (FileExist(sFilenameOut))
;------------------------------------------------------------------------------------------------------------------------------------------
; This function udfDBF3ToCSV() reads a DBF III plus file
; and creates a text file with comma separated fields.
;
; iTrimMode = 2 ... Trim leading and trailing blanks.
; iTrimMode = 1 ... Trim trailing blanks.
; iTrimMode = 0 ... Skip trimming blanks.
; iDelMode = 1 ... Show deleted records too.
; iDelMode = 0 ... Skip deleted records.
;
; Detlev Dalitz.20020510
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfdbf3tocsv
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfdbf3totab",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfdbf3totab
#DefineFunction udfDBF3ToTAB (sFilenameIn, sFilenameOut, iDelMode)
If !FileExist(sFilenameIn) Then Return (@FALSE) ; No input file.
If (sFilenameOut == "") Then Return (@FALSE) ; No output file.
iDelMode = Min(1,Max(0,iDelMode))
; Read dbf field table.
sFieldNameList = ""
sFieldLenList = ""
iDBFFieldLen = 32 ; Length of field description.
iDBFFieldEOT = 13 ; End of table marker 0Dh.
hBBField = BinaryAlloc(iDBFFieldLen)
iOffset = 32
While @TRUE
BinaryReadEx(hBBField,0,sFilenameIn,iOffset,iDBFFieldLen)
If (iDBFFieldEOT == BinaryPeek(hBBField,0)) Then Break ; End of table.
sFieldName = BinaryPeekStr(hBBField,0,10)
iFieldLen = BinaryPeek(hBBField,16)
sFieldNameList = ItemInsert(sFieldName,-1,sFieldNameList,@TAB)
sFieldLenList = ItemInsert(iFieldLen,-1,sFieldLenList,@TAB)
iOffset = iOffset + iDBFFieldLen
EndWhile
BinaryFree(hBBField)
iFieldCount = ItemCount(sFieldNameList,@TAB)
; Read dbf info.
hBBInfo = BinaryAlloc(12)
BinaryReadEx(hBBInfo,0,sFilenameIn,0,12)
iDBFRecCount = BinaryPeek4(hBBInfo,4)
iDBFHeadLen = BinaryPeek2(hBBInfo,8)
iDBFRecLen = BinaryPeek2(hBBInfo,10)
BinaryFree(hBBInfo)
; Create output file.
hFW = FileOpen(sFilenameOut, "WRITE")
; Write header record.
FileWrite(hFW,sFieldNameList)
; Read dbf records, write out to textfile.
hBBRecord = BinaryAlloc(iDBFRecLen)
iOffset = iDBFHeadLen
For iCount=1 To iDBFRecCount
If (iDBFRecLen <> BinaryReadEx(hBBRecord,0,sFilenameIn,iOffset,iDBFRecLen)) Then Break
iOffset = iOffset + iDBFRecLen ; Calculate next record.
; Leading byte 2Ah if the record is deleted, 20h if not deleted.
If (0 == iDelMode) Then If (42 == BinaryPeek(hBBRecord,0)) Then Continue ; Skip over deleted record.
IntControl(53,4,0,0,0) ; Set @TAB line terminator.
iRecOffset = 1
For iField=1 To iFieldCount
iFieldLen = ItemExtract(iField, sFieldLenList,@TAB)
sData = BinaryPeekStr(hBBRecord,iRecOffset,iFieldLen)
If (iField == iFieldCount) Then IntControl(53,1,0,0,0) ; Set @CRLF line terminator.
FileWrite(hFW,sData)
iRecOffset = iRecOffset + iFieldLen
Next
Next
BinaryFree(hBBRecord)
FileClose(hFW)
Return (FileExist(sFilenameOut))
;------------------------------------------------------------------------------------------------------------------------------------------
; This function udfDBF3ToTAB() reads a DBF III file
; and creates a text file with Database fields separated by tab char.
;
; iDelMode = 1 ... Show deleted records too.
; iDelMode = 0 ... Skip deleted records.
;
; Detlev Dalitz.20020510
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfdbf3totab
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
sFilenameIn = "\\SHARE\FOLDER\FILE.DBF" ; choose your own DBF III/plus file
If udfIsDBF3 (sFilenameIn)
sFilenameTmp = FileCreateTemp("TMP") ; Temporary file for test output.
; Do not show deleted records.
; Do not trim leading or trailing blanks.
iDelMode = 0
iTrimMode = 0
If udfDBF3ToCSV (sFilenameIn, sFilenameTmp, iDelMode, iTrimMode) ; No trim.
RunWait("notepad", sFilenameTmp) ; Wait for closing notepad.
EndIf
; Do not show deleted records.
; Trim trailing blanks.
iDelMode = 0
iTrimMode = 1
If udfDBF3ToCSV (sFilenameIn, sFilenameTmp, iDelMode, iTrimMode)
RunWait("notepad", sFilenameTmp) ; Wait for closing notepad.
EndIf
; Show deleted records too.
; Trim leading and trailing blanks.
iDelMode = 1
iTrimMode = 2
If udfDBF3ToCSV (sFilenameIn, sFilenameTmp, iDelMode, iTrimMode)
RunWait("notepad", sFilenameTmp) ; Wait for closing notepad.
EndIf
; Do not show deleted records.
iDelMode = 0
If udfDBF3ToTAB (sFilenameIn, sFilenameTmp, iDelMode)
RunWait("notepad", sFilenameTmp) ; Wait for closing notepad.
EndIf
; Show deleted records too.
iDelMode = 1
If udfDBF3ToTAB (sFilenameIn, sFilenameTmp, iDelMode)
RunWait("notepad", sFilenameTmp) ; Wait for closing notepad.
EndIf
; Cleaning.
FileDelete(sFilenameTmp)
EndIf
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
*EOF*
|
