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

TParadoxDataset: Avoid some ugly type-casts. Usable in Linux/64bit now.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6896 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-08 08:46:16 +00:00
parent bc06514531
commit 9a2aca4fed
2 changed files with 15 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/tparadoxdataset/lazparadoxpkg.lpk
View File

@@ -19,7 +19,7 @@
</CompilerOptions> </CompilerOptions>
<Description Value="Dataset for Paradox database files <Description Value="Dataset for Paradox database files
Read-only Read-only
Tested on Windows (32/64 bit) and Linux (32bit)"/> Tested on Win and Linux gtk2/qt (32bit/64bit)"/>
<License Value="LGPL"/> <License Value="LGPL"/>
<Version Minor="2"/> <Version Minor="2"/>
<Files Count="2"> <Files Count="2">

29
components/tparadoxdataset/paradoxds.pas
View File

@@ -79,7 +79,7 @@ type
changeCount2 : byte; changeCount2 : byte;
unknown2F : byte; unknown2F : byte;
tableNamePtrPtr : longint; // must be cast to ^pchar tableNamePtrPtr : longint; // must be cast to ^pchar
fldInfoPtr : longint; // must be cast to PFldInfoRec fldInfo : longint; // use FFieldInfoPtr instead
writeProtected : byte; writeProtected : byte;
fileVersionID : byte; fileVersionID : byte;
maxBlocks : word; maxBlocks : word;
@@ -153,6 +153,7 @@ type
FaBlockIdx: word; FaBlockIdx: word;
FBlockReaded: Boolean; FBlockReaded: Boolean;
FBookmarkOfs: LongWord; FBookmarkOfs: LongWord;
FFieldInfoPtr: PFldInfoRec;
procedure SetFileName(const AValue: TFileName); procedure SetFileName(const AValue: TFileName);
function GetEncrypted: Boolean; function GetEncrypted: Boolean;
@@ -189,8 +190,8 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
property Encrypted : Boolean read GetEncrypted; property Encrypted : Boolean read GetEncrypted;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
published published
property TableName : TFileName read FFileName write SetFileName; property TableName : TFileName read FFileName write SetFileName;
property TableLevel : real read GetVersion; property TableLevel : real read GetVersion;
@@ -312,11 +313,9 @@ begin
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) FFieldInfoPtr := @FHeader^.FieldInfo35
FHeader^.fldInfoPtr := LongInt(PtrInt(@FHeader^.fieldInfo35))
else else
// FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo); FFieldInfoPtr := @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);
@@ -340,21 +339,21 @@ end;
procedure TParadoxDataSet.InternalInitFieldDefs; procedure TParadoxDataSet.InternalInitFieldDefs;
var var
i : integer; i: integer;
F : PFldInfoRec; F: PFldInfoRec;
FNamesStart : PChar; FNamesStart: PChar;
fname: String; fname: String;
begin begin
FieldDefs.Clear; FieldDefs.Clear;
F := PFldInfoRec(PtrInt(FHeader^.fldInfoPtr)); { begin with the first field identifier } F := FFieldInfoPtr; { begin with the first field identifier }
FNamesStart := Pointer(F); FNamesStart := Pointer(F);
inc(FNamesStart, sizeof(F^)*(FHeader^.numFields)); //Jump over Fielddefs inc(FNamesStart, sizeof(F^)*(FHeader^.numFields)); //Jump over Fielddefs
inc(FNamesStart, sizeof(LongInt)); //over Tablenameptr inc(FNamesStart, sizeof(LongInt)); //over TableName pointer
inc(FNamesStart, sizeof(LongInt)*(FHeader^.numFields)); //over Fieldnamepointers inc(FNamesStart, sizeof(LongInt)*(FHeader^.numFields)); //over FieldName pointers
inc(FNamesStart, Strlen(FNamesStart)+1); //over Tablename inc(FNamesStart, Strlen(FNamesStart)+1); //over Tablename
while FnamesStart^ = char(0) do while FNamesStart^ = char(0) do
inc(FNamesStart); //over Padding inc(FNamesStart); //over Padding
For i := 1 to FHeader^.numFields do for i := 1 to FHeader^.NumFields do
begin begin
fname := StrPas(FNamesStart); fname := StrPas(FNamesStart);
case F^.fType of case F^.fType of
@@ -579,7 +578,7 @@ var
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 } F := FFieldInfoPtr; { 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