summaryrefslogtreecommitdiff
path: root/packages
diff options
context:
space:
mode:
Diffstat (limited to 'packages')
-rw-r--r--packages/fcl-base/src/fileinfo.pp2
-rw-r--r--packages/fcl-base/src/inifiles.pp12
-rw-r--r--packages/fcl-db/src/base/bufdataset.pas670
-rw-r--r--packages/fcl-db/src/base/dataset.inc2
-rw-r--r--packages/fcl-db/src/base/db.pas2
-rw-r--r--packages/fcl-db/tests/testdbbasics.pas10
-rw-r--r--packages/fcl-json/src/fpjsonrtti.pp5
-rw-r--r--packages/fcl-passrc/src/pparser.pp2
-rw-r--r--packages/fcl-web/src/base/fphttpclient.pp364
-rw-r--r--packages/fcl-xml/src/xmlwrite.pp15
-rw-r--r--packages/gdbint/src/gdbint.pp16
11 files changed, 741 insertions, 359 deletions
diff --git a/packages/fcl-base/src/fileinfo.pp b/packages/fcl-base/src/fileinfo.pp
index 7945fb3332..72edca1ee6 100644
--- a/packages/fcl-base/src/fileinfo.pp
+++ b/packages/fcl-base/src/fileinfo.pp
@@ -202,7 +202,7 @@ var
Stream: TResourceStream;
begin
FreeResources;
- Stream := TResourceStream.CreateFromID(Instance, 1, PChar(RT_VERSION));
+ Stream := TResourceStream.CreateFromID(Instance, 1, {$ifdef UNICODE}PWideChar{$else}PChar{$endif}(RT_VERSION));
try
FVersionInfo:=TVersionResource.Create;
FVersionInfo.SetCustomRawDataStream(Stream);
diff --git a/packages/fcl-base/src/inifiles.pp b/packages/fcl-base/src/inifiles.pp
index 8450d479db..c4007d0283 100644
--- a/packages/fcl-base/src/inifiles.pp
+++ b/packages/fcl-base/src/inifiles.pp
@@ -198,6 +198,9 @@ type
implementation
+Resourcestring
+ SErrCouldNotCreatePath = 'Could not create directory "%s"';
+
const
Brackets : array[0..1] of Char = ('[', ']');
Separator : Char = '=';
@@ -922,6 +925,8 @@ procedure TIniFile.UpdateFile;
var
slLines: TStringList;
i, j: integer;
+ D : String;
+
begin
slLines := TStringList.Create;
try
@@ -944,7 +949,12 @@ begin
slLines.Add('');
end;
if FFileName > '' then
- slLines.SaveToFile(FFileName)
+ begin
+ D:=ExtractFilePath(FFileName);
+ if not ForceDirectories(D) then
+ Raise EInoutError.CreateFmt(SErrCouldNotCreatePath,[D]);
+ slLines.SaveToFile(FFileName);
+ end
else if FStream <> nil then
slLines.SaveToStream(FStream);
FillSectionList(slLines);
diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas
index 9737e4b995..68025b5f7b 100644
--- a/packages/fcl-db/src/base/bufdataset.pas
+++ b/packages/fcl-db/src/base/bufdataset.pas
@@ -1,6 +1,6 @@
{
This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2006 by Joost van der Sluis, member of the
+ Copyright (c) 1999-2013 by Joost van der Sluis and other members of the
Free Pascal development team
BufDataset implementation
@@ -70,19 +70,19 @@ type
TRecUpdateBuffer = record
UpdateKind : TUpdateKind;
{ BookMarkData:
- - Is -1 if the update has canceled out. For example: a appended record has been deleted again
- - If UpdateKind is ukInsert it contains a bookmark to the new created record
- - If UpdateKind is ukModify it contains a bookmark to the record with the new data
- - If UpdateKind is ukDelete it contains a bookmark to the deleted record (ie: the record is still there)
+ - Is -1 if the update has canceled out. For example: an appended record has been deleted again
+ - If UpdateKind is ukInsert, it contains a bookmark to the newly created record
+ - If UpdateKind is ukModify, it contains a bookmark to the record with the new data
+ - If UpdateKind is ukDelete, it contains a bookmark to the deleted record (ie: the record is still there)
}
BookmarkData : TBufBookmark;
{ NextBookMarkData:
- - If UpdateKind is ukDelete it contains a bookmark to the record just after the deleted record
+ - If UpdateKind is ukDelete, it contains a bookmark to the record just after the deleted record
}
NextBookmarkData : TBufBookmark;
{ OldValuesBuffer:
- - If UpdateKind is ukModify it contains a record-buffer which contains the old data
- - If UpdateKind is ukDelete it contains a record-buffer with the data of the deleted record
+ - If UpdateKind is ukModify, it contains a record buffer which contains the old data
+ - If UpdateKind is ukDelete, it contains a record buffer with the data of the deleted record
}
OldValuesBuffer : TRecordBuffer;
end;
@@ -90,7 +90,7 @@ type
PBufBlobField = ^TBufBlobField;
TBufBlobField = record
- ConnBlobBuffer : array[0..11] of byte; // It's here where the db-specific data is stored
+ ConnBlobBuffer : array[0..11] of byte; // DB specific data is stored here
BlobBuffer : PBlobBuffer;
end;
@@ -159,16 +159,15 @@ type
// Normally only used in GetNextPacket
procedure AddRecord; virtual; abstract;
// Inserts a record before the current record, or if the record is sorted,
- // insert it to the proper position
+ // inserts it in the proper position
procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); virtual; abstract;
- procedure EndUpdate; virtual; abstract;
-
procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); virtual; abstract;
-
+ procedure OrderCurrentRecord; virtual; abstract;
+ procedure EndUpdate; virtual; abstract;
+
function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
Function GetRecNo(const ABookmark : PBufBookmark) : integer; virtual; abstract;
-
property SpareRecord : TRecordBuffer read GetSpareRecord;
property SpareBuffer : TRecordBuffer read GetSpareBuffer;
property CurrentRecord : TRecordBuffer read GetCurrentRecord;
@@ -222,12 +221,13 @@ type
procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
procedure ReleaseSpareRecord; override;
- procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
Function GetRecNo(const ABookmark : PBufBookmark) : integer; override;
procedure BeginUpdate; override;
procedure AddRecord; override;
procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
+ procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
+ procedure OrderCurrentRecord; override;
procedure EndUpdate; override;
end;
@@ -267,12 +267,13 @@ type
procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
procedure ReleaseSpareRecord; override;
- procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
Function GetRecNo(const ABookmark : PBufBookmark) : integer; override;
procedure BeginUpdate; override;
procedure AddRecord; override;
procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
+ procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
+ procedure OrderCurrentRecord; override;
procedure EndUpdate; override;
end;
@@ -324,11 +325,11 @@ type
procedure ReleaseSpareRecord; override;
Function GetRecNo(const ABookmark : PBufBookmark) : integer; override;
- procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
- procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
procedure BeginUpdate; override;
procedure AddRecord; override;
+ procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
+ procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); override;
procedure EndUpdate; override;
end;
@@ -352,7 +353,7 @@ type
public
constructor create(AStream : TStream); virtual;
// Load a dataset from stream:
- // Load the field-definitions from a stream.
+ // Load the field definitions from a stream.
procedure LoadFieldDefs(AFieldDefs : TFieldDefs; var AnAutoIncValue : integer); virtual; abstract;
// Is called before the records are loaded
procedure InitLoadRecords; virtual; abstract;
@@ -360,15 +361,15 @@ type
function GetRecordRowState(out AUpdOrder : Integer) : TRowState; virtual; abstract;
// Returns if there is at least one more record available in the stream
function GetCurrentRecord : boolean; virtual; abstract;
- // Store a record from stream in the current record-buffer
+ // Store a record from stream in the current record buffer
procedure RestoreRecord(ADataset : TCustomBufDataset); virtual; abstract;
// Move the stream to the next record
procedure GotoNextRecord; virtual; abstract;
// Store a dataset to stream:
- // Save the field-definitions to a stream.
+ // Save the field definitions to a stream.
procedure StoreFieldDefs(AFieldDefs : TFieldDefs; AnAutoIncValue : integer); virtual; abstract;
- // Save a record from the current record-buffer to the stream
+ // Save a record from the current record buffer to the stream
procedure StoreRecord(ADataset : TCustomBufDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
// Is called after all records are stored
procedure FinalizeStoreRecords; virtual; abstract;
@@ -399,9 +400,9 @@ type
FReadFromFile : boolean;
FFileStream : TFileStream;
FDatasetReader : TDataPacketReader;
+
FIndexes : array of TBufIndex;
FMaxIndexesCount: integer;
-
FIndexesCount : integer;
FCurrentIndex : TBufIndex;
@@ -432,7 +433,10 @@ type
FUpdateBlobBuffers: array of PBlobBuffer;
procedure FetchAll;
+ procedure ProcessFieldsToCompareStruct(const AFields, ADescFields, ACInsFields: TList;
+ const AIndexOptions: TIndexOptions; const ALocateOptions: TLocateOptions; out ACompareStruct: TDBCompareStruct);
procedure BuildIndex(var AIndex : TBufIndex);
+ function BufferOffset: integer;
function GetIndexDefs : TIndexDefs;
function GetCurrentBuffer: TRecordBuffer;
procedure CalcRecordSize;
@@ -445,7 +449,6 @@ type
function GetRecordUpdateBuffer(const ABookmark : TBufBookmark; IncludePrior : boolean = false; AFindNext : boolean = false) : boolean;
function GetRecordUpdateBufferCached(const ABookmark : TBufBookmark; IncludePrior : boolean = false) : boolean;
function GetActiveRecordUpdateBuffer : boolean;
- procedure ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
procedure SetIndexFieldNames(const AValue: String);
procedure SetIndexName(AValue: String);
procedure SetMaxIndexesCount(const AValue: Integer);
@@ -518,7 +521,7 @@ type
procedure MergeChangeLog;
procedure CancelUpdates; virtual;
destructor Destroy; override;
- function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; override;
+ function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; override;
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
function UpdateStatus: TUpdateStatus; override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
@@ -805,7 +808,7 @@ begin
end;
{
-// Code to dump raw dataset data, including indexes information, usefull for debugging
+// Code to dump raw dataset data, including indexes information, useful for debugging
procedure DumpRawMem(const Data: pointer; ALength: PtrInt);
var
b: integer;
@@ -886,9 +889,7 @@ var PCurRecLinkItem : PBufRecLinkItem;
IndexFields : TList;
DescIndexFields : TList;
CInsIndexFields : TList;
- FieldsAmount : Integer;
- FieldNr : integer;
- AField : TField;
+
Index0,
DblLinkIndex : TDoubleLinkedBufIndex;
@@ -911,8 +912,8 @@ var PCurRecLinkItem : PBufRecLinkItem;
end;
begin
- // Build the DBCompareStructure
- // One AS is enough, and makes debugging easier.
+ // Build the DBCompareStructure
+ // One AS is enough, and makes debugging easier.
DblLinkIndex:=(AIndex as TDoubleLinkedBufIndex);
Index0:=(FIndexes[0] as TDoubleLinkedBufIndex);
with DblLinkIndex do
@@ -922,24 +923,11 @@ begin
CInsIndexFields := TList.Create;
try
GetFieldList(IndexFields,FieldsName);
- FieldsAmount:=IndexFields.Count;
GetFieldList(DescIndexFields,DescFields);
GetFieldList(CInsIndexFields,CaseinsFields);
- if FieldsAmount=0 then
+ if IndexFields.Count=0 then
DatabaseError(SNoIndexFieldNameGiven);
- SetLength(DBCompareStruct,FieldsAmount);
- for FieldNr:=0 to FieldsAmount-1 do
- begin
- AField := TField(IndexFields[FieldNr]);
- ProcessFieldCompareStruct(AField,DBCompareStruct[FieldNr]);
-
- DBCompareStruct[FieldNr].Desc := (DescIndexFields.IndexOf(AField)>-1) or (ixDescending in Options);
- if (CInsIndexFields.IndexOf(AField)>-1) then
- DBCompareStruct[FieldNr].Options := [loCaseInsensitive]
- else
- DBCompareStruct[FieldNr].Options := [];
-
- end;
+ ProcessFieldsToCompareStruct(IndexFields, DescIndexFields, CInsIndexFields, Options, [], DBCompareStruct);
finally
CInsIndexFields.Free;
DescIndexFields.Free;
@@ -947,7 +935,7 @@ begin
end;
end;
-// This simply copies the index...
+ // This simply copies the index...
PCurRecLinkItem:=Index0.FFirstRecBuf;
PCurRecLinkItem[DblLinkIndex.IndNr].next := PCurRecLinkItem[0].next;
PCurRecLinkItem[DblLinkIndex.IndNr].prior := PCurRecLinkItem[0].prior;
@@ -966,46 +954,43 @@ begin
// Empty dataset
Exit;
-// Set FirstRecBuf and FCurrentRecBuf
+ // Set FirstRecBuf and FCurrentRecBuf
DblLinkIndex.FFirstRecBuf:=Index0.FFirstRecBuf;
DblLinkIndex.FCurrentRecBuf:=DblLinkIndex.FFirstRecBuf;
-// Link in the FLastRecBuf that belongs to this index
+ // Link in the FLastRecBuf that belongs to this index
PCurRecLinkItem[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
DblLinkIndex.FLastRecBuf[DblLinkIndex.IndNr].prior:=PCurRecLinkItem;
-// Mergesort. Used the algorithm as described here by Simon Tatham
-// http://www.chiark.greenend.org.uk/~sgtatham/algorithms/listsort.html
-// The comments in the code are from this website.
+ // Mergesort. Used the algorithm as described here by Simon Tatham
+ // http://www.chiark.greenend.org.uk/~sgtatham/algorithms/listsort.html
+ // The comments in the code are from this website.
-// In each pass, we are merging lists of size K into lists of size 2K.
-// (Initially K equals 1.)
+ // In each pass, we are merging lists of size K into lists of size 2K.
+ // (Initially K equals 1.)
k:=1;
repeat
-// So we start by pointing a temporary pointer p at the head of the list,
-// and also preparing an empty list L which we will add elements to the end
-// of as we finish dealing with them.
-
+ // So we start by pointing a temporary pointer p at the head of the list,
+ // and also preparing an empty list L which we will add elements to the end
+ // of as we finish dealing with them.
p := DblLinkIndex.FFirstRecBuf;
DblLinkIndex.FFirstRecBuf := nil;
q := p;
MergeAmount := 0;
-// Then:
-// * If p is null, terminate this pass.
+ // Then:
+ // * If p is null, terminate this pass.
while p <> DblLinkIndex.FLastRecBuf do
begin
-// * Otherwise, there is at least one element in the next pair of length-K
-// lists, so increment the number of merges performed in this pass.
-
+ // * Otherwise, there is at least one element in the next pair of length-K
+ // lists, so increment the number of merges performed in this pass.
inc(MergeAmount);
-// * Point another temporary pointer, q, at the same place as p. Step q along
-// the list by K places, or until the end of the list, whichever comes
-// first. Let psize be the number of elements you managed to step q past.
-
+ // * Point another temporary pointer, q, at the same place as p. Step q along
+ // the list by K places, or until the end of the list, whichever comes
+ // first. Let psize be the number of elements you managed to step q past.
i:=0;
while (i<k) and (q<>DblLinkIndex.FLastRecBuf) do
begin
@@ -1014,23 +999,21 @@ begin
end;
psize :=i;
-// * Let qsize equal K. Now we need to merge a list starting at p, of length
-// psize, with a list starting at q of length at most qsize.
-
+ // * Let qsize equal K. Now we need to merge a list starting at p, of length
+ // psize, with a list starting at q of length at most qsize.
qsize:=k;
-// * So, as long as either the p-list is non-empty (psize > 0) or the q-list
-// is non-empty (qsize > 0 and q points to something non-null):
-
+ // * So, as long as either the p-list is non-empty (psize > 0) or the q-list
+ // is non-empty (qsize > 0 and q points to something non-null):
while (psize>0) or ((qsize>0) and (q <> DblLinkIndex.FLastRecBuf)) do
begin
-// o Choose which list to take the next element from. If either list
-// is empty, we must choose from the other one. (By assumption, at
-// least one is non-empty at this point.) If both lists are
-// non-empty, compare the first element of each and choose the lower
-// one. If the first elements compare equal, choose from the p-list.
-// (This ensures that any two elements which compare equal are never
-// swapped, so stability is guaranteed.)
+ // * Choose which list to take the next element from. If either list
+ // is empty, we must choose from the other one. (By assumption, at
+ // least one is non-empty at this point.) If both lists are
+ // non-empty, compare the first element of each and choose the lower
+ // one. If the first elements compare equal, choose from the p-list.
+ // (This ensures that any two elements which compare equal are never
+ // swapped, so stability is guaranteed.)
if (psize=0) then
PlaceQRec := true
else if (qsize=0) or (q = DblLinkIndex.FLastRecBuf) then
@@ -1040,23 +1023,24 @@ begin
else
PlaceQRec := True;
-// o Remove that element, e, from the start of its list, by advancing
-// p or q to the next element along, and decrementing psize or qsize.
-// o Add e to the end of the list L we are building up.
+ // * Remove that element, e, from the start of its list, by advancing
+ // p or q to the next element along, and decrementing psize or qsize.
+ // * Add e to the end of the list L we are building up.
if PlaceQRec then
PlaceNewRec(q,qsize)
else
PlaceNewRec(p,psize);
end;
-// * Now we have advanced p until it is where q started out, and we have
-// advanced q until it is pointing at the next pair of length-K lists to
-// merge. So set p to the value of q, and go back to the start of this loop.
+
+ // * Now we have advanced p until it is where q started out, and we have
+ // advanced q until it is pointing at the next pair of length-K lists to
+ // merge. So set p to the value of q, and go back to the start of this loop.
p:=q;
end;
-// As soon as a pass like this is performed and only needs to do one merge, the
-// algorithm terminates, and the output list L is sorted. Otherwise, double the
-// value of K, and go back to the beginning.
+ // As soon as a pass like this is performed and only needs to do one merge, the
+ // algorithm terminates, and the output list L is sorted. Otherwise, double the
+ // value of K, and go back to the beginning.
l[DblLinkIndex.IndNr].next:=DblLinkIndex.FLastRecBuf;
@@ -1092,17 +1076,23 @@ begin
Result:=not (UniDirectional or ReadOnly);
end;
+function TCustomBufDataset.BufferOffset: integer;
+begin
+ // Returns the offset of data buffer in bufdataset record
+ Result := sizeof(TBufRecLinkItem) * FMaxIndexesCount;
+end;
+
function TCustomBufDataset.IntAllocRecordBuffer: TRecordBuffer;
begin
// Note: Only the internal buffers of TDataset provide bookmark information
- result := AllocMem(FRecordsize+sizeof(TBufRecLinkItem)*FMaxIndexesCount);
+ result := AllocMem(FRecordSize+BufferOffset);
end;
function TCustomBufDataset.AllocRecordBuffer: TRecordBuffer;
begin
- result := AllocMem(FRecordsize + BookmarkSize + CalcfieldsSize);
-// The records are initialised, or else the fields of an empty, just-opened dataset
-// are not null
+ result := AllocMem(FRecordSize + BookmarkSize + CalcFieldsSize);
+ // The records are initialised, or else the fields of an empty, just-opened dataset
+ // are not null
InitRecord(result);
end;
@@ -1138,7 +1128,7 @@ begin
// is not (correctly) created.
// commented for now. If there are constant expressions in the select
- // statement they are ftunknown, and not created.
+ // statement they are ftUnknown, and not created.
// See mantis #22030
// if Fields.Count<FieldDefs.Count then
@@ -1146,7 +1136,7 @@ begin
// If there is a field with FieldNo=0 then the fields are not found to the
// FieldDefs which is a sign that there is no dataset created. (Calculated and
- // lookupfields have FieldNo=-1)
+ // lookup fields have FieldNo=-1)
for i := 0 to Fields.Count-1 do
if fields[i].FieldNo=0 then
DatabaseError(SErrNoDataset)
@@ -1166,12 +1156,7 @@ begin
FOpen:=True;
// parse filter expression
- try
- ParseFilter(Filter);
- except
- // oops, a problem with parsing, clear filter for now
- on E: Exception do Filter := EmptyStr;
- end;
+ ParseFilter(Filter);
if assigned(FDatasetReader) then IntLoadRecordsFromFile;
end;
@@ -1245,11 +1230,6 @@ begin
SetToLastRecord;
end;
-function TDoubleLinkedBufIndex.GetCurrentRecord: TRecordBuffer;
-begin
- Result := TRecordBuffer(FCurrentRecBuf);
-end;
-
function TDoubleLinkedBufIndex.GetBookmarkSize: integer;
begin
Result:=sizeof(TBufBookmark);
@@ -1257,7 +1237,12 @@ end;
function TDoubleLinkedBufIndex.GetCurrentBuffer: Pointer;
begin
- Result := pointer(FCurrentRecBuf)+(sizeof(TBufRecLinkItem)*FDataset.MaxIndexesCount);
+ Result := pointer(FCurrentRecBuf) + FDataset.BufferOffset;
+end;
+
+function TDoubleLinkedBufIndex.GetCurrentRecord: TRecordBuffer;
+begin
+ Result := TRecordBuffer(FCurrentRecBuf);
end;
function TDoubleLinkedBufIndex.GetIsInitialized: boolean;
@@ -1267,7 +1252,7 @@ end;
function TDoubleLinkedBufIndex.GetSpareBuffer: TRecordBuffer;
begin
- Result := pointer(FLastRecBuf)+(sizeof(TBufRecLinkItem)*FDataset.MaxIndexesCount);
+ Result := pointer(FLastRecBuf) + FDataset.BufferOffset;
end;
function TDoubleLinkedBufIndex.GetSpareRecord: TRecordBuffer;
@@ -1386,7 +1371,7 @@ end;
procedure TDoubleLinkedBufIndex.InitialiseIndex;
begin
-// Do nothing
+ // Do nothing
end;
function TDoubleLinkedBufIndex.CanScrollForward: Boolean;
@@ -1411,21 +1396,6 @@ begin
FFirstRecBuf:= nil;
end;
-procedure TDoubleLinkedBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBookmark);
-var ARecord : PBufRecLinkItem;
-begin
- ARecord := ABookmark.BookmarkData;
- if ARecord = FCurrentRecBuf then DoScrollForward;
- if ARecord <> FFirstRecBuf then
- ARecord[IndNr].prior[IndNr].next := ARecord[IndNr].next
- else
- begin
- FFirstRecBuf := ARecord[IndNr].next;
- FLastRecBuf[IndNr].next := FFirstRecBuf;
- end;
- ARecord[IndNr].next[IndNr].prior := ARecord[IndNr].prior;
-end;
-
function TDoubleLinkedBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer;
Var TmpRecBuffer : PBufRecLinkItem;
recnr : integer;
@@ -1475,6 +1445,52 @@ begin
ANewRecord[IndNr].next[IndNr].prior:=ANewRecord;
end;
+procedure TDoubleLinkedBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBookmark);
+var ARecord : PBufRecLinkItem;
+begin
+ ARecord := ABookmark.BookmarkData;
+ if ARecord = FCurrentRecBuf then DoScrollForward;
+ if ARecord <> FFirstRecBuf then
+ ARecord[IndNr].prior[IndNr].next := ARecord[IndNr].next
+ else
+ begin
+ FFirstRecBuf := ARecord[IndNr].next;
+ FLastRecBuf[IndNr].next := FFirstRecBuf;
+ end;
+ ARecord[IndNr].next[IndNr].prior := ARecord[IndNr].prior;
+end;
+
+procedure TDoubleLinkedBufIndex.OrderCurrentRecord;
+var ARecord: PBufRecLinkItem;
+ ABookmark: TBufBookmark;
+begin
+ // all records except current are already sorted
+ // check prior records
+ ARecord := FCurrentRecBuf;
+ repeat
+ ARecord := ARecord[IndNr].prior;
+ until not assigned(ARecord) or (IndexCompareRecords(ARecord, FCurrentRecBuf, DBCompareStruct) <= 0);
+ if assigned(ARecord) then
+ ARecord := ARecord[IndNr].next
+ else
+ ARecord := FFirstRecBuf;
+ if ARecord = FCurrentRecBuf then
+ begin
+ // prior record is less equal than current
+ // check next records
+ repeat
+ ARecord := ARecord[IndNr].next;
+ until (ARecord=FLastRecBuf) or (IndexCompareRecords(ARecord, FCurrentRecBuf, DBCompareStruct) >= 0);
+ if ARecord = FCurrentRecBuf[IndNr].next then
+ Exit; // current record is on proper position
+ end;
+ StoreCurrentRecIntoBookmark(@ABookmark);
+ RemoveRecordFromIndex(ABookmark);
+ FCurrentRecBuf := ARecord;
+ InsertRecordBeforeCurrentRecord(TRecordBuffer(ABookmark.BookmarkData));
+ GotoBookmark(@ABookmark);
+end;
+
procedure TDoubleLinkedBufIndex.EndUpdate;
begin
FLastRecBuf[IndNr].next := FFirstRecBuf;
@@ -1507,18 +1523,6 @@ begin
end;
end;
-procedure TCustomBufDataset.InitDefaultIndexes;
-begin
- if FIndexesCount=0 then
- begin
- InternalAddIndex('DEFAULT_ORDER','',[],'','');
- FCurrentIndex:=FIndexes[0];
- if not IsUniDirectional then
- InternalAddIndex('','',[],'','');
- BookmarkSize := FCurrentIndex.BookmarkSize;
- end;
-end;
-
procedure TCustomBufDataset.SetReadOnly(AValue: Boolean);
begin
FReadOnly:=AValue;
@@ -1587,34 +1591,120 @@ begin
result := GetRecordUpdateBufferCached(ABookmark);
end;
-procedure TCustomBufDataset.ProcessFieldCompareStruct(AField: TField; var ACompareRec : TDBCompareRec);
-begin
- case AField.DataType of
- ftString, ftFixedChar : ACompareRec.Comparefunc := @DBCompareText;
- ftWideString, ftFixedWideChar: ACompareRec.Comparefunc := @DBCompareWideText;
- ftSmallint : ACompareRec.Comparefunc := @DBCompareSmallInt;
- ftInteger, ftBCD, ftAutoInc : ACompareRec.Comparefunc :=
- @DBCompareInt;
- ftWord : ACompareRec.Comparefunc := @DBCompareWord;
- ftBoolean : ACompareRec.Comparefunc := @DBCompareByte;
- ftFloat, ftCurrency : ACompareRec.Comparefunc := @DBCompareDouble;
- ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
- @DBCompareDouble;
- ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
- ftFmtBCD : ACompareRec.Comparefunc := @DBCompareBCD;
- else
- DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
- end;
+procedure TCustomBufDataset.ProcessFieldsToCompareStruct(const AFields, ADescFields, ACInsFields: TList;
+ const AIndexOptions: TIndexOptions; const ALocateOptions: TLocateOptions; out ACompareStruct: TDBCompareStruct);
+var i: integer;
+ AField: TField;
+ ACompareRec: TDBCompareRec;
+begin
+ SetLength(ACompareStruct, AFields.Count);
+ for i:=0 to high(ACompareStruct) do
+ begin
+ AField := TField(AFields[i]);
+
+ case AField.DataType of
+ ftString, ftFixedChar : ACompareRec.Comparefunc := @DBCompareText;
+ ftWideString, ftFixedWideChar: ACompareRec.Comparefunc := @DBCompareWideText;
+ ftSmallint : ACompareRec.Comparefunc := @DBCompareSmallInt;
+ ftInteger, ftBCD, ftAutoInc : ACompareRec.Comparefunc :=
+ @DBCompareInt;
+ ftWord : ACompareRec.Comparefunc := @DBCompareWord;
+ ftBoolean : ACompareRec.Comparefunc := @DBCompareByte;
+ ftFloat, ftCurrency : ACompareRec.Comparefunc := @DBCompareDouble;
+ ftDateTime, ftDate, ftTime : ACompareRec.Comparefunc :=
+ @DBCompareDouble;
+ ftLargeint : ACompareRec.Comparefunc := @DBCompareLargeInt;
+ ftFmtBCD : ACompareRec.Comparefunc := @DBCompareBCD;
+ else
+ DatabaseErrorFmt(SErrIndexBasedOnInvField, [AField.FieldName,Fieldtypenames[AField.DataType]]);
+ end;
+
+ ACompareRec.Off1:=BufferOffset + FFieldBufPositions[AField.FieldNo-1];
+ ACompareRec.Off2:=ACompareRec.Off1;
+
+ ACompareRec.FieldInd1:=AField.FieldNo-1;
+ ACompareRec.FieldInd2:=ACompareRec.FieldInd1;
+
+ ACompareRec.NullBOff1:=BufferOffset;
+ ACompareRec.NullBOff2:=ACompareRec.NullBOff1;
+
+ ACompareRec.Desc := ixDescending in AIndexOptions;
+ if assigned(ADescFields) then
+ ACompareRec.Desc := ACompareRec.Desc or (ADescFields.IndexOf(AField)>-1);
+
+ ACompareRec.Options := ALocateOptions;
+ if assigned(ACInsFields) and (ACInsFields.IndexOf(AField)>-1) then
+ ACompareRec.Options := ACompareRec.Options + [loCaseInsensitive];
+
+ ACompareStruct[i] := ACompareRec;
+ end;
+end;
+
+procedure TCustomBufDataset.InitDefaultIndexes;
+begin
+ if FIndexesCount=0 then
+ begin
+ InternalAddIndex('DEFAULT_ORDER','',[],'','');
+ FCurrentIndex:=FIndexes[0];
+ if not IsUniDirectional then
+ InternalAddIndex('','',[],'','');
+ BookmarkSize := FCurrentIndex.BookmarkSize;
+ end;
+end;
+
+procedure TCustomBufDataset.AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
+ const ACaseInsFields: string = '');
+begin
+ CheckBiDirectional;
+ if AFields='' then DatabaseError(SNoIndexFieldNameGiven);
- ACompareRec.Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+
- FFieldBufPositions[AField.FieldNo-1];
- ACompareRec.Off2:=ACompareRec.Off1;
+ if FIndexesCount=0 then
+ InitDefaultIndexes;
- ACompareRec.FieldInd1:=AField.FieldNo-1;
- ACompareRec.FieldInd2:=ACompareRec.FieldInd1;
+ if Active and (FIndexesCount=FMaxIndexesCount) then
+ DatabaseError(SMaxIndexes);
- ACompareRec.NullBOff1:=sizeof(TBufRecLinkItem)*MaxIndexesCount;
- ACompareRec.NullBOff2:=ACompareRec.NullBOff1;
+ // If not all packets are fetched, you can not sort properly.
+ if not Active then
+ FPacketRecords:=-1;
+ InternalAddIndex(AName,AFields,AOptions,ADescFields,ACaseInsFields);
+end;
+
+procedure TCustomBufDataset.InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
+ const ACaseInsFields: string);
+var StoreIndNr : Integer;
+begin
+ if Active then FetchAll;
+ if FIndexesCount>0 then
+ StoreIndNr:=FCurrentIndex.IndNr
+ else
+ StoreIndNr:=0;
+ inc(FIndexesCount);
+ setlength(FIndexes,FIndexesCount); // This invalidates the currentindex! -> not anymore
+ FCurrentIndex:=FIndexes[StoreIndNr];
+ if IsUniDirectional then
+ FIndexes[FIndexesCount-1] := TUniDirectionalBufIndex.Create(self)
+ else
+ FIndexes[FIndexesCount-1] := TDoubleLinkedBufIndex.Create(self);
+// FIndexes[FIndexesCount-1] := TArrayBufIndex.Create(self);
+ FIndexes[FIndexesCount-1].InitialiseIndex;
+ with (FIndexes[FIndexesCount-1] as TBufIndex) do
+ begin
+ Name:=AName;
+ FieldsName:=AFields;
+ DescFields:=ADescFields;
+ CaseinsFields:=ACaseInsFields;
+ Options:=AOptions;
+ IndNr:=FIndexesCount-1;
+ end;
+
+ if Active then
+ begin
+ FIndexes[FIndexesCount-1].InitialiseSpareRecord(IntAllocRecordBuffer);
+ BuildIndex(FIndexes[FIndexesCount-1]);
+ end
+ else if FIndexesCount>FMaxIndexesCount then
+ FMaxIndexesCount := FIndexesCount;
end;
procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String);
@@ -1625,7 +1715,7 @@ begin
InitDefaultIndexes;
FIndexes[1].FieldsName:=AValue;
FCurrentIndex:=FIndexes[1];
- if active then
+ if Active then
begin
FetchAll;
BuildIndex(FIndexes[1]);
@@ -1645,7 +1735,7 @@ begin
begin
(FIndexes[i] as TDoubleLinkedBufIndex).FCurrentRecBuf:=(FCurrentIndex as TDoubleLinkedBufIndex).FCurrentRecBuf;
FCurrentIndex:=FIndexes[i];
- if active then Resync([rmCenter]);
+ if Active then Resync([rmCenter]);
exit;
end;
end;
@@ -1707,7 +1797,7 @@ begin
i := 0;
pb := FIndexes[0].SpareBuffer;
- while ((i < FPacketRecords) or (FPacketRecords = -1)) and (loadbuffer(pb) = grOk) do
+ while ((i < FPacketRecords) or (FPacketRecords = -1)) and (LoadBuffer(pb) = grOk) do
begin
with FIndexes[0] do
begin
@@ -1790,7 +1880,7 @@ end;
function TCustomBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBookmark;
IncludePrior: boolean): boolean;
begin
- // if the current update buffer complies, immediately return true
+ // if the current update buffer matches, immediately return true
if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
(IncludePrior and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
@@ -1969,11 +2059,11 @@ begin
if FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind <> ukModify then
begin
FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil; //this 'disables' the updatebuffer
- // Do NOT release record buffer (pointed by RemRecBookmrk.BookmarkData) here
- // - When record is inserted and deleted(and memory released) and again inserted then same memory block can be returned
- // which leads to confusion, because we get same BookmarkData for distinct records
- // - In CancelUpdates when records are restored it is expected, that deleted records still exists in memory
- // There also could be record(s) in update-buffer, linked to this record.
+ // Do NOT release record buffer (pointed to by RemRecBookmrk.BookmarkData) here
+ // - When record is inserted and deleted (and memory released) and again inserted then the same memory block can be returned
+ // which leads to confusion, because we get the same BookmarkData for distinct records
+ // - In CancelUpdates when records are restored, it is expected that deleted records still exist in memory
+ // There also could be record(s) in the update buffer that is linked to this record.
end;
end;
FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
@@ -2022,7 +2112,7 @@ var StoreRecBM : TBufBookmark;
end
else if (UpdateKind = ukInsert) then
begin
- // Process all upd-buffers linked to this record before this record is removed
+ // Process all update buffers linked to this record before this record is removed
StoreUpdBuf:=FCurrentUpdateBuffer;
Bm := BookmarkData;
BookmarkData.BookmarkData:=nil; // Avoid infinite recursion...
@@ -2078,7 +2168,7 @@ begin
FOnUpdateError := AValue;
end;
-procedure TCustomBufDataset.ApplyUpdates; // For backwards-compatibility
+procedure TCustomBufDataset.ApplyUpdates; // For backward compatibility
begin
ApplyUpdates(0);
@@ -2117,7 +2207,7 @@ begin
on E: EDatabaseError do
begin
Inc(FailedCount);
- if failedcount > word(MaxErrors) then Response := rrAbort
+ if FailedCount > word(MaxErrors) then Response := rrAbort
else Response := rrSkip;
if assigned(FOnUpdateError) then
begin
@@ -2144,7 +2234,7 @@ begin
inc(r);
end;
finally
- if failedcount = 0 then
+ if FailedCount = 0 then
MergeChangeLog;
InternalGotoBookmark(@StoreCurrRec);
@@ -2246,23 +2336,19 @@ begin
FIndexes[i].GotoBookmark(ABookmark);
FIndexes[i].InsertRecordBeforeCurrentRecord(ABuff);
- // new inserted record becomes current record
+ // newly inserted record becomes current record
FIndexes[i].ScrollBackward;
end;
// Link the newly created record buffer to the newly created TDataset record
- with ABookmark^ do
- begin
- FCurrentIndex.StoreCurrentRecIntoBookmark(@BookmarkData);
- BookmarkFlag := bfInserted;
- end;
+ FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
+ ABookmark^.BookmarkFlag := bfInserted;
inc(FBRecordCount);
end
else
InternalSetToRecord(ActiveBuffer);
-
// If there is no updatebuffer already, add one
if not GetActiveRecordUpdateBuffer then
begin
@@ -2273,7 +2359,7 @@ begin
// Store a bookmark of the current record into the updatebuffer's bookmark
FCurrentIndex.StoreCurrentRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData);
- if state = dsEdit then
+ if State = dsEdit then
begin
// Create an oldvalues buffer with the old values of the record
FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := IntAllocRecordBuffer;
@@ -2290,6 +2376,11 @@ begin
end;
move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize);
+
+ // new data are now in current record so reorder current record if needed
+ for i := 1 to FIndexesCount-1 do
+ if (i<>1) or (FIndexes[i]=FCurrentIndex) then
+ FIndexes[i].OrderCurrentRecord;
end;
procedure TCustomBufDataset.CalcRecordSize;
@@ -2560,24 +2651,6 @@ begin
end;
end;
-procedure TCustomBufDataset.AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
- const ACaseInsFields: string = '');
-begin
- CheckBiDirectional;
- if AFields='' then DatabaseError(SNoIndexFieldNameGiven);
-
- if FIndexesCount=0 then
- InitDefaultIndexes;
-
- if active and (FIndexesCount=FMaxIndexesCount) then
- DatabaseError(SMaxIndexes);
-
- // If not all packets are fetched, you can not sort properly.
- if not active then
- FPacketRecords:=-1;
- InternalAddIndex(AName,AFields,AOptions,ADescFields,ACaseInsFields);
-end;
-
procedure TCustomBufDataset.SaveToFile(AFileName: string;
Format: TDataPacketFormat);
var AFileStream : TFileStream;
@@ -2629,7 +2702,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
ARowState := [rsvInserted];
FFilterBuffer:=AUpdBuffer.OldValuesBuffer;
- // If the record is inserted or inserted and afterwards deleted then OldValuesBuffer is nil
+ // OldValuesBuffer is nil if the record is either inserted or inserted and then deleted
if assigned(FFilterBuffer) then
FDatasetReader.StoreRecord(Self,AThisRowState,FCurrentUpdateBuffer);
end;
@@ -2666,7 +2739,7 @@ var ScrollResult : TGetResult;
begin
FDatasetReader := AWriter;
try
- //CheckActive;
+ // CheckActive;
ABookMark:=@ATBookmark;
FDatasetReader.StoreFieldDefs(FieldDefs,FAutoIncValue);
@@ -2690,7 +2763,7 @@ begin
ScrollResult := FCurrentIndex.ScrollForward;
end;
end;
- // There could be a update-buffer linked to the last (spare) record
+ // There could be an update buffer linked to the last (spare) record
FCurrentIndex.StoreSpareRecIntoBookmark(ABookmark);
HandleUpdateBuffersFromRecord(True,ABookmark^,RowState);
@@ -2910,43 +2983,6 @@ begin
BuildIndex(FIndexes[x]);
end;
-procedure TCustomBufDataset.InternalAddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string;
- const ACaseInsFields: string);
-var StoreIndNr : Integer;
-begin
- if Active then FetchAll;
- if FIndexesCount>0 then
- StoreIndNr:=FCurrentIndex.IndNr
- else
- StoreIndNr:=0;
- inc(FIndexesCount);
- setlength(FIndexes,FIndexesCount); // This invalidates the currentindex! -> not anymore
- FCurrentIndex:=FIndexes[StoreIndNr];
- if IsUniDirectional then
- FIndexes[FIndexesCount-1] := TUniDirectionalBufIndex.Create(self)
- else
- FIndexes[FIndexesCount-1] := TDoubleLinkedBufIndex.Create(self);
-// FIndexes[FIndexesCount-1] := TArrayBufIndex.Create(self);
- FIndexes[FIndexesCount-1].InitialiseIndex;
- with (FIndexes[FIndexesCount-1] as TBufIndex) do
- begin
- Name:=AName;
- FieldsName:=AFields;
- DescFields:=ADescFields;
- CaseinsFields:=ACaseInsFields;
- Options:=AOptions;
- IndNr:=FIndexesCount-1;
- end;
-
- if Active then
- begin
- FIndexes[FIndexesCount-1].InitialiseSpareRecord(IntAllocRecordBuffer);
- BuildIndex(FIndexes[FIndexesCount-1]);
- end
- else if FIndexesCount>FMaxIndexesCount then
- FMaxIndexesCount := FIndexesCount;
-end;
-
procedure TCustomBufDataset.DoFilterRecord(out Acceptable: Boolean);
begin
Acceptable := true;
@@ -3043,7 +3079,7 @@ begin
begin
FParser := TBufDatasetParser.Create(Self);
end;
- // have a parser now?
+ // is there a parser now?
if FParser <> nil then
begin
// set options
@@ -3055,46 +3091,14 @@ begin
end;
end;
-function TArrayBufIndex.GetRecordFromBookmark(ABookMark: TBufBookmark) : integer;
-begin
- // ABookmark.BookMarkBuf is nil if SetRecNo calls GotoBookmark
- if (ABookmark.BookmarkData<>nil) and (FRecordArray[ABookmark.BookmarkInt]<>ABookmark.BookmarkData) then
- begin
- // Start searching two records before the expected record
- if ABookmark.BookmarkInt > 2 then
- Result := ABookmark.BookmarkInt-2
- else
- Result := 0;
-
- while (Result<FLastRecInd) do
- begin
- if (FRecordArray[Result] = ABookmark.BookmarkData) then exit;
- inc(Result);
- end;
-
- Result:=0;
- while (Result<ABookmark.BookmarkInt) do
- begin
- if (FRecordArray[Result] = ABookmark.BookmarkData) then exit;
- inc(Result);
- end;
-
- DatabaseError(SInvalidBookmark)
- end
- else
- Result := ABookmark.BookmarkInt;
-end;
-
-Function TCustomBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; options: TLocateOptions) : boolean;
+Function TCustomBufDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
var CurrLinkItem : PBufRecLinkItem;
bm : TBufBookmark;
SearchFields : TList;
- FieldsAmount : Integer;
DBCompareStruct : TDBCompareStruct;
- FieldNr : Integer;
StoreDSState : TDataSetState;
- FilterBuffer : TRecordBuffer;
+ FilterRecord : TRecordBuffer;
FiltAcceptable : boolean;
begin
@@ -3107,36 +3111,29 @@ begin
SearchFields := TList.Create;
try
GetFieldList(SearchFields,KeyFields);
- FieldsAmount:=SearchFields.Count;
- if FieldsAmount=0 then exit;
-
- SetLength(DBCompareStruct,FieldsAmount);
- for FieldNr:=0 to FieldsAmount-1 do
- begin
- ProcessFieldCompareStruct(TField(SearchFields[FieldNr]),DBCompareStruct[FieldNr]);
- DBCompareStruct[FieldNr].Options:=options;
- end;
+ if SearchFields.Count=0 then exit;
+ ProcessFieldsToCompareStruct(SearchFields, nil, nil, [], Options, DBCompareStruct);
finally
SearchFields.Free;
end;
- // Set The filter-buffer
+ // Set the filter buffer
StoreDSState:=SetTempState(dsFilter);
FFilterBuffer:=FCurrentIndex.SpareBuffer;
- SetFieldValues(keyfields,KeyValues);
- CurrLinkItem := (FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
- FilterBuffer:=IntAllocRecordBuffer;
- move((FCurrentIndex as TDoubleLinkedBufIndex).FLastRecBuf^,FilterBuffer^,FRecordsize+sizeof(TBufRecLinkItem)*FMaxIndexesCount);
+ SetFieldValues(KeyFields,KeyValues);
+ FilterRecord:=IntAllocRecordBuffer;
+ move(FCurrentIndex.SpareRecord^, FilterRecord^, FRecordSize+BufferOffset);
// Iterate through the records until a match is found
+ CurrLinkItem := (FCurrentIndex as TDoubleLinkedBufIndex).FFirstRecBuf;
while (CurrLinkItem <> (FCurrentIndex as TDoubleLinkedBufIndex).FLastRecBuf) do
begin
- if (IndexCompareRecords(FilterBuffer,CurrLinkItem,DBCompareStruct) = 0) then
+ if (IndexCompareRecords(FilterRecord,CurrLinkItem,DBCompareStruct) = 0) then
begin
if Filtered then
begin
- FFilterBuffer:=pointer(CurrLinkItem)+(sizeof(TBufRecLinkItem)*MaxIndexesCount);
- // The dataset-state is still dsFilter at this point, so we don't have to set it.
+ FFilterBuffer:=pointer(CurrLinkItem)+BufferOffset;
+ // The dataset state is still dsFilter at this point, so we don't have to set it.
DoFilterRecord(FiltAcceptable);
if FiltAcceptable then
begin
@@ -3156,7 +3153,7 @@ begin
end;
RestoreState(StoreDSState);
- FreeRecordBuffer(FilterBuffer);
+ FreeRecordBuffer(FilterRecord);
// If a match is found, jump to the found record
if Result then
@@ -3178,7 +3175,7 @@ begin
try
if Locate(KeyFields,KeyValues,[]) then
begin
-// CalculateFields(ActiveBuffer); // not needed, done by Locate more than once
+ // CalculateFields(ActiveBuffer); // not needed, done by Locate more than once
result:=FieldValues[ResultFields];
end;
GotoBookmark(bm);
@@ -3280,8 +3277,8 @@ end;
procedure TArrayBufIndex.SetToFirstRecord;
begin
-// if FCurrentRecBuf = FLastRecBuf then the dataset is just opened and empty
-// in which case InternalFirst should do nothing (bug 7211)
+ // if FCurrentRecBuf = FLastRecBuf then the dataset is just opened and empty
+ // in which case InternalFirst should do nothing (bug 7211)
if FCurrentRecInd <> FLastRecInd then
FCurrentRecInd := -1;
end;
@@ -3330,6 +3327,36 @@ begin
end;
end;
+function TArrayBufIndex.GetRecordFromBookmark(ABookMark: TBufBookmark) : integer;
+begin
+ // ABookmark.BookMarkBuf is nil if SetRecNo calls GotoBookmark
+ if (ABookmark.BookmarkData<>nil) and (FRecordArray[ABookmark.BookmarkInt]<>ABookmark.BookmarkData) then
+ begin
+ // Start searching two records before the expected record
+ if ABookmark.BookmarkInt > 2 then
+ Result := ABookmark.BookmarkInt-2
+ else
+ Result := 0;
+
+ while (Result<FLastRecInd) do
+ begin
+ if (FRecordArray[Result] = ABookmark.BookmarkData) then exit;
+ inc(Result);
+ end;
+
+ Result:=0;
+ while (Result<ABookmark.BookmarkInt) do
+ begin
+ if (FRecordArray[Result] = ABookmark.BookmarkData) then exit;
+ inc(Result);
+ end;
+
+ DatabaseError(SInvalidBookmark)
+ end
+ else
+ Result := ABookmark.BookmarkInt;
+end;
+
procedure TArrayBufIndex.GotoBookmark(const ABookmark : PBufBookmark);
begin
FCurrentRecInd:=GetRecordFromBookmark(ABookmark^);
@@ -3337,7 +3364,7 @@ end;
procedure TArrayBufIndex.InitialiseIndex;
begin
-// FRecordArray:=nil;
+ // FRecordArray:=nil;
setlength(FRecordArray,FInitialBuffers);
FCurrentRecInd:=-1;
FLastRecInd:=-1;
@@ -3346,7 +3373,7 @@ end;
procedure TArrayBufIndex.InitialiseSpareRecord(const ASpareRecord: TRecordBuffer);
begin
FLastRecInd := 0;
- // FCurrentRecInd := 0;
+ // FCurrentRecInd := 0;
FRecordArray[0] := ASpareRecord;
end;
@@ -3360,14 +3387,6 @@ begin
Result := GetRecordFromBookmark(ABookmark^)+1;
end;
-procedure TArrayBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBookmark);
-var ARecordInd : integer;
-begin
- ARecordInd:=GetRecordFromBookmark(ABookmark);
- Move(FRecordArray[ARecordInd+1],FRecordArray[ARecordInd],sizeof(Pointer)*(FLastRecInd-ARecordInd));
- dec(FLastRecInd);
-end;
-
procedure TArrayBufIndex.InsertRecordBeforeCurrentRecord(const ARecord: TRecordBuffer);
begin
inc(FLastRecInd);
@@ -3379,9 +3398,17 @@ begin
inc(FCurrentRecInd);
end;
+procedure TArrayBufIndex.RemoveRecordFromIndex(const ABookmark : TBufBookmark);
+var ARecordInd : integer;
+begin
+ ARecordInd:=GetRecordFromBookmark(ABookmark);
+ Move(FRecordArray[ARecordInd+1],FRecordArray[ARecordInd],sizeof(Pointer)*(FLastRecInd-ARecordInd));
+ dec(FLastRecInd);
+end;
+
procedure TArrayBufIndex.BeginUpdate;
begin
-// inherited BeginUpdate;
+ // inherited BeginUpdate;
end;
procedure TArrayBufIndex.AddRecord;
@@ -3396,7 +3423,7 @@ end;
procedure TArrayBufIndex.EndUpdate;
begin
-// inherited EndUpdate;
+ // inherited EndUpdate;
end;
{ TDataPacketReader }
@@ -3491,7 +3518,7 @@ end;
procedure TFpcBinaryDatapacketReader.FinalizeStoreRecords;
begin
-// Do nothing
+ // Do nothing
end;
function TFpcBinaryDatapacketReader.GetCurrentRecord: boolean;
@@ -3502,12 +3529,12 @@ end;
procedure TFpcBinaryDatapacketReader.GotoNextRecord;
begin
-// Do Nothing
+ // Do Nothing
end;
procedure TFpcBinaryDatapacketReader.InitLoadRecords;
begin
-// SetLength(AChangeLog,0);
+ // SetLength(AChangeLog,0);
end;
procedure TFpcBinaryDatapacketReader.RestoreRecord(ADataset: TCustomBufDataset);
@@ -3550,7 +3577,7 @@ begin
// This code could be moved to the TBufIndex but that would make things
// more complicated and probably slower. So use a 'fake' bookmark of
// size TBufBookmark.
- // When there are other TBufIndexes which also need special bookmark-code
+ // When there are other TBufIndexes which also need special bookmark code
// this can be adapted.
Result:=sizeof(TBufBookmark);
end;
@@ -3562,7 +3589,7 @@ end;
function TUniDirectionalBufIndex.GetCurrentRecord: TRecordBuffer;
begin
-// Result:=inherited GetCurrentRecord;
+ // Result:=inherited GetCurrentRecord;
end;
function TUniDirectionalBufIndex.GetIsInitialized: boolean;
@@ -3628,7 +3655,7 @@ end;
function TUniDirectionalBufIndex.CanScrollForward: Boolean;
begin
- // should return true if a next record is already fetched
+ // should return true if next record is already fetched
result := false;
end;
@@ -3667,11 +3694,6 @@ begin
FSPareBuffer:=nil;
end;
-procedure TUniDirectionalBufIndex.RemoveRecordFromIndex(const ABookmark: TBufBookmark);
-begin
- DatabaseError(SUniDirectional);
-end;
-
function TUniDirectionalBufIndex.GetRecNo(const ABookmark: PBufBookmark): integer;
begin
result := -1;
@@ -3692,6 +3714,16 @@ begin
// Do nothing
end;
+procedure TUniDirectionalBufIndex.RemoveRecordFromIndex(const ABookmark: TBufBookmark);
+begin
+ DatabaseError(SUniDirectional);
+end;
+
+procedure TUniDirectionalBufIndex.OrderCurrentRecord;
+begin
+ // Do nothing
+end;
+
procedure TUniDirectionalBufIndex.EndUpdate;
begin
// Do nothing
diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc
index 355298085f..b8da7d6f5b 100644
--- a/packages/fcl-db/src/base/dataset.inc
+++ b/packages/fcl-db/src/base/dataset.inc
@@ -2305,7 +2305,7 @@ begin
FieldByName(Fieldname).Value := Value;
end;
-Function TDataset.Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean;
+Function TDataset.Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean;
begin
CheckBiDirectional;
diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas
index 882b6f6f9d..b62b3f8346 100644
--- a/packages/fcl-db/src/base/db.pas
+++ b/packages/fcl-db/src/base/db.pas
@@ -1605,7 +1605,7 @@ type
function IsLinkedTo(ADataSource: TDataSource): Boolean;
function IsSequenced: Boolean; virtual;
procedure Last;
- function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; virtual;
+ function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions) : boolean; virtual;
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; virtual;
function MoveBy(Distance: Longint): Longint;
procedure Next;
diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas
index 549a88d839..bdb23d945b 100644
--- a/packages/fcl-db/tests/testdbbasics.pas
+++ b/packages/fcl-db/tests/testdbbasics.pas
@@ -2111,6 +2111,7 @@ procedure TTestBufDatasetDBBasics.TestIndexAppendRecord;
var i: integer;
LastValue: string;
begin
+ // start with empty dataset
with DBConnector.GetNDataset(true,0) as TCustomBufDataset do
begin
MaxIndexesCount:=4;
@@ -2125,19 +2126,20 @@ begin
// append data at end
for i:=20 downto 0 do
AppendRecord([i, inttostr(i)]);
- First;
// insert data at begining
+ IndexName:='';
+ First;
for i:=21 to 22 do
InsertRecord([i, inttostr(i)]);
- // ATM new records are not ordered as they are added ?
+ // swith to index and check if records are ordered
+ IndexName := 'testindex';
LastValue := '';
First;
for i:=22 downto 0 do
begin
CheckEquals(23-i, RecNo, 'testindex.RecNo:');
- CheckEquals(inttostr(i), Fields[1].AsString, 'testindex.Fields[1].Value:');
- //CheckTrue(AnsiCompareStr(LastValue,Fields[1].AsString) < 0, 'testindex.LastValue>CurrValue');
+ CheckTrue(AnsiCompareStr(LastValue,Fields[1].AsString) < 0, 'testindex.LastValue>=CurrValue');
LastValue := Fields[1].AsString;
Next;
end;
diff --git a/packages/fcl-json/src/fpjsonrtti.pp b/packages/fcl-json/src/fpjsonrtti.pp
index 239183b16d..0c7554a3f9 100644
--- a/packages/fcl-json/src/fpjsonrtti.pp
+++ b/packages/fcl-json/src/fpjsonrtti.pp
@@ -107,6 +107,7 @@ Type
FOnGetObject: TJSONGetObjectEvent;
FOnPropError: TJSONpropertyErrorEvent;
FOnRestoreProp: TJSONRestorePropertyEvent;
+ FCaseInsensitive : Boolean;
procedure DeStreamClassProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
protected
function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
@@ -139,6 +140,8 @@ Type
// Called when a object-typed property must be restored, and the property is Nil. Must return an instance for the property.
// Published Properties of the instance will be further restored with available data.
Property OngetObject : TJSONGetObjectEvent Read FOnGetObject Write FOnGetObject;
+ // JSON is by definition case sensitive. Should properties be looked up case-insentive ?
+ Property CaseInsensitive : Boolean Read FCaseInsensitive Write FCaseInsensitive;
end;
EJSONRTTI = Class(Exception);
@@ -447,7 +450,7 @@ begin
try
For I:=0 to PIL.Count-1 do
begin
- J:=JSON.IndexOfName(Pil.Items[i]^.Name);
+ J:=JSON.IndexOfName(Pil.Items[i]^.Name,FCaseInsensitive);
If (J<>-1) then
RestoreProperty(AObject,PIL.Items[i],JSON.Items[J]);
end;
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 6c756b85dc..36fb427f38 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -757,6 +757,8 @@ Var
begin
Result := TPasAliasType(CreateElement(TPasAliasType, TypeName, Parent));
try
+ If (Result.Name='') then
+ Result.Name:='string';
NextToken;
if CurToken=tkSquaredBraceOpen then
begin
diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp
index bdf698df8c..c27280f70d 100644
--- a/packages/fcl-web/src/base/fphttpclient.pp
+++ b/packages/fcl-web/src/base/fphttpclient.pp
@@ -17,7 +17,7 @@ unit fphttpclient;
{ ---------------------------------------------------------------------
Todo:
* Proxy support ?
- * Easy calls for POST/DELETE/etc.
+ * Https support.
---------------------------------------------------------------------}
{$mode objfpc}{$H+}
@@ -59,7 +59,7 @@ Type
// Check if response code is in AllowedResponseCodes. if not, an exception is raised.
function CheckResponseCode(ACode: Integer; const AllowedResponseCodes: array of Integer): Boolean; virtual;
// Read response from server, and write any document to Stream.
- procedure ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer); virtual;
+ procedure ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean = False); virtual;
// Read server response line and headers. Returns status code.
Function ReadResponseHeaders : integer; virtual;
// Allow header in request ? (currently checks only if non-empty and contains : token)
@@ -106,6 +106,41 @@ Type
Class procedure SimplePost(const URL: string; Response : TStrings);
Class procedure SimplePost(const URL: string; const LocalFileName: String);
Class function SimplePost(const URL: string) : String;
+ // Simple Put
+ // Put URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ procedure Put(const URL: string; const Response: TStream);
+ procedure Put(const URL: string; Response : TStrings);
+ procedure Put(const URL: string; const LocalFileName: String);
+ function Put(const URL: string) : String;
+ // Simple class methods.
+ Class procedure SimplePut(const URL: string; const Response: TStream);
+ Class procedure SimplePut(const URL: string; Response : TStrings);
+ Class procedure SimplePut(const URL: string; const LocalFileName: String);
+ Class function SimplePut(const URL: string) : String;
+ // Simple Delete
+ // Delete URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ procedure Delete(const URL: string; const Response: TStream);
+ procedure Delete(const URL: string; Response : TStrings);
+ procedure Delete(const URL: string; const LocalFileName: String);
+ function Delete(const URL: string) : String;
+ // Simple class methods.
+ Class procedure SimpleDelete(const URL: string; const Response: TStream);
+ Class procedure SimpleDelete(const URL: string; Response : TStrings);
+ Class procedure SimpleDelete(const URL: string; const LocalFileName: String);
+ Class function SimpleDelete(const URL: string) : String;
+ // Simple Options
+ // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
+ procedure Options(const URL: string; const Response: TStream);
+ procedure Options(const URL: string; Response : TStrings);
+ procedure Options(const URL: string; const LocalFileName: String);
+ function Options(const URL: string) : String;
+ // Simple class methods.
+ Class procedure SimpleOptions(const URL: string; const Response: TStream);
+ Class procedure SimpleOptions(const URL: string; Response : TStrings);
+ Class procedure SimpleOptions(const URL: string; const LocalFileName: String);
+ Class function SimpleOptions(const URL: string) : String;
+ // Get HEAD
+ Class Procedure Head(AURL : String; Headers: TStrings);
// Post Form data (www-urlencoded).
// Formdata in string (urlencoded) or TStrings (plain text) format.
// Form data will be inserted in the requestbody.
@@ -298,7 +333,7 @@ begin
I:=Pos(':',Result);
if (I=0) then
I:=Length(Result);
- Delete(Result,1,I);
+ System.Delete(Result,1,I);
end;
Function TFPCustomHTTPClient.GetServerURL(URI : TURI) : String;
@@ -353,8 +388,8 @@ begin
If (URI.Port<>0) then
S:=S+':'+IntToStr(URI.Port);
S:=S+CRLF;
- If Assigned(RequestBody) and (IndexOfHeader('Content-length')=-1) then
- AddHeader('Content-length',IntToStr(RequestBody.Size));
+ If Assigned(RequestBody) and (IndexOfHeader('Content-Length')=-1) then
+ AddHeader('Content-Length',IntToStr(RequestBody.Size));
For I:=0 to FRequestHeaders.Count-1 do
begin
l:=FRequestHeaders[i];
@@ -414,7 +449,7 @@ begin
Result:=Result+#13
else
begin
- Delete(FBuffer,1,1);
+ System.Delete(FBuffer,1,1);
Done:=True;
end;
end;
@@ -434,7 +469,7 @@ begin
else
begin
Result:=Result+Copy(FBuffer,1,P-1);
- Delete(FBuffer,1,P+1);
+ System.Delete(FBuffer,1,P+1);
Done:=True;
end;
end;
@@ -469,7 +504,7 @@ begin
S:=Uppercase(GetNextWord(AStatusLine));
If (Copy(S,1,5)<>'HTTP/') then
Raise EHTTPClient.CreateFmt(SErrInvalidProtocolVersion,[S]);
- Delete(S,1,5);
+ System.Delete(S,1,5);
FServerHTTPVersion:=S;
S:=GetNextWord(AStatusLine);
Result:=StrToIntDef(S,-1);
@@ -490,14 +525,14 @@ Function TFPCustomHTTPClient.ReadResponseHeaders : Integer;
If Assigned(FCookies) then
FCookies.Clear;
P:=Pos(':',S);
- Delete(S,1,P);
+ System.Delete(S,1,P);
Repeat
P:=Pos(';',S);
If (P=0) then
P:=Length(S)+1;
C:=Trim(Copy(S,1,P-1));
Cookies.Add(C);
- Delete(S,1,P);
+ System.Delete(S,1,P);
Until (S='');
end;
@@ -555,7 +590,7 @@ begin
S:=Trim(LowerCase(FResponseHeaders[i]));
If (Copy(S,1,Length(Cl))=Cl) then
begin
- Delete(S,1,Length(CL));
+ System.Delete(S,1,Length(CL));
Result:=StrToIntDef(Trim(S),-1);
end;
Inc(I);
@@ -578,7 +613,7 @@ begin
S:=Trim(LowerCase(FResponseHeaders[i]));
If (Copy(S,1,Length(Cl))=Cl) then
begin
- Delete(S,1,Length(CL));
+ System.Delete(S,1,Length(CL));
Result:=Trim(S);
exit;
end;
@@ -599,7 +634,7 @@ begin
GetCookies.Assign(AValue);
end;
-procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer);
+procedure TFPCustomHTTPClient.ReadResponse(Stream: TStream; Const AllowedResponseCodes : Array of Integer; HeadersOnly: Boolean = False);
Function Transfer(LB : Integer) : Integer;
@@ -719,6 +754,8 @@ begin
FResponseStatusCode:=ReadResponseHeaders;
if not CheckResponseCode(FResponseStatusCode,AllowedResponseCodes) then
Raise EHTTPClient.CreateFmt(SErrUnexpectedResponse,[ResponseStatusCode]);
+ if HeadersOnly then
+ exit;
if CompareText(CheckTransferEncoding,'chunked')=0 then
ReadChunkedResponse
else
@@ -765,7 +802,7 @@ begin
ConnectToServer(URI.Host,URI.Port);
try
SendRequest(AMethod,URI);
- ReadResponse(Stream,AllowedResponseCodes);
+ ReadResponse(Stream,AllowedResponseCodes,CompareText(AMethod,'HEAD')=0);
finally
DisconnectFromServer;
end;
@@ -837,6 +874,7 @@ Class Procedure TFPCustomHTTPClient.SimpleGet(Const AURL : String; Stream : TStr
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Get(AURL,Stream);
finally
Free;
@@ -849,6 +887,7 @@ Class Procedure TFPCustomHTTPClient.SimpleGet(Const AURL : String; const LocalFi
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Get(AURL,LocalFileName);
finally
Free;
@@ -861,6 +900,7 @@ Class Procedure TFPCustomHTTPClient.SimpleGet(Const AURL : String; Response : TS
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Get(AURL,Response);
finally
Free;
@@ -927,6 +967,7 @@ Class procedure TFPCustomHTTPClient.SimplePost(const URL: string; const Response
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Post(URL,Response);
finally
Free;
@@ -939,6 +980,7 @@ Class procedure TFPCustomHTTPClient.SimplePost(const URL: string; Response : TSt
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Post(URL,Response);
finally
Free;
@@ -951,6 +993,7 @@ Class procedure TFPCustomHTTPClient.SimplePost(const URL: string; const LocalFil
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Post(URL,LocalFileName);
finally
Free;
@@ -963,13 +1006,291 @@ Class function TFPCustomHTTPClient.SimplePost(const URL: string) : String;
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Result:=Post(URL);
finally
Free;
end;
end;
+procedure TFPCustomHTTPClient.Put(const URL: string; const Response: TStream);
+begin
+ DoMethod('PUT',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Put(URL);
+end;
+
+procedure TFPCustomHTTPClient.Put(const URL: string;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Put(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.Put(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Put(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Put(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Put(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimplePut(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Put(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+Class function TFPCustomHTTPClient.SimplePut(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Put(URL);
+ finally
+ Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string; const Response: TStream);
+begin
+ DoMethod('DELETE',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Delete(URL);
+end;
+
+procedure TFPCustomHTTPClient.Delete(const URL: string;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Delete(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.Delete(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Delete(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+Class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Delete(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Delete(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleDelete(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Delete(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+Class function TFPCustomHTTPClient.SimpleDelete(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Delete(URL);
+ finally
+ Free;
+ end;
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream);
+begin
+ DoMethod('OPTIONS',URL,Response,[]);
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string; Response: TStrings);
+begin
+ Response.Text:=Options(URL);
+end;
+
+procedure TFPCustomHTTPClient.Options(const URL: string;
+ const LocalFileName: String);
+
+Var
+ F : TFileStream;
+
+begin
+ F:=TFileStream.Create(LocalFileName,fmCreate);
+ try
+ Options(URL,F);
+ finally
+ F.Free;
+ end;
+end;
+
+function TFPCustomHTTPClient.Options(const URL: string): String;
+Var
+ SS : TStringStream;
+begin
+ SS:=TStringStream.Create('');
+ try
+ Options(URL,SS);
+ Result:=SS.Datastring;
+ finally
+ SS.Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+ const Response: TStream);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Options(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+ Response: TStrings);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Options(URL,Response);
+ finally
+ Free;
+ end;
+end;
+
+Class procedure TFPCustomHTTPClient.SimpleOptions(const URL: string;
+ const LocalFileName: String);
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Options(URL,LocalFileName);
+ finally
+ Free;
+ end;
+end;
+
+Class function TFPCustomHTTPClient.SimpleOptions(const URL: string): String;
+
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ Result:=Options(URL);
+ finally
+ Free;
+ end;
+end;
+
+class procedure TFPCustomHTTPClient.Head(AURL : String; Headers: TStrings);
+begin
+ With Self.Create(nil) do
+ try
+ RequestHeaders.Add('Connection: Close');
+ HTTPMethod('HEAD', AURL, Nil, [200]);
+ Headers.Assign(ResponseHeaders);
+ Finally
+ Free;
+ end;
+end;
procedure TFPCustomHTTPClient.FormPost(const URL, FormData: string;
const Response: TStream);
@@ -1043,12 +1364,12 @@ begin
end;
end;
-
Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string; const Response: TStream);
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
FormPost(URL,FormData,Response);
Finally
Free;
@@ -1061,6 +1382,7 @@ Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL : string; FormData:
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
FormPost(URL,FormData,Response);
Finally
Free;
@@ -1073,6 +1395,7 @@ Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string;
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
FormPost(URL,FormData,Response);
Finally
Free;
@@ -1084,6 +1407,7 @@ Class Procedure TFPCustomHTTPClient.SimpleFormPost(const URL : string; FormData:
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
FormPost(URL,FormData,Response);
Finally
Free;
@@ -1095,6 +1419,7 @@ Class function TFPCustomHTTPClient.SimpleFormPost(const URL, FormData: string):
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Result:=FormPost(URL,FormData);
Finally
Free;
@@ -1106,6 +1431,7 @@ Class function TFPCustomHTTPClient.SimpleFormPost(const URL: string; FormData :
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
Result:=FormPost(URL,FormData);
Finally
Free;
@@ -1121,10 +1447,10 @@ Var
F : TFileStream;
begin
Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]);
- AddHeader('Content-type','multipart/form-data; boundary='+Sep);
+ AddHeader('Content-Type','multipart/form-data; boundary='+Sep);
S:='--'+Sep+CRLF;
- s:=s+Format('content-disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,AFileName]);
- s:=s+'Content-Type: Application/octet-string'+CRLF+CRLF;
+ s:=s+Format('Content-Disposition: form-data; name="%s"; filename="%s"'+CRLF,[AFieldName,AFileName]);
+ s:=s+'Content-Type: application/octet-string'+CRLF+CRLF;
SS:=TStringStream.Create(s);
try
SS.Seek(0,soFromEnd);
@@ -1151,12 +1477,12 @@ Class Procedure TFPCustomHTTPClient.SimpleFileFormPost(const AURL, AFieldName, A
begin
With Self.Create(nil) do
try
+ RequestHeaders.Add('Connection: Close');
FileFormPost(AURL,AFieldName,AFileName,Response);
Finally
Free;
end;
end;
-
end.
diff --git a/packages/fcl-xml/src/xmlwrite.pp b/packages/fcl-xml/src/xmlwrite.pp
index 2fe536b224..5bbd713913 100644
--- a/packages/fcl-xml/src/xmlwrite.pp
+++ b/packages/fcl-xml/src/xmlwrite.pp
@@ -384,12 +384,17 @@ end;
procedure CDSectSpecialCharCallback(Sender: TXMLWriter; const s: DOMString;
var idx: Integer);
begin
- if (idx <= Length(s)-2) and (s[idx+1] = ']') and (s[idx+2] = '>') then
+ if s[idx]=']' then
begin
- Sender.wrtStr(']]]]><![CDATA[>');
- Inc(idx, 2);
- // TODO: emit warning 'cdata-section-splitted'
- end
+ if (idx <= Length(s)-2) and (s[idx+1] = ']') and (s[idx+2] = '>') then
+ begin
+ Sender.wrtStr(']]]]><![CDATA[>');
+ Inc(idx, 2);
+ // TODO: emit warning 'cdata-section-splitted'
+ end
+ else
+ Sender.wrtChr(']');
+ end
else
raise EConvertError.Create('Illegal character');
end;
diff --git a/packages/gdbint/src/gdbint.pp b/packages/gdbint/src/gdbint.pp
index 263fffcbe2..5e742dfb23 100644
--- a/packages/gdbint/src/gdbint.pp
+++ b/packages/gdbint/src/gdbint.pp
@@ -303,16 +303,18 @@ interface
{$linklib kvm}
{$endif}
{$undef NotImplemented}
- {$LINKLIB gdb}
+ {$LINKLIB libgdb.a}
{$ifdef GDB_HAS_SIM}
- {$LINKLIB sim}
+ {$LINKLIB libsim.a}
{$endif GDB_HAS_SIM}
- {$LINKLIB bfd}
- {$LINKLIB readline}
- {$LINKLIB opcodes}
- {$LINKLIB history}
- {$LINKLIB iberty}
+ {$LINKLIB libbfd.a}
+ {$LINKLIB libreadline.a}
+ {$LINKLIB libopcodes.a}
+ {$LINKLIB libhistory.a}
+ {$LINKLIB libiberty.a}
+ {$LINKLIB libgnu.a} // at least 7.4 generates this.
{$LINKLIB ncurses}
+ {$LINKLIB z} // linked implictely by something on Linux
{$LINKLIB m}
{$LINKLIB iberty}
{$ifndef GDB_DISABLE_INTL}
View Lorry Controller Status