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

* Implemented the new-style blob-fields for Mysql

Browse Source 
* Cleaned up some old-style blob stuff

git-svn-id: trunk@6504 -
This commit is contained in:
joost 2007-02-15 21:34:09 +00:00
parent 9c9684b3a3
commit d33cd8d4c5
4 changed files with 29 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
fcl/db/bufdataset.pp
View File

@ -150,7 +150,6 @@ type
{abstracts, must be overidden by descendents}
function Fetch : boolean; virtual; abstract;
function LoadField(FieldDef : TFieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; virtual; abstract;
procedure LoadBlobIntoStream(Field: TField;AStream: TStream); virtual; abstract;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); virtual; abstract;
public

39
fcl/db/sqldb/mysql/mysqlconn.inc
View File

@ -5,7 +5,7 @@
interface
uses
Classes, SysUtils,sqldb,db,dynlibs,
Classes, SysUtils,bufdataset,sqldb,db,dynlibs,
{$IfDef mysql50}
mysql50dyn;
{$DEFINE TConnectionName:=TMySQL50Connection}
@ -70,7 +70,7 @@ Type
Procedure ConnectToServer; virtual;
Procedure SelectDatabase; virtual;
function MySQLDataType(AType: enum_field_types; ASize, ADecimals: Integer; var NewType: TFieldType; var NewSize: Integer): Boolean;
function MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; BlobStrings: TStringList ;Source, Dest: PChar): Boolean;
function MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
// SQLConnection methods
procedure DoInternalConnect; override;
procedure DoInternalDisconnect; override;
@ -90,6 +90,7 @@ Type
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
function Fetch(cursor : TSQLCursor) : boolean; override;
function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
function GetTransactionHandle(trans : TSQLHandle): pointer; override;
function Commit(trans : TSQLHandle) : boolean; override;
function RollBack(trans : TSQLHandle) : boolean; override;
@ -523,7 +524,6 @@ var
begin
// Writeln('LoadFieldsFromBuffer');
CreateBlob := False;
C:=Cursor as TCursorName;
if C.Row=nil then
begin
@ -535,7 +535,28 @@ begin
inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
field := mysql_fetch_field_direct(C.FRES, c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
Result := MySQLWriteData(field^.ftype, field^.length, FieldDef.DataType, c.FBlobStrings, Row^, Buffer);
Result := MySQLWriteData(field^.ftype, field^.length, FieldDef.DataType, Row^, Buffer, CreateBlob);
end;
procedure TConnectionName.LoadBlobIntoBuffer(FieldDef: TFieldDef;
ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
var
row : MYSQL_ROW;
C : TCursorName;
li : longint;
begin
C:=Cursor as TCursorName;
if C.Row=nil then
MySQLError(FMySQL,SErrFetchingData,Self);
Row:=C.Row;
inc(Row,c.MapDSRowToMSQLRow[FieldDef.FieldNo-1]);
li := strlen(pchar(row^));
ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer,li);
Move(pchar(row^)^, ABlobBuf^.BlobBuffer^.Buffer^, li);
ABlobBuf^.BlobBuffer^.Size := li;
end;
function InternalStrToFloat(S: string): Extended;
@ -650,7 +671,7 @@ begin
Result := Result + EncodeTime(EH, EN, ES, 0);;
end;
function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; BlobStrings: TStringList; Source, Dest: PChar): Boolean;
function TConnectionName.MySQLWriteData(AType: enum_field_types;ASize: Integer; AFieldType: TFieldType; Source, Dest: PChar; out CreateBlob : boolean): Boolean;
var
VI: Integer;
@ -661,6 +682,7 @@ var
begin
Result := False;
CreateBlob := False;
if Source = Nil then
exit;
Src:=StrPas(Source);
@ -748,12 +770,7 @@ begin
Dest^ := #0;
end;
FIELD_TYPE_BLOB:
begin
// The data is stored in the TStringlist BlobStrings and it's index is
// stored in the record-buffer.
vi := BlobStrings.Add(Src);
Move(VI, Dest^, SizeOf(Integer));
end
CreateBlob := True;
end;
Result := True;
end;

12
fcl/db/sqldb/odbc/odbcconn.pas
View File

@ -90,7 +90,6 @@ type
procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
function Fetch(cursor:TSQLCursor):boolean; override;
function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
procedure LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
procedure FreeFldBuffers(cursor:TSQLCursor); override;
// - UpdateIndexDefs
procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override;
@ -650,17 +649,6 @@ begin
// writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
end;
procedure TODBCConnection.LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction);
var
ODBCCursor: TODBCCursor;
BlobMemoryStream: TMemoryStream;
begin
Field.GetData(@BlobMemoryStream);
if BlobMemoryStream<>nil then
// AStream.LoadFromStream(BlobMemoryStream);
end;
procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
var
ODBCCursor:TODBCCursor;

46
fcl/db/sqldb/sqldb.pp
View File

@ -47,10 +47,6 @@ type
FPrepared : Boolean;
FInitFieldDef : Boolean;
FStatementType : TStatementType;
FBlobStrings : TStringList; // list of strings in which the blob-fields are stored
public
constructor Create; virtual;
destructor Destroy; override;
end;
@ -108,7 +104,6 @@ type
procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
procedure LoadBlobIntoStream(Field: TField;AStream: TStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); virtual;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
public
property Handle: Pointer read GetHandle;
@ -236,7 +231,6 @@ type
procedure SetServerFilterText(const Value: string); virtual;
Function GetDataSource : TDatasource; override;
Procedure SetDataSource(AValue : TDatasource);
procedure LoadBlobIntoStream(Field: TField;AStream: TStream); override;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
public
procedure Prepare; virtual;
@ -496,7 +490,7 @@ end;
procedure TSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
begin
cursor.FBlobStrings.Clear;
// empty
end;
function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
@ -505,24 +499,6 @@ begin
DatabaseError(SMetadataUnavailable);
end;
procedure TSQLConnection.LoadBlobIntoStream(Field: TField;AStream: TStream; cursor: TSQLCursor;ATransaction : TSQLTransaction);
var blobId : pinteger;
BlobBuf : TBufBlobField;
s : string;
begin
{ if not field.getData(@BlobBuf) then
exit;
blobId := @BlobBuf.BufBlobId;
s := cursor.FBlobStrings.Strings[blobid^];
AStream.WriteBuffer(s[1],length(s));
AStream.seek(0,soFromBeginning);}
end;
procedure TSQLConnection.CreateDB;
begin
@ -1323,12 +1299,6 @@ begin
SQL.Add((DataBase as tsqlconnection).GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern));
end;
procedure TSQLQuery.LoadBlobIntoStream(Field: TField;AStream: TStream);
begin
(DataBase as tsqlconnection).LoadBlobIntoStream(Field, AStream, FCursor,(Transaction as tsqltransaction));
end;
procedure TSQLQuery.LoadBlobIntoBuffer(FieldDef: TFieldDef;
ABlobBuf: PBufBlobField);
begin
@ -1450,18 +1420,4 @@ begin
until pBufPos^ = #0;
end;
{ TSQLCursor }
constructor TSQLCursor.Create;
begin
FBlobStrings := TStringList.Create;
inherited;
end;
destructor TSQLCursor.Destroy;
begin
FBlobStrings.Free;
inherited Destroy;
end;
end.