paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 06:06:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fcl-db: limit allowed blob types to real blob types only. Provide ftBlobTypes to third party code useful for determining blob types instead of TBlobType.

Browse Source 
git-svn-id: trunk@27682 -
This commit is contained in:
reiniero 2014-04-28 12:01:18 +00:00
parent 8f96b9985f
commit a12e5406c7
2 changed files with 27 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -363,7 +363,7 @@ type
procedure SetAsString(const AValue: string); virtual; procedure SetAsString(const AValue: string); virtual;
procedure SetAsWideString(const AValue: WideString); virtual; procedure SetAsWideString(const AValue: WideString); virtual;
procedure SetDataset(AValue : TDataset); virtual; procedure SetDataset(AValue : TDataset); virtual;
procedure SetDataType(AValue: TFieldType); virtual; procedure SetDataType(AValue: TFieldType);
procedure SetNewValue(const AValue: Variant); procedure SetNewValue(const AValue: Variant);
procedure SetSize(AValue: Integer); virtual; procedure SetSize(AValue: Integer); virtual;
procedure SetParentComponent(AParent: TComponent); override; procedure SetParentComponent(AParent: TComponent); override;
@ -856,14 +856,21 @@ type
{ TBlobField } { TBlobField }
TBlobStreamMode = (bmRead, bmWrite, bmReadWrite); TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
TBlobType = ftBlob..ftWideMemo; // This type is needed for compatibility. While it should contain only blob
// types, it actually does not.
// Instead of this, please use function IsBlobType
TBlobType = ftBlob..ftWideMemo deprecated
'Warning: Does not contain BLOB types. Please use BlobTypes.';
TBlobField = class(TField) TBlobField = class(TField)
private private
FBlobType : TBlobType;
FModified : Boolean; FModified : Boolean;
FTransliterate : Boolean; FTransliterate : Boolean;
Function GetBlobStream (Mode : TBlobStreamMode) : TStream; Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
// Wrapper that retrieves FDataType as a TBlobType
function GetBlobType: TBlobType;
// Wrapper that calls SetFieldtype
procedure SetBlobType(AValue: TBlobType);
protected protected
procedure FreeBuffers; override; procedure FreeBuffers; override;
function GetAsBytes: TBytes; override; function GetAsBytes: TBytes; override;
@ -875,7 +882,6 @@ type
procedure GetText(var TheText: string; ADisplayText: Boolean); override; procedure GetText(var TheText: string; ADisplayText: Boolean); override;
procedure SetAsBytes(const AValue: TBytes); override; procedure SetAsBytes(const AValue: TBytes); override;
procedure SetAsString(const AValue: string); override; procedure SetAsString(const AValue: string); override;
procedure SetDataType(AValue: TFieldType); override;
procedure SetText(const AValue: string); override; procedure SetText(const AValue: string); override;
procedure SetVarValue(const AValue: Variant); override; procedure SetVarValue(const AValue: Variant); override;
procedure SetAsWideString(const AValue: WideString); override; procedure SetAsWideString(const AValue: WideString); override;
@ -893,7 +899,7 @@ type
property Value: string read GetAsString write SetAsString; property Value: string read GetAsString write SetAsString;
property Transliterate: Boolean read FTransliterate write FTransliterate; property Transliterate: Boolean read FTransliterate write FTransliterate;
published published
property BlobType: TBlobType read FBlobType write FBlobType; property BlobType: TBlobType read GetBlobType write SetBlobType;
property Size default 0; property Size default 0;
end; end;
@ -2131,6 +2137,11 @@ const
dsEditModes = [dsEdit, dsInsert, dsSetKey]; dsEditModes = [dsEdit, dsInsert, dsSetKey];
dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
dsNewValue, dsInternalCalc]; dsNewValue, dsInternalCalc];
// Correct list of all field types that are BLOB types.
// Please use this instead of checking TBlobType which will give
// incorrect results
ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle,
ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob, ftWideMemo];
{ Auxiliary functions } { Auxiliary functions }

21
packages/fcl-db/src/base/fields.inc
View File

@ -2750,6 +2750,16 @@ begin
Result:=FDataset.CreateBlobStream(Self,Mode); Result:=FDataset.CreateBlobStream(Self,Mode);
end; end;
function TBlobField.GetBlobType: TBlobType;
begin
result:= TBlobType(DataType);
end;
procedure TBlobField.SetBlobType(AValue: TBlobType);
begin
SetFieldType(TFieldType(BlobType));
end;
procedure TBlobField.FreeBuffers; procedure TBlobField.FreeBuffers;
begin begin
@ -2894,14 +2904,6 @@ begin
end; end;
end; end;
procedure TBlobField.SetDataType(AValue: TFieldType);
begin
inherited SetDataType(AValue);
If AValue in [Low(TBlobType)..High(TBlobType)] then
FBlobType := AValue;
end;
procedure TBlobField.SetAsWideString(const AValue: WideString); procedure TBlobField.SetAsWideString(const AValue: WideString);
var var
Len : Integer; Len : Integer;
@ -3000,9 +3002,8 @@ begin
end; end;
procedure TBlobField.SetFieldType(AValue: TFieldType); procedure TBlobField.SetFieldType(AValue: TFieldType);
begin begin
If AValue in [Low(TBlobType)..High(TBlobType)] then if AValue in ftBlobTypes then
SetDatatype(AValue); SetDatatype(AValue);
end; end;