pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

TParadoxDataset: Fix compilation for 64-bit target.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6892 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-07 17:22:44 +00:00
parent acda1ecd09
commit 999664065a
1 changed files with 53 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
components/tparadoxdataset/paradoxds.pas
View File

@ -9,7 +9,7 @@ unit paradoxds;
interface interface
uses uses
Classes, SysUtils, db, Forms, Objects, LclProc; Classes, SysUtils, db, Forms, Objects, LclProc;
@ -66,8 +66,8 @@ type
unknown12x13 : word; unknown12x13 : word;
modifiedFlags1 : byte; modifiedFlags1 : byte;
indexFieldNumber : byte; indexFieldNumber : byte;
primaryIndexWorkspace : pointer; primaryIndexWorkspace : longint; // currently not used; cast to "pointer"
unknownPtr1A : pointer; unknownPtr1A : longint; // not used; cast to pointer;
unknown1Ex20 : array[$001E..$0020] of byte; unknown1Ex20 : array[$001E..$0020] of byte;
numFields : smallint; numFields : smallint;
primaryKeyFields : smallint; primaryKeyFields : smallint;
@ -78,16 +78,16 @@ type
changeCount1 : byte; changeCount1 : byte;
changeCount2 : byte; changeCount2 : byte;
unknown2F : byte; unknown2F : byte;
tableNamePtrPtr : ^pchar; tableNamePtrPtr : longint; // must be cast to ^pchar
fldInfoPtr : PFldInfoRec; fldInfoPtr : longint; // must be cast to PFldInfoRec
writeProtected : byte; writeProtected : byte;
fileVersionID : byte; fileVersionID : byte;
maxBlocks : word; maxBlocks : word;
unknown3C : byte; unknown3C : byte;
auxPasswords : byte; auxPasswords : byte;
unknown3Ex3F : array[$003E..$003F] of byte; unknown3Ex3F : array[$003E..$003F] of byte;
cryptInfoStartPtr : pointer; cryptInfoStartPtr : longint; // not used; cast to pointer
cryptInfoEndPtr : pointer; cryptInfoEndPtr : longint; // not used; cast to pointer
unknown48 : byte; unknown48 : byte;
autoIncVal : longint; autoIncVal : longint;
unknown4Dx4E : array[$004D..$004E] of byte; unknown4Dx4E : array[$004D..$004E] of byte;
@ -150,9 +150,9 @@ type
FaRecord : Longword; FaRecord : Longword;
FaBlockstart : LongInt; FaBlockstart : LongInt;
FaBlock : PDataBlock; FaBlock : PDataBlock;
FaBlockIdx : word; FaBlockIdx: word;
FBlockReaded : Boolean; FBlockReaded: Boolean;
FBookmarkOfs :LongWord; FBookmarkOfs: LongWord;
procedure SetFileName(const AValue: TFileName); procedure SetFileName(const AValue: TFileName);
function GetEncrypted: Boolean; function GetEncrypted: Boolean;
@ -311,10 +311,12 @@ begin
DatabaseError('No valid Paradox file !'); DatabaseError('No valid Paradox file !');
if not ((FHeader^.maxTableSize >= 1) and (FHeader^.maxTableSize <= 4)) then if not ((FHeader^.maxTableSize >= 1) and (FHeader^.maxTableSize <= 4)) then
DatabaseError('No valid Paradox file !'); DatabaseError('No valid Paradox file !');
if (FHeader^.fileVersionID <= 4) or not (FHeader^.fileType in [0,2,3,5]) then if (FHeader^.fileVersionID <= 4) or not (FHeader^.FileType in [0,2,3,5]) then
FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo35) // FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo35)
FHeader^.fldInfoPtr := LongInt(PtrInt(@FHeader^.fieldInfo35))
else else
FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo); // FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo);
FHeader^.fldInfoPtr := longint(PtrInt(@FHeader^.fieldInfo));
if Encrypted then exit; if Encrypted then exit;
FaBlock := AllocMem(FHeader^.maxTableSize * $0400); FaBlock := AllocMem(FHeader^.maxTableSize * $0400);
BookmarkSize := SizeOf(longword); BookmarkSize := SizeOf(longword);
@ -341,41 +343,42 @@ var
i : integer; i : integer;
F : PFldInfoRec; F : PFldInfoRec;
FNamesStart : PChar; FNamesStart : PChar;
fname: String;
begin begin
FieldDefs.Clear; FieldDefs.Clear;
F := FHeader^.fldInfoPtr; { begin with the first field identifier } F := PFldInfoRec(PtrInt(FHeader^.fldInfoPtr)); { begin with the first field identifier }
FNamesStart := Pointer(F); FNamesStart := Pointer(F);
//anyone an better solution for this ? inc(FNamesStart, sizeof(F^)*(FHeader^.numFields)); //Jump over Fielddefs
inc(ptrrec(FNamesStart).ofs, sizeof(F^)*(FHeader^.numFields));//Jump over Fielddefs inc(FNamesStart, sizeof(LongInt)); //over Tablenameptr
inc(ptrrec(FNamesStart).ofs, sizeof(Pointer)); //over Tablenameptr inc(FNamesStart, sizeof(LongInt)*(FHeader^.numFields)); //over Fieldnamepointers
inc(ptrrec(FNamesStart).ofs, sizeof(PChar)*(FHeader^.numFields));//over Fieldnamepointers inc(FNamesStart, Strlen(FNamesStart)+1); //over Tablename
inc(ptrrec(FNamesStart).ofs, Strlen(FnamesStart)+1); //over Tablename
while FnamesStart^ = char(0) do while FnamesStart^ = char(0) do
inc(ptrrec(FNamesStart).ofs); //over Padding inc(FNamesStart); //over Padding
For i := 1 to FHeader^.numFields do For i := 1 to FHeader^.numFields do
begin begin
case F^.fType of fname := StrPas(FNamesStart);
pxfAlpha: Fielddefs.Add(StrPas(FNamesStart),ftString,F^.fSize); case F^.fType of
pxfDate: Fielddefs.Add(StrPas(FNamesStart),ftDate,0); pxfAlpha: Fielddefs.Add(fname, ftString, F^.fSize);
pxfShort: Fielddefs.Add(StrPas(FNamesStart),ftSmallInt,F^.fSize); pxfDate: Fielddefs.Add(fname, ftDate, 0);
pxfLong: Fielddefs.Add(StrPas(FNamesStart),ftInteger,F^.fSize); pxfShort: Fielddefs.Add(fname, ftSmallInt, F^.fSize);
pxfCurrency: Fielddefs.Add(StrPas(FNamesStart),ftFloat,F^.fSize); pxfLong: Fielddefs.Add(fname, ftInteger, F^.fSize);
pxfNumber: Fielddefs.Add(StrPas(FNamesStart),ftFloat,F^.fSize); pxfCurrency: Fielddefs.Add(fname, ftFloat, F^.fSize);
pxfLogical: Fielddefs.Add(StrPas(FNamesStart),ftBoolean,F^.fSize); pxfNumber: Fielddefs.Add(fname, ftFloat, F^.fSize);
pxfMemoBLOb: Fielddefs.Add(StrPas(FNamesStart),ftMemo,F^.fSize); pxfLogical: Fielddefs.Add(fname, ftBoolean, F^.fSize);
pxfBLOb: Fielddefs.Add(StrPas(FNamesStart),ftBlob,F^.fSize); pxfMemoBLOb: Fielddefs.Add(fname, ftMemo, F^.fSize);
pxfFmtMemoBLOb:Fielddefs.Add(StrPas(FNamesStart),ftMemo,F^.fSize); pxfBLOb: Fielddefs.Add(fname, ftBlob, F^.fSize);
pxfOLE: Fielddefs.Add(StrPas(FNamesStart),ftBlob,F^.fSize); pxfFmtMemoBLOb: Fielddefs.Add(fname, ftMemo, F^.fSize);
pxfGraphic: Fielddefs.Add(StrPas(FNamesStart),ftBlob,F^.fSize); pxfOLE: Fielddefs.Add(fname, ftBlob, F^.fSize);
pxfTime: Fielddefs.Add(StrPas(FNamesStart),ftTime,F^.fSize); pxfGraphic: Fielddefs.Add(fname, ftBlob, F^.fSize);
pxfTimestamp:Fielddefs.Add(StrPas(FNamesStart),ftdateTime,0); pxfTime: Fielddefs.Add(fname, ftTime, F^.fSize);
pxfAutoInc: Fielddefs.Add(StrPas(FNamesStart),ftAutoInc,F^.fSize); pxfTimestamp: Fielddefs.Add(fname, ftDateTime, 0);
pxfBCD: Fielddefs.Add(StrPas(FNamesStart),ftBCD,F^.fSize); pxfAutoInc: Fielddefs.Add(fname, ftAutoInc, F^.fSize);
pxfBytes: Fielddefs.Add(StrPas(FNamesStart),ftString,F^.fSize); pxfBCD: Fielddefs.Add(fname, ftBCD, F^.fSize);
end; pxfBytes: Fielddefs.Add(fname, ftString, F^.fSize);
inc(ptrrec(FNamesStart).ofs, Strlen(FnamesStart)+1);
inc(ptrrec(F).ofs, sizeof(F^));
end; end;
inc(FNamesStart, Length(fname)+1);
inc(F);
end;
end; end;
function TParadoxDataSet.AllocRecordBuffer: PChar; function TParadoxDataSet.AllocRecordBuffer: PChar;
@ -575,17 +578,21 @@ var
d: Double absolute s; d: Double absolute s;
begin begin
Result := False; Result := False;
F := FHeader^.fldInfoPtr; { begin with the first field identifier } // F := FHeader^.fldInfoPtr; { begin with the first field identifier }
F := PFldInfoRec(PtrInt(FHeader^.fldInfoPtr)); { begin with the first field identifier }
p := ActiveBuffer; p := ActiveBuffer;
For i := 1 to FHeader^.numFields do For i := 1 to FHeader^.numFields do
begin begin
if i = Field.FieldNo then if i = Field.FieldNo then
break; break;
If F^.fType = pxfBCD then { BCD field size value not used for field size } If F^.fType = pxfBCD then { BCD field size value not used for field size }
Inc(ptrrec(p).ofs, 17) //Inc(ptrrec(p).ofs, 17)
Inc(p, 17)
else else
Inc(ptrrec(p).ofs, F^.fSize); //Inc(ptrrec(p).ofs, F^.fSize);
Inc(ptrrec(F).ofs, sizeof(F^)); Inc(p, F^.fSize);
//Inc(ptrrec(F).ofs, sizeof(F^));
Inc(F);
end; end;
If F^.fType = pxfBCD then { BCD field size value not used for field size } If F^.fType = pxfBCD then { BCD field size value not used for field size }
size := 17 size := 17