mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 12:59:29 +01:00
709 lines
14 KiB
PHP
709 lines
14 KiB
PHP
|
|
{ TParams }
|
|
|
|
Function TParams.GetItem(Index: Integer): TParam;
|
|
begin
|
|
Result:=(Inherited GetItem(Index)) as TParam;
|
|
end;
|
|
|
|
Function TParams.GetParamValue(const ParamName: string): Variant;
|
|
begin
|
|
Result:=ParamByName(ParamName).Value;
|
|
end;
|
|
|
|
Procedure TParams.SetItem(Index: Integer; Value: TParam);
|
|
begin
|
|
Inherited SetItem(Index,Value);
|
|
end;
|
|
|
|
Procedure TParams.SetParamValue(const ParamName: string; const Value: Variant);
|
|
begin
|
|
ParamByName(ParamName).Value:=Value;
|
|
end;
|
|
|
|
Procedure TParams.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if (Dest is TParams) then
|
|
TParams(Dest).Assign(Self)
|
|
else
|
|
inherited AssignTo(Dest);
|
|
end;
|
|
|
|
Function TParams.GetDataSet: TDataSet;
|
|
begin
|
|
If (FOwner is TDataset) Then
|
|
Result:=TDataset(FOwner)
|
|
else
|
|
Result:=Nil;
|
|
end;
|
|
|
|
Function TParams.GetOwner: TPersistent;
|
|
begin
|
|
Result:=FOwner;
|
|
end;
|
|
|
|
|
|
constructor TParams.Create(AOwner: TPersistent);
|
|
begin
|
|
Inherited Create(TParam);
|
|
Fowner:=AOwner;
|
|
end;
|
|
|
|
constructor TParams.Create;
|
|
begin
|
|
Create(TPersistent(Nil));
|
|
end;
|
|
|
|
Procedure TParams.AddParam(Value: TParam);
|
|
begin
|
|
Value.Collection:=Self;
|
|
end;
|
|
|
|
Procedure TParams.AssignValues(Value: TParams);
|
|
|
|
Var
|
|
I : Integer;
|
|
P,PS : TParam;
|
|
|
|
begin
|
|
For I:=0 to Value.Count-1 do
|
|
begin
|
|
PS:=Value[i];
|
|
P:=FindParam(PS.Name);
|
|
If Assigned(P) then
|
|
P.Assign(PS);
|
|
end;
|
|
end;
|
|
|
|
Function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
|
|
ParamType: TParamType): TParam;
|
|
|
|
begin
|
|
Result:=Add as TParam;
|
|
With Result do
|
|
begin
|
|
Name:=ParamName;
|
|
DataType:=FldType;
|
|
ParamType:=ParamType;
|
|
end;
|
|
end;
|
|
|
|
Function TParams.FindParam(const Value: string): TParam;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
Result:=Nil;
|
|
I:=Count-1;
|
|
While (Result=Nil) and (I>=0) do
|
|
If (CompareText(Value,Items[i].Name)=0) then
|
|
Result:=Items[i]
|
|
else
|
|
Dec(i);
|
|
end;
|
|
|
|
Procedure TParams.GetParamList(List: TList; const ParamNames: string);
|
|
|
|
Function NextName(Var S : String) : String;
|
|
Var
|
|
P : Integer;
|
|
begin
|
|
P:=Pos(';',S);
|
|
If (P=0) then
|
|
P:=Length(S)+1;
|
|
Result:=Copy(S,1,P-1);
|
|
Delete(S,1,P);
|
|
end;
|
|
|
|
Var
|
|
L,N : String;
|
|
|
|
begin
|
|
L:=ParamNames;
|
|
While (Length(L)>0) do
|
|
begin
|
|
N:=NextName(L);
|
|
List.Add(ParamByName(N));
|
|
end;
|
|
end;
|
|
|
|
Function TParams.IsEqual(Value: TParams): Boolean;
|
|
|
|
Var
|
|
I : Integer;
|
|
|
|
begin
|
|
Result:=(Value.Count=Count);
|
|
I:=Count-1;
|
|
While Result and (I>=0) do
|
|
begin
|
|
Result:=Items[I].IsEqual(Value[i]);
|
|
Dec(I);
|
|
end;
|
|
end;
|
|
|
|
Function TParams.ParamByName(const Value: string): TParam;
|
|
begin
|
|
Result:=FindParam(Value);
|
|
If (Result=Nil) then
|
|
DatabaseErrorFmt(SParameterNotFound,[Value],Dataset);
|
|
end;
|
|
|
|
Function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
|
|
begin
|
|
|
|
end;
|
|
|
|
Procedure TParams.RemoveParam(Value: TParam);
|
|
begin
|
|
Value.Collection:=Nil;
|
|
end;
|
|
|
|
{ TParam }
|
|
|
|
Function TParam.GetDataSet: TDataSet;
|
|
begin
|
|
If Assigned(Collection) and (Collection is TParams) then
|
|
Result:=TParams(Collection).GetDataset
|
|
else
|
|
Result:=Nil;
|
|
end;
|
|
|
|
Function TParam.IsParamStored: Boolean;
|
|
begin
|
|
Result:=Bound;
|
|
end;
|
|
|
|
Procedure TParam.AssignParam(Param: TParam);
|
|
begin
|
|
if Not Assigned(Param) then
|
|
begin
|
|
Clear;
|
|
FDataType:=ftunknown;
|
|
FParamType:=ptUnknown;
|
|
Name:='';
|
|
Size:=0;
|
|
Precision:=0;
|
|
NumericScale:=0;
|
|
end
|
|
else
|
|
begin
|
|
FDataType:=Param.DataType;
|
|
if Param.IsNull then
|
|
Clear
|
|
else
|
|
FValue:=Param.FValue;
|
|
FBound:=Param.Bound;
|
|
Name:=Param.Name;
|
|
if (ParamType=ptUnknown) then
|
|
ParamType:=Param.ParamType;
|
|
Size:=Param.Size;
|
|
Precision:=Param.Precision;
|
|
NumericScale:=Param.NumericScale;
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if (Dest is TField) then
|
|
AssignToField(TField(Dest))
|
|
else
|
|
inherited AssignTo(Dest);
|
|
end;
|
|
|
|
Function TParam.GetAsBoolean: Boolean;
|
|
begin
|
|
If IsNull then
|
|
Result:=False
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsCurrency: Currency;
|
|
begin
|
|
If IsNull then
|
|
Result:=0.0
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsDateTime: TDateTime;
|
|
begin
|
|
If IsNull then
|
|
Result:=0.0
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsFloat: Double;
|
|
begin
|
|
If IsNull then
|
|
Result:=0.0
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsInteger: Longint;
|
|
begin
|
|
If IsNull then
|
|
Result:=0
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsMemo: string;
|
|
begin
|
|
If IsNull then
|
|
Result:=''
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsString: string;
|
|
begin
|
|
If IsNull then
|
|
Result:=''
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetAsVariant: Variant;
|
|
begin
|
|
if IsNull then
|
|
Result:=Null
|
|
else
|
|
Result:=FValue;
|
|
end;
|
|
|
|
Function TParam.GetDisplayName: string;
|
|
begin
|
|
if (FName<>'') then
|
|
Result:=FName
|
|
else
|
|
Result:=inherited GetDisplayName
|
|
end;
|
|
|
|
Function TParam.GetIsNull: Boolean;
|
|
begin
|
|
Result:=FNull or VarIsNull(FValue) or VarIsClear(FValue);
|
|
end;
|
|
|
|
Function TParam.IsEqual(AValue: TParam): Boolean;
|
|
begin
|
|
Result:=(Name=AValue.Name)
|
|
and (IsNull=AValue.IsNull)
|
|
and (Bound=AValue.Bound)
|
|
and (DataType=AValue.DataType)
|
|
and (ParamType=AValue.ParamType)
|
|
and (VarType(FValue)=VarType(AValue.FValue))
|
|
and (FValue=AValue.FValue);
|
|
end;
|
|
|
|
Procedure TParam.SetAsBlob(const AValue: TBlobData);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftBlob;
|
|
end;
|
|
|
|
Procedure TParam.SetAsBoolean(AValue: Boolean);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftBoolean;
|
|
end;
|
|
|
|
Procedure TParam.SetAsCurrency(const AValue: Currency);
|
|
begin
|
|
FValue:=Avalue;
|
|
FDataType:=ftCurrency;
|
|
end;
|
|
|
|
Procedure TParam.SetAsDate(const AValue: TDateTime);
|
|
begin
|
|
FValue:=Avalue;
|
|
FDataType:=ftDate;
|
|
end;
|
|
|
|
Procedure TParam.SetAsDateTime(const AValue: TDateTime);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftDateTime;
|
|
end;
|
|
|
|
Procedure TParam.SetAsFloat(const AValue: Double);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftFloat;
|
|
end;
|
|
|
|
Procedure TParam.SetAsInteger(AValue: Longint);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftInteger;
|
|
end;
|
|
|
|
Procedure TParam.SetAsMemo(const AValue: string);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftMemo;
|
|
end;
|
|
|
|
|
|
Procedure TParam.SetAsSmallInt(AValue: LongInt);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftSmallInt;
|
|
end;
|
|
|
|
Procedure TParam.SetAsString(const AValue: string);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftString;
|
|
end;
|
|
|
|
Procedure TParam.SetAsTime(const AValue: TDateTime);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftTime;
|
|
end;
|
|
|
|
Procedure TParam.SetAsVariant(const AValue: Variant);
|
|
begin
|
|
FValue:=AValue;
|
|
FBound:=not VarIsClear(Value);
|
|
FNull:=VarIsClear(Value) or VarIsNull(Value);
|
|
if FDataType = ftUnknown then
|
|
case VarType(Value) of
|
|
varBoolean : FDataType:=ftBoolean;
|
|
varSmallint,
|
|
varShortInt,
|
|
varByte : FDataType:=ftSmallInt;
|
|
varWord,
|
|
varInteger : FDataType:=ftInteger;
|
|
varCurrency : FDataType:=ftCurrency;
|
|
varLongWord,
|
|
varSingle,
|
|
varDouble : FDataType:=ftFloat;
|
|
varDate : FDataType:=ftDateTime;
|
|
varString,
|
|
varOleStr : if (FDataType<>ftFixedChar) then
|
|
FDataType:=ftString;
|
|
varInt64 : FDataType:=ftLargeInt;
|
|
else
|
|
FDataType:=ftUnknown;
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.SetAsWord(AValue: LongInt);
|
|
begin
|
|
FValue:=AValue;
|
|
FDataType:=ftWord;
|
|
end;
|
|
|
|
|
|
Procedure TParam.SetDataType(AValue: TFieldType);
|
|
|
|
Var
|
|
VT : Integer;
|
|
|
|
begin
|
|
FDataType:=AValue;
|
|
VT:=FieldTypetoVariantMap[AValue];
|
|
If (VT=varError) then
|
|
clear
|
|
else
|
|
Try
|
|
FValue:=VarAsType(AValue,VT)
|
|
except
|
|
Clear;
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.SetText(const AValue: string);
|
|
begin
|
|
Value:=AValue;
|
|
end;
|
|
|
|
constructor TParam.Create(ACollection: TCollection);
|
|
begin
|
|
inherited Create(Collection);
|
|
ParamType:=ptUnknown;
|
|
DataType:=ftUnknown;
|
|
FValue:=Unassigned;
|
|
FNull:=True;
|
|
end;
|
|
|
|
constructor TParam.Create(AParams: TParams; AParamType: TParamType);
|
|
begin
|
|
Create(AParams);
|
|
ParamType:=AParamType;
|
|
end;
|
|
|
|
Procedure TParam.Assign(Source: TPersistent);
|
|
begin
|
|
if (Source is TParam) then
|
|
AssignParam(TParam(Source))
|
|
else if (Source is TField) then
|
|
AssignField(TField(Source))
|
|
else if (source is TStrings) then
|
|
AsMemo:=TStrings(Source).Text
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
Procedure TParam.AssignField(Field: TField);
|
|
begin
|
|
if Assigned(Field) then
|
|
begin
|
|
// Need TField.Value
|
|
// AssignFieldValue(Field,Field.Value);
|
|
Name:=Field.FieldName;
|
|
end
|
|
else
|
|
begin
|
|
Clear;
|
|
Name:='';
|
|
end
|
|
end;
|
|
|
|
procedure TParam.AssignToField(Field : TField);
|
|
|
|
begin
|
|
if Assigned(Field) then
|
|
case FDataType of
|
|
ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
|
|
// Need TField.AsSmallInt
|
|
ftSmallint : Field.AsInteger:=AsSmallInt;
|
|
// Need TField.AsWord
|
|
ftWord : Field.AsInteger:=AsWord;
|
|
ftInteger,
|
|
ftAutoInc : Field.AsInteger:=AsInteger;
|
|
// Need TField.AsCurrency
|
|
ftCurrency : Field.asFloat:=AsCurrency;
|
|
ftFloat : Field.asFloat:=AsFloat;
|
|
ftBoolean : Field.AsBoolean:=AsBoolean;
|
|
ftBlob,
|
|
ftGraphic..ftTypedBinary,
|
|
ftOraBlob,
|
|
ftOraClob,
|
|
ftString,
|
|
ftMemo,
|
|
ftAdt,
|
|
ftFixedChar: Field.AsString:=AsString;
|
|
ftTime,
|
|
ftDate,
|
|
ftDateTime : Field.AsDateTime:=AsDateTime;
|
|
ftBytes,
|
|
ftVarBytes : ; // Todo.
|
|
else
|
|
If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
|
|
DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.AssignFieldValue(Field: TField; const AValue: Variant);
|
|
begin
|
|
If Assigned(Field) then
|
|
begin
|
|
// Need TField.FixedChar property.
|
|
if (Field.DataType = ftString) {and TStringField(Field).FixedChar} then
|
|
DataType:=ftFixedChar
|
|
else if (Field.DataType = ftMemo) and (Field.Size > 255) then
|
|
DataType:=ftString
|
|
else
|
|
DataType:=Field.DataType;
|
|
if VarIsNull(AValue) then
|
|
Clear
|
|
else
|
|
Value:=AValue;
|
|
Size:=Field.DataSize;
|
|
FBound:=True;
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.Clear;
|
|
begin
|
|
FValue:=UnAssigned;
|
|
FNull:=True;
|
|
end;
|
|
|
|
Procedure TParam.GetData(Buffer: Pointer);
|
|
|
|
Var
|
|
P : Pointer;
|
|
S : String;
|
|
|
|
begin
|
|
case FDataType of
|
|
ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
|
|
ftSmallint : PSmallint(Buffer)^:=AsSmallInt;
|
|
ftWord : PWord(Buffer)^:=AsWord;
|
|
ftInteger,
|
|
ftAutoInc : PInteger(Buffer)^:=AsInteger;
|
|
ftCurrency : PDouble(Buffer)^:=AsCurrency;
|
|
ftFloat : PDouble(Buffer)^:=AsFloat;
|
|
ftBoolean : PWordBool(Buffer)^:=AsBoolean;
|
|
ftString,
|
|
ftMemo,
|
|
ftAdt,
|
|
ftFixedChar:
|
|
begin
|
|
S:=AsString;
|
|
StrMove(PChar(Buffer),Pchar(S),Length(S)+1);
|
|
end;
|
|
ftTime : PInteger(Buffer)^:=DateTimeToTimeStamp(AsTime).Time;
|
|
ftDate : PInteger(Buffer)^:=DateTimeToTimeStamp(AsTime).Date;
|
|
ftDateTime : PDouble(Buffer)^:=TimeStampToMSecs(DateTimeToTimeStamp(AsDateTime));
|
|
ftBlob,
|
|
ftGraphic..ftTypedBinary,
|
|
ftOraBlob,
|
|
ftOraClob :
|
|
begin
|
|
S:=GetAsString;
|
|
Move(PChar(S)^, Buffer^, Length(S));
|
|
end;
|
|
ftBytes, ftVarBytes:
|
|
begin
|
|
if VarIsArray(FValue) then
|
|
begin
|
|
P:=VarArrayLock(FValue);
|
|
try
|
|
Move(P^, Buffer^, VarArrayHighBound(FValue, 1) + 1);
|
|
finally
|
|
VarArrayUnlock(FValue);
|
|
end;
|
|
end;
|
|
end;
|
|
else
|
|
If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
|
|
DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
|
|
end;
|
|
end;
|
|
|
|
Function TParam.GetDataSize: Integer;
|
|
begin
|
|
Result:=0;
|
|
case DataType of
|
|
ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
|
|
ftBoolean : Result:=SizeOf(WordBool);
|
|
ftInteger,
|
|
ftAutoInc : Result:=SizeOf(Integer);
|
|
ftSmallint : Result:=SizeOf(SmallInt);
|
|
ftWord : Result:=SizeOf(Word);
|
|
ftTime,
|
|
ftDate : Result:=SizeOf(Integer);
|
|
ftDateTime,
|
|
ftCurrency,
|
|
ftFloat : Result:=SizeOf(Double);
|
|
ftString,
|
|
ftFixedChar,
|
|
ftMemo,
|
|
ftADT : Result:=Length(AsString)+1;
|
|
ftBytes,
|
|
ftVarBytes : if VarIsArray(FValue) then
|
|
Result:=VarArrayHighBound(FValue,1)+1
|
|
else
|
|
Result:=0;
|
|
ftBlob,
|
|
ftGraphic..ftTypedBinary,
|
|
ftOraClob,
|
|
ftOraBlob : Result:=Length(AsString);
|
|
ftArray,
|
|
ftDataSet,
|
|
ftReference,
|
|
ftCursor : Result:=0;
|
|
else
|
|
DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
|
|
end;
|
|
|
|
|
|
end;
|
|
|
|
Procedure TParam.LoadFromFile(const FileName: string; BlobType: TBlobType);
|
|
|
|
Var
|
|
S : TFileStream;
|
|
|
|
begin
|
|
S:=TFileStream.Create(FileName,fmOpenRead);
|
|
Try
|
|
LoadFromStream(S,BlobType);
|
|
Finally
|
|
FreeAndNil(S);
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.LoadFromStream(Stream: TStream; BlobType: TBlobType);
|
|
|
|
Var
|
|
Temp : String;
|
|
|
|
begin
|
|
FDataType:=BlobType;
|
|
With Stream do
|
|
begin
|
|
Position:=0;
|
|
SetLength(Temp,Size);
|
|
ReadBuffer(Pointer(Temp)^,Size);
|
|
FValue:=Temp;
|
|
end;
|
|
end;
|
|
|
|
Procedure TParam.SetBlobData(Buffer: Pointer; Size: Integer);
|
|
|
|
Var
|
|
Temp : String;
|
|
|
|
begin
|
|
SetLength(Temp,Size);
|
|
Move(Buffer^,Temp,Size);
|
|
AsBlob:=Temp;
|
|
end;
|
|
|
|
Procedure TParam.SetData(Buffer: Pointer);
|
|
|
|
Function FromTimeStamp(T,D : Integer) : TDateTime;
|
|
|
|
Var TS : TTimeStamp;
|
|
|
|
begin
|
|
TS.Time:=T;
|
|
TS.Date:=D;
|
|
Result:=TimeStampToDateTime(TS);
|
|
end;
|
|
|
|
begin
|
|
case FDataType of
|
|
ftUnknown : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
|
|
ftSmallint : AsSmallInt:=PSmallint(Buffer)^;
|
|
ftWord : AsWord:=PWord(Buffer)^;
|
|
ftInteger,
|
|
ftAutoInc : AsInteger:=PInteger(Buffer)^;
|
|
ftCurrency : AsCurrency:= PDouble(Buffer)^;
|
|
ftFloat : AsFloat:=PDouble(Buffer)^;
|
|
ftBoolean : AsBoolean:=PWordBool(Buffer)^;
|
|
ftString,
|
|
ftFixedChar: AsString:=StrPas(Buffer);
|
|
ftMemo : AsMemo:=StrPas(Buffer);
|
|
ftTime : AsTime:=FromTimeStamp(PInteger(Buffer)^,DateDelta);
|
|
ftDate : Asdate:=FromTimeStamp(0,PInteger(Buffer)^);
|
|
ftDateTime : AsDateTime:=TimeStampToDateTime(MSecsToTimeStamp(trunc(PDouble(Buffer)^)));
|
|
ftCursor : FValue:=0;
|
|
ftBlob,
|
|
ftGraphic..ftTypedBinary,
|
|
ftOraBlob,
|
|
ftOraClob : SetBlobData(Buffer, StrLen(PChar(Buffer)));
|
|
else
|
|
DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
|
|
end;
|
|
end;
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.2 2004-12-15 23:02:42 florian
|
|
* fixed compilation for targets where comp=int64
|
|
|
|
Revision 1.1 2004/12/13 20:19:49 michael
|
|
+ Initial implementation of params
|
|
|
|
} |