paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 10:59:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Rest of fcl-db adapted to use TRecordBuffer.

Browse Source 
git-svn-id: trunk@19998 -
This commit is contained in:
marco 2012-01-07 21:18:29 +00:00
parent eb2b836b06
commit e328c7c1cb
11 changed files with 290 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
packages/fcl-db/src/base/db.pas
View File

@ -1257,6 +1257,7 @@ type
Testing with TRecordBuffer=PByte will turn up typing problems. TRecordBuffer=pansichar is backwards
compatible, even if overriden with "pchar" variants.
}
TRecordBufferBaseType = AnsiChar; // must match TRecordBuffer.
TRecordBuffer = PAnsiChar;
PBufferList = ^TBufferList;
TBufferList = array[0..dsMaxBufferCount - 1] of TRecordBuffer; // Dynamic array in Delphi.

85
packages/fcl-db/src/dbase/dbf.pas
View File

@ -120,7 +120,7 @@ type
FOnMasterChange: TNotifyEvent;
FOnMasterDisable: TNotifyEvent;
function GetFieldsVal: PChar;
function GetFieldsVal: TRecordBuffer;
procedure SetFieldNames(const Value: string);
protected
@ -135,7 +135,7 @@ type
property FieldNames: string read FFieldNames write SetFieldNames;
property ValidExpression: Boolean read FValidExpression write FValidExpression;
property FieldsVal: PChar read GetFieldsVal;
property FieldsVal: TRecordBuffer read GetFieldsVal;
property Parser: TDbfParser read FParser;
property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
@ -160,8 +160,8 @@ type
FAbsolutePath: string;
FIndexName: string;
FReadOnly: Boolean;
FFilterBuffer: PChar;
FTempBuffer: PChar;
FFilterBuffer: TRecordBuffer;
FTempBuffer: TRecordBuffer;
FEditingRecNo: Integer;
{$ifdef SUPPORT_VARIANTS}
FLocateRecNo: Integer;
@ -221,18 +221,18 @@ type
function ParseIndexName(const AIndexName: string): string;
procedure ParseFilter(const AFilter: string);
function GetDbfFieldDefs: TDbfFieldDefs;
function ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult;
function ReadCurrentRecord(Buffer: TRecordBuffer; var Acceptable: Boolean): TGetResult;
function SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
procedure SetRangeBuffer(LowRange: PChar; HighRange: PChar);
protected
{ abstract methods }
function AllocRecordBuffer: PChar; override; {virtual abstract}
procedure ClearCalcFields(Buffer: PChar); override;
procedure FreeRecordBuffer(var Buffer: PChar); override; {virtual abstract}
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract}
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
function AllocRecordBuffer: TRecordBuffer; override; {virtual abstract}
procedure ClearCalcFields(Buffer: TRecordBuffer); override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override; {virtual abstract}
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; {virtual abstract}
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override; {virtual abstract}
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
function GetRecordSize: Word; override; {virtual abstract}
procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; {virtual abstract}
procedure InternalClose; override; {virtual abstract}
@ -241,7 +241,7 @@ type
procedure InternalGotoBookmark(ABookmark: Pointer); override; {virtual abstract}
procedure InternalHandleException; override; {virtual abstract}
procedure InternalInitFieldDefs; override; {virtual abstract}
procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract}
procedure InternalInitRecord(Buffer: TRecordBuffer); override; {virtual abstract}
procedure InternalLast; override; {virtual abstract}
procedure InternalOpen; override; {virtual abstract}
procedure InternalEdit; override; {virtual}
@ -252,11 +252,11 @@ type
{$endif}
{$endif}
procedure InternalPost; override; {virtual abstract}
procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
procedure InternalSetToRecord(Buffer: TRecordBuffer); override; {virtual abstract}
procedure InitFieldDefs; override;
function IsCursorOpen: Boolean; override; {virtual abstract}
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract}
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override; {virtual abstract}
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; {virtual abstract}
procedure SetFieldData(Field: TField; Buffer: Pointer);
{$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
@ -338,7 +338,7 @@ type
{$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}): Boolean;
procedure SetRangePChar(LowRange: PChar; HighRange: PChar; KeyIsANSI: boolean
{$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif});
function GetCurrentBuffer: PChar;
function GetCurrentBuffer: TRecordBuffer;
procedure ExtractKey(KeyBuffer: PChar);
procedure UpdateIndexDefs; override;
procedure GetFileNames(Strings: TStrings; Files: TDbfFileNames); {$ifdef SUPPORT_DEFAULT_PARAMS} overload; {$endif}
@ -667,27 +667,27 @@ begin
FMasterLink.Free;
end;
function TDbf.AllocRecordBuffer: PChar; {override virtual abstract from TDataset}
function TDbf.AllocRecordBuffer: TRecordBuffer; {override virtual abstract from TDataset}
begin
GetMem(Result, SizeOf(TDbfRecordHeader)+FDbfFile.RecordSize+CalcFieldsSize+1);
end;
procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
procedure TDbf.FreeRecordBuffer(var Buffer: TRecordBuffer); {override virtual abstract from TDataset}
begin
FreeMemAndNil(Pointer(Buffer));
end;
procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
procedure TDbf.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); {override virtual abstract from TDataset}
begin
pBookmarkData(Data)^ := pDbfRecord(Buffer)^.BookmarkData;
end;
function TDbf.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; {override virtual abstract from TDataset}
function TDbf.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; {override virtual abstract from TDataset}
begin
Result := pDbfRecord(Buffer)^.BookmarkFlag;
end;
function TDbf.GetCurrentBuffer: PChar;
function TDbf.GetCurrentBuffer: TRecordBuffer;
begin
case State of
dsFilter: Result := FFilterBuffer;
@ -726,7 +726,7 @@ const
NativeFormat = true;
{$endif}
var
Src: PChar;
Src: TRecordBuffer;
begin
Src := GetCurrentBuffer;
if Src = nil then
@ -799,7 +799,7 @@ begin
OnFilterRecord(Self, Acceptable);
end;
function TDbf.ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult;
function TDbf.ReadCurrentRecord(Buffer: TRecordBuffer; var Acceptable: Boolean): TGetResult;
var
lPhysicalRecNo: Integer;
pRecord: pDbfRecord;
@ -817,7 +817,7 @@ begin
end;
end;
function TDbf.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
function TDbf.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
acceptable: Boolean;
@ -1116,7 +1116,7 @@ begin
end;
end;
procedure TDbf.InternalInitRecord(Buffer: PChar); {override virtual abstract from TDataset}
procedure TDbf.InternalInitRecord(Buffer: TRecordBuffer); {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
begin
@ -2083,7 +2083,7 @@ end;
{$endif}
procedure TDbf.ClearCalcFields(Buffer: PChar);
procedure TDbf.ClearCalcFields(Buffer: TRecordBuffer);
var
lRealBuffer, lCalcBuffer: PChar;
begin
@ -2092,7 +2092,7 @@ begin
FillChar(lCalcBuffer^, CalcFieldsSize, 0);
end;
procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
procedure TDbf.InternalSetToRecord(Buffer: TRecordBuffer); {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
begin
@ -2118,12 +2118,12 @@ begin
Result := StoreDefs and (FieldDefs.Count > 0);
end;
procedure TDbf.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); {override virtual abstract from TDataset}
procedure TDbf.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); {override virtual abstract from TDataset}
begin
pDbfRecord(Buffer)^.BookmarkFlag := Value;
end;
procedure TDbf.SetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
procedure TDbf.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); {override virtual abstract from TDataset}
begin
pDbfRecord(Buffer)^.BookmarkData := pBookmarkData(Data)^;
end;
@ -2616,26 +2616,26 @@ end;
function TDbf.IsDeleted: Boolean;
var
src: PChar;
src: TRecordBuffer;
begin
src := GetCurrentBuffer;
IsDeleted := (src=nil) or (src^ = '*')
IsDeleted := (src=nil) or (AnsiChar(src^) = '*')
end;
procedure TDbf.Undelete;
var
src: PChar;
src: TRecordBuffer;
begin
if State <> dsEdit then
inherited Edit;
// get active buffer
src := GetCurrentBuffer;
if (src <> nil) and (src^ = '*') then
if (src <> nil) and (AnsiChar(src^) = '*') then
begin
// notify indexes record is about to be recalled
FDbfFile.RecordRecalled(FCursor.PhysicalRecNo, src);
// recall record
src^ := ' ';
src^ := TRecordBufferBaseType(' ');
FDbfFile.WriteRecord(FCursor.PhysicalRecNo, src);
end;
end;
@ -2821,19 +2821,22 @@ end;
procedure TDbf.UpdateRange;
var
fieldsVal: PChar;
fieldsVal: TRecordBuffer;
tempBuffer: array[0..300] of char;
begin
fieldsVal := FMasterLink.FieldsVal;
if (TDbf(FMasterLink.DataSet).DbfFile.UseCodePage <> FDbfFile.UseCodePage)
and (FMasterLink.Parser.ResultType = etString) then
begin
FMasterLink.DataSet.Translate(fieldsVal, @tempBuffer[0], false);
FMasterLink.DataSet.Translate(pansichar(fieldsVal), @tempBuffer[0], false);
fieldsVal := @tempBuffer[0];
Translate(fieldsVal, fieldsVal, true);
Translate(pansichar(fieldsVal), pansichar(fieldsVal), true);
end;
fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType);
SetRangeBuffer(fieldsVal, fieldsVal);
// preparekey, setrangebuffer and updatekeyfrom* are functions which arguments
// are not entirely classified in pchar<>trecordbuffer terms.
// so we typecast for now.
fieldsVal := TRecordBuffer(TIndexCursor(FCursor).IndexFile.PrepareKey((fieldsVal), FMasterLink.Parser.ResultType));
SetRangeBuffer(pansichar(fieldsVal), pansichar(fieldsVal));
end;
procedure TDbf.MasterChanged(Sender: TObject);
@ -3018,9 +3021,9 @@ begin
end;
end;
function TDbfMasterLink.GetFieldsVal: PChar;
function TDbfMasterLink.GetFieldsVal: TRecordBuffer;
begin
Result := FParser.ExtractFromBuffer(@pDbfRecord(TDbf(DataSet).ActiveBuffer)^.DeletedFlag);
Result := TRecordBuffer(FParser.ExtractFromBuffer(@pDbfRecord(TDbf(DataSet).ActiveBuffer)^.DeletedFlag));
end;
////////////////////////////////////////////////////////////////////////////

