paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 19:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TBlobData is now TBytes as in Delphi (avoid code page conversions)

Browse Source 
git-svn-id: trunk@39331 -
This commit is contained in:
michael 2018-06-28 13:41:04 +00:00
parent 58b480e0b2
commit b859d486b4
5 changed files with 48 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1163,7 +1163,7 @@ type
{ TParam }
TBlobData = AnsiString; // Delphi defines it as alias to TBytes
TBlobData = TBytes;
TParamBinding = array of integer;
@ -1212,6 +1212,7 @@ type
Procedure SetAsBlob(const AValue: TBlobData); virtual;
Procedure SetAsBoolean(AValue: Boolean); virtual;
Procedure SetAsBytes(const AValue: TBytes); virtual;
Procedure SetAsBlobData(const AValue: TBlobData); virtual;
Procedure SetAsCurrency(const AValue: Currency); virtual;
Procedure SetAsDate(const AValue: TDateTime); virtual;
Procedure SetAsDateTime(const AValue: TDateTime); virtual;
@ -1247,7 +1248,7 @@ type
Procedure SetBlobData(Buffer: Pointer; ASize: Integer);
Procedure SetData(Buffer: Pointer);
Property AsBCD : Currency read GetAsCurrency write SetAsBCD;
Property AsBlob : TBlobData read GetAsAnsiString write SetAsBlob;
Property AsBlob : TBlobData read GetAsBytes write SetAsBlobData;
Property AsBoolean : Boolean read GetAsBoolean write SetAsBoolean;
Property AsBytes : TBytes read GetAsBytes write SetAsBytes;
Property AsCurrency : Currency read GetAsCurrency write SetAsCurrency;

8
packages/fcl-db/src/base/dsparams.inc
View File

@ -700,6 +700,12 @@ begin
Value:=AValue;
end;
procedure TParam.SetAsBlobData(const AValue: TBlobData);
begin
FDataType:=ftBlob;
Value:=AValue;
end;
Procedure TParam.SetAsCurrency(const AValue: Currency);
begin
FDataType:=ftCurrency;
@ -1150,7 +1156,7 @@ end;
Procedure TParam.SetBlobData(Buffer: Pointer; ASize: Integer);
Var
Temp : String;
Temp : TBlobData;
begin
SetLength(Temp,ASize);

8
packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
View File

@ -693,7 +693,7 @@ procedure TOracleConnection.SetParameters(cursor : TSQLCursor; ATransaction : TS
var i : integer;
year, month, day, hour, min, sec, msec : word;
s : string;
LobBuffer : string;
LobBuffer : TBytes;
LobLength : ub4;
begin
@ -736,15 +736,15 @@ begin
// create empty temporary LOB with zero length
if OciLobCreateTemporary(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer, OCI_DEFAULT, OCI_DEFAULT, OCI_TEMP_BLOB, False, OCI_DURATION_SESSION) = OCI_ERROR then
HandleError;
if (LobLength > 0) and (OciLobWrite(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer, @LobLength, 1, @LobBuffer[1], LobLength, OCI_ONE_PIECE, nil, nil, 0, SQLCS_IMPLICIT) = OCI_ERROR) then
if (LobLength > 0) and (OciLobWrite(TOracleTrans(ATransaction.Handle).FOciSvcCtx, FOciError, ParamBuffers[i].Buffer, @LobLength, 1, @LobBuffer[0], LobLength, OCI_ONE_PIECE, nil, nil, 0, SQLCS_IMPLICIT) = OCI_ERROR) then
HandleError;
end;
ftMemo : begin
LobBuffer := AsString;
LobBuffer := AsBytes;
LobLength := length(LobBuffer);
if LobLength > 65531 then LobLength := 65531;
PInteger(ParamBuffers[i].Buffer)^ := LobLength;
Move(LobBuffer[1], (ParamBuffers[i].Buffer+sizeof(integer))^, LobLength);
Move(LobBuffer[0], (ParamBuffers[i].Buffer+sizeof(integer))^, LobLength);
end;
else
DatabaseErrorFmt(SUnsupportedParameter,[DataType],self);

26
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -974,8 +974,10 @@ end;
procedure TPQConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams);
var ar : array of PAnsiChar;
handled : boolean;
l,i : integer;
s : RawByteString;
bd : TBlobData;
lengths,formats : array of integer;
ParamNames,
ParamValues : array of string;
@ -1004,6 +1006,7 @@ begin
setlength(formats,l);
for i := 0 to AParams.Count -1 do if not AParams[i].IsNull then
begin
handled:=False;
case AParams[i].DataType of
ftDateTime:
s := FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss.zzz', AParams[i].AsDateTime);
@ -1024,13 +1027,28 @@ begin
ftFmtBCD:
s := BCDToStr(AParams[i].AsFMTBCD, FSQLFormatSettings);
ftBlob, ftGraphic:
s := AParams[i].AsBlob;
begin
Handled:=true;
bd:= AParams[i].AsBlob;
l:=length(BD);
if l>0 then
begin
GetMem(ar[i],l+1);
ar[i][l]:=#0;
Move(BD[0],ar[i]^, L);
lengths[i]:=l;
end;
end
else
s := GetAsString(AParams[i]);
end; {case}
GetMem(ar[i],length(s)+1);
StrMove(PAnsiChar(ar[i]), PAnsiChar(s), Length(S)+1);
lengths[i]:=Length(s);
if not handled then
begin
l:=length(s);
GetMem(ar[i],l+1);
StrMove(PAnsiChar(ar[i]), PAnsiChar(s), L+1);
lengths[i]:=L;
end;
if (AParams[i].DataType in [ftBlob,ftMemo,ftGraphic,ftCurrency]) then
Formats[i]:=1
else

14
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -135,10 +135,20 @@ type
procedure TestStringsReplace;
end;
Function ToTBytes( S : AnsiString) : TBytes;
implementation
uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
Function ToTBytes( S : AnsiString) : TBytes;
begin
SetLength(Result,Length(S));
if length(Result)>0 then
Move(S[1],Result[0],Length(Result));
end;
Type HackedDataset = class(TDataset);
const
@ -1619,7 +1629,7 @@ begin
Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
ftDateTime: Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(ParamValues[i], DBConnector.FormatSettings);
ftBlob : Params.ParamByName('field1').AsBlob := testBlobValues[i];
ftBlob : Params.ParamByName('field1').AsBlob := ToTBytes(testBlobValues[i]);
ftBytes : if cross then
Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
else
@ -1690,7 +1700,7 @@ begin
begin
case asWhat of
0: Params.ParamByName('blobParam').AsMemo := TestBlobValues[i];
1: Params.ParamByName('blobParam').AsBlob := TestBlobValues[i];
1: Params.ParamByName('blobParam').AsBlob := ToTBytes(TestBlobValues[i]);
2: Params.ParamByName('blobParam').AsString := TestBlobValues[i];
end;
ExecSQL;