Search the Community

I am currently busy to create code to read local Borland Delphi database structures. I do not have a Delphi environment to be able to create all situations, and i have one situation that keeps me scratching the back of my head. I got a *lot* of information from this patent file explaining the structure and it got me reasonably far: https://docs.google.com/viewer?url=patentimages.storage.googleapis.com/pdfs/US6151602.pdf The type code descriptions give a general idea, but they whip up examples that i cannot cope with other parts of the information. There is a thing with the optional parameters that i do not grasp: for each column a parameter count field is present but in the "Test_change_Log.dat" the svCHANGE_LOG parameter is added directly behind an svWIDTH parameter, also with a count of 1. There was also stuff i could not trace back within the description, like the data-offset point in the file. It is set whenever the offset point falls within the scope of FFFF, if the data starts much further away, this field is 0000. The below package, contains the source-file with a couple of .dat file examples, you can unmark/remark the specific $DatFile around line 66 to test each file. You need to copy the sqlite3.dll into the source-folder if you don't have it in a spot where it can be always called from. Frankly what this source does is this: Translate the BDE header into an Sqlite header with the exact matching description (if you ever need to translate the contents back into another or same database form using Query2d -> "PRAGMA table_info(DatTable);", you have all the exact entity type descriptors available) Then it inserts all records from the DAT file into the sqlite database. To keep the program fast, it will recap a 2D array query of maximum 1000 records as ArrayDisplay remains slow as hell. I think this is specially appealing to those who are familiar with Borland Delphi or have stuff around that they need to port over. I have also inserted the code for everybody to view online. For those interested in this puzzle: Watch out for these nasty pitfalls: These BDE database files are in some parts written in 8-bit block parts whereas _WinAPI_ReadFile() picks up in blocks of 32 bit. This goes fine whenever your $str structure blocks are filling consecutive 32-bit blocks, but mess up your file-pointer when they are ending in odd 16 or 8 bit particles. I have not even tested when you would compile this source into a 64-bit executable and what _WinAPI_ReadFile() does in that case. But to end with my remaining questions: I do not have enough example files to cover all situations described in the Patent and i don't own a Delphi developer environment that would help me create these extra examples, like:how should BCD blocks be interpreted? IEEE Floats, Timestamps, Date/Time fields etc. How should the optional parameters be read in which order? Cheers, Lbsl #include <SQLite.au3> #include <SQLite.dll.au3> #include <Array.au3> #include <WinAPI.au3> Global $Debug = True Dim $QueryList[1] Global $bdeheader, $gdbparameter, $gdbcolumns, $gdbrecordcount, $gdbtype, $gdboffset, $gdbtitledata Global $IntervalPerc Global $SmallRecordMax = 1000 Global $BDEMagic = 0xBDE01996, $BDEMajorVer = 0x1, $BDEMinorVer = 0x0, $BDEHeaderSize = 0x18, $BDEDataOffset = 0x0 Global $BDEColumns = 0, $BDERows = 0, $BDEPropertyValue, $BDERowStatus = 0x00, $BDENULLBits = 0x00 ;Hidden/visible columns Global $BDERecNotModified = 0x00, $BDERecOrg = 0x01, $BDERecDeleted = 0x02, $BDERecNew = 0x04, $BDERecModified = 0x08, $BDERecUnused = 0x20 ;dsRecNotModified 0X00 Unmodified ‘original’ roW. ;dsRecOrg 0X01 Original version of modified roW. -> hidden ;dsRecDeleted 0X02 Deleted roW. - Hidden ;dsRecNeW 0X04 Inserted roW. ;dsRecModified 0X08 Modified roW. ;dsRecunused 0X20 Unused roW. -Hidden ;Blank values ;NOLBLANK 0x00 Contains non-Null value. ;BLANKiNULL 0x01 Contains Null-value. -Not present ;BLANKLUNCHANGED 0x02 Contains ‘unchanged’ Null-value. -Not present Local $str = "DWORD iMagicCookie;USHORT iMajorVer;USHORT iMinorVer;DWORD iHeaderSize" $bdeheader = DllStructCreate($str) $str = "USHORT iColCount" $bdecolumncount = DllStructCreate($str) $str = "DWORD iRowCount" $bderowcount = DllStructCreate($str) $str = "DWORD iProperties" $bdeproperties = DllStructCreate($str) $str = "USHORT iDataOffset" $bdeOffset = DllStructCreate($str) $str = "UBYTE iRowStatus" $bdeirowstatus = DllStructCreate($str) $str = "UBYTE iNullBits" $bdeinullbits = DllStructCreate($str) $str = "USHORT offset" $gdboffset = DllStructCreate($str) Dim $ByteOrder[2] $ByteOrder[0] = 0x03 $ByteOrder[1] = 0x0c $str = "DWORD type;DWORD subtype" ;Dim $DatFileContentArray[1][1] ;Trailing constants Global $PAD_ZERO = 1 Global $PRX_SPACE = 2 Global $SFX_SPACE = 3 Global $TRIM_ONLY = 4 ;Local $DatFile = ".\test_extended_small.Dat" Local $DatFile = ".\test.WHD.Dat" ;Local $DatFile = ".\test_extended.Dat" ;Local $DatFile = ".\test_change_log.Dat" ;Local $DatFile = ".\test_small.Dat" StartSQL() _LoadDelphiDat ($DatFile) Func _LoadDelphiDat($sFile) $BDEDataOffset = 17 Local $pzn, $Country, $code, $article, $shortedarticle, $prevperc, $str, $size Enum $PZNTableType, $WHDTableType, $NEULCBTableType, $WK4TableType Local $TableType = $PZNTableType, $nBytes = 0 Local $ByteString = "" Local $sDrive, $sDir, $sName, $sExt Local $Path = _PathSplit($sFile, $sDrive, $sDir, $sName, $sExt) Local $DbFile = $sDrive & $sDir & $sName & ".sqlite" Dim $DBTable[0] ;GUICtrlSetState($GUIStartSync, $GUI_DISABLE) StdOut(" Opening BDE database file .." & $sFile) Local $sourceFile = _WinAPI_CreateFile($sFile, 2, 2) StdOut(" Sourcefile geopend..") $BDEMagic = 0x0 GetBDEHeader($sourceFile, $nBytes) GetBDEDataProperties($sourceFile, $nBytes) StdOut(Hex($BDEMagic, 8)) StdOut($BDEColumns) StdOut($BDERows) If Hex($BDEMagic, 8) <> "BDE01996" Then StdOut("Magic Number incorrect") Return -1 EndIf ;$BDEMajorVer ;$BDEMinorVer ;$BDEHeaderSize ;$BDEColumns ;$BDERows ;$BDEProperties ;$BDEDataOffset StdOut(" header read..") StdOut("Current filepos (EndOfHeader)[" & Hex($BDEDataOffset) & "]:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) Local $StopCode = 0x0000 If $BDEDataOffset == 0 Then ;_WinAPI_ReadFile($sourceFile, DllStructGetPtr($data), DllStructGetSize($data), $nBytes) ;$BDEDataOffset = DllStructGetData($data, "endofheader") ;If $BDEDataOffset == 0 Then; NEULCBPZN open? $StopCode = 0x0004 StdOut("Stopcode changed!") ;EndIf EndIf StdOut("Columns:" & $BDEColumns) ;StdOut("HeaderMarker->" & $PaddedBytes) StdOut("Table rows:" & $BDERows) ;$BDEDataOffset = DllStructGetData($bdeheader, "endofheader")+7 ;BestandWK4 StdOut("Table record start:" & $BDEDataOffset) ;Exit If $BDEColumns > 0 Then ReDim $DBTable[$BDEColumns][4] StdOut("[Columnreading] Current fileposition:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) Local $CurrentColumn Enum $iColumnTitle, $iColumnType, $iColumnAttribute, $iColumnParameterCount For $t = 1 To $BDEColumns $CurrentColumn = GetBDEColumnProperties($sourceFile, $nBytes) ;_ArrayDisplay($CurrentColumn) If IsArray($CurrentColumn) Then $DBTable[$t - 1][$iColumnTitle] = $CurrentColumn[$iColumnTitle] $DBTable[$t - 1][$iColumnType] = $CurrentColumn[$iColumnType] $DBTable[$t - 1][$iColumnAttribute] = $CurrentColumn[$iColumnAttribute] $DBTable[$t - 1][$iColumnParameterCount] = $CurrentColumn[$iColumnParameterCount] If $CurrentColumn[$iColumnParameterCount] > 0 Then StdOut("Table2 :[" & UBound($DBTable, 2) & "] Parameter + table count:" & $CurrentColumn[$iColumnParameterCount] + UBound($DBTable, 2)) If (2 * $CurrentColumn[$iColumnParameterCount]) + ($iColumnParameterCount + 1) > UBound($DBTable, 2) Then ReDim $DBTable[UBound($DBTable)][(2 * $CurrentColumn[$iColumnParameterCount]) + ($iColumnParameterCount + 1)] StdOut(UBound($DBTable, 2)) EndIf For $u = $iColumnParameterCount + 1 To $iColumnParameterCount + (2 * $CurrentColumn[$iColumnParameterCount]) StdOut($u) $DBTable[$t - 1][$u] = $CurrentColumn[$u] Next EndIf EndIf ;_ArrayDisplay($DBTable) ;StdOut("Current fileposition:" & _WinAPI_SetFilePointer($sourceFile, 0, 1)) ;StdOut(" reading column " & $t) Next _ArrayDisplay($DBTable) If @error Then StdOut("Arraydisplay error:" & @error) For $x = 0 To 4 StdOut($DBTable[0][$x] & "->" & $DBTable[0][$x]) Next EndIf Else _WinAPI_CloseHandle($sourceFile) StdOut("Database does not contain columns?") Return -1 EndIf StdOut("fileposition for offset:"&Hex(_WinAPI_SetFilePointer($sourceFile, 0,1))) Local $DBHandle = OpenDb($DbFile) Exec($DBHandle, "PRAGMA synchronous=NORMAL;") ;Exec($DBHandle, "PRAGMA auto_vacuum = FULL;") Exec($DBHandle, "PRAGMA default_cache_size=10000;") Exec($DBHandle, "PRAGMA journal_mode=WAL;") Exec($DBHandle, "PRAGMA main.wal_checkpoint(FULL);") Exec($DBHandle, "PRAGMA journal_size_limit=0;") Exec($DBHandle, "PRAGMA encoding='UTF-16';") ;Exec($DBHandle, "PRAGMA table_info(DatTable);") Local $ExecInsertPrefix = "INSERT OR REPLACE INTO DatTable (" If UBound($DBTable) > 0 Then Local $ExecCommand = "CREATE TABLE IF NOT EXISTS DatTable (" $ExecInsertPrefix = "INSERT OR REPLACE INTO DatTable (" For $x = 0 To UBound($DBTable) - 1 ;StdOut($x) Local $CharType = " INT" StdOut(Hex($DBTable[$x][1], 8)) ;Exit Switch StringLeft(Hex($DBTable[$x][1], 8), 4) Case "0000" ; Unknown Case "0001" ; Signed Switch StringRight(Hex($DBTable[$x][1], 8), 4) Case "0001" $CharType = " INT8" Case "0002" $CharType = " INT16" Case "0004" $CharType = " INT32" Case "0008" $CharType = " INT64" EndSwitch Case "0002" ; Unsigned Switch StringRight(Hex($DBTable[$x][1], 8), 4) Case "0001" $CharType = " UINT8" Case "0002" $CharType = " UINT16" Case "0004" $CharType = " UINT32" Case "0008" $CharType = " UINT64" EndSwitch Case "0003" ;Boolean Switch StringRight(Hex($DBTable[$x][1], 8), 4) Case "0001" $CharType = " BOOL8" Case "0002" $CharType = " BOOL16" Case "0004" $CharType = " BOOL32" EndSwitch Case "0004" ;IEEE Float Case "0005" ;BCD; Comes with "WIDTH and "DECIMALS" parameter Case "0006" ;Date Size must be 4 Case "0007" ;Time Size must be 4 Case "0008" ;TimeStamp Size must be 8 Case "0009", "0049" ;Multibyte string, size is 1-byte size prefix, if WIDTH parameter value > 255 then 2 byte size. Local $StringSize = 0 If UBound($DBTable, 2) == 6 Then If $DBTable[$x][4] == "WIDTH" Then $StringSize = $DBTable[$x][5] $CharType = " VARCHAR(" & StringStripWS($StringSize, 8) & ")" EndIf EndIf Case "000a", "004a" ;Unicode string, size is 1-byte size prefix, if WIDTH parameter value > 255 then 2 byte size. Case "000b", "004b" ;Block Bytes ;Case "0x0100490000000100" ;String preceded by length-byte EndSwitch Switch $x Case UBound($DBTable) - 1 $ExecCommand &= $DBTable[$x][0] & $CharType & ")" $ExecInsertPrefix &= $DBTable[$x][0] & ")" Case Else $ExecCommand &= $DBTable[$x][0] & $CharType & "," $ExecInsertPrefix &= $DBTable[$x][0] & "," EndSwitch Next $ExecInsertPrefix &= " VALUES (" StdOut($ExecCommand) ;Exit Exec($DBHandle, $ExecCommand) EndIf Switch $BDEDataOffset Case 0 $BDEDataOffset = _WinAPI_SetFilePointer($sourceFile, 0, 1) ; First byte is BitProperties MsgBox(0, "Filestructure unsupported", "This file-structure is not supported" & @CRLF & "Please open with shutdown-viewer and save under a new name," & @CRLF & "then reselect the new file here.") ;Return Case 0x5c ; Column precense bytes, USHort ;$BDEDataOffset += 2 ;LCBZN StdOut("LCBPZN") ;$BDEDataOffset += 1 Case 0xA3 ;$BDEDataOffset += 1 ;WHD, bitrange ushort starts one byte further! $TableType = $WHDTableType ; Every record terminates with one 0x00 byte! StdOut("Picking.WHD") Case 0x01e9 ;$BDEDataOffset += 1 ;BestandWK4, bitrange ushort starts one byte further! $TableType = $WK4TableType ; Every record terminates with one 0x00 byte! StdOut("BestandWK4") EndSwitch ;Missing column logic: ;00000001 (1) Geen PZN ;00000100 (4) Geen Country ;00010000 (10) Geen CodeType ;00000101 (5) Geen PZN en Country ;00010100 (14) Geen Country en CodeType ;00010001 (11) Geen PZN en CodeType ;00010101 (15) Geen PZN, Country en Codetype ;WHD.dat: ;Missende kolommen: ;1 0002 0000000000000010 ;1,2 000a 0000000000001010 ;1,2,3 002a 0000000000101010 ;1,2,3,4 2a00 0100 0010101000000000 ?000100000000? ;1,2,3,4,5 002a 0001 0000000000101010 0001 ;1,2,3,4,5,6 022a 0001 0000001000101010 0001 ;1,2,3,4,5,6 0a2a 010a 0000101000101010 ?000100001010? ;1,2,3,4,5,6,7 2a2a 0001 0010101000101010 0001 ;2 0008 0000000000001000 ;3 0020 0000000000100000 ;4 0000 0000000000000000 ;5 0200 0000001000000000 ;6 0800 0000100000000000 ;7 2000 0010000000000000 ;8 8000 1000000000000000 ;BestandWK4.dat: For every missing string a termination 00 with a leading char counter (01) is being used ;If columns are strings, they shall *not* be defined as lacking in the bitstatecolumns, the stringsize is set to 1 byte and that will be a 00 byte terminator _WinAPI_SetFilePointer($sourceFile, $BDEDataOffset, 0) StdOut("Starting at first record:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) Local $counter = 1 If $BDERows > 0 Then $BDEColumns = UBound($DBTable) ;ReDim $DatFileContentArray[1][$BDEColumns] ;For $x = 0 To UBound($DBTable) - 1 ; $DatFileContentArray[0][$x] = $DBTable[$x][0] ;Next StdOut("Reading BDE database..." & $BDERows & " records.") ;StdOut("Inlezen database:" & $BDERows & " records." & @CRLF) ;ProgressOn('Reading LCBPZN', "%", "", -1, -1, 16) Local $RecordField, $RecordFieldValue ;StdOut("Checking records...") ProgressOn("Processing " & $sFile, "Gathering data", $sFile, -1, -1, 16) ;Remove this condition limit when done ;If $BDERows > 1000 Then ; $BDERows = 1000 ;EndIf Dim $ByteConverted[2] Dim $RecordFields[$BDEColumns] For $x = 1 To $BDERows Local $bits = $BDEColumns * 2 Local $Shorts = Ceiling($bits / 16) ;StdOut("Shorts:" & $Shorts & @CRLF) $BitBlock = GetBDERowBits($sourceFile, $nBytes) ;Stdout("current filepos :"&Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) ;_ArrayDisplay($BitBlock) ;StdOut(@CRLF & @CRLF & @CRLF) ;StdOut("Current fileposition:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) Switch True Case $BDERows < $SmallRecordMax ProgressSet(Round($x / $BDERows * 100, 0), "Reading .DAT", Round($x / $BDERows * 100, 0) & "%") Case Else If Round($x / $BDERows * 100) >= $prevperc + $IntervalPerc Then $prevperc = Round($x / $BDERows * 100) ProgressSet(Round($x / $BDERows * 100, 0), "Reading .DAT", Round($x / $BDERows * 100, 0) & "%") EndIf EndSwitch ;ReDim $DatFileContentArray[UBound($DatFileContentArray) + 1][$BDEColumns] Local $ByteOrderPosition = 0 Local $BinBlock, $BitSet, $FormerSet $ByteConverted[0] = 0 $ByteConverted[1] = 0 For $y = 0 To ($BDEColumns - 1) $BitSet = Ceiling(($y + 1) / 4) If $FormerSet <> $BitSet Then $FormerSet = $BitSet $ByteConverted[0] = 0 $ByteConverted[1] = 0 EndIf If $ByteConverted[$ByteOrderPosition] == 0 Then $ByteConverted[$ByteOrderPosition] = $ByteOrder[$ByteOrderPosition] Else $ByteConverted[$ByteOrderPosition] *= 0x10 EndIf ;StdOut(@CRLF & "Checking Column [" & $y & "]on bitblock ["&$BitBlock[$BitSet]&"] bitset:"& $BitSet& " compared to byte-mask ["&HEX($ByteConverted[$ByteOrderPosition])&"] Byteorder:"&$ByteOrderPosition&@CRLF) ;StdOut("BitAnd("&_IntToAny($BitBlock[$BitSet],2,32)&","&_IntToAny($ByteConverted[$ByteOrderPosition],2,32)&")"&@CRLF) If BitAND($ByteConverted[$ByteOrderPosition], $BitBlock[$BitSet]) Then ;StdOut(@CRLF & "Bitset [" & $BitSet & "] byteconverted [" & $ByteConverted[$ByteOrderPosition] & "] bitblock [" & $BitBlock[$BitSet] & "]" & @CRLF) ;StdOut("Column [" & $y & "] not present" & @CRLF) $ByteOrderPosition += 1 If $ByteOrderPosition > 1 Then $ByteOrderPosition = 0 EndIf $RecordFields[$y] = 'NULL' ;If $TableType <> $NEULCBTableType Then ContinueLoop ;EndIf EndIf $ByteOrderPosition += 1 If $ByteOrderPosition > 1 Then $ByteOrderPosition = 0 EndIf Local $CurBinPos = _WinAPI_SetFilePointer($sourceFile, 0, 1) Local $ColumnType = Hex($DBTable[$y][1], 8) Local $StringSize = 0 StdOut("Checking [" & $y & "] column types current position:" & $CurBinPos & "/" & Hex($CurBinPos)& "Column type:"&$ColumnType) Switch StringLeft($ColumnType, 4) Case "0000" ; Unknown Case "0001" ; Signed Switch StringRight($ColumnType, 4) Case "0001" $str = "BYTE FieldValue" Case "0002" $str = "SHORT FieldValue" Case "0004" $str = "DWORD FieldValue" Case "0008" $str = "INT64 FieldValue" EndSwitch Case "0002" ; Unsigned Switch StringRight($ColumnType, 4) Case "0001" $str = "UBYTE FieldValue" Case "0002" $str = "USHORT FieldValue" Case "0004" $str = "DWORD FieldValue" Case "0008" $str = "UINT64 FieldValue" EndSwitch Case "0003" ;Boolean Switch StringRight($ColumnType, 4) Case "0001" $str = "UBYTE FieldValue" Case "0002" $str = "USHORT FieldValue" Case "0004" $str = "DWORD FieldValue" EndSwitch Case "0004" ;IEEE Float Case "0005" ;BCD; Comes with "WIDTH and "DECIMALS" parameter Case "0006" ;Date Size must be 4 Case "0007" ;Time Size must be 4 Case "0008" ;TimeStamp Size must be 8 Case "0009", "0049" ;Multibyte string, size is 1-byte size prefix, if WIDTH parameter value > 255 then 2 byte size. Local $StringSize = 0 If UBound($DBTable, 2) == 6 Then If $DBTable[$y][4] == "WIDTH" Then $StringSize = $DBTable[$y][5] $CharType = " VARCHAR(" & StringStripWS($StringSize, 8) & ")" ;StdOut($DBTable[$y][0]&"["&$y&"] "&$DBTable[$y][4]&"->"&$DBTable[$y][5]) EndIf EndIf Switch StringRight($ColumnType, 4) Case "0001" $str = "UBYTE StringSize" Case "0002" $str = "USHORT StringSize" Case "0004" $str = "ULONG StringSize" EndSwitch StdOut($str) $RecordField = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($RecordField), DllStructGetSize($RecordField), $nBytes) $RecordFieldValue = Number(DllStructGetData($RecordField, "StringSize")) Local $CurrentStringSize = $RecordFieldValue ;StdOut("True Stringsize [" & $RecordFieldValue & "]") ;StdOut("Number "& $CurrentStringSize &"<="&$StringSize&"?") If Number($CurrentStringSize) <= $StringSize Then ;StdOut("Number "& $CurrentStringSize &"<="&$StringSize&"!") If $CurrentStringSize > 0 Then $str = StringReplace($str," StringSize","") $str &= " FieldValue[" & StringStripWS(Number($CurrentStringSize), 8) & "]" ;StdOut($str) ;$RecordField = DllStructCreate($str) EndIf ;Else ; StdOut("Error, field-value (" & $RecordFieldValue & "|0x" & Hex($RecordFieldValue) & ")larger than maximum allocated chars (" & $StringSize & ")") EndIf Case "000a", "004a" ;Unicode string, size is 1-byte size prefix, if WIDTH parameter value > 255 then 2 byte size. Case "000b", "004b" ;Block Bytes EndSwitch $RecordField = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($RecordField), DllStructGetSize($RecordField), $nBytes) $RecordFieldValue = DllStructGetData($RecordField, "FieldValue") ;StdOut($RecordFieldValue) Switch StringLeft($ColumnType, 4) Case "0000" ; Unknown Case "0001" ; Signed $RecordFields[$y] = $RecordFieldValue Case "0002" ; Unsigned $RecordFields[$y] = $RecordFieldValue Case "0003" ;Boolean If $RecordFieldValue > 0 Then $RecordFieldValue = "False" Else $RecordFieldValue = "True" EndIf $RecordFields[$y] = $RecordFieldValue Case "0004" ;IEEE Float Case "0005" ;BCD; Comes with "WIDTH and "DECIMALS" parameter Case "0006" ;Date Size must be 4 Case "0007" ;Time Size must be 4 Case "0008" ;TimeStamp Size must be 8 Case "0009", "0049" ;Multibyte string, size is 1-byte size prefix, if WIDTH parameter value > 255 then 2 byte size. If $CurrentStringSize == 1 Then If StringLen($RecordFieldValue) == 1 And Asc($RecordFieldValue) = 0 Then $RecordFieldValue = "" EndIf If $RecordFieldValue == "0x00" Then $RecordFieldValue = "" EndIf EndIf If StringLeft($RecordFieldValue, 2) == "0x" Then $RecordFields[$y] = BinaryToString($RecordFieldValue) Else $RecordFields[$y] = $RecordFieldValue EndIf Case "000a", "004a" ;Unicode string, size is 1-byte size prefix, if WIDTH parameter value > 255 then 2 byte size. Case "000b", "004b" ;Block Bytes EndSwitch ;If $DatFileContentArray[$x][3]="K7458" Then ;_ArrayDisplay($DatFileContentArray) ;EndIf Next $ExecCommand = $ExecInsertPrefix For $t = 0 To UBound($RecordFields) - 1 $RecordFields[$t] = StringReplace($RecordFields[$t], "'", "") If $t < UBound($RecordFields) - 1 Then If StringStripWS($RecordFields[$t], 8) == "" Then $RecordFields[$t] = "NULL" Else $RecordFields[$t] = "'" & $RecordFields[$t] & "'" EndIf $ExecCommand &= $RecordFields[$t] & "," Else If StringStripWS($RecordFields[$t], 8) == "" Then $RecordFields[$t] = "NULL" Else $RecordFields[$t] = "'" & $RecordFields[$t] & "'" EndIf $ExecCommand &= $RecordFields[$t] & ");" EndIf Next StdOut($ExecCommand) Exec($DBHandle, $ExecCommand) StdOut(@CRLF & @CRLF & @CRLF) ;_ArrayDisplay($RecordFields) ;_ArrayDisplay($DatFileContentArray)1 Switch $TableType Case $NEULCBTableType Case $WHDTableType, $PZNTableType, $WK4TableType ;_WinAPI_SetFilePointer($sourceFile, 1, 1); Skip termination sequence WHD EndSwitch StdOut("Current filepointer:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) ;StdOut("Inlezen database..." & Round(($x / $BDERows) * 100) & "%") Next ProgressOff() Local $SmallEndResult = Query2D($DBHandle,"SELECT * FROM DatTable LIMIT 1000;") CloseDb($DBHandle) _ArrayDisplay($SmallEndResult) ;_ArrayDisplay($DatFileContentArray) _WinAPI_CloseHandle($sourceFile) StdOut("Reading complete. (" & $counter - 1 & " rows)") Return -1 Else ;StdOut("Inlezen Mislukt. (" & $BDERows & " artikelen geteld)" & @CRLF) StdOut("Reading failed. (" & $BDERows & " rows counted)") EndIf EndFunc ;==>_LoadDelphiDat Func GetBDEHeader($sourceFile, ByRef $nBytes) _WinAPI_SetFilePointer($sourceFile, 0) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bdeheader), DllStructGetSize($bdeheader), $nBytes) StdOut("New filepointer:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1)) & @CRLF) $BDEMagic = DllStructGetData($bdeheader, "iMagicCookie") $BDEMajorVer = DllStructGetData($bdeheader, "iMajorVer") $BDEMinorVer = DllStructGetData($bdeheader, "iMinorVer") $BDEHeaderSize = DllStructGetData($bdeheader, "iHeaderSize") EndFunc ;==>GetBDEHeader Func GetBDERowBits($sourceFile, ByRef $nBytes) Local $ByteFields = (2 * $BDEColumns + 7) / 8 ;Local $bits = $BDEColumns * 2 ;Local $Shorts = Ceiling($bits / 16) Stdout("Reading RowStatus at :" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bdeirowstatus), DllStructGetSize($bdeirowstatus), $nBytes) Dim $BitBlock[$ByteFields + 1] For $b = 1 To $ByteFields _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bdeinullbits), DllStructGetSize($bdeinullbits), $nBytes) $BitBlock[$b] = DllStructGetData($bdeinullbits, "iNullBits") StdOut("Record bitrange [" & $b & "]" & $BitBlock[$b] & "->" & $BitBlock[$b] & "/" & Hex($BitBlock[$b])) ;StdOut("Current fileposition:" & Hex(_WinAPI_SetFilePointer($sourceFile, 0, 1))) Next Return $BitBlock EndFunc ;==>GetBDERowBits Func SetBDEHeader($targetFile, ByRef $nBytes, $BDEDataOffset = 0x0) Local $BDEMagic = 0xBDE01996, $BDEMajorVer = 0x1, $BDEMinorVer = 0x0, $BDEHeaderSize = 0x18 _WinAPI_SetFilePointer($targetFile, 0) DllStructSetData($bdeheader, "iMagicCookie", $BDEMagic) DllStructSetData($bdeheader, "iMajorVer", $BDEMajorVer) DllStructSetData($bdeheader, "iMinorVer", $BDEMinorVer) DllStructSetData($bdeheader, "iHeaderSize", $BDEHeaderSize) DllStructSetData($bdeOffset, "iDataOffset", $BDEDataOffset) _WinAPI_WriteFile($targetFile, DllStructGetPtr($bdeheader), DllStructGetSize($bdeheader), $nBytes) _WinAPI_WriteFile($targetFile, DllStructGetPtr($bdeOffset), DllStructGetSize($bdeOffset), $nBytes) EndFunc ;==>SetBDEHeader Func GetBDEDataProperties($sourceFile, ByRef $nBytes) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bdecolumncount), DllStructGetSize($bdecolumncount), $nBytes) ;StdOut("Columns "&Hex(_WinAPI_SetFilePointer($sourceFile, 0,1))) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bderowcount), DllStructGetSize($bderowcount), $nBytes) ;StdOut("Rows "&Hex(_WinAPI_SetFilePointer($sourceFile, 0,1))) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bdeproperties), DllStructGetSize($bdeproperties), $nBytes) ;StdOut("Properties "&Hex(_WinAPI_SetFilePointer($sourceFile, 0,1))) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($bdeOffset), DllStructGetSize($bdeOffset), $nBytes) ;StdOut("Offset "&Hex(_WinAPI_SetFilePointer($sourceFile, 0,1))) $BDEColumns = DllStructGetData($bdecolumncount, "iColCount") $BDERows = DllStructGetData($bderowcount, "iRowCount") $BDEPropertyValue = DllStructGetData($bdeproperties, "iProperties") $BDEDataOffset = DllStructGetData($bdeOffset, "iDataOffset") EndFunc ;==>GetBDEDataProperties Func SetBDEDataProperties($targetFile, $Columns, $Records, $properties) DllStructSetData($bdeproperties, "iProperties", $properties) DllStructSetData($bdecolumncount, "iColCount", $Columns) DllStructSetData($bderowcount, "iRowCount", $Records) EndFunc ;==>SetBDEDataProperties Func GetBDEColumnProperties($sourceFile, ByRef $nBytes) Dim $ColumnProperties[4] Local $str = "DWORD IColType;" $bdeColumnProperties = DllStructCreate($str) $str = "byte charsize[1]" $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), DllStructGetSize($gdbtitledata), $nBytes) $size = Number(DllStructGetData($gdbtitledata, "charsize")) $columntitle = DllStructCreate("char[" & $size & "]") $nBytes = $size $str = "char columntitle[" & StringStripWS(String($size), 8) & "]" $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), $size, $nBytes) $ColumnProperties[0] = DllStructGetData($gdbtitledata, "columntitle") #comments-start Type codes Name Value Type Description dsfldUNKNOWN 0 Unknown Unknown format. dsfldINT 1 Signed integer Size must be 1, 2, 4, or 8. dsfldUINT 2 Unsigned integer Size must be 1, 2, 4, or 8. dsfldBOOL 3 Boolean Size must be 1, 2, 4. dsfldFLOATIEEE 4 IEEE float Size must be 4 (Single), 8 (Double), or 10 (Extended). dsfldBCD 5 BCD Used for BDEfldBCD. Precision and decimals are given as optional parameters. (szWIDTH, szDECIMALS). dsfldDATE 6 Date Size must be 4. Used for BDEfldDATE. dsfldTIME 7 Time Size must be 4. Used for BDEfldTIME. dsfldTIMESTAMP 8 Timestamp Size must be 8. Used for BDEfldTIMESTAMP. dsfldZSTRING 9 Multi-byte string Used for BDEfldZSTRING. Varying field with 1 or 2-byte length prefix. Field-width is given as optional parameter (szWIDTH). dsfldUNICODE 1O Unicode string Size is in bytes and therefore always even. Varying field with 1 or 2-byte length prefix. Field-width is given as optional parameter (szWIDTH). dsfldBYTES 11 Bytes Used for BDEfldBYTES, fldVARBYTES, and fldBLOB. FldBYTES is fixed-length fldVARBYTES is variable length, with a 1 or 2-byte lengthprefix. fldBLOB is variable length, with a 4 byte length prefix. The subtype, if any, is given as optional parameter (SzSUBTYPE). Field-width is given as optional parameter (szWIDTH) forfldBYTES and fldVARBYTES. #comments-end ;0x00010001 1 byte, 8 bit BYTE ;0x00020004 4 bytes 32-bit ULONG ;0x00030002 2 bytes Boolean (0=False,1=True) ;0x00490001 1 byte length multibyte string ;0x004a0002, 2 byte length, unicode string ;0x004b0004 4 byte length, block bytes ;0x00820002 4 byte element count followed by x-many 16-bit ushorts $str = "DWORD iColType" $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), DllStructGetSize($gdbtitledata), $nBytes) $ColumnProperties[1] = DllStructGetData($gdbtitledata, "iColType") ;0x001 = column hidden, 0x0002 column is read only, 0x0004, column may not be null $str = "USHORT iColAttr;USHORT iParCount" $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), DllStructGetSize($gdbtitledata), $nBytes) $ColumnProperties[2] = DllStructGetData($gdbtitledata, "iColAttr") $ColumnProperties[3] = DllStructGetData($gdbtitledata, "iParCount") If $ColumnProperties[3] > 0 Then Local $ParTitle = "" For $x = 1 To $ColumnProperties[3] ReDim $ColumnProperties[UBound($ColumnProperties) + 2] $str = "byte charsize[1]" $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), DllStructGetSize($gdbtitledata), $nBytes) $size = Number(DllStructGetData($gdbtitledata, "charsize")) $str = "byte iParTitle[" & StringStripWS(String($size), 8) & "]" $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), DllStructGetSize($gdbtitledata), $nBytes) $ParTitle = DllStructGetData($gdbtitledata, "iParTitle") If StringLeft($ParTitle, 2) == "0x" Then $ColumnProperties[UBound($ColumnProperties) - 2] = BinaryToString($ParTitle) Else $ColumnProperties[UBound($ColumnProperties) - 2] = $ParTitle EndIf Local $FieldStructureSize = "USHORT FieldSize" Switch $ParTitle Case "DEFAULT_ORDER" $FieldStructureSize = "USHORT FieldSize" Case "UNIQUE_KEY" $FieldStructureSize = "USHORT FieldSize" Case "CHANGE_LOG" $FieldStructureSize = "DWORD FieldSize" Case "SERVER_COL" ; String $FieldStructureSize = "USHORT FieldSize" Case "ZLCID" $FieldStructureSize = "DWORD FieldSize" Case "READONLY" ; Boolean $FieldStructureSize = "USHORT FieldSize" Case "WIDTH" $FieldStructureSize = "USHORT FieldSize" Case "DECIMALS" $FieldStructureSize = "USHORT FieldSize" Case "SUBTYPE" ; String $FieldStructureSize = "USHORT FieldSize" Case "DATASET_DELTA" ;Boolean $FieldStructureSize = "USHORT FieldSize" Case "DATASET_CONTEXT" $FieldStructureSize = "UBYTE FieldSize" Case "BDEDOMX" $FieldStructureSize = "UBYTE FieldSize" Case "BDERECX" $FieldStructureSize = "UBYTE FieldSize" Case "BDEDEFX" $FieldStructureSize = "UBYTE FieldSize" Case "AUTOINCVALUE" ; Indicates the next value to use in a column in case a new row is inserted. This parameter can be used to simulate the semantics of an autoincrement field. $FieldStructureSize = "DWORD FieldSize" EndSwitch $str = "byte datatype[4];" & $FieldStructureSize $gdbtitledata = DllStructCreate($str) _WinAPI_ReadFile($sourceFile, DllStructGetPtr($gdbtitledata), DllStructGetSize($gdbtitledata), $nBytes) $ColumnProperties[UBound($ColumnProperties) - 1] = DllStructGetData($gdbtitledata, "FieldSize") Next EndIf Return $ColumnProperties EndFunc ;==>GetBDEColumnProperties Func StdOut($text) If $Debug Then ConsoleWrite($text & @CRLF) EndIf EndFunc ;==>StdOut Func StartSQL() _SQLite_Startup() If @error Then MsgBox(16, "SQLite Error:" & @error, "SQLite3.dll kan niet opgestart worden!") Exit -1 Else _SQLite_SafeMode(True) EndIf StdOut("(LPC) _SQLite_LibVersion=" & _SQLite_LibVersion() & @CRLF) EndFunc ;==>StartSQL Func OpenDb($dbfile) Local $DBHandle If StringStripWS($dbfile,8) <> "" Then Local $szDrive, $szDir, $szFName, $szExt, $DBHandle Local $TestPath = _PathSplit($dbfile, $szDrive, $szDir, $szFName, $szExt) If Not FileExists($szDrive & $szDir) Then Local $text = "Database folder created: [" & $szDrive & $szDir & "]" StdOut($text) DirCreate($szDrive & $szDir) EndIf $DBHandle = _SQLite_Open($dbfile) ; Open a permanent disk database Else $DBHandle = _SQLite_Open() ; Open a permanent disk database EndIf If @error Then MsgBox(16, "SQLite Error", $szFName & $szExt & " kan niet worden geopend of gemaakt!") CheckError(@extended, $DBHandle, $dbfile) $DBHandle = -1 ;Exit -1 EndIf Return $DBHandle EndFunc ;==>OpenDb Func CloseDb($DBHandle) _SQLite_Close($DBHandle) EndFunc ;==>CloseDb Func ClearDb($dbfile) FileDelete($dbfile) EndFunc ;==>ClearDb Func StopSQL() _SQLite_Shutdown() EndFunc ;==>StopSQL Func Exec($DBHandle, $DBCommand) Local $result = _SQLite_Exec($DBHandle, $DBCommand) Local $RetryTimer = TimerInit() While @error ; Check if the Database is locked:retry (WAL mode is enabled, but somehow XP file-locking doesn't give a shit about that) If _SQLite_ErrCode($DBHandle) == 5 Or _SQLite_ErrCode($DBHandle) == 6 Then If TimerDiff($RetryTimer) > 5000 Then;Escape when retry fails within 5 seconds CheckError($result, $DBHandle, $DBCommand) ExitLoop EndIf $result = _SQLite_Exec($DBHandle, $DBCommand) Else ; If @error Then CheckError($result, $DBHandle, $DBCommand) ; EndIf ExitLoop EndIf WEnd EndFunc ;==>Exec Func Query($DBHandle, $DBCommand) Local $hQuery, $aRow If IsArray($QueryList) Then ReDim $QueryList[1] Else Dim $QueryList[1] EndIf $QueryList[0] = 0 _SQLite_Query($DBHandle, $DBCommand, $hQuery) ; the query While _SQLite_FetchData($hQuery, $aRow) = $SQLITE_OK ReDim $QueryList[UBound($QueryList) + 1] $QueryList[0] = UBound($QueryList) - 1 For $x = 0 To UBound($aRow) - 1 $QueryList[$QueryList[0]] &= $aRow[$x] If $x < UBound($aRow) - 1 Then $QueryList[$QueryList[0]] &= "\*" EndIf Next WEnd _SQLite_QueryFinalize($hQuery) Return $QueryList EndFunc ;==>Query Func Query2D($DBHandle, $DBCommand) Local $iRows, $iColumns, $QueryResult If UBound($QueryList) > 0 Then ReDim $QueryList[1][1] Else Dim $QueryList[1][1] EndIf $QueryList[0][0] = 0 $QueryResult = _SQLite_GetTable2d($DBHandle, $DBCommand, $QueryList, $iRows, $iColumns) If $QueryResult = $SQLITE_OK Then Return $QueryList Else Dim $QueryList[1][1] $QueryList[0][0] = 0 Return $QueryList EndIf EndFunc ;==>Query2D Func CheckError($errorcode, $DBHandle, $DBCommand) Dim $CriticalErrors[17] $CriticalErrors[0] = 3 ;/* Access permission denied */ $CriticalErrors[1] = 5 ;/* The database file is locked */ $CriticalErrors[2] = 6 ;/* A table in the database is locked */ $CriticalErrors[3] = 7 ;/* A malloc() failed */ $CriticalErrors[4] = 8 ;/* Attempt to write a readonly database */ $CriticalErrors[5] = 10 ; /* Some kind of disk I/O error occurred */ $CriticalErrors[6] = 11 ; /* The database disk image is malformed */ $CriticalErrors[7] = 13 ; /* Insertion failed because database is full */ $CriticalErrors[8] = 14 ; /* Unable to open the database file */ $CriticalErrors[9] = 15 ; /* Database lock protocol error */ $CriticalErrors[10] = 17 ; /* The database schema changed */ $CriticalErrors[11] = 18 ; /* Too much data for one row of a table */ $CriticalErrors[12] = 19 ; /* Abort due to constraint violation */ Not unique etc. $CriticalErrors[13] = 20 ; /* Data type mismatch */ $CriticalErrors[14] = 21 ; /* Library used incorrectly */ $CriticalErrors[15] = 22 ; /* Uses OS features not supported on host */ $CriticalErrors[16] = 23 ; /* Authorization denied */ ; Global Const $SQLITE_OK = 0 ; /* Successful result */ ;Global Const $SQLITE_ERROR = 1 ; /* SQL error or missing database */ Table ;Global Const $SQLITE_INTERNAL = 2 ; /* An internal logic error in SQLite */ ;Global Const $SQLITE_PERM = 3 ; /* Access permission denied */ ;Global Const $SQLITE_ABORT = 4 ; /* Callback routine requested an abort */ ;Global Const $SQLITE_BUSY = 5 ; /* The database file is locked */ ;Global Const $SQLITE_LOCKED = 6 ; /* A table in the database is locked */ ;Global Const $SQLITE_NOMEM = 7 ; /* A malloc() failed */ ;Global Const $SQLITE_READONLY = 8 ; /* Attempt to write a readonly database */ ;Global Const $SQLITE_INTERRUPT = 9 ; /* Operation terminated by sqlite_interrupt() */ ;Global Const $SQLITE_IOERR = 10 ; /* Some kind of disk I/O error occurred */ ;Global Const $SQLITE_CORRUPT = 11 ; /* The database disk image is malformed */ ;Global Const $SQLITE_NOTFOUND = 12 ; /* (Internal Only) Table or record not found */ ;Global Const $SQLITE_FULL = 13 ; /* Insertion failed because database is full */ ;Global Const $SQLITE_CANTOPEN = 14 ; /* Unable to open the database file */ ;Global Const $SQLITE_PROTOCOL = 15 ; /* Database lock protocol error */ ;Global Const $SQLITE_EMPTY = 16 ; /* (Internal Only) Database table is empty */ ;Global Const $SQLITE_SCHEMA = 17 ; /* The database schema changed */ ;Global Const $SQLITE_TOOBIG = 18 ; /* Too much data for one row of a table */ ;Global Const $SQLITE_CONSTRAINT = 19 ; /* Abort due to constraint violation */ Not unique etc. ;Global Const $SQLITE_MISMATCH = 20 ; /* Data type mismatch */ ;Global Const $SQLITE_MISUSE = 21 ; /* Library used incorrectly */ ;Global Const $SQLITE_NOLFS = 22 ; /* Uses OS features not supported on host */ ;Global Const $SQLITE_AUTH = 23 ; /* Authorization denied */ ; For $x = 0 To UBound($CriticalErrors) -1 If _SQLite_ErrCode($DBHandle) <> 0 Then Local $text = "SQL fout [" & _SQLite_ErrCode($DBHandle) & "]:" & _SQLite_ErrMsg($DBHandle) & " <- [" & $DBCommand & "]" & @CRLF StdOut($text) ;MsgBox(16,"SQL Error",$Text) EndIf ; Next EndFunc ;==>CheckError BDE_Fast_test.zip