mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-27 11:52:51 +02:00
Merged revisions 710,803,829-830 via svnmerge from
/trunk git-svn-id: branches/fixes_2_0@831 -
This commit is contained in:
joost
parent
699d8f8ab9
commit
93e78cd7ce
@ -88,23 +88,32 @@ begin
|
||||
for i := 0 to Fields.Count - 1 do
|
||||
with Fields[i] do begin
|
||||
if Binding then begin
|
||||
if FieldKind in [fkCalculated, fkLookup] then begin
|
||||
FFieldNo := -1;
|
||||
FOffset := FCalcFieldsSize;
|
||||
Inc(FCalcFieldsSize, DataSize + 1);
|
||||
end else begin
|
||||
FieldDef := nil;
|
||||
FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
|
||||
if FieldIndex <> -1 then begin
|
||||
FieldDef := FieldDefs[FieldIndex];
|
||||
FFieldNo := FieldDef.FieldNo;
|
||||
if IsBlob then begin
|
||||
FSize := FieldDef.Size;
|
||||
FOffset := FBlobFieldCount;
|
||||
Inc(FBlobFieldCount);
|
||||
end;
|
||||
end else FFieldNo := FieldIndex;
|
||||
end;
|
||||
if FieldKind in [fkCalculated, fkLookup] then begin
|
||||
FFieldNo := -1;
|
||||
FOffset := FCalcFieldsSize;
|
||||
Inc(FCalcFieldsSize, DataSize + 1);
|
||||
if FieldKind in [fkLookup] then begin
|
||||
if ((FLookupDataSet = nil) or (FLookupKeyFields = '') or
|
||||
(FLookupResultField = '') or (FKeyFields = '')) then
|
||||
DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
|
||||
FFields.CheckFieldNames(FKeyFields);
|
||||
FLookupDataSet.Fields.CheckFieldNames(FLookupKeyFields);
|
||||
FLookupDataSet.FieldByName(FLookupResultField);
|
||||
if FLookupCache then RefreshLookupList;
|
||||
end
|
||||
end else begin
|
||||
FieldDef := nil;
|
||||
FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
|
||||
if FieldIndex <> -1 then begin
|
||||
FieldDef := FieldDefs[FieldIndex];
|
||||
FFieldNo := FieldDef.FieldNo;
|
||||
if IsBlob then begin
|
||||
FSize := FieldDef.Size;
|
||||
FOffset := FBlobFieldCount;
|
||||
Inc(FBlobFieldCount);
|
||||
end;
|
||||
end else FFieldNo := FieldIndex;
|
||||
end;
|
||||
end else FFieldNo := 0;;
|
||||
end;
|
||||
end;
|
||||
@ -129,7 +138,7 @@ begin
|
||||
ClearCalcFields(CalcBuffer);
|
||||
for I := 0 to Fields.Count - 1 do
|
||||
with Fields[I] do
|
||||
if FieldKind = fkLookup then {CalcLookupValue};
|
||||
if FieldKind = fkLookup then CalcLookupValue;
|
||||
end;
|
||||
DoOnCalcFields;
|
||||
end;
|
||||
@ -480,78 +489,30 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
|
||||
NativeFormat: Boolean): Boolean;
|
||||
|
||||
function ConvertData(Field: TField; Source: TDateTimeRec): TDateTime;
|
||||
var
|
||||
TimeStamp: TTimeStamp;
|
||||
begin
|
||||
case Field.DataType of
|
||||
ftDate:
|
||||
begin
|
||||
TimeStamp.Time := 0;
|
||||
TimeStamp.Date := Source.Date;
|
||||
end;
|
||||
ftTime:
|
||||
begin
|
||||
TimeStamp.Time := Source.Time;
|
||||
TimeStamp.Date := DateDelta;
|
||||
end;
|
||||
else
|
||||
try
|
||||
TimeStamp := MSecsToTimeStamp(Trunc(Source.DateTime));
|
||||
except
|
||||
TimeStamp.Time := 0;
|
||||
TimeStamp.Date := 0;
|
||||
end;
|
||||
end;
|
||||
// Result := TimeStampToDateTime(TimeStamp);
|
||||
Result := (TimeStamp.Date - DateDelta) + (TimeStamp.Time / MSecsPerDay);
|
||||
end;
|
||||
|
||||
var
|
||||
d: TDateTimeRec;
|
||||
begin
|
||||
if NativeFormat then
|
||||
Result := GetFieldData(Field, Buffer) else
|
||||
if Field.DataType in [ ftDate, ftDateTime, ftTime ] then begin
|
||||
Result := GetFieldData(Field, @d);
|
||||
if Result then
|
||||
TDateTime(Buffer^) := ConvertData(Field, d);
|
||||
end else
|
||||
Result := GetFieldData(Field, Buffer);
|
||||
Result := GetFieldData(Field, Buffer);
|
||||
end;
|
||||
|
||||
procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer);
|
||||
|
||||
begin
|
||||
// empty procedure
|
||||
end;
|
||||
|
||||
procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
|
||||
NativeFormat: Boolean);
|
||||
|
||||
function ConvertData(Field: TField; Data: TDateTime): TDateTimeRec;
|
||||
var
|
||||
TimeStamp: TTimeStamp;
|
||||
begin
|
||||
TimeStamp.Time := Trunc(Frac(Data) * MSecsPerDay);
|
||||
TimeStamp.Date := DateDelta + Trunc(System.Int(Data));
|
||||
// TimeStamp := DateTimeToTimeStamp(Data);
|
||||
case Field.DataType of
|
||||
ftDate: Result.Date := TimeStamp.Date;
|
||||
ftTime: Result.Time := TimeStamp.Time;
|
||||
else
|
||||
Result.DateTime := TimeStampToMSecs(TimeStamp);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
d: TDateTimeRec;
|
||||
begin
|
||||
if NativeFormat then
|
||||
SetFieldData(Field, Buffer)
|
||||
else
|
||||
if Field.DataType in [ ftDate, ftDateTime, ftTime ] then begin
|
||||
d := ConvertData(Field, TDateTime(Buffer^));
|
||||
SetFieldData(Field, @d);
|
||||
end else
|
||||
SetFieldData(Field, Buffer);
|
||||
SetFieldData(Field, Buffer);
|
||||
end;
|
||||
|
||||
Function TDataset.GetField (Index : Longint) : TField;
|
||||
@ -1003,12 +964,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TDataset.TempBuffer: PChar;
|
||||
|
||||
begin
|
||||
//!! To be implemented
|
||||
end;
|
||||
|
||||
Procedure TDataset.UpdateIndexDefs;
|
||||
|
||||
begin
|
||||
@ -1868,16 +1823,42 @@ begin
|
||||
FBuffers[0]:=TempBuf;
|
||||
end;
|
||||
|
||||
function TDataset.GetFieldValues(Fieldname : string) : string;
|
||||
function TDataset.GetFieldValues(Fieldname: string): Variant;
|
||||
|
||||
var i: Integer;
|
||||
FieldList: TList;
|
||||
begin
|
||||
result := findfield(Fieldname).asstring;
|
||||
if Pos(';', FieldName) <> 0 then begin
|
||||
FieldList := TList.Create;
|
||||
try
|
||||
GetFieldList(FieldList, FieldName);
|
||||
Result := VarArrayCreate([0, FieldList.Count - 1], varVariant);
|
||||
for i := 0 to FieldList.Count - 1 do
|
||||
Result[i] := TField(FieldList[i]).Value;
|
||||
finally
|
||||
FieldList.Free;
|
||||
end;
|
||||
end else
|
||||
Result := FieldByName(FieldName).Value
|
||||
end;
|
||||
|
||||
procedure TDataset.SetFieldValues(Fieldname : string;value : string);
|
||||
procedure TDataset.SetFieldValues(Fieldname: string; Value: Variant);
|
||||
|
||||
var i: Integer;
|
||||
FieldList: TList;
|
||||
begin
|
||||
findfield(Fieldname).asstring := value;
|
||||
if Pos(';', FieldName) <> 0 then
|
||||
begin
|
||||
FieldList := TList.Create;
|
||||
try
|
||||
GetFieldList(FieldList, FieldName);
|
||||
for i := 0 to FieldList.Count - 1 do
|
||||
TField(FieldList[i]).Value := Value[i];
|
||||
finally
|
||||
FieldList.Free;
|
||||
end;
|
||||
end else
|
||||
FieldByName(FieldName).Value := Value;
|
||||
end;
|
||||
|
||||
Function TDataset.Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean;
|
||||
|
||||
83
fcl/db/db.pp
83
fcl/db/db.pp
@ -126,8 +126,8 @@ type
|
||||
procedure SetPrecision(const AValue: Longint);
|
||||
procedure SetSize(const AValue: Word);
|
||||
protected
|
||||
function GetDisplayName: string;
|
||||
procedure SetDisplayName(const AValue: string);
|
||||
function GetDisplayName: string; override;
|
||||
procedure SetDisplayName(const AValue: string); override;
|
||||
public
|
||||
constructor Create(AOwner: TFieldDefs; const AName: string;
|
||||
ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
|
||||
@ -189,6 +189,25 @@ type
|
||||
TFieldRef = ^TField;
|
||||
TFieldChars = set of Char;
|
||||
|
||||
PLookupListRec = ^TLookupListRec;
|
||||
TLookupListRec = record
|
||||
Key: Variant;
|
||||
Value: Variant;
|
||||
end;
|
||||
|
||||
{ TLookupList }
|
||||
|
||||
TLookupList = class(TObject)
|
||||
private
|
||||
FList: TList;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Add(const AKey, AValue: Variant);
|
||||
procedure Clear;
|
||||
function ValueOfKey(const AKey: Variant): Variant;
|
||||
end;
|
||||
|
||||
{ TField }
|
||||
|
||||
TField = class(TComponent)
|
||||
@ -218,6 +237,7 @@ type
|
||||
FLookupDataSet : TDataSet;
|
||||
FLookupKeyfields : String;
|
||||
FLookupresultField : String;
|
||||
FLookupList: TLookupList;
|
||||
FOffset : Word;
|
||||
FOnChange : TFieldNotifyEvent;
|
||||
FOnGetText: TFieldGetTextEvent;
|
||||
@ -243,6 +263,8 @@ type
|
||||
procedure SetReadOnly(const AValue: Boolean);
|
||||
procedure SetVisible(const AValue: Boolean);
|
||||
function IsDisplayStored : Boolean;
|
||||
function GetLookupList: TLookupList;
|
||||
procedure CalcLookupValue;
|
||||
protected
|
||||
function AccessError(const TypeName: string): EDatabaseError;
|
||||
procedure CheckInactive;
|
||||
@ -296,6 +318,7 @@ type
|
||||
function GetData(Buffer: Pointer): Boolean;
|
||||
class function IsBlob: Boolean; virtual;
|
||||
function IsValidChar(InputChar: Char): Boolean; virtual;
|
||||
procedure RefreshLookupList;
|
||||
procedure SetData(Buffer: Pointer);
|
||||
procedure SetFieldType(AValue: TFieldType); virtual;
|
||||
procedure Validate(Buffer: Pointer);
|
||||
@ -327,6 +350,7 @@ type
|
||||
property Value: variant read GetAsVariant write SetAsVariant;
|
||||
property OldValue: variant read GetOldValue;
|
||||
property ProviderFlags : TProviderFlags read FProviderFlags write FProviderFlags;
|
||||
property LookupList: TLookupList read GetLookupList;
|
||||
published
|
||||
property AlignMent : TAlignMent Read FAlignMent write SetAlignment default taLeftJustify;
|
||||
property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
|
||||
@ -988,7 +1012,7 @@ type
|
||||
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
|
||||
function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
|
||||
Function GetfieldCount : Integer;
|
||||
function GetFieldValues(fieldname : string) : string; virtual;
|
||||
function GetFieldValues(fieldname : string) : Variant; virtual;
|
||||
function GetIsIndexField(Field: TField): Boolean; virtual;
|
||||
function GetNextRecords: Longint; virtual;
|
||||
function GetNextRecord: Boolean; virtual;
|
||||
@ -1013,14 +1037,13 @@ type
|
||||
procedure SetFilterOptions(Value: TFilterOptions); virtual;
|
||||
procedure SetFilterText(const Value: string); virtual;
|
||||
procedure SetFound(const Value: Boolean);
|
||||
procedure SetFieldValues(fieldname : string;value : string); virtual;
|
||||
procedure SetFieldValues(fieldname: string; Value: Variant); virtual;
|
||||
procedure SetModified(Value: Boolean);
|
||||
procedure SetName(const Value: TComponentName); override;
|
||||
procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
|
||||
procedure SetRecNo(Value: Longint); virtual;
|
||||
procedure SetState(Value: TDataSetState);
|
||||
function SetTempState(const Value: TDataSetState): TDataSetState;
|
||||
function TempBuffer: PChar;
|
||||
procedure UpdateIndexDefs; virtual;
|
||||
property ActiveRecord: Longint read FActiveRecord;
|
||||
property CurrentRecord: Longint read FCurrentRecord;
|
||||
@ -1038,7 +1061,7 @@ type
|
||||
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
|
||||
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
|
||||
function GetDataSource: TDataSource; virtual;
|
||||
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual; abstract;
|
||||
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
|
||||
function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
|
||||
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
|
||||
function GetRecordSize: Word; virtual; abstract;
|
||||
@ -1057,7 +1080,7 @@ type
|
||||
function IsCursorOpen: Boolean; virtual; abstract;
|
||||
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
|
||||
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
|
||||
procedure SetFieldData(Field: TField; Buffer: Pointer); overload; virtual; abstract;
|
||||
procedure SetFieldData(Field: TField; Buffer: Pointer); overload; virtual;
|
||||
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; virtual;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
@ -1128,7 +1151,7 @@ type
|
||||
property RecordSize: Word read GetRecordSize;
|
||||
property State: TDataSetState read FState;
|
||||
property Fields : TFields read FFieldList;
|
||||
property FieldValues[fieldname : string] : string read GetFieldValues write SetFieldValues; default;
|
||||
property FieldValues[fieldname : string] : Variant read GetFieldValues write SetFieldValues; default;
|
||||
property Filter: string read FFilterText write SetFilterText;
|
||||
property Filtered: Boolean read FFiltered write SetFiltered default False;
|
||||
property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
|
||||
@ -2010,6 +2033,50 @@ begin
|
||||
//!! To be implemented
|
||||
end;
|
||||
|
||||
{ TLookupList }
|
||||
|
||||
constructor TLookupList.Create;
|
||||
|
||||
begin
|
||||
FList := TList.Create;
|
||||
end;
|
||||
|
||||
destructor TLookupList.Destroy;
|
||||
|
||||
begin
|
||||
if FList <> nil then Clear;
|
||||
FList.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TLookupList.Add(const AKey, AValue: Variant);
|
||||
|
||||
var LookupRec: PLookupListRec;
|
||||
begin
|
||||
New(LookupRec);
|
||||
LookupRec^.Key := AKey;
|
||||
LookupRec^.Value := AValue;
|
||||
FList.Add(LookupRec);
|
||||
end;
|
||||
|
||||
procedure TLookupList.Clear;
|
||||
var i: integer;
|
||||
begin
|
||||
for i := 0 to FList.Count - 1 do Dispose(PLookupListRec(FList[i]));
|
||||
FList.Clear;
|
||||
end;
|
||||
|
||||
function TLookupList.ValueOfKey(const AKey: Variant): Variant;
|
||||
|
||||
var I: Integer;
|
||||
begin
|
||||
Result := Null;
|
||||
if VarIsNull(AKey) then Exit;
|
||||
i := FList.Count - 1;
|
||||
while (i > 0) And (PLookupListRec(FList.Items[I])^.Key <> AKey) do Dec(i);
|
||||
if i >= 0 then Result := PLookupListRec(FList.Items[I])^.Value;
|
||||
end;
|
||||
|
||||
{$i dataset.inc}
|
||||
{$i fields.inc}
|
||||
{$i datasource.inc}
|
||||
|
||||
@ -72,6 +72,7 @@ Const
|
||||
SInvalidCalcType = 'Field ''%s'' cannot be a calculated or lookup field';
|
||||
SDuplicateName = 'Duplicate name ''%s'' in %s';
|
||||
SNoParseSQL = '%s is only possible if ParseSQL is True';
|
||||
SLookupInfoError = 'Lookup information for field ''%s'' is incomplete';
|
||||
|
||||
Implementation
|
||||
|
||||
|
||||
@ -332,6 +332,7 @@ begin
|
||||
if Assigned(FFields) then
|
||||
FFields.Remove(Self);
|
||||
end;
|
||||
FLookupList.Free;
|
||||
Inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -557,7 +558,7 @@ begin
|
||||
Move (FValueBuffer^,Buffer^ ,DataSize);
|
||||
end
|
||||
else
|
||||
Result:=FDataset.GetFieldData(Self,Buffer,False);
|
||||
Result:=FDataset.GetFieldData(Self,Buffer);
|
||||
end;
|
||||
|
||||
function TField.GetDataSize: Word;
|
||||
@ -587,6 +588,22 @@ begin
|
||||
Result:=(DisplayLabel<>FieldName);
|
||||
end;
|
||||
|
||||
function TField.GetLookupList: TLookupList;
|
||||
begin
|
||||
if not Assigned(FLookupList) then
|
||||
FLookupList := TLookupList.Create;
|
||||
Result := FLookupList;
|
||||
end;
|
||||
|
||||
procedure TField.CalcLookupValue;
|
||||
begin
|
||||
if FLookupCache then
|
||||
Value := LookupList.ValueOfKey(FDataSet.FieldValues[FKeyFields])
|
||||
else if (FLookupDataSet <> nil) and FLookupDataSet.Active then
|
||||
Value := FLookupDataSet.Lookup(FLookupKeyFields,
|
||||
FDataSet.FieldValues[FKeyFields], FLookupResultField);
|
||||
end;
|
||||
|
||||
function TField.getIndex : longint;
|
||||
|
||||
begin
|
||||
@ -651,10 +668,41 @@ begin
|
||||
Result:=InputChar in FValidChars;
|
||||
end;
|
||||
|
||||
procedure TField.RefreshLookupList;
|
||||
var SaveActive: Boolean;
|
||||
begin
|
||||
if (FLookupDataSet <> nil) And (FLookupKeyFields <> '') And
|
||||
(FlookupResultField <> '') And (FKeyFields <> '') then begin
|
||||
SaveActive := FLookupDataSet.Active;
|
||||
with FLookupDataSet do
|
||||
try
|
||||
Active := True;
|
||||
FFields.CheckFieldNames(FLookupKeyFields);
|
||||
FieldByName(FLookupResultField);
|
||||
LookupList.Clear;
|
||||
DisableControls;
|
||||
try
|
||||
First;
|
||||
while not Eof do begin
|
||||
FLookupList.Add(FieldValues[FLookupKeyFields],
|
||||
FieldValues[FLookupResultField]);
|
||||
Next;
|
||||
end;
|
||||
finally
|
||||
EnableControls;
|
||||
end;
|
||||
finally
|
||||
Active := SaveActive;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TField.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
|
||||
begin
|
||||
Inherited Notification(AComponent,Operation);
|
||||
if (Operation = opRemove) and (AComponent = FLookupDataSet) then
|
||||
FLookupDataSet := nil;
|
||||
end;
|
||||
|
||||
procedure TField.PropertyChanged(LayoutAffected: Boolean);
|
||||
@ -2400,7 +2448,7 @@ begin
|
||||
T:=Value;
|
||||
Repeat
|
||||
I:=Pos(T,';');
|
||||
If I=0 Then I:=Length(T);
|
||||
If I=0 Then I:=Length(T)+1;
|
||||
S:=Copy(T,1,I-1);
|
||||
Delete(T,1,I);
|
||||
// Will raise an error if no such field...
|
||||
|
||||
@ -243,7 +243,6 @@ procedure TMySQLConnection.PrepareStatement(cursor: TSQLCursor;
|
||||
begin
|
||||
if assigned(AParams) and (AParams.count > 0) then
|
||||
DatabaseError('Parameters (not) yet supported for the MySQL SqlDB connection.',self);
|
||||
ObtainSQLStatementType(cursor,buf);
|
||||
With Cursor as TMysqlCursor do
|
||||
begin
|
||||
FStatement:=Buf;
|
||||
|
||||
@ -381,7 +381,6 @@ var s : string;
|
||||
i : integer;
|
||||
|
||||
begin
|
||||
ObtainSQLStatementType(cursor,buf);
|
||||
with (cursor as TPQCursor) do
|
||||
begin
|
||||
FPrepared := False;
|
||||
|
||||
@ -56,6 +56,9 @@ const
|
||||
|
||||
{ TSQLConnection }
|
||||
type
|
||||
|
||||
{ TSQLConnection }
|
||||
|
||||
TSQLConnection = class (TDatabase)
|
||||
private
|
||||
FPassword : string;
|
||||
@ -97,11 +100,12 @@ type
|
||||
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
|
||||
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
|
||||
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;abstract;
|
||||
Procedure ObtainSQLStatementType(Cursor : TSQLCursor; SQLStr : string);
|
||||
public
|
||||
property Handle: Pointer read GetHandle;
|
||||
destructor Destroy; override;
|
||||
property ConnOptions: TConnOptions read FConnOptions;
|
||||
procedure ExecuteDirect(SQL : String); overload; virtual;
|
||||
procedure ExecuteDirect(SQL : String; Transaction : TSQLTransaction); overload; virtual;
|
||||
published
|
||||
property Password : string read FPassword write FPassword;
|
||||
property Transaction : TSQLTransaction read FTransaction write SetTransaction;
|
||||
@ -198,7 +202,6 @@ type
|
||||
function GetCanModify: Boolean; override;
|
||||
function ApplyRecUpdate(UpdateKind : TUpdateKind) : boolean; override;
|
||||
Function IsPrepared : Boolean; virtual;
|
||||
procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; override;
|
||||
procedure SetFiltered(Value: Boolean); override;
|
||||
public
|
||||
procedure Prepare; virtual;
|
||||
@ -301,6 +304,41 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Procedure TSQLConnection.ExecuteDirect(SQL: String);
|
||||
|
||||
begin
|
||||
ExecuteDirect(SQL,FTransaction);
|
||||
end;
|
||||
|
||||
Procedure TSQLConnection.ExecuteDirect(SQL: String; Transaction : TSQLTransaction);
|
||||
|
||||
var Cursor : TSQLCursor;
|
||||
|
||||
begin
|
||||
if not assigned(Transaction) then
|
||||
DatabaseError(SErrTransactionnSet);
|
||||
|
||||
if not Connected then Open;
|
||||
if not Transaction.Active then Transaction.StartTransaction;
|
||||
|
||||
try
|
||||
Cursor := AllocateCursorHandle;
|
||||
|
||||
SQL := TrimRight(SQL);
|
||||
|
||||
if SQL = '' then
|
||||
DatabaseError(SErrNoStatement);
|
||||
|
||||
Cursor.FStatementType := stNone;
|
||||
|
||||
PrepareStatement(cursor,Transaction,SQL,Nil);
|
||||
execute(cursor,Transaction, Nil);
|
||||
CloseStatement(Cursor);
|
||||
finally;
|
||||
DeAllocateCursorHandle(Cursor);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetAsSQLText(Field : TField) : string;
|
||||
|
||||
begin
|
||||
@ -314,54 +352,6 @@ begin
|
||||
end; {case}
|
||||
end;
|
||||
|
||||
Procedure TSQLConnection.ObtainSQLStatementType(Cursor : TSQLCursor; SQLStr : string);
|
||||
|
||||
Var
|
||||
L : Integer;
|
||||
cmt : boolean;
|
||||
P,PE,PP : PChar;
|
||||
S : string;
|
||||
|
||||
begin
|
||||
L := Length(SQLstr);
|
||||
|
||||
if L=0 then
|
||||
begin
|
||||
DatabaseError(SErrNoStatement);
|
||||
exit;
|
||||
end;
|
||||
|
||||
P:=Pchar(SQLstr);
|
||||
PP:=P;
|
||||
Cmt:=False;
|
||||
While ((P-PP)<L) do
|
||||
begin
|
||||
if not (P^ in [' ',#13,#10,#9]) then
|
||||
begin
|
||||
if not Cmt then
|
||||
begin
|
||||
// Check for comment.
|
||||
Cmt:=(P^='/') and (((P-PP)<=L) and (P[1]='*'));
|
||||
if not (cmt) then
|
||||
Break;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Check for end of comment.
|
||||
Cmt:=Not( (P^='*') and (((P-PP)<=L) and (P[1]='/')) );
|
||||
If not cmt then
|
||||
Inc(p);
|
||||
end;
|
||||
end;
|
||||
inc(P);
|
||||
end;
|
||||
PE:=P+1;
|
||||
While ((PE-PP)<L) and (PE^ in ['0'..'9','a'..'z','A'..'Z','_']) do
|
||||
Inc(PE);
|
||||
Setlength(S,PE-P);
|
||||
Move(P^,S[1],(PE-P));
|
||||
Cursor.FStatementType := StrToStatementType(s);
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
|
||||
|
||||
@ -529,12 +519,6 @@ begin
|
||||
Result := Assigned(FCursor) and FCursor.FPrepared;
|
||||
end;
|
||||
|
||||
procedure TSQLQuery.SetFieldData(Field: TField; Buffer: Pointer;
|
||||
NativeFormat: Boolean);
|
||||
begin
|
||||
SetFieldData(Field, Buffer);
|
||||
end;
|
||||
|
||||
Function TSQLQuery.AddFilter(SQLstr : string) : string;
|
||||
|
||||
begin
|
||||
@ -595,6 +579,9 @@ begin
|
||||
|
||||
FSQLBuf := TrimRight(FSQL.Text);
|
||||
|
||||
if FSQLBuf = '' then
|
||||
DatabaseError(SErrNoStatement);
|
||||
|
||||
SQLParser(FSQLBuf);
|
||||
|
||||
if filtered then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user