54
packages/fcl-db/src/dbase/dbf_dbffile.pas
View File

@ -48,8 +48,8 @@ type
FIndexNames: TStringList;
FIndexFiles: TList;
FDbfVersion: TXBaseVersion;
FPrevBuffer: PChar;
FDefaultBuffer: PChar;
FPrevBuffer: TRecordBuffer;
FDefaultBuffer: TRecordBuffer;
FRecordBufferSize: Integer;
FLockUserLen: DWORD;
FFileCodePage: Cardinal;
@ -76,7 +76,7 @@ type
procedure ConstructFieldDefs;
procedure InitDefaultBuffer;
procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
procedure WriteLockInfo(Buffer: PChar);
procedure WriteLockInfo(Buffer: TRecordBuffer);
public
constructor Create;
@ -97,9 +97,9 @@ type
procedure CloseIndex(AIndexName: string);
procedure RepageIndex(AIndexFile: string);
procedure CompactIndex(AIndexFile: string);
function Insert(Buffer: PChar): integer;
function Insert(Buffer: TRecordBuffer): integer;
procedure WriteHeader; override;
procedure ApplyAutoIncToBuffer(DestBuf: PChar); // dBase7 support. Writeback last next-autoinc value
procedure ApplyAutoIncToBuffer(DestBuf: TRecordBuffer); // dBase7 support. Writeback last next-autoinc value
procedure FastPackTable;
procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
procedure Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean);
@ -109,13 +109,13 @@ type
function GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType;
Src, Dst: Pointer; NativeFormat: boolean): Boolean;
procedure SetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer; NativeFormat: boolean);
procedure InitRecord(DestBuf: PChar);
procedure InitRecord(DestBuf: TRecordBuffer);
procedure PackIndex(lIndexFile: TIndexFile; AIndexName: string);
procedure RegenerateIndexes;
procedure LockRecord(RecNo: Integer; Buffer: PChar);
procedure UnlockRecord(RecNo: Integer; Buffer: PChar);
procedure RecordDeleted(RecNo: Integer; Buffer: PChar);
procedure RecordRecalled(RecNo: Integer; Buffer: PChar);
procedure LockRecord(RecNo: Integer; Buffer: TRecordBuffer);
procedure UnlockRecord(RecNo: Integer; Buffer: TRecordBuffer);
procedure RecordDeleted(RecNo: Integer; Buffer: TRecordBuffer);
procedure RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer);
property MemoFile: TMemoFile read FMemoFile;
property FieldDefs: TDbfFieldDefs read FFieldDefs;
@ -128,7 +128,7 @@ type
property UseCodePage: Cardinal read FUseCodePage write FUseCodePage;
property FileLangId: Byte read FFileLangId write FFileLangId;
property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
property PrevBuffer: PChar read FPrevBuffer;
property PrevBuffer: TRecordBuffer read FPrevBuffer;
property ForceClose: Boolean read FForceClose;
property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString;
property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling;
@ -1133,7 +1133,7 @@ var
OldIndexFiles: TStrings;
IndexName, NewBaseName: string;
I, lRecNo, lFieldNo, lFieldSize, lBlobPageNo, lWRecNo, srcOffset, dstOffset: Integer;
pBuff, pDestBuff: PChar;
pBuff, pDestBuff: TRecordBuffer;
RestructFieldInfo: PRestructFieldInfo;
BlobStream: TMemoryStream;
begin
@ -1264,7 +1264,7 @@ begin
// read record from original dbf
ReadRecord(lRecNo, pBuff);
// copy record?
if (pBuff^ <> '*') or not Pack then
if (ansichar(pBuff^) <> '*') or not Pack then
begin
// if restructure, initialize dest
if DbfFieldDefs <> nil then
@ -1940,14 +1940,14 @@ begin
end;
end;
procedure TDbfFile.InitRecord(DestBuf: PChar);
procedure TDbfFile.InitRecord(DestBuf: TRecordBuffer);
begin
if FDefaultBuffer = nil then
InitDefaultBuffer;
Move(FDefaultBuffer^, DestBuf^, RecordSize);
end;
procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: PChar);
procedure TDbfFile.ApplyAutoIncToBuffer(DestBuf: TRecordBuffer);
var
TempFieldDef: TDbfFieldDef;
I, NextVal, lAutoIncOffset: {LongWord} Cardinal; {Delphi 3 does not know LongWord?}
@ -2358,7 +2358,7 @@ begin
end;
end;
function TDbfFile.Insert(Buffer: PChar): integer;
function TDbfFile.Insert(Buffer: TRecordBuffer): integer;
type
TErrorContext = (ecNone, ecInsert, ecWriteIndex, ecWriteDbf);
var
@ -2472,7 +2472,7 @@ begin
Result := newRecord;
end;
procedure TDbfFile.WriteLockInfo(Buffer: PChar);
procedure TDbfFile.WriteLockInfo(Buffer: TRecordBuffer);
//
// *) assumes FHasLockField = true
//
@ -2486,19 +2486,19 @@ begin
// set time
DecodeDate(Now(), year, month, day);
DecodeTime(Now(), hour, minute, sec, msec);
Buffer[lockoffset+2] := Char(hour);
Buffer[lockoffset+3] := Char(minute);
Buffer[lockoffset+4] := Char(sec);
Buffer[lockoffset+2] := TRecordBufferBaseType(hour);
Buffer[lockoffset+3] := TRecordBufferBaseType(minute);
Buffer[lockoffset+4] := TRecordBufferBaseType(sec);
// set date
Buffer[lockoffset+5] := Char(year - 1900);
Buffer[lockoffset+6] := Char(month);
Buffer[lockoffset+7] := Char(day);
Buffer[lockoffset+5] := TRecordBufferBaseType(year - 1900);
Buffer[lockoffset+6] := TRecordBufferBaseType(month);
Buffer[lockoffset+7] := TRecordBufferBaseType(day);
// set name
FillChar(Buffer[lockoffset+8], FLockField.Size-8, ' ');
Move(DbfGlobals.UserName[1], Buffer[lockoffset+8], FLockUserLen);
end;
procedure TDbfFile.LockRecord(RecNo: Integer; Buffer: PChar);
procedure TDbfFile.LockRecord(RecNo: Integer; Buffer: TRecordBuffer);
begin
if LockPage(RecNo, false) then
begin
@ -2518,7 +2518,7 @@ begin
raise EDbfError.Create(STRING_RECORD_LOCKED);
end;
procedure TDbfFile.UnlockRecord(RecNo: Integer; Buffer: PChar);
procedure TDbfFile.UnlockRecord(RecNo: Integer; Buffer: TRecordBuffer);
var
I: Integer;
lIndex, lErrorIndex: TIndexFile;
@ -2548,7 +2548,7 @@ begin
UnlockPage(RecNo);
end;
procedure TDbfFile.RecordDeleted(RecNo: Integer; Buffer: PChar);
procedure TDbfFile.RecordDeleted(RecNo: Integer; Buffer: TRecordBuffer);
var
I: Integer;
lIndex: TIndexFile;
@ -2561,7 +2561,7 @@ begin
end;
end;
procedure TDbfFile.RecordRecalled(RecNo: Integer; Buffer: PChar);
procedure TDbfFile.RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer);
var
I: Integer;
lIndex, lErrorIndex: TIndexFile;

