// C:\FWH\SAMPLES\DBFTOTXT.PRG
#include "FiveWin.ch"
PROCEDURE Main
LOCAL cFilePath := "..\samples\Data\database.dbf"
LOCAL cName := "clark"
LOCAL aResult
aResult := FindNameInDbf( cFilePath, cName )
IF .NOT. Empty( aResult )
WriteRecordsToFile( aResult, "..\samples\Data\output.txt" )
ENDIF
RETURN NIL
FUNCTION FindNameInDbf( cFilePath, cName )
LOCAL nHandle := FOpen( cFilePath )
LOCAL cHeader := Space( 32 )
LOCAL nHeaderSize, nRecordSize, nNumRecords
LOCAL aFieldDescriptors := {}
LOCAL aFieldOffsets := {}
LOCAL nOffset := 0
LOCAL cFieldDescriptor, cFieldName
LOCAL nFieldLength
LOCAL nNameOffset, nNameLength
LOCAL aMatchingRecords := {}
LOCAL cRecord, cExtractedName
LOCAL hField, hRecordData
LOCAL i, j
LOCAL cFieldValue
LOCAL hFieldDescriptor := { => }
LOCAL nFound := 0
LOCAL cFileData
LOCAL nVersion
LOCAL nYear
LOCAL nMonth
LOCAL nDay
LOCAL LastUpdate
// Msginfo( "Start Suche" ) // Start search
Msginfo( "Start search" ) // German Language
IF nHandle == -1
? "Konnte die Datei nicht öffnen." // Could not open the file.
? "Could not open the file." // German Language
RETURN {} // ??? NIL ?
ENDIF
// Read entire file into memory
cFileData := MemoRead( cFilePath )
// Header lesen
cHeader := Left( cFileData, 32 )
// Byte-Interpretation der Header-Daten
nNumRecords := ( Asc( SubStr( cHeader, 5, 1 ) ) + ( Asc( SubStr( cHeader, 6, 1 ) ) * 256 ) + ( Asc( SubStr( cHeader, 7, 1 ) ) * 65536 ) + ( Asc( SubStr( cHeader, 8, 1 ) ) * 16777216 ) )
nHeaderSize := ( Asc( SubStr( cHeader, 9, 1 ) ) + ( Asc( SubStr( cHeader, 10, 1 ) ) * 256 ) )
nRecordSize := ( Asc( SubStr( cHeader, 11, 1 ) ) + ( Asc( SubStr( cHeader, 12, 1 ) ) * 256 ) )
// Felddeskriptoren lesen
FOR i := 33 TO nHeaderSize STEP 32
cFieldDescriptor := SubStr( cFileData, i, 32 )
IF Asc( Left( cFieldDescriptor, 1 ) ) == 13
EXIT
ENDIF
cFieldName := RTrim( SubStr( cFieldDescriptor, 1, 11 ) )
nFieldLength := Asc( SubStr( cFieldDescriptor, 17, 1 ) )
AAdd( aFieldDescriptors, { "name" => cFieldName, "length" => nFieldLength } )
NEXT
// Feld-Offsets berechnen
FOR i := 1 TO Len( aFieldDescriptors )
hFieldDescriptor := aFieldDescriptors[ i ]
AAdd( aFieldOffsets, { hFieldDescriptor[ "name" ], nOffset, hFieldDescriptor[ "length" ] } )
nOffset += hFieldDescriptor[ "length" ]
NEXT
nNameOffset := AScan( aFieldOffsets, {| a | Left( a[ 1 ], 10 ) = "LAST" } )
nNameLength := aFieldOffsets[ nNameOffset, 3 ]
// FILTER, welche Felder
aFieldDescriptors := {}
AAdd( aFieldDescriptors, { "name" => "FIRST", "length" => 20 } )
AAdd( aFieldDescriptors, { "name" => "LAST", "length" => 20 } )
xbrowse( aFieldDescriptors )
// Process records
FOR i := 1 TO nNumRecords
cRecord := SubStr( cFileData, nHeaderSize + ( i - 1 ) * nRecordSize + 1, nRecordSize )
cExtractedName := AllTrim( Lower( SubStr( cRecord, aFieldOffsets[ nNameOffset, 2 ] + 1, nNameLength ) ) )
// Search
IF cExtractedName = cName
nFound += 1
hRecordData := { "recno" => i }
nOffset := 0
FOR j := 1 TO Len( aFieldDescriptors )
hField := aFieldDescriptors[ j ]
cFieldValue := ( SubStr( cRecord, nOffset + 2, hField[ "length" ] ) )
hRecordData[ hField[ "name" ] ] := cFieldValue
nOffset += hField[ "length" ]
NEXT
AAdd( aMatchingRecords, hRecordData )
ENDIF
NEXT
xbrowse( aMatchingRecords )
RETURN( aMatchingRecords )
FUNCTION WriteRecordsToFile( aRecords, cFilePath )
LOCAL nHandle := FCreate( cFilePath )
LOCAL cLine
LOCAL hRecord
LOCAL cFieldName
LOCAL cValue
IF nHandle == -1
// ? "Konnte die Datei nicht erstellen." // Could not create the file.
? "Could not create the file." // German Language
RETURN NIL
ENDIF
FOR EACH hRecord IN aRecords
cLine := ""
FOR cFieldName := 1 TO Len( hRecord )
IF HGetKeyAt( hRecord, cFieldName ) != "recno"
cValue := hRecord[ HGetKeyAt( hRecord, cFieldName ) ]
cLine += cValue + Chr( 9 ) // Tab-separated
ENDIF
NEXT
cLine := RTrim( cLine ) + CRLF
FWrite( nHandle, cLine )
NEXT
FClose( nHandle )
// ? "Datei erfolgreich erstellt: ", cFilePath // File created successfully:
? "File created successfully:: ", cFilePath
RETURN NIL
// Funktion zum rechtsbündigen Auffüllen eines Strings auf eine bestimmte Länge
FUNCTION PadR( cText, nLength )
RETURN SubStr( cText + Space( nLength ), 1, nLength )
// FIN / END