Browse Source

* reallocmem fixes

peter 26 years ago
parent
commit
7bf3155e2f
2 changed files with 174 additions and 168 deletions
  1. 143 140
      fcl/db/dataset.inc
  2. 31 28
      fcl/db/db.pp

+ 143 - 140
fcl/db/dataset.inc

@@ -1,11 +1,11 @@
 {
 {
     $Id$
     $Id$
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
+    Copyright (c) 1999 by Michael Van Canneyt, member of the
     Free Pascal development team
     Free Pascal development team
 
 
     Dataset implementation
     Dataset implementation
-    
+
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -41,7 +41,7 @@ begin
 end;
 end;
 
 
 
 
-procedure TDataset.ActivateBuffers; 
+procedure TDataset.ActivateBuffers;
 
 
 begin
 begin
   FBOF:=False;
   FBOF:=False;
@@ -50,7 +50,7 @@ begin
   FActiveRecord:=0;
   FActiveRecord:=0;
 end;
 end;
 
 
-procedure TDataset.UpdateFieldDefs; 
+procedure TDataset.UpdateFieldDefs;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -65,7 +65,7 @@ begin
      Here some magic will be needed later; for now just simply set
      Here some magic will be needed later; for now just simply set
      Just set fieldno from listindex...
      Just set fieldno from listindex...
      Later we should take it from the fielddefs.
      Later we should take it from the fielddefs.
-  }   
+  }
   For I:=0 to FFieldList.Count-1 do
   For I:=0 to FFieldList.Count-1 do
     FFieldList[i].FFieldNo:=I;
     FFieldList[i].FFieldNo:=I;
 end;
 end;
@@ -75,31 +75,31 @@ function TDataset.BookmarkAvailable: Boolean;
 Const BookmarkStates = [dsBrowse,dsEdit,dsInsert];
 Const BookmarkStates = [dsBrowse,dsEdit,dsInsert];
 
 
 begin
 begin
-  Result:=(Not IsEmpty) and (State in BookmarkStates) 
+  Result:=(Not IsEmpty) and (State in BookmarkStates)
           and (getBookMarkFlag(ActiveBuffer)=bfCurrent);
           and (getBookMarkFlag(ActiveBuffer)=bfCurrent);
 end;
 end;
 
 
-procedure TDataset.CalculateFields(Buffer: PChar); 
+procedure TDataset.CalculateFields(Buffer: PChar);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.CheckActive; 
+procedure TDataset.CheckActive;
 
 
 begin
 begin
   If Not Active then
   If Not Active then
     DataBaseError(SInactiveDataset);
     DataBaseError(SInactiveDataset);
 end;
 end;
 
 
-procedure TDataset.CheckInactive; 
+procedure TDataset.CheckInactive;
 
 
 begin
 begin
   If Active then
   If Active then
     DataBaseError(SActiveDataset);
     DataBaseError(SActiveDataset);
 end;
 end;
 
 
-procedure TDataset.ClearBuffers; 
+procedure TDataset.ClearBuffers;
 
 
 begin
 begin
   FRecordCount:=0;
   FRecordCount:=0;
@@ -109,19 +109,19 @@ begin
   FEOF:=True;
   FEOF:=True;
 end;
 end;
 
 
-procedure TDataset.ClearCalcFields(Buffer: PChar); 
+procedure TDataset.ClearCalcFields(Buffer: PChar);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.CloseBlob(Field: TField); 
+procedure TDataset.CloseBlob(Field: TField);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.CloseCursor; 
+procedure TDataset.CloseCursor;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -141,127 +141,127 @@ begin
         CreateField(self);
         CreateField(self);
 end;
 end;
 
 
-procedure TDataset.DataEvent(Event: TDataEvent; Info: Longint); 
+procedure TDataset.DataEvent(Event: TDataEvent; Info: Longint);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.DestroyFields; 
+procedure TDataset.DestroyFields;
 
 
 begin
 begin
   FFieldList.Clear;
   FFieldList.Clear;
 end;
 end;
 
 
-procedure TDataset.DoAfterCancel; 
+procedure TDataset.DoAfterCancel;
 
 
 begin
 begin