19
packages/fcl-db/src/dbase/dbf_idxcur.pas
View File

@ -7,6 +7,7 @@ interface
uses
SysUtils,
Classes,
db,
dbf_cursor,
dbf_idxfile,
dbf_prsdef,
@ -30,7 +31,7 @@ type
procedure SetPhysicalRecNo(RecNo: Integer); override;
procedure SetSequentialRecNo(RecNo: Integer); override;
procedure VariantStrToBuffer(Key: Variant; ABuffer: PChar);
procedure VariantStrToBuffer(Key: Variant; ABuffer: TRecordBuffer);
public
constructor Create(DbfIndexFile: TIndexFile);
destructor Destroy; override;
@ -40,11 +41,11 @@ type
procedure First; override;
procedure Last; override;
procedure Insert(RecNo: Integer; Buffer: PChar);
procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
procedure Insert(RecNo: Integer; Buffer: TRecordBuffer);
procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: TRecordBuffer);
{$ifdef SUPPORT_VARIANTS}
function VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType;
function VariantToBuffer(Key: Variant; ABuffer: TRecordBuffer): TExpressionType;
{$endif}
function CheckUserKey(Key: PChar; StringBuf: PChar): PChar;
@ -79,13 +80,13 @@ begin
inherited Destroy;
end;
procedure TIndexCursor.Insert(RecNo: Integer; Buffer: PChar);
procedure TIndexCursor.Insert(RecNo: Integer; Buffer: TRecordBuffer);
begin
TIndexFile(PagedFile).Insert(RecNo,Buffer);
// TODO SET RecNo and Key
end;
procedure TIndexCursor.Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar);
procedure TIndexCursor.Update(RecNo: Integer; PrevBuffer, NewBuffer: TRecordBuffer);
begin
TIndexFile(PagedFile).Update(RecNo, PrevBuffer, NewBuffer);
end;
@ -137,18 +138,18 @@ end;
{$ifdef SUPPORT_VARIANTS}
procedure TIndexCursor.VariantStrToBuffer(Key: Variant; ABuffer: PChar);
procedure TIndexCursor.VariantStrToBuffer(Key: Variant; ABuffer: TRecordBuffer);
var
currLen: Integer;
StrKey: string;
begin
StrKey := Key;
currLen := TranslateString(GetACP, FIndexFile.CodePage, PChar(StrKey), ABuffer, -1);
currLen := TranslateString(GetACP, FIndexFile.CodePage, PAnsiChar(StrKey), PAnsiChar(ABuffer), -1);
// we have null-terminated string, pad with spaces if string too short
FillChar(ABuffer[currLen], TIndexFile(PagedFile).KeyLen-currLen, ' ');
end;
function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: PChar): TExpressionType;
function TIndexCursor.VariantToBuffer(Key: Variant; ABuffer: TRecordBuffer): TExpressionType;
// assumes ABuffer is large enough ie. at least max key size
begin
if (TIndexFile(PagedFile).KeyType='N') then

56
packages/fcl-db/src/dbase/dbf_idxfile.pas
View File

@ -285,12 +285,12 @@ type
function CalcTagOffset(AIndex: Integer): Pointer;
function FindKey(AInsert: boolean): Integer;
function InsertKey(Buffer: PChar): Boolean;
procedure DeleteKey(Buffer: PChar);
function InsertKey(Buffer: TRecordBuffer): Boolean;
procedure DeleteKey(Buffer: TRecordBuffer);
function InsertCurrent: Boolean;
procedure DeleteCurrent;
function UpdateCurrent(PrevBuffer, NewBuffer: PChar): Boolean;
function UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
function UpdateCurrent(PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
function UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
procedure ReadIndexes;
procedure Resync(Relative: boolean);
procedure ResyncRoot;
@ -337,19 +337,19 @@ type
procedure AddNewLevel;
procedure UnlockHeader;
procedure InsertError;
function Insert(RecNo: Integer; Buffer: PChar): Boolean;
function Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
procedure Delete(RecNo: Integer; Buffer: PChar);
function CheckKeyViolation(Buffer: PChar): Boolean;
procedure RecordDeleted(RecNo: Integer; Buffer: PChar);
function RecordRecalled(RecNo: Integer; Buffer: PChar): Boolean;
function Insert(RecNo: Integer; Buffer:TRecordBuffer ): Boolean;
function Update(RecNo: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
procedure Delete(RecNo: Integer; Buffer: TRecordBuffer);
function CheckKeyViolation(Buffer: TRecordBuffer): Boolean;
procedure RecordDeleted(RecNo: Integer; Buffer: TRecordBuffer);
function RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer): Boolean;
procedure DeleteIndex(const AIndexName: string);
procedure RepageFile;
procedure CompactFile;
procedure PrepareRename(NewFileName: string);
procedure CreateIndex(FieldDesc, TagName: string; Options: TIndexOptions);
function ExtractKeyFromBuffer(Buffer: PChar): PChar;
function ExtractKeyFromBuffer(Buffer: TRecordBuffer): PChar;
function SearchKey(Key: PChar; SearchType: TSearchKeyType): Boolean;
function Find(RecNo: Integer; Buffer: PChar): Integer;
function IndexOf(const AIndexName: string): Integer;
@ -371,7 +371,7 @@ type
function MatchKey(UserKey: PChar): Integer;
function CompareKey(Key: PChar): Integer;
function CompareKeys(Key1, Key2: PChar): Integer;
function PrepareKey(Buffer: PChar; ResultType: TExpressionType): PChar;
function PrepareKey(Buffer: TRecordBuffer; ResultType: TExpressionType): PChar;
property KeyLen: Integer read GetKeyLen;
property IndexVersion: TXBaseVersion read FIndexVersion;
@ -1725,7 +1725,7 @@ const
AnsiFuncsToMode: array[boolean] of TStringFieldMode = (smRaw, smAnsi);
var
TempRec: PExpressionRec;
TempBuffer: pchar;
TempBuffer: TRecordBuffer;
I: integer;
hasAnsiFuncs: boolean;
begin
@ -2818,7 +2818,7 @@ begin
UnlockPage(0);
end;
function TIndexFile.Insert(RecNo: Integer; Buffer: PChar): Boolean; {override;}
function TIndexFile.Insert(RecNo: Integer; Buffer: TRecordBuffer): Boolean; {override;}
var
I, curSel, count: Integer;
begin
@ -2856,7 +2856,7 @@ begin
ResyncRange(true);
end;
function TIndexFile.CheckKeyViolation(Buffer: PChar): Boolean;
function TIndexFile.CheckKeyViolation(Buffer: TRecordBuffer): Boolean;
var
I, curSel: Integer;
begin
@ -2886,7 +2886,7 @@ begin
end;
end;
function TIndexFile.PrepareKey(Buffer: PChar; ResultType: TExpressionType): PChar;
function TIndexFile.PrepareKey(Buffer: TRecordBuffer; ResultType: TExpressionType): PChar;
var
FloatRec: TFloatRec;
I, IntSrc, NumDecimals: Integer;
@ -2898,7 +2898,7 @@ var
begin
// need to convert numeric?
Result := Buffer;
Result := PChar(Buffer);
if PIndexHdr(FIndexHeader)^.KeyType in ['N', 'F'] then
begin
if FIndexVersion = xBaseIII then
@ -3000,19 +3000,19 @@ begin
end;
end;
function TIndexFile.ExtractKeyFromBuffer(Buffer: PChar): PChar;
function TIndexFile.ExtractKeyFromBuffer(Buffer: TRecordBuffer): PChar;
begin
// execute expression to get key
Result := PrepareKey(FCurrentParser.ExtractFromBuffer(Buffer), FCurrentParser.ResultType);
Result := PrepareKey(TRecordBuffer(FCurrentParser.ExtractFromBuffer(Buffer)), FCurrentParser.ResultType);
if FCurrentParser.StringFieldMode <> smRaw then
TranslateString(GetACP, FCodePage, Result, Result, KeyLen);
end;
function TIndexFile.InsertKey(Buffer: PChar): boolean;
function TIndexFile.InsertKey(Buffer: TRecordBuffer): boolean;
begin
Result := true;
// ignore deleted records
if (FModifyMode = mmNormal) and (FUniqueMode = iuDistinct) and (Buffer^ = '*') then
if (FModifyMode = mmNormal) and (FUniqueMode = iuDistinct) and (AnsiChar(Buffer^) = '*') then
exit;
// check proper index and modifiability
if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
@ -3077,7 +3077,7 @@ begin
raise EDbfError.Create(errorStr);
end;
procedure TIndexFile.Delete(RecNo: Integer; Buffer: PChar);
procedure TIndexFile.Delete(RecNo: Integer; Buffer: TRecordBuffer);
var
I, curSel: Integer;
begin
@ -3101,7 +3101,7 @@ begin
ResyncRange(true);
end;
procedure TIndexFile.DeleteKey(Buffer: PChar);
procedure TIndexFile.DeleteKey(Buffer: TRecordBuffer);
begin
if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
begin
@ -3131,13 +3131,13 @@ begin
end;
end;
function TIndexFile.UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
function TIndexFile.UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
begin
SelectIndexVars(Index);
Result := UpdateCurrent(PrevBuffer, NewBuffer);
end;
function TIndexFile.Update(RecNo: Integer; PrevBuffer, NewBuffer: PChar): Boolean;
function TIndexFile.Update(RecNo: Integer; PrevBuffer, NewBuffer: TRecordBuffer): Boolean;
var
I, curSel, count: Integer;
begin
@ -3175,7 +3175,7 @@ begin
ResyncRange(true);
end;
function TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: PChar): boolean;
function TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: TRecordBuffer): boolean;
var
InsertKey, DeleteKey: PChar;
TempBuffer: array [0..100] of Char;
@ -3421,7 +3421,7 @@ begin
ResyncRange(true);
end;
procedure TIndexFile.RecordDeleted(RecNo: Integer; Buffer: PChar);
procedure TIndexFile.RecordDeleted(RecNo: Integer; Buffer: TRecordBuffer);
begin
// are we distinct -> then delete record from index
FModifyMode := mmDeleteRecall;
@ -3429,7 +3429,7 @@ begin
FModifyMode := mmNormal;
end;
function TIndexFile.RecordRecalled(RecNo: Integer; Buffer: PChar): Boolean;
function TIndexFile.RecordRecalled(RecNo: Integer; Buffer: TRecordBuffer): Boolean;
begin
// are we distinct -> then reinsert record in index
FModifyMode := mmDeleteRecall;

