4bda1c0662
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1197 8e941d3f-bd1b-0410-a28a-d453659cc2b4
667 lines
18 KiB
ObjectPascal
667 lines
18 KiB
ObjectPascal
unit paradoxds;
|
|
|
|
{ TParadoxdataSet
|
|
Christian Ulrich christian@ullihome.de
|
|
License: LGPL
|
|
}
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, db, Forms, Objects, LclProc;
|
|
|
|
|
|
const
|
|
{ Paradox codes for field types }
|
|
pxfAlpha = $01;
|
|
pxfDate = $02;
|
|
pxfShort = $03;
|
|
pxfLong = $04;
|
|
pxfCurrency = $05;
|
|
pxfNumber = $06;
|
|
pxfLogical = $09;
|
|
pxfMemoBLOb = $0C;
|
|
pxfBLOb = $0D;
|
|
pxfFmtMemoBLOb = $0E;
|
|
pxfOLE = $0F;
|
|
pxfGraphic = $10;
|
|
pxfTime = $14;
|
|
pxfTimestamp = $15;
|
|
pxfAutoInc = $16;
|
|
pxfBCD = $17;
|
|
pxfBytes = $18;
|
|
|
|
|
|
type
|
|
{Internal Record information}
|
|
PRecInfo = ^TRecInfo;
|
|
TRecInfo = packed record
|
|
RecordNumber: PtrInt;
|
|
BookmarkFlag: TBookmarkFlag;
|
|
end;
|
|
|
|
PLongWord = ^Longword;
|
|
|
|
{ field information record used in TPxHeader below }
|
|
PFldInfoRec = ^TFldInfoRec;
|
|
TFldInfoRec = packed RECORD
|
|
fType : byte;
|
|
fSize : byte;
|
|
end;
|
|
|
|
|
|
PPxHeader = ^TPxHeader;
|
|
TPxHeader = packed RECORD
|
|
recordSize : word;
|
|
headerSize : word;
|
|
fileType : byte;
|
|
maxTableSize : byte;
|
|
numRecords : longint;
|
|
nextBlock : word;
|
|
fileBlocks : word;
|
|
firstBlock : word;
|
|
lastBlock : word;
|
|
unknown12x13 : word;
|
|
modifiedFlags1 : byte;
|
|
indexFieldNumber : byte;
|
|
primaryIndexWorkspace : pointer;
|
|
unknownPtr1A : pointer;
|
|
unknown1Ex20 : array[$001E..$0020] of byte;
|
|
numFields : smallint;
|
|
primaryKeyFields : smallint;
|
|
encryption1 : longint;
|
|
sortOrder : byte;
|
|
modifiedFlags2 : byte;
|
|
unknown2Bx2C : array[$002B..$002C] of byte;
|
|
changeCount1 : byte;
|
|
changeCount2 : byte;
|
|
unknown2F : byte;
|
|
tableNamePtrPtr : ^pchar;
|
|
fldInfoPtr : PFldInfoRec;
|
|
writeProtected : byte;
|
|
fileVersionID : byte;
|
|
maxBlocks : word;
|
|
unknown3C : byte;
|
|
auxPasswords : byte;
|
|
unknown3Ex3F : array[$003E..$003F] of byte;
|
|
cryptInfoStartPtr : pointer;
|
|
cryptInfoEndPtr : pointer;
|
|
unknown48 : byte;
|
|
autoIncVal : longint;
|
|
unknown4Dx4E : array[$004D..$004E] of byte;
|
|
indexUpdateRequired : byte;
|
|
unknown50x54 : array[$0050..$0054] of byte;
|
|
refIntegrity : byte;
|
|
unknown56x57 : array[$0056..$0057] of byte;
|
|
case smallint of
|
|
3: (fieldInfo35 : array[1..255] of TFldInfoRec);
|
|
4: (fileVerID2 : smallint;
|
|
fileVerID3 : smallint;
|
|
encryption2 : longint;
|
|
fileUpdateTime : longint; { 4.0 only }
|
|
hiFieldID : word;
|
|
hiFieldIDinfo : word;
|
|
sometimesNumFields:smallint;
|
|
dosCodePage : word;
|
|
unknown6Cx6F : array[$006C..$006F] of byte;
|
|
changeCount4 : smallint;
|
|
unknown72x77 : array[$0072..$0077] of byte;
|
|
fieldInfo : array[1..255] of TFldInfoRec);
|
|
|
|
{ This is only the first part of the file header. The last field
|
|
is described as an array of 255 elements, but its size is really
|
|
determined by the number of fields in the table. The actual
|
|
table header has more information that follows. }
|
|
end;
|
|
|
|
{Paradox Data Block Header}
|
|
PDataBlock = ^TDataBlock;
|
|
TDataBlock = packed RECORD
|
|
nextBlock : word;
|
|
prevBlock : word;
|
|
addDataSize : smallint;
|
|
fileData : array[0..$0FF9] of byte;
|
|
{ fileData size varies according to maxTableSize }
|
|
end;
|
|
|
|
{ APdoxBlk = packed record
|
|
Next,
|
|
Prev,
|
|
Last: Word;
|
|
end;}
|
|
|
|
{10-byte Blob Info Block}
|
|
APdoxBlob = packed record
|
|
Offset,
|
|
Length: LongWord;
|
|
ModNum: Word;
|
|
end;
|
|
|
|
{ TParadoxDataSet }
|
|
|
|
TParadoxDataSet = class(TDataSet)
|
|
private
|
|
FActive : Boolean;
|
|
FStream : TFileStream;
|
|
FFileName: TFileName;
|
|
FHeader : PPxHeader;
|
|
FaRecord : Longword;
|
|
FaBlockstart : LongInt;
|
|
FaBlock : PDataBlock;
|
|
FaBlockIdx : word;
|
|
FBlockReaded : Boolean;
|
|
FBookmarkOfs :LongWord;
|
|
|
|
procedure SetFileName(const AValue: TFileName);
|
|
function GetEncrypted: Boolean;
|
|
procedure ReadBlock;
|
|
procedure ReadNextBlockHeader;
|
|
procedure ReadPrevBlockHeader;
|
|
function GetVersion: real;
|
|
protected
|
|
procedure InternalOpen; override;
|
|
procedure InternalClose; override;
|
|
procedure InternalInitFieldDefs; override;
|
|
function AllocRecordBuffer: PChar; override;
|
|
procedure FreeRecordBuffer(var Buffer: PChar); override;
|
|
function GetRecordCount: Integer; override;
|
|
function IsCursorOpen: Boolean; override;
|
|
procedure InternalFirst; override;
|
|
procedure InternalHandleException; override;
|
|
procedure InternalInitRecord(Buffer: PChar); override;
|
|
procedure InternalLast; override;
|
|
procedure InternalPost; override;
|
|
procedure InternalEdit; override;
|
|
procedure InternalSetToRecord(Buffer: PChar); override;
|
|
procedure InternalGotoBookmark(ABookmark: Pointer); override;
|
|
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
|
|
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
|
|
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
|
|
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
|
|
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
|
|
function GetRecordSize: Word; override;
|
|
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
|
|
function GetCanModify: Boolean;override;
|
|
procedure SetRecNo(Value: Integer); override;
|
|
function GetRecNo: Integer; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property Encrypted : Boolean read GetEncrypted;
|
|
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
|
|
published
|
|
property TableName : TFileName read FFileName write SetFileName;
|
|
property TableLevel : real read GetVersion;
|
|
property FieldDefs;
|
|
property Active;
|
|
property AutoCalcFields;
|
|
property Filtered;
|
|
property BeforeOpen;
|
|
property AfterOpen;
|
|
property BeforeClose;
|
|
property AfterClose;
|
|
property BeforeInsert;
|
|
property AfterInsert;
|
|
property BeforeEdit;
|
|
property AfterEdit;
|
|
property BeforePost;
|
|
property AfterPost;
|
|
property BeforeCancel;
|
|
property AfterCancel;
|
|
property BeforeDelete;
|
|
property AfterDelete;
|
|
property BeforeScroll;
|
|
property AfterScroll;
|
|
// property BeforeRefresh;
|
|
// property AfterRefresh;
|
|
property OnCalcFields;
|
|
property OnDeleteError;
|
|
property OnEditError;
|
|
property OnFilterRecord;
|
|
property OnNewRecord;
|
|
property OnPostError;
|
|
end;
|
|
|
|
implementation
|
|
|
|
|
|
{ TParadoxDataSet }
|
|
|
|
procedure TParadoxDataSet.SetFileName(const AValue: TFileName);
|
|
begin
|
|
if Active then
|
|
Close;
|
|
FFilename := AValue;
|
|
end;
|
|
|
|
function TParadoxDataSet.GetEncrypted: Boolean;
|
|
begin
|
|
if not Assigned(FHeader) then exit;
|
|
If (FHeader^.fileVersionID <= 4) or not (FHeader^.fileType in [0,2,3,5]) then
|
|
Result := (FHeader^.encryption1 <> 0)
|
|
else
|
|
Result := (FHeader^.encryption2 <> 0)
|
|
end;
|
|
|
|
procedure TParadoxDataSet.ReadBlock;
|
|
var
|
|
L : longint;
|
|
begin
|
|
L := FaBlockIdx-1;
|
|
L := (L * FHeader^.maxTableSize * $0400) + FHeader^.headerSize;
|
|
FStream.Position := L;
|
|
FStream.Read(FaBlock^, FHeader^.maxTableSize * $0400);
|
|
FBlockReaded := True;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.ReadNextBlockHeader;
|
|
var
|
|
L : longint;
|
|
begin
|
|
if FaBlock^.nextBlock = 0 then exit; //last block
|
|
//Increment Blockstart
|
|
FaBlockStart := FaBlockStart+(FaBlock^.addDataSize div FHeader^.recordSize)+1;
|
|
FaRecord := FaBlockStart+1;
|
|
L := FaBlock^.nextBlock-1;
|
|
L := (L * FHeader^.maxTableSize * $0400) + FHeader^.headerSize;
|
|
FaBlockIdx := FaBlock^.nextBlock;
|
|
FBlockReaded := False;
|
|
FStream.Position := L;
|
|
FStream.Read(FaBlock^,6); //read only Block header
|
|
end;
|
|
|
|
procedure TParadoxDataSet.ReadPrevBlockHeader;
|
|
var
|
|
L: LongWord;
|
|
begin
|
|
L := FaBlock^.prevBlock-1;
|
|
L := (L * FHeader^.maxTableSize * $0400) + FHeader^.headerSize;
|
|
FaBlockIdx := FaBlock^.prevBlock;
|
|
FBlockReaded := False;
|
|
FStream.Position := L;
|
|
FStream.Read(FaBlock^,6); //read only Block header
|
|
//decrement Blockstart
|
|
L := ((FaBlock^.addDataSize div FHeader^.recordSize)+1);
|
|
FaBlockStart := FaBlockStart-L;
|
|
FaRecord := FaBlockStart+1;
|
|
end;
|
|
|
|
function TParadoxDataSet.GetVersion: real;
|
|
begin
|
|
Result := 0;
|
|
if not FActive then exit;
|
|
if not Assigned(FHeader) then exit;
|
|
case FHeader^.fileVersionID of
|
|
$3:Result := 3.0;
|
|
$4:Result := 3.5;
|
|
$5..$9:Result := 4.0;
|
|
$a..$b:Result := 5.0;
|
|
$c:Result := 7.0;
|
|
end;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalOpen;
|
|
begin
|
|
FStream := TFileStream.Create(FFilename,fmOpenRead or fmShareDenyNone);
|
|
FHeader := AllocMem($800);
|
|
FStream.Position := 0;
|
|
if not FStream.Read(FHeader^, $800) = sizeof(FHeader^) then
|
|
DatabaseError('No valid Paradox file !');
|
|
if not ((FHeader^.maxTableSize >= 1) and (FHeader^.maxTableSize <= 4)) then
|
|
DatabaseError('No valid Paradox file !');
|
|
if (FHeader^.fileVersionID <= 4) or not (FHeader^.fileType in [0,2,3,5]) then
|
|
FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo35)
|
|
else
|
|
FHeader^.fldInfoPtr := addr(FHeader^.fieldInfo);
|
|
if Encrypted then exit;
|
|
FaBlock := AllocMem(FHeader^.maxTableSize * $0400);
|
|
BookmarkSize := SizeOf(longword);
|
|
InternalFirst;
|
|
InternalInitFieldDefs;
|
|
if DefaultFields then CreateFields;
|
|
BindFields(True);
|
|
FActive := True;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalClose;
|
|
begin
|
|
BindFields(FALSE);
|
|
if DefaultFields then // Destroy the TField
|
|
DestroyFields;
|
|
Freemem(FHeader);
|
|
Freemem(FaBlock);
|
|
FHeader := nil;
|
|
FActive := False;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalInitFieldDefs;
|
|
var
|
|
i : integer;
|
|
F : PFldInfoRec;
|
|
FNamesStart : PChar;
|
|
begin
|
|
FieldDefs.Clear;
|
|
F := FHeader^.fldInfoPtr; { begin with the first field identifier }
|
|
FNamesStart := Pointer(F);
|
|
//anyone an better solution for this ?
|
|
inc(ptrrec(FNamesStart).ofs, sizeof(F^)*(FHeader^.numFields));//Jump over Fielddefs
|
|
inc(ptrrec(FNamesStart).ofs, sizeof(Pointer)); //over Tablenameptr
|
|
inc(ptrrec(FNamesStart).ofs, sizeof(PChar)*(FHeader^.numFields));//over Fieldnamepointers
|
|
inc(ptrrec(FNamesStart).ofs, Strlen(FnamesStart)+1); //over Tablename
|
|
while FnamesStart^ = char(0) do
|
|
inc(ptrrec(FNamesStart).ofs); //over Padding
|
|
For i := 1 to FHeader^.numFields do
|
|
begin
|
|
case F^.fType of
|
|
pxfAlpha: Fielddefs.Add(StrPas(FNamesStart),ftString,F^.fSize);
|
|
pxfDate: Fielddefs.Add(StrPas(FNamesStart),ftDate,0);
|
|
pxfShort: Fielddefs.Add(StrPas(FNamesStart),ftSmallInt,F^.fSize);
|
|
pxfLong: Fielddefs.Add(StrPas(FNamesStart),ftInteger,F^.fSize);
|
|
pxfCurrency: Fielddefs.Add(StrPas(FNamesStart),ftFloat,F^.fSize);
|
|
pxfNumber: Fielddefs.Add(StrPas(FNamesStart),ftFloat,F^.fSize);
|
|
pxfLogical: Fielddefs.Add(StrPas(FNamesStart),ftBoolean,F^.fSize);
|
|
pxfMemoBLOb: Fielddefs.Add(StrPas(FNamesStart),ftMemo,F^.fSize);
|
|
pxfBLOb: Fielddefs.Add(StrPas(FNamesStart),ftBlob,F^.fSize);
|
|
pxfFmtMemoBLOb:Fielddefs.Add(StrPas(FNamesStart),ftMemo,F^.fSize);
|
|
pxfOLE: Fielddefs.Add(StrPas(FNamesStart),ftBlob,F^.fSize);
|
|
pxfGraphic: Fielddefs.Add(StrPas(FNamesStart),ftBlob,F^.fSize);
|
|
pxfTime: Fielddefs.Add(StrPas(FNamesStart),ftTime,F^.fSize);
|
|
pxfTimestamp:Fielddefs.Add(StrPas(FNamesStart),ftdateTime,0);
|
|
pxfAutoInc: Fielddefs.Add(StrPas(FNamesStart),ftAutoInc,F^.fSize);
|
|
pxfBCD: Fielddefs.Add(StrPas(FNamesStart),ftBCD,F^.fSize);
|
|
pxfBytes: Fielddefs.Add(StrPas(FNamesStart),ftString,F^.fSize);
|
|
end;
|
|
inc(ptrrec(FNamesStart).ofs, Strlen(FnamesStart)+1);
|
|
inc(ptrrec(F).ofs, sizeof(F^));
|
|
end;
|
|
end;
|
|
|
|
function TParadoxDataSet.AllocRecordBuffer: PChar;
|
|
begin
|
|
if Assigned(Fheader) then
|
|
Result := AllocMem(GetRecordSize)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.FreeRecordBuffer(var Buffer: PChar);
|
|
begin
|
|
if Assigned(Buffer) then
|
|
FreeMem(Buffer);
|
|
end;
|
|
|
|
function TParadoxDataSet.GetRecordCount: Integer;
|
|
begin
|
|
if not Assigned(Fheader) then exit;
|
|
Result := FHeader^.numRecords;
|
|
end;
|
|
|
|
function TParadoxDataSet.IsCursorOpen: Boolean;
|
|
begin
|
|
Result := FActive;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalFirst;
|
|
begin
|
|
FaBlockIdx := FHeader^.firstBlock;
|
|
FaBlockstart := 0;
|
|
FaRecord := 0;
|
|
ReadBlock;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalHandleException;
|
|
begin
|
|
Application.HandleException(Self);
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalInitRecord(Buffer: PChar);
|
|
begin
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalLast;
|
|
begin
|
|
while FaBlockIdx <> FHeader^.lastBlock do
|
|
ReadNextBlockHeader;
|
|
inc(FaRecord,(FaBlock^.addDataSize div FHeader^.recordSize)+1);
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalPost;
|
|
begin
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalEdit;
|
|
begin
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalSetToRecord(Buffer: PChar);
|
|
begin
|
|
if (State <> dsInsert) then
|
|
InternalGotoBookmark(@PRecInfo(Buffer + FHeader^.recordSize)^.RecordNumber);
|
|
end;
|
|
|
|
procedure TParadoxDataSet.InternalGotoBookmark(ABookmark: Pointer);
|
|
begin
|
|
SetrecNo(PLongWord(ABookmark)^);
|
|
end;
|
|
|
|
procedure TParadoxDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
|
|
begin
|
|
//TODO
|
|
end;
|
|
|
|
function TParadoxDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
|
|
begin
|
|
Result := PRecInfo(Buffer + FHeader^.recordSize)^.BookmarkFlag;
|
|
end;
|
|
|
|
function TParadoxDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
|
|
var
|
|
OK : Boolean;
|
|
L: Longword;
|
|
begin
|
|
Result := grOK;
|
|
case GetMode of
|
|
gmNext:
|
|
begin
|
|
inc(FaRecord);
|
|
if (FaBlockIdx = FHeader^.lastBlock) and (FaRecord > FaBlockStart+(FaBlock^.addDataSize div FHeader^.recordSize)+1) then
|
|
Result := grEOF
|
|
else
|
|
begin
|
|
if FaRecord > FaBlockStart+1+(FaBlock^.addDataSize div FHeader^.recordSize) then
|
|
ReadNextBlockHeader;
|
|
end;
|
|
end;
|
|
gmPrior:
|
|
begin
|
|
dec(FaRecord);
|
|
if (FaBlockIdx = FHeader^.firstBlock) and (FaRecord < 1) then
|
|
Result := grBOF
|
|
else
|
|
begin
|
|
if FaRecord <= FaBlockStart then
|
|
begin
|
|
ReadPrevBlockHeader;
|
|
FaRecord := FaBlockStart+(FaBlock^.addDataSize div FHeader^.recordSize)+1;
|
|
end;
|
|
end;
|
|
end;
|
|
gmCurrent:
|
|
begin
|
|
if (FaRecord > RecordCount) or (FaRecord < 1) then
|
|
result := grError;
|
|
end;
|
|
end;
|
|
if Result = grOK then
|
|
begin
|
|
if not FBlockreaded then
|
|
ReadBlock;
|
|
L := ((faRecord-(FaBlockstart+1))*FHeader^.recordSize)+6;
|
|
if (faRecord-(FaBlockstart+1)) >= 0 then
|
|
begin
|
|
Move(PChar(FaBlock)[L],Buffer[0],FHeader^.recordSize);
|
|
end
|
|
else
|
|
result := grError;
|
|
with PRecInfo(Buffer + FHeader^.recordSize)^ do
|
|
begin
|
|
BookmarkFlag := bfCurrent;
|
|
RecordNumber := FaRecord;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TParadoxDataSet.GetRecordSize: Word;
|
|
begin
|
|
Result := FHeader^.recordSize + sizeof(TRecInfo);
|
|
end;
|
|
|
|
procedure TParadoxDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
|
|
begin
|
|
PRecInfo(Buffer + FHeader^.recordSize)^.BookmarkFlag := Value;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
|
|
begin
|
|
//TODO
|
|
end;
|
|
|
|
procedure TParadoxDataSet.SetFieldData(Field: TField; Buffer: Pointer);
|
|
begin
|
|
end;
|
|
|
|
function TParadoxDataSet.GetCanModify: Boolean;
|
|
begin
|
|
Result:=False;
|
|
end;
|
|
|
|
procedure TParadoxDataSet.SetRecNo(Value: Integer);
|
|
begin
|
|
if Value < FaRecord then
|
|
begin
|
|
while (Value <= FaBlockstart) do
|
|
ReadPrevBlockHeader;
|
|
FaRecord := Value;
|
|
end
|
|
else
|
|
begin
|
|
while (Value > FaBlockstart+((FaBlock^.addDataSize div FHeader^.recordSize)+1)) do
|
|
ReadNextBlockHeader;
|
|
FaRecord := Value;
|
|
end;
|
|
end;
|
|
|
|
function TParadoxDataSet.GetRecNo: Integer;
|
|
begin
|
|
Result := -1;
|
|
if Assigned(ActiveBuffer) then
|
|
Result := PRecInfo(ActiveBuffer + FHeader^.recordSize)^.RecordNumber;
|
|
end;
|
|
|
|
function TParadoxDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
|
|
type
|
|
TNRec= array[0..16] of byte;
|
|
var
|
|
b : Boolean;
|
|
F : PFldInfoRec;
|
|
i: Integer;
|
|
size: Integer;
|
|
p: PChar;
|
|
s: array[0..7] of byte;
|
|
si: SmallInt absolute s;
|
|
int: LongInt absolute s;
|
|
d: Double absolute s;
|
|
begin
|
|
Result := False;
|
|
F := FHeader^.fldInfoPtr; { begin with the first field identifier }
|
|
p := ActiveBuffer;
|
|
For i := 1 to FHeader^.numFields do
|
|
begin
|
|
if i = Field.FieldNo then
|
|
break;
|
|
If F^.fType = pxfBCD then { BCD field size value not used for field size }
|
|
Inc(ptrrec(p).ofs, 17)
|
|
else
|
|
Inc(ptrrec(p).ofs, F^.fSize);
|
|
Inc(ptrrec(F).ofs, sizeof(F^));
|
|
end;
|
|
If F^.fType = pxfBCD then { BCD field size value not used for field size }
|
|
size := 17
|
|
else
|
|
size := F^.fSize;
|
|
if F^.fType in [pxfDate..pxfNumber, pxfTime..pxfAutoInc] then
|
|
begin
|
|
for i := 0 to pred(size) do
|
|
begin
|
|
s[pred(size-i)] := byte(p[i]);
|
|
end;
|
|
s[pred(size)] := s[pred(size)] xor $80;
|
|
end;
|
|
|
|
case F^.fType of
|
|
pxfAlpha,pxfMemoBLOb,pxfFmtMemoBLOb:
|
|
begin
|
|
if (Buffer <> nil) then
|
|
StrLCopy(Buffer, p, Field.Size)
|
|
else
|
|
exit;
|
|
Result := True;
|
|
end;
|
|
pxfDate:
|
|
begin
|
|
i := int;
|
|
Move(i,Buffer^,sizeof(Integer));
|
|
Result := True;
|
|
end;
|
|
pxfShort:
|
|
begin
|
|
i := si;
|
|
Move(i,Buffer^,sizeof(Integer));
|
|
Result := True;
|
|
end;
|
|
pxfLong,pxfAutoInc:
|
|
begin
|
|
i := int;
|
|
Move(i,Buffer^,sizeof(Integer));
|
|
Result := True;
|
|
end;
|
|
pxfCurrency,pxfNumber:
|
|
begin
|
|
Move(d,Buffer^,sizeof(d));
|
|
Result := True;
|
|
end;
|
|
|
|
pxfLogical:
|
|
begin
|
|
// b := (p^ = #80);
|
|
// Move(b,Buffer^,sizeof(Boolean));
|
|
// Result := True;
|
|
end;
|
|
pxfTime:
|
|
begin
|
|
i := int;
|
|
Move(i,Buffer^,sizeof(Integer));
|
|
Result := True;
|
|
end;
|
|
pxfTimestamp:
|
|
begin
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TParadoxDataSet.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FHeader := nil;
|
|
end;
|
|
|
|
destructor TParadoxDataSet.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
end.
|
|
|