- If assigned(FAfterCancel) then 
+ If assigned(FAfterCancel) then
    FAfterCancel(Self);
    FAfterCancel(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterClose; 
+procedure TDataset.DoAfterClose;
 
 
 begin
 begin
- If assigned(FAfterClose) then 
+ If assigned(FAfterClose) then
    FAfterClose(Self);
    FAfterClose(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterDelete; 
+procedure TDataset.DoAfterDelete;
 
 
 begin
 begin
- If assigned(FAfterDelete) then 
+ If assigned(FAfterDelete) then
    FAfterDelete(Self);
    FAfterDelete(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterEdit; 
+procedure TDataset.DoAfterEdit;
 
 
 begin
 begin
- If assigned(FAfterEdit) then 
+ If assigned(FAfterEdit) then
    FAfterEdit(Self);
    FAfterEdit(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterInsert; 
+procedure TDataset.DoAfterInsert;
 
 
 begin
 begin
- If assigned(FAfterInsert) then 
+ If assigned(FAfterInsert) then
    FAfterInsert(Self);
    FAfterInsert(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterOpen; 
+procedure TDataset.DoAfterOpen;
 
 
 begin
 begin
- If assigned(FAfterOpen) then 
+ If assigned(FAfterOpen) then
    FAfterOpen(Self);
    FAfterOpen(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterPost; 
+procedure TDataset.DoAfterPost;
 
 
 begin
 begin
- If assigned(FAfterPost) then 
+ If assigned(FAfterPost) then
    FAfterPost(Self);
    FAfterPost(Self);
 end;
 end;
 
 
-procedure TDataset.DoAfterScroll; 
+procedure TDataset.DoAfterScroll;
 
 
 begin
 begin
- If assigned(FAfterScroll) then 
+ If assigned(FAfterScroll) then
    FAfterScroll(Self);
    FAfterScroll(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeCancel; 
+procedure TDataset.DoBeforeCancel;
 
 
 begin
 begin
- If assigned(FBeforeCancel) then 
+ If assigned(FBeforeCancel) then
    FBeforeCancel(Self);
    FBeforeCancel(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeClose; 
+procedure TDataset.DoBeforeClose;
 
 
 begin
 begin
- If assigned(FBeforeClose) then 
+ If assigned(FBeforeClose) then
    FBeforeClose(Self);
    FBeforeClose(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeDelete; 
+procedure TDataset.DoBeforeDelete;
 
 
 begin
 begin
- If assigned(FBeforeDelete) then 
+ If assigned(FBeforeDelete) then
    FBeforeDelete(Self);
    FBeforeDelete(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeEdit; 
+procedure TDataset.DoBeforeEdit;
 
 
 begin
 begin
- If assigned(FBeforeEdit) then 
+ If assigned(FBeforeEdit) then
    FBeforeEdit(Self);
    FBeforeEdit(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeInsert; 
+procedure TDataset.DoBeforeInsert;
 
 
 begin
 begin
- If assigned(FBeforeInsert) then 
+ If assigned(FBeforeInsert) then
    FBeforeInsert(Self);
    FBeforeInsert(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeOpen; 
+procedure TDataset.DoBeforeOpen;
 
 
 begin
 begin
- If assigned(FBeforeOpen) then 
+ If assigned(FBeforeOpen) then
    FBeforeOpen(Self);
    FBeforeOpen(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforePost; 
+procedure TDataset.DoBeforePost;
 
 
 begin
 begin
- If assigned(FBeforePost) then 
+ If assigned(FBeforePost) then
    FBeforePost(Self);
    FBeforePost(Self);
 end;
 end;
 
 
-procedure TDataset.DoBeforeScroll; 
+procedure TDataset.DoBeforeScroll;
 
 
 begin
 begin
- If assigned(FBeforeScroll) then 
+ If assigned(FBeforeScroll) then
    FBeforeScroll(Self);
    FBeforeScroll(Self);
 end;
 end;
 
 
@@ -279,8 +279,8 @@ begin
     GetNextRecords;
     GetNextRecords;
     DoAfterOpen;
     DoAfterOpen;
     DoAfterScroll;
     DoAfterScroll;
-  except 
-    SetState(dsInactive);   
+  except
+    SetState(dsInactive);
     DoInternalClose;
     DoInternalClose;
     raise;
     raise;
   end;
   end;
@@ -290,7 +290,7 @@ Function TDataset.RequiredBuffers : longint;
 {
 {
   If later some datasource requires more buffers (grids etc)
   If later some datasource requires more buffers (grids etc)
   then it should be taken into account here...
   then it should be taken into account here...
-} 
+}
 
 
 begin
 begin
   Result:=0;
   Result:=0;
@@ -305,17 +305,17 @@ begin
   InternalClose;
   InternalClose;
 end;
 end;
 
 
-procedure TDataset.DoOnCalcFields; 
+procedure TDataset.DoOnCalcFields;
 
 
 begin
 begin
- If assigned(FOnCalcfields) then 
+ If assigned(FOnCalcfields) then
    FOnCalcFields(Self);
    FOnCalcFields(Self);
 end;
 end;
 
 
-procedure TDataset.DoOnNewRecord; 
+procedure TDataset.DoOnNewRecord;
 
 
 begin
 begin
- If assigned(FOnNewRecord) then 
+ If assigned(FOnNewRecord) then
    FOnNewRecord(Self);
    FOnNewRecord(Self);
 end;
 end;
 
 
@@ -325,13 +325,13 @@ begin
   Result:=FFieldList.FieldByNumber(FieldNo);
   Result:=FFieldList.FieldByNumber(FieldNo);
 end;
 end;
 
 
-function TDataset.FindRecord(Restart, GoForward: Boolean): Boolean; 
+function TDataset.FindRecord(Restart, GoForward: Boolean): Boolean;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.FreeFieldBuffers; 
+procedure TDataset.FreeFieldBuffers;
 
 
 Var I : longint;
 Var I : longint;
 
 
@@ -340,7 +340,7 @@ begin
     FFieldList[i].FreeBuffers;
     FFieldList[i].FreeBuffers;
 end;
 end;
 
 
-function TDataset.GetBookmarkStr: TBookmarkStr; 
+function TDataset.GetBookmarkStr: TBookmarkStr;
 
 
 begin
 begin
   Result:='';
   Result:='';
@@ -351,25 +351,25 @@ begin
     end
     end
 end;
 end;
 
 
-Function TDataset.GetBuffer (Index : longint) : Pchar;  
+Function TDataset.GetBuffer (Index : longint) : Pchar;
 
 
 begin
 begin
   Result:=FBuffers[Index];
   Result:=FBuffers[Index];
 end;
 end;
 
 
-procedure TDataset.GetCalcFields(Buffer: PChar); 
+procedure TDataset.GetCalcFields(Buffer: PChar);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-function TDataset.GetCanModify: Boolean; 
+function TDataset.GetCanModify: Boolean;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent); 
+procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -384,7 +384,7 @@ end;
 {
 {
   This is not yet allowed, FPC doesn't allow typed consts of Classes...
   This is not yet allowed, FPC doesn't allow typed consts of Classes...
 
 
-Const 
+Const
   DefFieldClasses : Array [TFieldType] of TFieldClass =
   DefFieldClasses : Array [TFieldType] of TFieldClass =
     ( { ftUnknown} Tfield,
     ( { ftUnknown} Tfield,
       { ftString} TStringField,
       { ftString} TStringField,
@@ -410,10 +410,10 @@ Const
     );
     );
 }
 }
 
 
-function TDataset.GetFieldClass(FieldType: TFieldType): TFieldClass; 
+function TDataset.GetFieldClass(FieldType: TFieldType): TFieldClass;
 
 
 begin
 begin
-  Case FieldType of 
+  Case FieldType of
      ftUnknown : Result:=Tfield;
      ftUnknown : Result:=Tfield;
      ftString: Result := TStringField;
      ftString: Result := TStringField;
      ftSmallint: Result := TLongIntField;
      ftSmallint: Result := TLongIntField;
@@ -438,20 +438,20 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TDataset.GetIsIndexField(Field: TField): Boolean; 
+function TDataset.GetIsIndexField(Field: TField): Boolean;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-function TDataset.GetNextRecord: Boolean; 
+function TDataset.GetNextRecord: Boolean;
 
 
 Var Shifted : Boolean;
 Var Shifted : Boolean;
 
 
 begin
 begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
   Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
-{$endif}  
+{$endif}
   Shifted:=FRecordCount=FBufferCount;
   Shifted:=FRecordCount=FBufferCount;
   If Shifted then
   If Shifted then
     begin
     begin
@@ -460,16 +460,16 @@ begin
     end;
     end;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Getting data into buffer : ',FRecordCount);
   Writeln ('Getting data into buffer : ',FRecordCount);
-{$endif}  
+{$endif}
   Result:=GetRecord(FBuffers[FRecordCount],gmNext,True)=grOK;
   Result:=GetRecord(FBuffers[FRecordCount],gmNext,True)=grOK;
   If Result then
   If Result then
     begin
     begin
-    If FRecordCount=0 then 
+    If FRecordCount=0 then
       ActivateBuffers
       ActivateBuffers
     else
     else
       If FRecordCount<FBufferCount then
       If FRecordCount<FBufferCount then
         Inc(FRecordCount);
         Inc(FRecordCount);
-    FCurrentRecord:=FRecordCount;  
+    FCurrentRecord:=FRecordCount;
     end
     end
   else
   else
     begin
     begin
@@ -481,34 +481,34 @@ begin
     CursorPosChanged;
     CursorPosChanged;
     end;
     end;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
-  Writeln ('Result getting next record : ',Result);  
-{$endif}  
+  Writeln ('Result getting next record : ',Result);
+{$endif}
 end;
 end;
 
 
-function TDataset.GetNextRecords: Longint; 
+function TDataset.GetNextRecords: Longint;
 
 
 begin
 begin
   Result:=0;
   Result:=0;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Getting next record(s), need :',FBufferCount);
   Writeln ('Getting next record(s), need :',FBufferCount);
-{$endif}  
+{$endif}
   While (FRecordCount<FBufferCount) and GetNextRecord do
   While (FRecordCount<FBufferCount) and GetNextRecord do
     Inc(Result);
     Inc(Result);
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Result Getting next record(s), GOT :',RESULT);
   Writeln ('Result Getting next record(s), GOT :',RESULT);
-{$endif}  
+{$endif}
 end;
 end;
 
 
-function TDataset.GetPriorRecord: Boolean; 
+function TDataset.GetPriorRecord: Boolean;
 
 
 Var Shifted : boolean;
 Var Shifted : boolean;
 
 
 begin
 begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Getting previous record');
   Writeln ('Getting previous record');
-{$endif}  
+{$endif}
   Shifted:=FRecordCount>0;
   Shifted:=FRecordCount>0;
-  If Shifted Then 
+  If Shifted Then
     begin
     begin
     SetCurrentRecord(0);
     SetCurrentRecord(0);
     ShiftBuffers(-1);
     ShiftBuffers(-1);
@@ -516,18 +516,18 @@ begin
   Result:=GetRecord(FBuffers[0],gmPrior,True)=grOK;
   Result:=GetRecord(FBuffers[0],gmPrior,True)=grOK;
   If Result then
   If Result then
     begin
     begin
-    If FRecordCount=0 then 
+    If FRecordCount=0 then
       ActivateBuffers
       ActivateBuffers
     else
     else
       begin
       begin
       If FrecordCount<FBufferCount then
       If FrecordCount<FBufferCount then
         Inc(FRecordCount);
         Inc(FRecordCount);
       end;
       end;
-    FCurrentRecord:=0;    
+    FCurrentRecord:=0;
     end
     end
   else
   else
     begin
     begin
-    If Shifted then 
+    If Shifted then
       begin
       begin
       ShiftBuffers(1);
       ShiftBuffers(1);
       end;
       end;
@@ -535,73 +535,73 @@ begin
     end;
     end;
 end;
 end;
 
 
-function TDataset.GetPriorRecords: Longint; 
+function TDataset.GetPriorRecords: Longint;
 
 
 begin
 begin
   Result:=0;
   Result:=0;
 {$ifdef dsdebug}
 {$ifdef dsdebug}
   Writeln ('Getting previous record(s), need :',FBufferCount);
   Writeln ('Getting previous record(s), need :',FBufferCount);
-{$endif}  
+{$endif}
   While (FRecordCount<FbufferCount) and GetPriorRecord do
   While (FRecordCount<FbufferCount) and GetPriorRecord do
     Inc(Result);
     Inc(Result);
 end;
 end;
 
 
-function TDataset.GetRecNo: Longint; 
+function TDataset.GetRecNo: Longint;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-function TDataset.GetRecordCount: Longint; 
+function TDataset.GetRecordCount: Longint;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.InitFieldDefs; 
+procedure TDataset.InitFieldDefs;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.InitRecord(Buffer: PChar); 
+procedure TDataset.InitRecord(Buffer: PChar);
 
 
 begin
 begin
   InternalInitRecord(Buffer);
   InternalInitRecord(Buffer);
   ClearCalcFields(Buffer);
   ClearCalcFields(Buffer);
 end;
 end;
 
 
-procedure TDataset.InternalCancel; 
+procedure TDataset.InternalCancel;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.InternalEdit; 
+procedure TDataset.InternalEdit;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.InternalRefresh; 
+procedure TDataset.InternalRefresh;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.Loaded; 
+procedure TDataset.Loaded;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.OpenCursor(InfoQuery: Boolean); 
+procedure TDataset.OpenCursor(InfoQuery: Boolean);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.RefreshInternalCalcFields(Buffer: PChar); 
+procedure TDataset.RefreshInternalCalcFields(Buffer: PChar);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -624,7 +624,7 @@ begin
   FActive:=Value;
   FActive:=Value;
 end;
 end;
 
 
-procedure TDataset.SetBookmarkStr(const Value: TBookmarkStr); 
+procedure TDataset.SetBookmarkStr(const Value: TBookmarkStr);
 
 
 begin
 begin
   GotoBookMark(Pointer(Value))
   GotoBookMark(Pointer(Value))
@@ -641,7 +641,7 @@ begin
     Value:=I;
     Value:=I;
   If Value>FBufferCount then
   If Value>FBufferCount then
     begin
     begin
-    ReAllocMem(FBuffers,(FBufferCount+1)*SizeOf(PChar),(Value+1)*SizeOf(PChar));
+    ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
     FillChar(FBuffers[FBufferCount+1],(Value-FBufferCount)*SizeOF(Pchar),#0);
     FillChar(FBuffers[FBufferCount+1],(Value-FBufferCount)*SizeOF(Pchar),#0);
     Try
     Try
       For I:=FBufferCount to Value do
       For I:=FBufferCount to Value do
@@ -653,25 +653,25 @@ begin
         FreeRecordBuffer(FBuffers[i]);
         FreeRecordBuffer(FBuffers[i]);
         Inc(i);
         Inc(i);
         end;
         end;
-      raise;          
-    end;   
+      raise;
+    end;
     end
     end
   else
   else
     begin
     begin
     For I:=Value+1 to FBufferCount do
     For I:=Value+1 to FBufferCount do
       FreeRecordBuffer(FBuffers[i]);
       FreeRecordBuffer(FBuffers[i]);
-    ReAllocMem(FBuffers,FBufferCount*SizeOf(Pchar),Value*SizeOf(Pchar));  
+    ReAllocMem(FBuffers,Value*SizeOf(Pchar));
     end;
     end;
-  FBufferCount:=Value;   
+  FBufferCount:=Value;
 end;
 end;
 
 
-procedure TDataset.SetChildOrder(Component: TComponent; Order: Longint); 
+procedure TDataset.SetChildOrder(Component: TComponent; Order: Longint);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetCurrentRecord(Index: Longint); 
+procedure TDataset.SetCurrentRecord(Index: Longint);
 
 
 begin
 begin
   If FCurrentRecord<>Index then
   If FCurrentRecord<>Index then
@@ -681,7 +681,7 @@ begin
       bfCurrent : InternalSetToRecord(FBuffers[Index]);
       bfCurrent : InternalSetToRecord(FBuffers[Index]);
       bfBOF : InternalFirst;
       bfBOF : InternalFirst;
       bfEOF : InternalLast;
       bfEOF : InternalLast;
-      end; 
+      end;
     FCurrentRecord:=index;
     FCurrentRecord:=index;
     end;
     end;
 end;
 end;
@@ -692,19 +692,19 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetFilterOptions(Value: TFilterOptions); 
+procedure TDataset.SetFilterOptions(Value: TFilterOptions);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetFilterText(const Value: string); 
+procedure TDataset.SetFilterText(const Value: string);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetFiltered(Value: Boolean); 
+procedure TDataset.SetFiltered(Value: Boolean);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -722,19 +722,19 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetName(const Value: TComponentName); 
+procedure TDataset.SetName(const Value: TComponentName);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetOnFilterRecord(const Value: TFilterRecordEvent); 
+procedure TDataset.SetOnFilterRecord(const Value: TFilterRecordEvent);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.SetRecNo(Value: Longint); 
+procedure TDataset.SetRecNo(Value: Longint);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -761,7 +761,7 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.UpdateIndexDefs; 
+procedure TDataset.UpdateIndexDefs;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -782,7 +782,7 @@ function TDataset.ActiveBuffer: PChar;
 begin
 begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
 //  Writeln ('Active buffer requested. Returning:',ActiveRecord);
 //  Writeln ('Active buffer requested. Returning:',ActiveRecord);
-{$endif}  
+{$endif}
   Result:=FBuffers[ActiveRecord];
   Result:=FBuffers[ActiveRecord];
 end;
 end;
 
 
@@ -800,7 +800,7 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-function TDataset.BookmarkValid(ABookmark: TBookmark): Boolean; 
+function TDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
 {
 {
   Should be overridden by descendant objects.
   Should be overridden by descendant objects.
 }
 }
@@ -808,7 +808,7 @@ begin
   Result:=False
   Result:=False
 end;
 end;
 
 
-procedure TDataset.Cancel; 
+procedure TDataset.Cancel;
 
 
 
 
 begin
 begin
@@ -843,14 +843,14 @@ begin
   Active:=False;
   Active:=False;
 end;
 end;
 
 
-function TDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; 
+function TDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
 
 
 
 
 begin
 begin
   Result:=0;
   Result:=0;
 end;
 end;
 
 
-function TDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; 
+function TDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
 
 
 
 
 begin
 begin
@@ -952,18 +952,18 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TDataset.FreeBookmark(ABookmark: TBookmark); 
+procedure TDataset.FreeBookmark(ABookmark: TBookmark);
 
 
 
 
 begin
 begin
   FreeMem(ABookMark,FBookMarkSize);
   FreeMem(ABookMark,FBookMarkSize);
 end;
 end;
 
 
-function TDataset.GetBookmark: TBookmark; 
+function TDataset.GetBookmark: TBookmark;
 
 
 
 
 begin
 begin
-  if BookmarkAvailable then 
+  if BookmarkAvailable then
     begin
     begin
     GetMem (Result,FBookMarkSize);
     GetMem (Result,FBookMarkSize);
     GetBookMarkdata(ActiveBuffer,Result);
     GetBookMarkdata(ActiveBuffer,Result);
@@ -972,7 +972,7 @@ begin
     Result:=Nil;
     Result:=Nil;
 end;
 end;
 
 
-function TDataset.GetCurrentRecord(Buffer: PChar): Boolean; 
+function TDataset.GetCurrentRecord(Buffer: PChar): Boolean;
 
 
 
 
 begin
 begin
@@ -983,7 +983,7 @@ procedure TDataset.GetFieldList(List: TList; const FieldNames: string);
 
 
 
 
 begin
 begin
-  
+
 end;
 end;
 
 
 procedure TDataset.GetFieldNames(List: TStrings);
 procedure TDataset.GetFieldNames(List: TStrings);
@@ -1027,7 +1027,7 @@ begin
   Result:=(Bof and Eof);
   Result:=(Bof and Eof);
 end;
 end;
 
 
-function TDataset.IsSequenced: Boolean; 
+function TDataset.IsSequenced: Boolean;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -1052,13 +1052,13 @@ end;
 function TDataset.MoveBy(Distance: Longint): Longint;
 function TDataset.MoveBy(Distance: Longint): Longint;
 
 
   Procedure Scrollforward;
   Procedure Scrollforward;
-  
+
   begin
   begin
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln('Scrolling forward :',Distance);
     Writeln('Scrolling forward :',Distance);
     Writeln('Active buffer : ',FActiveRecord);
     Writeln('Active buffer : ',FActiveRecord);
     Writeln('RecordCunt    : ',FRecordCount);
     Writeln('RecordCunt    : ',FRecordCount);
-{$endif}    
+{$endif}
     While (Distance>0) and not FEOF do
     While (Distance>0) and not FEOF do
       begin
       begin
       If FActiveRecord<FRecordCount-1 then
       If FActiveRecord<FRecordCount-1 then
@@ -1070,7 +1070,7 @@ function TDataset.MoveBy(Distance: Longint): Longint;
         begin
         begin
        {$ifdef dsdebug}
        {$ifdef dsdebug}
            Writeln('Moveby : need next record');
            Writeln('Moveby : need next record');
-       {$endif}    
+       {$endif}
         If GetNextRecord then
         If GetNextRecord then
           Dec(Distance)
           Dec(Distance)
         else
         else
@@ -1080,14 +1080,14 @@ function TDataset.MoveBy(Distance: Longint): Longint;
   end;
   end;
 
 
   Procedure ScrollBackward;
   Procedure ScrollBackward;
-  
+
   begin
   begin
 
 
 {$ifdef dsdebug}
 {$ifdef dsdebug}
     Writeln('Scrolling backward:',Abs(Distance));
     Writeln('Scrolling backward:',Abs(Distance));
     Writeln('Active buffer : ',FActiveRecord);
     Writeln('Active buffer : ',FActiveRecord);
     Writeln('RecordCunt    : ',FRecordCount);
     Writeln('RecordCunt    : ',FRecordCount);
-{$endif}    
+{$endif}
     While (Distance<0) and not FBOF do
     While (Distance<0) and not FBOF do
       begin
       begin
       If FActiveRecord>0 then
       If FActiveRecord>0 then
@@ -1099,7 +1099,7 @@ function TDataset.MoveBy(Distance: Longint): Longint;
         begin
         begin
        {$ifdef dsdebug}
        {$ifdef dsdebug}
            Writeln('Moveby : need next record');
            Writeln('Moveby : need next record');
-       {$endif}    
+       {$endif}
         If GetPriorRecord then
         If GetPriorRecord then
           Inc(Distance)
           Inc(Distance)
         else
         else
@@ -1116,9 +1116,9 @@ begin
      ((Distance<0) and FBOF) then
      ((Distance<0) and FBOF) then
     exit;
     exit;
   Try
   Try
-    If Distance>0 then 
+    If Distance>0 then
       ScrollForward
       ScrollForward
-    else 
+    else
       ScrollBackward;
       ScrollBackward;
   finally
   finally
      DoAfterScroll;
      DoAfterScroll;
@@ -1137,7 +1137,7 @@ begin
   Active:=True;
   Active:=True;
 end;
 end;
 
 
-procedure TDataset.Post; 
+procedure TDataset.Post;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -1155,7 +1155,7 @@ begin
   //!! To be implemented
   //!! To be implemented
 end;
 end;
 
 
-procedure TDataset.Resync(Mode: TResyncMode); 
+procedure TDataset.Resync(Mode: TResyncMode);
 
 
 Var Count,ShiftCount : Longint;
 Var Count,ShiftCount : Longint;
 
 
@@ -1164,7 +1164,7 @@ begin
   If rmExact in Mode then
   If rmExact in Mode then
     begin
     begin
     { throw an exception if not found.
     { throw an exception if not found.
-      Normally the descendant should do this if DoCheck is true. }  
+      Normally the descendant should do this if DoCheck is true. }
     If GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk Then
     If GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk Then
       DatabaseError(SNoSuchRecord,Self);
       DatabaseError(SNoSuchRecord,Self);
     end
     end
@@ -1172,18 +1172,18 @@ begin
     { Can we find a record in the neighbourhood ?
     { Can we find a record in the neighbourhood ?
       Use Shortcut evaluation for this, or we'll have some funny results. }
       Use Shortcut evaluation for this, or we'll have some funny results. }
     If (GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk) and
     If (GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk) and
-       (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) and 
+       (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) and
        (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) then
        (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) then
        begin
        begin
        // nothing found, invalidate buffer and bail out.
        // nothing found, invalidate buffer and bail out.
        ClearBuffers;
        ClearBuffers;
        Exit;
        Exit;
-       end; 
-  If (rmCenter in Mode) then     
+       end;
+  If (rmCenter in Mode) then
     ShiftCount:=FbufferCount div 2
     ShiftCount:=FbufferCount div 2
   else
   else
     // keep current position.
     // keep current position.
-    ShiftCount:=FActiveRecord;  
+    ShiftCount:=FActiveRecord;
   // Reposition on 0
   // Reposition on 0
   ShiftBuffers(FRecordCount-1);
   ShiftBuffers(FRecordCount-1);
   ActivateBuffers;
   ActivateBuffers;
@@ -1209,7 +1209,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TDataset.Translate(Src, Dest: PChar; ToOem: Boolean); 
+procedure TDataset.Translate(Src, Dest: PChar; ToOem: Boolean);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -1243,7 +1243,7 @@ Procedure TDataset.ShiftBuffers (Distance : longint);
 
 
 Var Temp : Pointer;
 Var Temp : Pointer;
     MoveSize : Longint;
     MoveSize : Longint;
-      
+
   Procedure ShiftBuffersUp;
   Procedure ShiftBuffersUp;
   begin
   begin
     {$ifdef DSDEBUG}
     {$ifdef DSDEBUG}
@@ -1256,7 +1256,7 @@ Var Temp : Pointer;
   end;
   end;
 
 
   Procedure ShiftBuffersDown;
   Procedure ShiftBuffersDown;
-  
+
   begin
   begin
     // Distance is NEGATIVE
     // Distance is NEGATIVE
     {$ifdef DSDEBUG}
     {$ifdef DSDEBUG}
@@ -1277,14 +1277,17 @@ begin
       ShiftBuffersDown
       ShiftBuffersDown
     else If Distance>0 then
     else If Distance>0 then
       ShiftBuffersUp;
       ShiftBuffersUp;
-  Finally  
+  Finally
     FreeMem(temp);
     FreeMem(temp);
   end;
   end;
 end;
 end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
+  Revision 1.3  1999-11-09 13:33:47  peter
+    * reallocmem fixes
+
+  Revision 1.2  1999/10/24 17:07:54  michael
   + Added copyright header
   + Added copyright header
 
 
 }
 }

+ 31 - 28
fcl/db/db.pp

@@ -1,12 +1,12 @@
 {
 {
     $Id$
     $Id$
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
+    Copyright (c) 1999 by Michael Van Canneyt, member of the
     Free Pascal development team
     Free Pascal development team
 
 
 
 
     DB header file with interface section.
     DB header file with interface section.
-    
+
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
 
 
@@ -28,11 +28,11 @@ const
 
 
   dsMaxBufferCount = MAXINT div 8;
   dsMaxBufferCount = MAXINT div 8;
   dsMaxStringSize = 8192;
   dsMaxStringSize = 8192;
- 
+
   // Used in AsBoolean for string fields to determine
   // Used in AsBoolean for string fields to determine
   // whether it's true or false.
   // whether it's true or false.
   YesNoChars : Array[Boolean] of char = ('Y','N');
   YesNoChars : Array[Boolean] of char = ('Y','N');
-  
+
 type
 type
 
 
 { Auxiliary type }
 { Auxiliary type }
@@ -91,7 +91,7 @@ type
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldClass: TFieldClass read GetFieldClass;
     property FieldNo: Longint read FFieldNo;
     property FieldNo: Longint read FFieldNo;
     property Name: string read FName;
     property Name: string read FName;
-    property Precision: Longint read FPrecision write FPrecision; 
+    property Precision: Longint read FPrecision write FPrecision;
     property Required: Boolean read FRequired;
     property Required: Boolean read FRequired;
     property Size: Word read FSize;
     property Size: Word read FSize;
   end;
   end;
@@ -123,7 +123,7 @@ type
 
 
   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
   TFieldKinds = Set of TFieldKind;
   TFieldKinds = Set of TFieldKind;
-  
+
   TFieldNotifyEvent = procedure(Sender: TField) of object;
   TFieldNotifyEvent = procedure(Sender: TField) of object;
   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
     DisplayText: Boolean) of object;
     DisplayText: Boolean) of object;
@@ -132,7 +132,7 @@ type
   TFieldChars = set of Char;
   TFieldChars = set of Char;
   { TAlignment may need to come from somewhere else }
   { TAlignment may need to come from somewhere else }
   TAlignMent = (taLeftjustify,taCenter,taRightJustify);
   TAlignMent = (taLeftjustify,taCenter,taRightJustify);
-  
+
   TField = class(TComponent)
   TField = class(TComponent)
   Private
   Private
     FAlignMent : TAlignment;
     FAlignMent : TAlignment;
@@ -162,7 +162,7 @@ type
     FLookupKeyfields : String;
     FLookupKeyfields : String;
     FLookupresultField : String;
     FLookupresultField : String;
     FOffset : Word;
     FOffset : Word;
-    FOnChange : TNotifyEvent;
+    FOnChange : TFieldNotifyEvent;
     FOnGetText: TFieldGetTextEvent;
     FOnGetText: TFieldGetTextEvent;
     FOnSetText: TFieldSetTextEvent;
     FOnSetText: TFieldSetTextEvent;
     FOnValidate: TFieldNotifyEvent;
     FOnValidate: TFieldNotifyEvent;
@@ -335,7 +335,7 @@ type
     property MinValue: Longint read FMinValue write SetMinValue default 0;
     property MinValue: Longint read FMinValue write SetMinValue default 0;
   end;
   end;
   TIntegerField = TLongintField;
   TIntegerField = TLongintField;
-  
+
 { TSmallintField }
 { TSmallintField }
 
 
   TSmallintField = class(TLongintField)
   TSmallintField = class(TLongintField)
@@ -366,7 +366,7 @@ type
 { TFloatField }
 { TFloatField }
 
 
   TFloatField = class(TNumericField)
   TFloatField = class(TNumericField)
-  private 
+  private
     FMaxValue : Extended;
     FMaxValue : Extended;
     FMinValue : Extended;
     FMinValue : Extended;
     FPrecision : Longint;
     FPrecision : Longint;
@@ -383,7 +383,7 @@ type
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : Extended) : Boolean;
     Function CheckRange(AValue : Extended) : Boolean;
     property Value: Extended read GetAsFloat write SetAsFloat;
     property Value: Extended read GetAsFloat write SetAsFloat;
-    
+
   published
   published
     property MaxValue: Extended read FMaxValue write FMaxValue;
     property MaxValue: Extended read FMaxValue write FMaxValue;
     property MinValue: Extended read FMinValue write FMinValue;
     property MinValue: Extended read FMinValue write FMinValue;
@@ -569,7 +569,7 @@ type
     ixCaseInsensitive, ixExpression);
     ixCaseInsensitive, ixExpression);
 
 
   TIndexDef = class
   TIndexDef = class
-  Private 
+  Private
     FExpression : String;
     FExpression : String;
     FFields : String;
     FFields : String;
     FName : String;
     FName : String;
@@ -630,8 +630,8 @@ type
 { TCheckConstraints }
 { TCheckConstraints }
 
 
   TCheckConstraints = class(TCollection)
   TCheckConstraints = class(TCollection)
-  Private 
-   Function GetItem(Index : Longint) : TCheckConstraint; 
+  Private
+   Function GetItem(Index : Longint) : TCheckConstraint;
    Procedure SetItem(index : Longint; Value : TCheckConstraint);
    Procedure SetItem(index : Longint; Value : TCheckConstraint);
   protected
   protected
     function GetOwner: TPersistent; override;
     function GetOwner: TPersistent; override;
@@ -674,7 +674,7 @@ type
       Property Dataset : TDataset Read FDataset;
       Property Dataset : TDataset Read FDataset;
       Property Fields [Index : Integer] : TField Read GetField; default;
       Property Fields [Index : Integer] : TField Read GetField; default;
     end;
     end;
-    
+
 
 
 { TDataSet }
 { TDataSet }
 
 
@@ -715,7 +715,7 @@ type
 
 
   TDatasetClass = Class of TDataset;
   TDatasetClass = Class of TDataset;
   TBufferArray = ^pchar;
   TBufferArray = ^pchar;
-     
+
   TDataSet = class(TComponent)
   TDataSet = class(TComponent)
   Private
   Private
     FActive: Boolean;
     FActive: Boolean;
@@ -771,7 +771,7 @@ type
     FState: TDataSetState;
     FState: TDataSetState;
     Procedure DoInternalOpen;
     Procedure DoInternalOpen;
     Procedure DoInternalClose;
     Procedure DoInternalClose;
-    Function  GetBuffer (Index : longint) : Pchar;  
+    Function  GetBuffer (Index : longint) : Pchar;
     Function  GetField (Index : Longint) : TField;
     Function  GetField (Index : Longint) : TField;
     Procedure RemoveField (Field : TField);
     Procedure RemoveField (Field : TField);
     Procedure SetActive (Value : Boolean);
     Procedure SetActive (Value : Boolean);
@@ -988,14 +988,14 @@ type
     Published
     Published
       Property DataBase : TDatabase Read FDatabase Write SetDatabase;
       Property DataBase : TDatabase Read FDatabase Write SetDatabase;
     end;
     end;
-  
+
   { TDatabase }
   { TDatabase }
-    
+
   TLoginEvent = procedure(Database: TDatabase;
   TLoginEvent = procedure(Database: TDatabase;
     LoginParams: TStrings) of object;
     LoginParams: TStrings) of object;
 
 
   TDatabaseClass = Class Of TDatabase;
   TDatabaseClass = Class Of TDatabase;
-  
+
   TDatabase = class(TComponent)
   TDatabase = class(TComponent)
   private
   private
     FConnected : Boolean;
     FConnected : Boolean;
@@ -1070,7 +1070,7 @@ Const
 Procedure DatabaseError (Const Msg : String);
 Procedure DatabaseError (Const Msg : String);
 Procedure DatabaseError (Const Msg : String; Comp : TComponent);
 Procedure DatabaseError (Const Msg : String; Comp : TComponent);
 Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
 Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const; 
+Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
                             Comp : TComponent);
                             Comp : TComponent);
 
 
 implementation
 implementation
@@ -1078,7 +1078,7 @@ implementation
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
     Auxiliary functions
     Auxiliary functions
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
-  
+
 
 
 
 
 Procedure DatabaseError (Const Msg : String);
 Procedure DatabaseError (Const Msg : String);
@@ -1099,7 +1099,7 @@ begin
   Raise EDatabaseError.CreateFmt(Fmt,Args);
   Raise EDatabaseError.CreateFmt(Fmt,Args);
 end;
 end;
 
 
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const; 
+Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
                             Comp : TComponent);
                             Comp : TComponent);
 begin
 begin
   Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
   Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
@@ -1118,8 +1118,8 @@ begin
 end;
 end;
 
 
 
 
-      
-destructor TIndexDef.Destroy; 
+
+destructor TIndexDef.Destroy;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -1202,7 +1202,7 @@ end;
 
 
 { TCheckConstraint }
 { TCheckConstraint }
 
 
-procedure TCheckConstraint.Assign(Source: TPersistent); 
+procedure TCheckConstraint.Assign(Source: TPersistent);
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -1212,7 +1212,7 @@ end;
 
 
 { TCheckConstraints }
 { TCheckConstraints }
 
 
-Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint; 
+Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint;
 
 
 begin
 begin
   //!! To be implemented
   //!! To be implemented
@@ -1256,7 +1256,10 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
+  Revision 1.3  1999-11-09 13:33:47  peter
+    * reallocmem fixes
+
+  Revision 1.2  1999/10/24 17:07:54  michael
   + Added copyright header
   + Added copyright header
 
 
 }
 }