38
packages/fcl-db/src/dbase/dbf_parser.pas
View File

@ -55,7 +55,7 @@ type
procedure ClearExpressions; override;
procedure ParseExpression(AExpression: string); virtual;
function ExtractFromBuffer(Buffer: PChar): PChar; virtual;
function ExtractFromBuffer(Buffer: TRecordBuffer): PChar; virtual;
property DbfFile: Pointer read FDbfFile write FDbfFile;
property Expression: string read FCurrentExpression;
@ -96,7 +96,7 @@ type
public
constructor Create(UseFieldDef: TDbfFieldDef; ADbfFile: TDbfFile);
procedure Refresh(Buffer: PChar); virtual; abstract;
procedure Refresh(Buffer: TRecordBuffer); virtual; abstract;
property FieldVal: Pointer read GetFieldVal;
property FieldDef: TDbfFieldDef read FFieldDef;
@ -118,7 +118,7 @@ type
public
destructor Destroy; override;
procedure Refresh(Buffer: PChar); override;
procedure Refresh(Buffer: TRecordBuffer); override;
property Mode: TStringFieldMode read FMode write SetMode;
end;
@ -130,7 +130,7 @@ type
function GetFieldVal: Pointer; override;
function GetFieldType: TExpressionType; override;
public
procedure Refresh(Buffer: PChar); override;
procedure Refresh(Buffer: TRecordBuffer); override;
end;
TIntegerFieldVar = class(TFieldVar)
@ -140,7 +140,7 @@ type
function GetFieldVal: Pointer; override;
function GetFieldType: TExpressionType; override;
public
procedure Refresh(Buffer: PChar); override;
procedure Refresh(Buffer: TRecordBuffer); override;
end;
{$ifdef SUPPORT_INT64}
@ -151,7 +151,7 @@ type
function GetFieldVal: Pointer; override;
function GetFieldType: TExpressionType; override;
public
procedure Refresh(Buffer: PChar); override;
procedure Refresh(Buffer: TRecordBuffer); override;
end;
{$endif}
@ -162,7 +162,7 @@ type
protected
function GetFieldVal: Pointer; override;
public
procedure Refresh(Buffer: PChar); override;
procedure Refresh(Buffer: TRecordBuffer); override;
end;
TBooleanFieldVar = class(TFieldVar)
@ -172,7 +172,7 @@ type
protected
function GetFieldVal: Pointer; override;
public
procedure Refresh(Buffer: PChar); override;
procedure Refresh(Buffer: TRecordBuffer); override;
end;
{ TFieldVar }
@ -212,10 +212,10 @@ begin
Result := etString;
end;
procedure TStringFieldVar.Refresh(Buffer: PChar);
procedure TStringFieldVar.Refresh(Buffer: TRecordBuffer);
var
Len: Integer;
Src: PChar;
Src: TRecordBuffer;
begin
Src := Buffer+FieldDef.Offset;
if FMode <> smRaw then
@ -223,12 +223,12 @@ begin
// copy field data
Len := FieldDef.Size;
if FMode = smAnsiTrim then
while (Len >= 1) and (Src[Len-1] = ' ') do Dec(Len);
while (Len >= 1) and (Src[Len-1] = TRecordbufferbasetype(' ')) do Dec(Len);
// translate to ANSI
Len := TranslateString(DbfFile.UseCodePage, GetACP, Src, FFieldVal, Len);
Len := TranslateString(DbfFile.UseCodePage, GetACP, pansichar(Src), FFieldVal, Len);
FFieldVal[Len] := #0;
end else
FFieldVal := Src;
FFieldVal := pansichar(Src);
end;
procedure TStringFieldVar.SetExprWord(NewExprWord: TExprWord);
@ -269,7 +269,7 @@ begin
Result := etFloat;
end;
procedure TFloatFieldVar.Refresh(Buffer: PChar);
procedure TFloatFieldVar.Refresh(Buffer: TRecordBuffer);
begin
// database width is default 64-bit double
if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal, false) then
@ -287,7 +287,7 @@ begin
Result := etInteger;
end;
procedure TIntegerFieldVar.Refresh(Buffer: PChar);
procedure TIntegerFieldVar.Refresh(Buffer: TRecordBuffer);
begin
FFieldVal := 0;
FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal, false);
@ -306,7 +306,7 @@ begin
Result := etLargeInt;
end;
procedure TLargeIntFieldVar.Refresh(Buffer: PChar);
procedure TLargeIntFieldVar.Refresh(Buffer: TRecordBuffer);
begin
if not FDbfFile.GetFieldDataFromDef(FieldDef, FieldDef.FieldType, Buffer, @FFieldVal, false) then
FFieldVal := 0;
@ -325,7 +325,7 @@ begin
Result := etDateTime;
end;
procedure TDateTimeFieldVar.Refresh(Buffer: PChar);
procedure TDateTimeFieldVar.Refresh(Buffer: TRecordBuffer);
begin
if not FDbfFile.GetFieldDataFromDef(FieldDef, ftDateTime, Buffer, @FFieldVal, false) then
FFieldVal.DateTime := 0.0;
@ -342,7 +342,7 @@ begin
Result := etBoolean;
end;
procedure TBooleanFieldVar.Refresh(Buffer: PChar);
procedure TBooleanFieldVar.Refresh(Buffer: TRecordBuffer);
var
lFieldVal: word;
begin
@ -575,7 +575,7 @@ begin
FCurrentExpression := AExpression;
end;
function TDbfParser.ExtractFromBuffer(Buffer: PChar): PChar;
function TDbfParser.ExtractFromBuffer(Buffer: TRecordBuffer): PChar;
var
I: Integer;
begin

41
packages/fcl-db/src/json/fpjsondataset.pp
View File

@ -76,12 +76,12 @@ type
procedure SetRows(AValue: TJSONArray);
protected
// dataset virtual methods
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function AllocRecordBuffer: TRecordBuffer; override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordSize: Word; override;
procedure InternalClose; override;
procedure InternalDelete; override;
@ -94,11 +94,11 @@ type
procedure InternalEdit; override;
procedure InternalCancel; override;
procedure InternalInitFieldDefs; override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
function GetFieldClass(FieldType: TFieldType): TFieldClass; override;
function IsCursorOpen: Boolean; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat : Boolean): Boolean; override;
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat : Boolean); override;
function GetRecordCount: Integer; override;
@ -319,27 +319,28 @@ begin
FRows:=AValue;
end;
function TBaseJSONDataSet.AllocRecordBuffer: PChar;
function TBaseJSONDataSet.AllocRecordBuffer: TRecordBuffer;
begin
Result := StrAlloc(fRecordSize);
Result := TRecordBuffer(StrAlloc(fRecordSize));
end;
procedure TBaseJSONDataSet.InternalInitRecord(Buffer: PChar);
// the next two are particularly ugly.
procedure TBaseJSONDataSet.InternalInitRecord(Buffer: TRecordBuffer);
begin
FillChar(Buffer^, FRecordSize, 0);
end;
procedure TBaseJSONDataSet.FreeRecordBuffer (var Buffer: PChar);
procedure TBaseJSONDataSet.FreeRecordBuffer (var Buffer: TRecordBuffer);
begin
StrDispose(Buffer);
StrDispose(pansichar(Buffer));
end;
procedure TBaseJSONDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TBaseJSONDataSet.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
PInteger(Data)^ := PRecInfo(Buffer)^.Bookmark;
end;
function TBaseJSONDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
function TBaseJSONDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
Result := PRecInfo(Buffer)^.BookmarkFlag;
end;
@ -706,7 +707,7 @@ begin
end;
end;
function TBaseJSONDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
function TBaseJSONDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
begin
Result := grOK; // default
@ -869,7 +870,7 @@ begin
FEditRow:=Nil;
end;
procedure TBaseJSONDataSet.InternalSetToRecord(Buffer: PChar);
procedure TBaseJSONDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
begin
FCurrent := PRecInfo(Buffer)^.Index;
end;
@ -890,7 +891,7 @@ begin
Result := Assigned(FDefaultList);
end;
procedure TBaseJSONDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TBaseJSONDataSet.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
PRecInfo(Buffer)^.Bookmark := PInteger(Data)^;
end;
@ -1074,7 +1075,7 @@ begin
// Writeln('Field data is set : ',FEditRow.AsJSON);
end;
procedure TBaseJSONDataSet.SetBookmarkFlag(Buffer: PChar;
procedure TBaseJSONDataSet.SetBookmarkFlag(Buffer: TRecordBuffer;
Value: TBookmarkFlag);
begin
PRecInfo(Buffer)^.BookmarkFlag := Value;

70
packages/fcl-db/src/memds/memds.pp
View File

@ -66,29 +66,29 @@ type
FCurrRecNo: integer;
FIsOpen: boolean;
FTableIsCreated: boolean;
FFilterBuffer: PChar;
FFilterBuffer: TRecordBuffer;
ffieldoffsets: PInteger;
ffieldsizes: PInteger;
function GetCharPointer(p:PChar; Pos:Integer):PChar;
function GetRecordBufferPointer(p:TRecordBuffer; Pos:Integer):TRecordBuffer;
function GetIntegerPointer(p:PInteger; Pos:Integer):PInteger;
procedure calcrecordlayout;
function MDSGetRecordOffset(ARecNo: integer): longint;
function MDSGetFieldOffset(FieldNo: integer): integer;
function MDSGetBufferSize(FieldNo: integer): integer;
function MDSGetActiveBuffer(var Buffer: PChar): Boolean;
procedure MDSReadRecord(Buffer:PChar;ARecNo:Integer);
procedure MDSWriteRecord(Buffer:PChar;ARecNo:Integer);
procedure MDSAppendRecord(Buffer:PChar);
function MDSFilterRecord(Buffer: PChar): Boolean;
function MDSGetActiveBuffer(var Buffer: TRecordBuffer): Boolean;
procedure MDSReadRecord(Buffer:TRecordBuffer;ARecNo:Integer);
procedure MDSWriteRecord(Buffer:TRecordBuffer;ARecNo:Integer);
procedure MDSAppendRecord(Buffer:TRecordBuffer);
function MDSFilterRecord(Buffer:TRecordBuffer): Boolean;
protected
// Mandatory
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
function AllocRecordBuffer: TRecordBuffer; override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordSize: Word; override;
procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
procedure InternalClose; override;
@ -96,14 +96,14 @@ type
procedure InternalFirst; override;
procedure InternalGotoBookmark(ABookmark: Pointer); override;
procedure InternalInitFieldDefs; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure InternalLast; override;
procedure InternalOpen; override;
procedure InternalPost; override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
function IsCursorOpen: Boolean; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
// Optional.
@ -328,7 +328,7 @@ begin
{$ENDIF}
end;
function TMemDataset.MDSGetActiveBuffer(var Buffer: PChar): Boolean;
function TMemDataset.MDSGetActiveBuffer(var Buffer: TRecordBuffer): Boolean;
begin
case State of
@ -348,20 +348,20 @@ begin
Result:=(Buffer<>nil);
end;
procedure TMemDataset.MDSReadRecord(Buffer:PChar;ARecNo:Integer); //Reads a Rec from Stream in Buffer
procedure TMemDataset.MDSReadRecord(Buffer:TRecordBuffer;ARecNo:Integer); //Reads a Rec from Stream in Buffer
begin
FStream.Position:=MDSGetRecordOffset(ARecNo);
FStream.ReadBuffer(Buffer^, FRecSize);
end;
procedure TMemDataset.MDSWriteRecord(Buffer:PChar;ARecNo:Integer); //Writes a Rec from Buffer to Stream
procedure TMemDataset.MDSWriteRecord(Buffer:TRecordBuffer;ARecNo:Integer); //Writes a Rec from Buffer to Stream
begin
FStream.Position:=MDSGetRecordOffset(ARecNo);
FStream.WriteBuffer(Buffer^, FRecSize);
FFileModified:=True;
end;
procedure TMemDataset.MDSAppendRecord(Buffer:PChar); //Appends a Rec (from Buffer) to Stream
procedure TMemDataset.MDSAppendRecord(Buffer:TRecordBuffer); //Appends a Rec (from Buffer) to Stream
begin
FStream.Position:=MDSGetRecordOffset(FRecCount);
FStream.WriteBuffer(Buffer^, FRecSize);
@ -369,17 +369,17 @@ begin
end;
//Abstract Overrides
function TMemDataset.AllocRecordBuffer: PChar;
function TMemDataset.AllocRecordBuffer: TRecordBuffer;
begin
GetMem(Result,FRecBufferSize);
end;
procedure TMemDataset.FreeRecordBuffer (var Buffer: PChar);
procedure TMemDataset.FreeRecordBuffer (var Buffer: TRecordBuffer);
begin
FreeMem(Buffer);
end;
procedure TMemDataset.InternalInitRecord(Buffer: PChar);
procedure TMemDataset.InternalInitRecord(Buffer: TRecordBuffer);
var
I : integer;
@ -663,7 +663,7 @@ begin
Result:=FIsOpen;
end;
function TMemDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
function TMemDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
Accepted: Boolean;
@ -709,7 +709,7 @@ end;
function TMemDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
SrcBuffer: PChar;
SrcBuffer: TRecordBuffer;
I: integer;
begin
I:= Field.FieldNo - 1;
@ -717,13 +717,13 @@ begin
not getfieldisnull(pointer(srcbuffer),I);
if result and (buffer <> nil) then
begin
Move(getcharpointer(SrcBuffer,getintegerpointer(ffieldoffsets,I)^)^, Buffer^,GetIntegerPointer(FFieldSizes, I)^);
Move(GetRecordBufferPointer((SrcBuffer),getintegerpointer(ffieldoffsets,I)^)^, Buffer^,GetIntegerPointer(FFieldSizes, I)^);
end;
end;
procedure TMemDataset.SetFieldData(Field: TField; Buffer: Pointer);
var
DestBuffer: PChar;
DestBuffer: TRecordBuffer;
I,J: integer;
begin
@ -740,7 +740,7 @@ begin
J:=GetIntegerPointer(FFieldSizes, I)^;
if Field.DataType=ftString then
Dec(J); // Do not move terminating 0, which is in the size.
Move(Buffer^,GetCharPointer(DestBuffer, getIntegerPointer(FFieldOffsets, I)^)^,J);
Move(Buffer^,GetRecordBufferPointer((DestBuffer), getIntegerPointer(FFieldOffsets, I)^)^,J);
dataevent(defieldchange,ptrint(field));
end;
end;
@ -765,7 +765,7 @@ begin
RaiseError(SErrBookMarkNotFound,[ReqBookmark]);
end;
procedure TMemDataset.InternalSetToRecord(Buffer: PChar);
procedure TMemDataset.InternalSetToRecord(Buffer: TRecordBuffer);
var
ReqBookmark: integer;
@ -775,26 +775,26 @@ begin
InternalGotoBookmark (@ReqBookmark);
end;
function TMemDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
function TMemDataset.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
Result:=PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag;
end;
procedure TMemDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
procedure TMemDataset.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
PRecInfo(Buffer+FRecInfoOffset)^.BookmarkFlag := Value;
end;
procedure TMemDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TMemDataset.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
if Data<>nil then
PInteger(Data)^:=PRecInfo(Buffer+FRecInfoOffset)^.Bookmark;
end;
procedure TMemDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TMemDataset.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
if Data<>nil then
@ -803,7 +803,7 @@ begin
PRecInfo(Buffer+FRecInfoOffset)^.Bookmark:=0;
end;
function TMemDataset.MDSFilterRecord(Buffer: PChar): Boolean;
function TMemDataset.MDSFilterRecord(Buffer: TRecordBuffer): Boolean;
var
SaveState: TDatasetState;
@ -1007,7 +1007,7 @@ begin
end;
end;
function TMemDataset.GetCharPointer(p:PChar; Pos:Integer):PChar;
function TMemDataset.GetRecordBufferPointer(p:TRecordBuffer; Pos:Integer):TRecordBuffer;
begin
Result:=p;
inc(Result, Pos);

78
packages/fcl-db/src/paradox/paradox.pp
View File

@ -43,7 +43,7 @@ type
FPXLibrary : String;
FCurrRecNo : Integer;
FDoc : PPX_Doc;
FFilterBuffer : PChar;
FFilterBuffer : TRecordBuffer;
FOffsets : PInteger;
FTableName : String;
FInputEncoding : String;
@ -54,8 +54,8 @@ type
function GetTargetEncoding: String;
procedure OpenBlobFile;
procedure PXAppendRecord(Buffer: Pointer);
function PXFilterRecord(Buffer: PChar): Boolean;
function PXGetActiveBuffer(var Buffer: PChar): Boolean;
function PXFilterRecord(Buffer: TRecordBuffer): Boolean;
function PXGetActiveBuffer(var Buffer: TRecordBuffer): Boolean;
procedure RaiseError(Fmt: String; Args: array of const);
procedure SetBlobFileName(const AValue: String);
procedure SetFileName(const AValue: String);
@ -70,12 +70,12 @@ type
procedure SetFiltered(Value: Boolean); override; {virtual;}
procedure ParseFilter(const AFilter: string);
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
function AllocRecordBuffer: TRecordBuffer; override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordSize: Word; override;
procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
procedure InternalClose; override;
@ -83,14 +83,14 @@ type
procedure InternalFirst; override;
procedure InternalGotoBookmark(ABookmark: Pointer); override;
procedure InternalInitFieldDefs; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure InternalLast; override;
procedure InternalOpen; override;
procedure InternalPost; override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
function IsCursorOpen: Boolean; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure DataConvert(aField: TField; aSource, aDest: Pointer; aToNative: Boolean); override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
@ -276,7 +276,7 @@ begin
FBlobFileName:=AValue;
end;
function TParadox.PXFilterRecord(Buffer: PChar): Boolean;
function TParadox.PXFilterRecord(Buffer: TRecordBuffer): Boolean;
var
SaveState: TDatasetState;
@ -299,20 +299,20 @@ end;
{
procedure TParadox.MDSReadRecord(Buffer:PChar;ARecNo:Integer); //Reads a Rec from Stream in Buffer
procedure TParadox.MDSReadRecord(Buffer:TRecordBuffer;ARecNo:Integer); //Reads a Rec from Stream in Buffer
begin
FStream.Position:=MDSGetRecordOffset(ARecNo);
FStream.ReadBuffer(Buffer^, FRecSize);
end;
procedure TParadox.MDSWriteRecord(Buffer:PChar;ARecNo:Integer); //Writes a Rec from Buffer to Stream
procedure TParadox.MDSWriteRecord(Buffer:TRecordBuffer;ARecNo:Integer); //Writes a Rec from Buffer to Stream
begin
FStream.Position:=MDSGetRecordOffset(ARecNo);
FStream.WriteBuffer(Buffer^, FRecSize);
FFileModified:=True;
end;
procedure TParadox.MDSAppendRecord(Buffer:PChar); //Appends a Rec (from Buffer) to Stream
procedure TParadox.MDSAppendRecord(Buffer:TRecordBuffer); //Appends a Rec (from Buffer) to Stream
begin
FStream.Position:=MDSGetRecordOffset(FRecCount);
FStream.WriteBuffer(Buffer^, FRecSize);
@ -320,7 +320,7 @@ begin
end;
}
function TParadox.PXGetActiveBuffer(var Buffer: PChar): Boolean;
function TParadox.PXGetActiveBuffer(var Buffer: TRecordBuffer): Boolean;
begin
case State of
@ -390,18 +390,18 @@ end;
//Abstract Overrides
function TParadox.AllocRecordBuffer: PChar;
function TParadox.AllocRecordBuffer: TRecordBuffer;
begin
Result:=Nil;
GetMem(Result,SizeOf(TPXRecInfo)+GetRecordSize);
end;
procedure TParadox.FreeRecordBuffer (var Buffer: PChar);
procedure TParadox.FreeRecordBuffer (var Buffer: TRecordBuffer);
begin
FreeMem(Buffer);
end;
procedure TParadox.InternalInitRecord(Buffer: PChar);
procedure TParadox.InternalInitRecord(Buffer: TRecordBuffer);
begin
fillchar((Buffer+DataOffSet)^,GetRecordSize,0);
@ -579,7 +579,7 @@ begin
if ((State<>dsEdit) and (State<>dsInsert)) then
Exit;
if (State=dsEdit) then
PX_put_recordn(FDoc,ActiveBuffer, FCurrRecNo)
PX_put_recordn(FDoc,pansichar(ActiveBuffer), FCurrRecNo)
else
InternalAddRecord(ActiveBuffer,True);
end;
@ -590,7 +590,7 @@ begin
Result:=(FDoc<>Nil);
end;
function TParadox.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
function TParadox.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
Accepted: Boolean;
@ -621,7 +621,7 @@ begin
end;
if result=grOK then
begin
PX_get_record(Doc,FCurrRecNo,Buffer+DataOffset);
PX_get_record(Doc,FCurrRecNo,pansichar(Buffer+DataOffset));
PPXRecInfo(Buffer)^.Bookmark:=FCurrRecNo;
PPXRecInfo(Buffer)^.BookmarkFlag:=bfCurrent;
if (Filtered) then
@ -637,7 +637,7 @@ end;
function TParadox.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
Buf : PChar;
Buf : TRecordbuffer;
No,pft,flen : integer;
pxf : PPx_field;
Value : Pchar;
@ -660,7 +660,7 @@ begin
Case pft of
pxfAlpha:
begin
Result:=PX_get_data_alpha(FDoc,Buf,flen,@value)>0;
Result:=PX_get_data_alpha(FDoc,pansichar(Buf),flen,@value)>0;
If result then
begin
Move(Value^,Buffer^,flen);
@ -671,7 +671,7 @@ begin
end;
pxfDate:
begin
Result:=PX_get_data_long(FDoc,Buf,flen,@longv)>0;
Result:=PX_get_data_long(FDoc,pansichar(Buf),flen,@longv)>0;
If Result then
begin
// 1721425 is the number of the days between the start of the
@ -683,33 +683,33 @@ begin
end;
pxfShort:
begin
Result:=PX_get_data_short(FDoc,Buf, flen, @D)>0;
Result:=PX_get_data_short(FDoc,pansichar(Buf), flen, @D)>0;
If result then
PSmallInt(Buffer)^:=D;
end;
pxfAutoInc,
pxfLong:
begin
Result:=(PX_get_data_long(FDoc,buf,flen,@longv)>0);
Result:=(PX_get_data_long(FDoc,pansichar(buf),flen,@longv)>0);
If Result then
PInteger(Buffer)^:=Longv;
end;
pxfCurrency,
pxfNumber:
begin
Result:=(PX_get_data_double(FDoc,Buf,Flen,@R)>0);
Result:=(PX_get_data_double(FDoc,pansichar(Buf),Flen,@R)>0);
If Result then
PDouble(Buffer)^:=R;
end;
pxfLogical:
begin
Result:=(PX_get_data_byte(FDoc,Buf,flen,@C)>0);
Result:=(PX_get_data_byte(FDoc,pansichar(Buf),flen,@C)>0);
If result then
PWordBool(Buffer)^:=(C<>#0);
end;
pxfBytes:
begin
Result:=PX_get_data_bytes(FDoc,Buf,FLen,@Value)>0;
Result:=PX_get_data_bytes(FDoc,pansichar(Buf),FLen,@Value)>0;
If Result then
begin
Move(Value^,Buffer^,FLen);
@ -727,13 +727,13 @@ begin
end;
pxfTime:
begin
Result:=(PX_get_data_long(FDoc,Buf,flen,@longv)>0);
Result:=(PX_get_data_long(FDoc,pansichar(Buf),flen,@longv)>0);
If result then
PDateTime(Buffer)^:=longv/MSecsPerDay;
end;
pxfTimestamp:
begin
Result:=(PX_get_data_double(FDoc,buf,flen,@R)>0);
Result:=(PX_get_data_double(FDoc,pansichar(buf),flen,@R)>0);
if Result then
begin
R:=R/1000.0;
@ -761,7 +761,7 @@ end;
procedure TParadox.SetFieldData(Field: TField; Buffer: Pointer);
var
DestBuffer: PChar;
DestBuffer: TRecordBuffer;
I: integer;
begin
@ -848,7 +848,7 @@ begin
RaiseError(SErrBookMarkNotFound,[ReqBookmark]);
end;
procedure TParadox.InternalSetToRecord(Buffer: PChar);
procedure TParadox.InternalSetToRecord(Buffer: TRecordBuffer);
var
ReqBookmark: integer;
@ -858,26 +858,26 @@ begin
InternalGotoBookmark (@ReqBookmark);
end;
function TParadox.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
function TParadox.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
Result:=PPXRecInfo(Buffer)^.BookmarkFlag;
end;
procedure TParadox.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
procedure TParadox.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
PPXRecInfo(Buffer)^.BookmarkFlag := Value;
end;
procedure TParadox.GetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TParadox.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
if Data<>nil then
PInteger(Data)^:=PPXRecInfo(Buffer)^.Bookmark;
end;
procedure TParadox.SetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TParadox.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
if Data<>nil then

89
packages/fcl-db/src/sdf/sdfdata.pp
View File

@ -144,7 +144,7 @@ type
private
FSchema :TStringList;
FFileName :TFileName;
FFilterBuffer :PChar;
FFilterBuffer :TRecordBuffer;
FFileMustExist :Boolean;
FReadOnly :Boolean;
FLoadfromStream :Boolean;
@ -156,8 +156,8 @@ type
procedure SetReadOnly(Value : Boolean);
procedure RemoveWhiteLines(List : TStrings; IsFileRecord : Boolean);
procedure LoadFieldScheme(List : TStrings; MaxSize : Integer);
function GetActiveRecBuf(var RecBuf: PChar): Boolean;
procedure SetFieldPos(var Buffer : PChar; FieldNo : Integer);
function GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
procedure SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
protected
FData :TStringlist;
FCurRec :Integer;
@ -170,8 +170,8 @@ type
FDefaultRecordLength:Cardinal;
FDataOffset : Integer;
protected
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
function AllocRecordBuffer: TRecordBuffer; override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
procedure InternalClose; override;
procedure InternalDelete; override;
@ -179,28 +179,28 @@ type
procedure InternalGotoBookmark(ABookmark: Pointer); override;
procedure InternalHandleException; override;
procedure InternalInitFieldDefs; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure InternalLast; override;
procedure InternalOpen; override;
procedure InternalPost; override;
procedure InternalEdit; override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
function IsCursorOpen: Boolean; override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordSize: Word; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure ClearCalcFields(Buffer: PChar); override;
procedure ClearCalcFields(Buffer: TRecordBuffer); override;
function GetRecordCount: Integer; override;
function GetRecNo: Integer; override;
procedure SetRecNo(Value: Integer); override;
function GetCanModify: boolean; override;
function TxtGetRecord(Buffer : PChar; GetMode: TGetMode): TGetResult;
function TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
function RecordFilter(RecBuf: Pointer; ARecNo: Integer): Boolean;
function BufToStore(Buffer: PChar): String; virtual;
function BufToStore(Buffer: TRecordBuffer): String; virtual;
function StoreToBuf(Source: String): String; virtual;
public
property DefaultRecordLength: Cardinal read FDefaultRecordLength
@ -262,9 +262,9 @@ type
procedure SetDelimiter(Value : Char);
protected
procedure InternalInitFieldDefs; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean)
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean)
: TGetResult; override;
function BufToStore(Buffer: PChar): String; override;
function BufToStore(Buffer: TRecordBuffer): String; override;
function StoreToBuf(Source: String): String; override;
public
constructor Create(AOwner: TComponent); override;
@ -447,7 +447,7 @@ begin
end;
// Record Functions
function TFixedFormatDataSet.AllocRecordBuffer: PChar;
function TFixedFormatDataSet.AllocRecordBuffer: TRecordBuffer;
begin
if FRecBufSize > 0 then
Result := AllocMem(FRecBufSize)
@ -455,23 +455,23 @@ begin
Result := nil;
end;
procedure TFixedFormatDataSet.FreeRecordBuffer(var Buffer: PChar);
procedure TFixedFormatDataSet.FreeRecordBuffer(var Buffer: TRecordBuffer);
begin
if Buffer <> nil then
FreeMem(Buffer);
end;
procedure TFixedFormatDataSet.InternalInitRecord(Buffer: PChar);
procedure TFixedFormatDataSet.InternalInitRecord(Buffer: TRecordBuffer);
begin
FillChar(Buffer[0], FRecordSize, 0);
end;
procedure TFixedFormatDataSet.ClearCalcFields(Buffer: PChar);
procedure TFixedFormatDataSet.ClearCalcFields(Buffer: TRecordBuffer);
begin
FillChar(Buffer[RecordSize], CalcFieldsSize, 0);
end;
function TFixedFormatDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
function TFixedFormatDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
begin
if (FData.Count < (1+FDataOffset)) then
@ -500,7 +500,7 @@ end;
function TFixedFormatDataSet.GetRecNo: Longint;
var
BufPtr: PChar;
BufPtr: TRecordBuffer;
begin
Result := -1;
if GetActiveRecBuf(BufPtr) then
@ -524,7 +524,7 @@ begin
Result := FRecordSize;
end;
function TFixedFormatDataSet.GetActiveRecBuf(var RecBuf: PChar): Boolean;
function TFixedFormatDataSet.GetActiveRecBuf(var RecBuf: TRecordBuffer): Boolean;
begin
case State of
dsBrowse: if IsEmpty then RecBuf := nil else RecBuf := ActiveBuffer;
@ -537,7 +537,7 @@ begin
Result := RecBuf <> nil;
end;
function TFixedFormatDataSet.TxtGetRecord(Buffer : PChar; GetMode: TGetMode): TGetResult;
function TFixedFormatDataSet.TxtGetRecord(Buffer : TRecordBuffer; GetMode: TGetMode): TGetResult;
var
Accepted : Boolean;
begin
@ -624,15 +624,15 @@ end;
function TFixedFormatDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
TempPos, RecBuf: PChar;
TempPos, recbuf : PChar;
begin
Result := GetActiveRecBuf(RecBuf);
Result := GetActiveRecBuf(TRecordBuffer(RecBuf));
if Result then
begin
if Field.FieldNo > 0 then
begin
TempPos := RecBuf;
SetFieldPos(RecBuf, Field.FieldNo);
SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
Result := (RecBuf < StrEnd(TempPos));
end
else
@ -661,12 +661,13 @@ end;
procedure TFixedFormatDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var
RecBuf, BufEnd: PChar;
RecBuf: PChar;
BufEnd: PChar;
p : Integer;
begin
if not (State in dsWriteModes) then
DatabaseError(SNotEditing, Self);
GetActiveRecBuf(RecBuf);
GetActiveRecBuf(TRecordBuffer(RecBuf));
if Field.FieldNo > 0 then
begin
if State = dsCalcFields then
@ -677,8 +678,8 @@ begin
Field.Validate(Buffer);
if Field.FieldKind <> fkInternalCalc then
begin
SetFieldPos(RecBuf, Field.FieldNo);
BufEnd := StrEnd(ActiveBuffer); // Fill with blanks when necessary
SetFieldPos(TRecordBuffer(RecBuf), Field.FieldNo);
BufEnd := StrEnd(pansichar(ActiveBuffer)); // Fill with blanks when necessary
if BufEnd > RecBuf then
BufEnd := RecBuf;
FillChar(BufEnd[0], Field.Size + PtrInt(RecBuf) - PtrInt(BufEnd), Ord(' '));
@ -697,7 +698,7 @@ begin
DataEvent(deFieldChange, Ptrint(Field));
end;
procedure TFixedFormatDataSet.SetFieldPos(var Buffer : PChar; FieldNo : Integer);
procedure TFixedFormatDataSet.SetFieldPos(var Buffer : TRecordBuffer; FieldNo : Integer);
var
i : Integer;
begin
@ -770,28 +771,28 @@ begin
DatabaseError('Bookmark not found');
end;
procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: PChar);
procedure TFixedFormatDataSet.InternalSetToRecord(Buffer: TRecordBuffer);
begin
if (State <> dsInsert) then
InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs)^.RecordNumber);
end;
function TFixedFormatDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
function TFixedFormatDataSet.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
Result := PRecInfo(Buffer + FRecInfoOfs)^.BookmarkFlag;
end;
procedure TFixedFormatDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
procedure TFixedFormatDataSet.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
PRecInfo(Buffer + FRecInfoOfs)^.BookmarkFlag := Value;
end;
procedure TFixedFormatDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TFixedFormatDataSet.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
Move(Buffer[FRecInfoOfs], Data^, BookmarkSize);
end;
procedure TFixedFormatDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TFixedFormatDataSet.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
Move(Data^, Buffer[FRecInfoOfs], BookmarkSize);
end;
@ -823,7 +824,7 @@ var
i : Integer;
begin
for i := FData.Count -1 downto 0 do
FData[i] := BufToStore(PChar(StoreToBuf(FData[i])));
FData[i] := BufToStore(trecordbuffer(StoreToBuf(FData[i])));
FData.SaveToFile(FileName);
end;
@ -839,9 +840,9 @@ begin
Result := Source;
end;
function TFixedFormatDataSet.BufToStore(Buffer: PChar): String;
function TFixedFormatDataSet.BufToStore(Buffer: TRecordBuffer): String;
begin
Result := Copy(Buffer, 1, FRecordSize);
Result := Copy(pansichar(Buffer), 1, FRecordSize);
end;
//-----------------------------------------------------------------------------
@ -910,7 +911,7 @@ begin
inherited;
end;
function TSdfDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
function TSdfDataSet.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
begin
if FirstLineAsSchema then
@ -1020,7 +1021,7 @@ begin
Result := Ret;
end;
function TSdfDataSet.BufToStore(Buffer: PChar): String;
function TSdfDataSet.BufToStore(Buffer: TRecordBuffer): String;
const
QuoteDelimiter='"';
var
@ -1033,7 +1034,7 @@ begin
QuoteMe:=false;
for i := 0 to FieldDefs.Count - 1 do
begin
Str := Trim(Copy(Buffer, p, FieldDefs[i].Size));
Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
Inc(p, FieldDefs[i].Size);
if FFMultiLine=true then
begin

42
packages/fcl-db/src/sqlite/customsqliteds.pas
View File

@ -169,15 +169,15 @@ type
function GetRowsAffected: Integer; virtual; abstract;
procedure RetrieveFieldDefs; virtual; abstract;
//TDataSet overrides
function AllocRecordBuffer: PChar; override;
procedure ClearCalcFields(Buffer: PChar); override;
function AllocRecordBuffer: TRecordBuffer; override;
procedure ClearCalcFields(Buffer: TRecordBuffer); override;
procedure DoBeforeClose; override;
procedure DoAfterInsert; override;
procedure DoBeforeInsert; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordCount: Integer; override;
function GetRecNo: Integer; override;
function GetRecordSize: Word; override;
@ -189,14 +189,14 @@ type
procedure InternalFirst; override;
procedure InternalGotoBookmark(ABookmark: Pointer); override;
procedure InternalInitFieldDefs; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalInitRecord(Buffer: TRecordBuffer); override;
procedure InternalLast; override;
procedure InternalOpen; override;
procedure InternalPost; override;
procedure InternalSetToRecord(Buffer: PChar); override;
procedure InternalSetToRecord(Buffer: TRecordBuffer); override;
function IsCursorOpen: Boolean; override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
procedure SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag); override;
procedure SetExpectedAppends(AValue: Integer);
procedure SetExpectedUpdates(AValue: Integer);
procedure SetExpectedDeletes(AValue: Integer);
@ -428,13 +428,13 @@ end;
// TCustomSqliteDataset override methods
function TCustomSqliteDataset.AllocRecordBuffer: PChar;
function TCustomSqliteDataset.AllocRecordBuffer: TRecordBuffer;
begin
Result := AllocMem(SizeOf(PPDataRecord));
PDataRecord(Pointer(Result)^) := FBeginItem;
end;
procedure TCustomSqliteDataset.ClearCalcFields(Buffer: PChar);
procedure TCustomSqliteDataset.ClearCalcFields(Buffer: TRecordBuffer);
var
i: Integer;
RecordItem: PDataRecord;
@ -668,17 +668,17 @@ begin
FreeMem(FCacheItem^.Row, FRowBufferSize);
end;
procedure TCustomSqliteDataset.FreeRecordBuffer(var Buffer: PChar);
procedure TCustomSqliteDataset.FreeRecordBuffer(var Buffer: TRecordBuffer);
begin
FreeMem(Buffer);
end;
procedure TCustomSqliteDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TCustomSqliteDataset.GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
Pointer(Data^) := PPDataRecord(Buffer)^;
end;
function TCustomSqliteDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
function TCustomSqliteDataset.GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag;
begin
Result := PPDataRecord(Buffer)^^.BookmarkFlag;
end;
@ -737,7 +737,7 @@ begin
Result := GetFieldData(Field, Buffer, False);
end;
function TCustomSqliteDataset.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
function TCustomSqliteDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
Result := grOk;
case GetMode of
@ -936,7 +936,7 @@ begin
RetrieveFieldDefs;
end;
procedure TCustomSqliteDataset.InternalInitRecord(Buffer: PChar);
procedure TCustomSqliteDataset.InternalInitRecord(Buffer: TRecordBuffer);
var
TempStr: String;
begin
@ -996,7 +996,7 @@ begin
end;
end;
procedure TCustomSqliteDataset.InternalSetToRecord(Buffer: PChar);
procedure TCustomSqliteDataset.InternalSetToRecord(Buffer: TRecordBuffer);
begin
FCurrentItem := PPDataRecord(Buffer)^;
end;
@ -1283,7 +1283,7 @@ begin
begin
SaveState := SetTempState(dsInternalCalc);
try
CalculateFields(PChar(@TempItem));
CalculateFields(TRecordBuffer(@TempItem));
Result := FieldByName(ResultFields).Value;
finally
RestoreState(SaveState);
@ -1293,12 +1293,12 @@ begin
Result := Null;
end;
procedure TCustomSqliteDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
procedure TCustomSqliteDataset.SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer);
begin
//The BookMarkData is the Buffer itself: no need to set nothing;
end;
procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
procedure TCustomSqliteDataset.SetBookmarkFlag(Buffer: TRecordBuffer; Value: TBookmarkFlag);
begin
PPDataRecord(Buffer)^^.BookmarkFlag := Value;
end;