mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 08:09:28 +02:00
+ Fixes in TDBDataset etc. Changed MySQLDb to use database as well
This commit is contained in:
michael
parent
df1fa8669a
commit
2e6d07b89e
@ -66,6 +66,8 @@ constructor TDatabase.Create(AOwner: TComponent);
|
||||
|
||||
begin
|
||||
Inherited Create(AOwner);
|
||||
FParams:=TStringlist.Create;
|
||||
FDatasets:=TList.Create;
|
||||
end;
|
||||
|
||||
destructor TDatabase.Destroy;
|
||||
@ -74,6 +76,7 @@ begin
|
||||
Connected:=False;
|
||||
RemoveDatasets;
|
||||
FDatasets.Free;
|
||||
FParams.Free;
|
||||
Inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -173,9 +176,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TDBDataset.CheckDatabase;
|
||||
|
||||
begin
|
||||
If (FDatabase=Nil) then
|
||||
DatabaseError(SErrNoDatabaseAvailable,Self)
|
||||
end;
|
||||
|
||||
Destructor TDBDataset.Destroy;
|
||||
|
||||
begin
|
||||
Database:=Nil;
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2002-09-07 15:15:22 peter
|
||||
Revision 1.4 2003-08-16 16:42:21 michael
|
||||
+ Fixes in TDBDataset etc. Changed MySQLDb to use database as well
|
||||
|
||||
Revision 1.3 2002/09/07 15:15:22 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
}
|
||||
|
||||
10
fcl/db/db.pp
10
fcl/db/db.pp
@ -1145,7 +1145,10 @@ type
|
||||
Private
|
||||
FDatabase : TDatabase;
|
||||
Procedure SetDatabase (Value : TDatabase);
|
||||
Protected
|
||||
Procedure CheckDatabase;
|
||||
Public
|
||||
Destructor destroy; override;
|
||||
Property DataBase : TDatabase Read FDatabase Write SetDatabase;
|
||||
end;
|
||||
|
||||
@ -1161,7 +1164,7 @@ type
|
||||
FConnected : Boolean;
|
||||
FDataBaseName : String;
|
||||
FDataSets : TList;
|
||||
FDirectOry : String;
|
||||
FDirectory : String;
|
||||
FKeepConnection : Boolean;
|
||||
FLoginPrompt : Boolean;
|
||||
FOnLogin : TLoginEvent;
|
||||
@ -1459,7 +1462,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2003-05-15 15:15:15 michael
|
||||
Revision 1.10 2003-08-16 16:42:21 michael
|
||||
+ Fixes in TDBDataset etc. Changed MySQLDb to use database as well
|
||||
|
||||
Revision 1.9 2003/05/15 15:15:15 michael
|
||||
+ Database class in TDBDataset is public, not published
|
||||
|
||||
Revision 1.8 2003/05/08 21:52:41 michael
|
||||
|
||||
@ -43,9 +43,15 @@ Const
|
||||
SDatasetReadOnly = 'Dataset is read-only.';
|
||||
SNeedField = 'Field %s is required, but not supplied.';
|
||||
SNotInEditState = 'Operation not allowed, dataset "%s" is not in an edit state.';
|
||||
SErrNoDatabaseAvailable = 'Invalid operation: Not attached to database';
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2002-09-07 15:15:23 peter
|
||||
Revision 1.5 2003-08-16 16:42:21 michael
|
||||
+ Fixes in TDBDataset etc. Changed MySQLDb to use database as well
|
||||
|
||||
Revision 1.4 2002/09/07 15:15:23 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
}
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/04/01]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/06/26]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos macosx emx
|
||||
MAKEFILETARGETS=linux win32
|
||||
override PATH:=$(subst \,/,$(PATH))
|
||||
ifeq ($(findstring ;,$(PATH)),)
|
||||
inUnix=1
|
||||
@ -32,7 +32,7 @@ inOS2=1
|
||||
endif
|
||||
endif
|
||||
else
|
||||
ifneq ($(findstring cygwin,$(MACHTYPE)),)
|
||||
ifneq ($(findstring cygdrive,$(PATH)),)
|
||||
inCygWin=1
|
||||
endif
|
||||
endif
|
||||
@ -205,7 +205,7 @@ endif
|
||||
PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
|
||||
override PACKAGE_NAME=fcl
|
||||
override TARGET_UNITS+=mysqldb
|
||||
override TARGET_EXAMPLES+=testm
|
||||
override TARGET_EXAMPLES+=mtest
|
||||
override CLEAN_UNITS+=mysql mysql_com mysql_version
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
override COMPILER_OPTIONS+=-S2
|
||||
@ -519,6 +519,12 @@ ifeq ($(OS_TARGET),macos)
|
||||
EXEEXT=
|
||||
FPCMADE=fpcmade.mcc
|
||||
endif
|
||||
ifeq ($(OS_TARGET),darwin)
|
||||
EXEEXT=
|
||||
HASSHAREDLIB=1
|
||||
FPCMADE=fpcmade.darwin
|
||||
ZIPSUFFIX=darwin
|
||||
endif
|
||||
else
|
||||
ifeq ($(OS_TARGET),go32v1)
|
||||
PPUEXT=.pp1
|
||||
@ -877,76 +883,40 @@ TAREXT=.tar.gz
|
||||
endif
|
||||
override REQUIRE_PACKAGES=rtl mysql
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),go32v2)
|
||||
endif
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(CPU_TARGET),m68k)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
endif
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(CPU_TARGET),powerpc)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
endif
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(CPU_TARGET),sparc)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
endif
|
||||
ifeq ($(OS_TARGET),linux)
|
||||
ifeq ($(CPU_TARGET),x86_64)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
endif
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
ifeq ($(CPU_TARGET),i386)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),os2)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),freebsd)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),beos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),netbsd)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),amiga)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),atari)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),sunos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),qnx)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),netware)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),openbsd)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),wdosx)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),palmos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macosx)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifeq ($(OS_TARGET),emx)
|
||||
REQUIRE_PACKAGES_RTL=1
|
||||
REQUIRE_PACKAGES_MYSQL=1
|
||||
endif
|
||||
ifdef REQUIRE_PACKAGES_RTL
|
||||
PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/$(OS_TARGET)/Makefile.fpc,$(PACKAGESDIR))))))
|
||||
@ -1119,7 +1089,7 @@ override COMPILER:=$(FPC) $(FPCOPT)
|
||||
ifeq (,$(findstring -s ,$(COMPILER)))
|
||||
EXECPPAS=
|
||||
else
|
||||
ifeq ($(OS_SOURCE),$(OS_TARGET))
|
||||
ifeq ($(FULL_SOURCE),$(FULL_TARGET))
|
||||
EXECPPAS:=@$(PPAS)
|
||||
endif
|
||||
endif
|
||||
|
||||
@ -7,7 +7,7 @@ main=fcl
|
||||
|
||||
[target]
|
||||
units=mysqldb
|
||||
examples=testm
|
||||
examples=mtest
|
||||
|
||||
[clean]
|
||||
units=mysql mysql_com mysql_version
|
||||
|
||||
@ -13,6 +13,8 @@
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
program mtest;
|
||||
|
||||
uses db,sysutils,mysqldb;
|
||||
@ -74,6 +76,7 @@ begin
|
||||
end;
|
||||
|
||||
Var
|
||||
Dbase : TMySQLDatabase;
|
||||
Data : TMysqldataset;
|
||||
I,Count : longint;
|
||||
Bookie : TBookMarkStr;
|
||||
@ -112,16 +115,26 @@ begin
|
||||
Writeln ('Usage : mtest db user pwd sql');
|
||||
Halt(1);
|
||||
end;
|
||||
Log ('Creating Database');
|
||||
DBase:=TMySQLDatabase.Create(Nil);
|
||||
Try
|
||||
With DBase do
|
||||
begin
|
||||
Log('Setting database');
|
||||
DatabaseName:=Paramstr(1);
|
||||
Log('Setting user');
|
||||
UserName:=Paramstr(2);
|
||||
Log('Setting password');
|
||||
PassWord := Paramstr(3);
|
||||
Log('Connecting');
|
||||
Connected:=True;
|
||||
end;
|
||||
Log ('Creating Dataset');
|
||||
Data:=TMysqlDataset.Create(Nil);
|
||||
With Data do
|
||||
begin
|
||||
Log('Setting database');
|
||||
Database:=Paramstr(1);
|
||||
Log('Setting user');
|
||||
User:=Paramstr(2);
|
||||
Log('Setting password');
|
||||
PassWord := Paramstr(3);
|
||||
Try
|
||||
Log('Setting database property');
|
||||
Database:=DBase;
|
||||
Log('Setting SQL');
|
||||
SQL.text := Paramstr(4);
|
||||
Log('Opening Dataset');
|
||||
@ -176,13 +189,21 @@ begin
|
||||
Log('Closing Dataset');
|
||||
Close;
|
||||
Log('End.');
|
||||
Finally
|
||||
Free;
|
||||
end;
|
||||
Finally
|
||||
Writeln('Freeing database');
|
||||
DBase.free;
|
||||
end;
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2002-09-07 15:15:23 peter
|
||||
Revision 1.3 2003-08-16 16:42:21 michael
|
||||
+ Fixes in TDBDataset etc. Changed MySQLDb to use database as well
|
||||
|
||||
Revision 1.2 2002/09/07 15:15:23 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
}
|
||||
|
||||
@ -16,44 +16,60 @@ type
|
||||
|
||||
Pinteger = ^Integer;
|
||||
|
||||
TMySQLDataset = class(TDataSet)
|
||||
private
|
||||
FSQL: TStrings;
|
||||
FDatabase: string;
|
||||
FHost: string;
|
||||
FPort: Integer;
|
||||
FUser: string;
|
||||
FPassword: string;
|
||||
|
||||
FRecordSize: Integer;
|
||||
FBufferSize: Integer;
|
||||
|
||||
// MySQL data
|
||||
TMySQLDatabase = class(TDatabase)
|
||||
Private
|
||||
FMYSQL: PMYSQL;
|
||||
FMYSQLRES: PMYSQL_RES;
|
||||
|
||||
FCurrentRecord: Integer; { Record pointer }
|
||||
|
||||
FServerInfo: string;
|
||||
FHostInfo: string;
|
||||
function GetHostName: String;
|
||||
Function GetUserName : String;
|
||||
procedure SetHostName(const AValue: String);
|
||||
Procedure SetUserName (Value : String);
|
||||
Procedure SetPassword (Value : String);
|
||||
Function GetPassword : String;
|
||||
Function GetClientInfo : String;
|
||||
Protected
|
||||
Procedure ConnectToServer;
|
||||
Procedure SelectDatabase;
|
||||
Procedure DoInternalConnect; override;
|
||||
Procedure DoInternalDisConnect; override;
|
||||
procedure StartTransaction; override;
|
||||
procedure EndTransaction; override;
|
||||
function GetServerStatus: string;
|
||||
Public
|
||||
Procedure CreateDatabase;
|
||||
Procedure DropDatabase;
|
||||
Property ServerInfo : String Read FServerInfo;
|
||||
Property HostInfo : String Read FHostInfo;
|
||||
property ClientInfo: string read GetClientInfo;
|
||||
property ServerStatus : String read GetServerStatus;
|
||||
Published
|
||||
Property UserName : String Read GetUserName Write SetUserName;
|
||||
Property HostName : String Read GetHostName Write SetHostName;
|
||||
Property Password : String Read GetPassword Write SetPassword;
|
||||
end;
|
||||
|
||||
TMySQLDataset = class(TDBDataSet)
|
||||
private
|
||||
FSQL: TStrings;
|
||||
FRecordSize: Integer;
|
||||
FBufferSize: Integer;
|
||||
// MySQL data
|
||||
FMYSQLRES: PMYSQL_RES;
|
||||
FCurrentRecord: Integer; { Record pointer }
|
||||
FAffectedRows: QWord;
|
||||
FLastInsertID: Integer;
|
||||
FLoadingFieldDefs: Boolean;
|
||||
|
||||
procedure DoOpen;
|
||||
procedure DoClose;
|
||||
procedure DoQuery;
|
||||
procedure DoGetResult;
|
||||
|
||||
procedure CalculateSizes;
|
||||
procedure LoadBufferFromData(Buffer: PChar);
|
||||
function GetServerStatus: string;
|
||||
protected
|
||||
procedure SetDatabase(const Value: string);
|
||||
Function FMySQL : PMySQL;
|
||||
procedure SetSQL(const Value: TStrings);
|
||||
function GetClientInfo: string;
|
||||
|
||||
function InternalStrToFloat(S: string): Extended;
|
||||
function InternalStrToDate(S: string): TDateTime;
|
||||
function InternalStrToTime(S: string): TDateTime;
|
||||
@ -109,21 +125,11 @@ type
|
||||
// TDataset method
|
||||
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
|
||||
|
||||
property ServerInfo: string read FServerInfo;
|
||||
property ClientInfo: string read GetClientInfo;
|
||||
property HostInfo: string read FHostInfo;
|
||||
property AffectedRows: QWord read FAffectedRows;
|
||||
property LastInsertID: Integer read FLastInsertID;
|
||||
property ServerStatus: string read GetServerStatus;
|
||||
published
|
||||
property Active;
|
||||
property SQL: TStrings read FSQL write SetSQL;
|
||||
property Database: string read FDatabase write SetDatabase;
|
||||
property Host: string read FHost write FHost;
|
||||
property Port: Integer read FPort write FPort;
|
||||
property User: string read FUser write FUser;
|
||||
property Password: string read FPassword write FPassword;
|
||||
|
||||
property BeforeOpen;
|
||||
property AfterOpen;
|
||||
property BeforeClose;
|
||||
@ -144,33 +150,53 @@ type
|
||||
property OnEditError;
|
||||
end;
|
||||
|
||||
EMySQLError = Class(Exception);
|
||||
|
||||
implementation
|
||||
|
||||
Resourcestring
|
||||
SErrServerConnectFailed = 'Server connect failed.';
|
||||
SErrDatabaseSelectFailed = 'failed to select database: %s';
|
||||
SErrDatabaseCreate = 'Failed to create database: %s';
|
||||
SErrDatabaseDrop = 'Failed to drop database: %s';
|
||||
SErrNoData = 'No data for record';
|
||||
SErrExecuting = 'Error executing query: %s';
|
||||
SErrFetchingdata = 'Error fetching row data: %s';
|
||||
SErrGettingResult = 'Error getting result set: %s';
|
||||
|
||||
Procedure MySQlError(R : PMySQL;Msg: String;Comp : TComponent);
|
||||
|
||||
Var
|
||||
MySQLMsg : String;
|
||||
|
||||
begin
|
||||
If (R<>Nil) then
|
||||
begin
|
||||
MySQLMsg:=Strpas(mysql_error(R));
|
||||
DatabaseErrorFmt(Msg,[MySQLMsg],Comp);
|
||||
end
|
||||
else
|
||||
DatabaseError(Msg,Comp);
|
||||
end;
|
||||
|
||||
{ TMySQLDataset }
|
||||
|
||||
constructor TMySQLDataset.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FSQL := TStringList.Create;
|
||||
FHost := '';
|
||||
FPort := 0;
|
||||
FUser := '';
|
||||
FPassword := '';
|
||||
|
||||
FBufferSize := 0;
|
||||
FRecordSize := 0;
|
||||
FCurrentRecord := -1;
|
||||
FLoadingFieldDefs := False;
|
||||
|
||||
FAffectedRows := 0;
|
||||
FLastInsertID := -1;
|
||||
|
||||
FMYSQL := nil;
|
||||
FMYSQLRES := nil;
|
||||
end;
|
||||
|
||||
destructor TMySQLDataset.Destroy;
|
||||
begin
|
||||
Close;
|
||||
FSQL.Free;
|
||||
inherited destroy;
|
||||
end;
|
||||
@ -182,6 +208,7 @@ end;
|
||||
|
||||
procedure TMySQLDataset.FreeRecordBuffer(var Buffer: PChar);
|
||||
begin
|
||||
If (@Buffer<>nil) then
|
||||
FreeMem(Buffer);
|
||||
end;
|
||||
|
||||
@ -192,36 +219,34 @@ end;
|
||||
|
||||
function TMySQLDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
|
||||
begin
|
||||
Result := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag;
|
||||
Result:=PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag;
|
||||
end;
|
||||
|
||||
function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
|
||||
|
||||
var
|
||||
I, FC: Integer;
|
||||
fld: TMYSQL_FIELD;
|
||||
CurBuf: PChar;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
CurBuf := ActiveBuffer;
|
||||
|
||||
FC := mysql_num_fields(FMYSQLRES);
|
||||
for I := 0 to FC-1 do
|
||||
begin
|
||||
fld := mysql_fetch_field_direct(FMYSQLRES, I);
|
||||
|
||||
//if Field.FieldNo = I+1 then
|
||||
if Field.FieldName = fld.name then
|
||||
begin
|
||||
Move(CurBuf^, PChar(Buffer)^, MySQLDataSize(fld.ftype, fld.length));
|
||||
|
||||
if Field.DataType in [ftString{, ftWideString}] then
|
||||
begin
|
||||
Result := PChar(buffer)^ <> #0;
|
||||
if Result then
|
||||
// Terminate string (necessary for enum fields)
|
||||
PChar(buffer)[fld.length] := #0;
|
||||
end else
|
||||
end
|
||||
else
|
||||
Result := True;
|
||||
break;
|
||||
end
|
||||
@ -233,10 +258,10 @@ end;
|
||||
function TMySQLDataset.GetRecNo: Integer;
|
||||
begin
|
||||
UpdateCursorPos;
|
||||
if (FCurrentRecord = -1) and (RecordCount > 0) then
|
||||
Result := 1
|
||||
if (FCurrentRecord=-1) and (RecordCount > 0) then
|
||||
Result:=1
|
||||
else
|
||||
Result := FCurrentRecord + 1;
|
||||
Result:=FCurrentRecord+1;
|
||||
end;
|
||||
|
||||
function TMySQLDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
|
||||
@ -257,16 +282,15 @@ begin
|
||||
else
|
||||
Dec(FCurrentRecord);
|
||||
gmCurrent:
|
||||
if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
|
||||
if (FCurrentRecord<0) or (FCurrentRecord>=RecordCount) then
|
||||
Result := grError;
|
||||
gmNext:
|
||||
if FCurrentRecord >= RecordCount-1 then
|
||||
if FCurrentRecord>=RecordCount-1 then
|
||||
Result := grEOF
|
||||
else
|
||||
Inc(FCurrentRecord);
|
||||
end;
|
||||
|
||||
if Result = grOK then
|
||||
if (Result=grOK) then
|
||||
begin
|
||||
LoadBufferFromData(Buffer);
|
||||
with PMySQLDatasetBookmark(Buffer + FRecordSize)^ do
|
||||
@ -276,19 +300,19 @@ begin
|
||||
end;
|
||||
end
|
||||
else
|
||||
if (Result = grError) and (DoCheck) then
|
||||
DatabaseError('No record');
|
||||
if (Result=grError) and (DoCheck) then
|
||||
DatabaseError(SerrNoData,Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMySQLDataset.GetRecordCount: Integer;
|
||||
begin
|
||||
Result := mysql_num_rows(FMYSQLRES);
|
||||
Result:=mysql_num_rows(FMYSQLRES);
|
||||
end;
|
||||
|
||||
function TMySQLDataset.GetRecordSize: Word;
|
||||
begin
|
||||
Result := FRecordSize;
|
||||
Result:=FRecordSize;
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
|
||||
@ -299,9 +323,7 @@ end;
|
||||
procedure TMySQLDataset.InternalClose;
|
||||
begin
|
||||
FCurrentRecord := -1;
|
||||
|
||||
DoClose;
|
||||
|
||||
if DefaultFields then
|
||||
DestroyFields;
|
||||
end;
|
||||
@ -323,25 +345,25 @@ end;
|
||||
|
||||
procedure TMySQLDataset.InternalHandleException;
|
||||
begin
|
||||
// Application.HandleException(self);
|
||||
// Application.HandleException(self);
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.InternalInitFieldDefs;
|
||||
|
||||
var
|
||||
I, FC: Integer;
|
||||
field: TMYSQL_FIELD;
|
||||
DFT: TFieldType;
|
||||
DFS: Integer;
|
||||
WasClosed: Boolean;
|
||||
|
||||
begin
|
||||
if FLoadingFieldDefs then Exit;
|
||||
|
||||
FLoadingFieldDefs := True;
|
||||
try
|
||||
WasClosed := not IsCursorOpen;
|
||||
if WasClosed then
|
||||
begin
|
||||
DoOpen;
|
||||
DoQuery;
|
||||
DoGetResult;
|
||||
end;
|
||||
@ -356,10 +378,8 @@ begin
|
||||
end;
|
||||
finally
|
||||
if WasClosed then
|
||||
begin
|
||||
DoClose;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
FLoadingFieldDefs := False;
|
||||
end;
|
||||
@ -377,30 +397,21 @@ end;
|
||||
|
||||
procedure TMySQLDataset.InternalOpen;
|
||||
begin
|
||||
FMYSQL := nil;
|
||||
CheckDatabase;
|
||||
FMYSQLRES := nil;
|
||||
try
|
||||
DoOpen;
|
||||
DoQuery;
|
||||
DoGetResult;
|
||||
|
||||
FCurrentRecord := -1;
|
||||
|
||||
InternalInitFieldDefs;
|
||||
|
||||
if DefaultFields then
|
||||
CreateFields;
|
||||
CalculateSizes;
|
||||
|
||||
BindFields(True);
|
||||
except
|
||||
DoClose;
|
||||
FMYSQL := nil;
|
||||
FMYSQLRES := nil;
|
||||
raise;
|
||||
end;
|
||||
FServerInfo := mysql_get_server_info(FMYSQL);
|
||||
FHostInfo := mysql_get_host_info(FMYSQL);
|
||||
BookMarkSize:=SizeOf(Longint);
|
||||
end;
|
||||
|
||||
@ -411,7 +422,7 @@ end;
|
||||
|
||||
function TMySQLDataset.IsCursorOpen: Boolean;
|
||||
begin
|
||||
Result := FMYSQL <> nil;
|
||||
Result:=(FMYSQLRES<>nil);
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
|
||||
@ -447,34 +458,19 @@ end;
|
||||
|
||||
procedure TMySQLDataset.ExecSQL;
|
||||
begin
|
||||
try
|
||||
DoOpen;
|
||||
try
|
||||
DoQuery;
|
||||
finally
|
||||
DoClose;
|
||||
end;
|
||||
finally
|
||||
FMYSQLRES := nil;
|
||||
FMYSQL := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.SetDatabase(const Value: string);
|
||||
begin
|
||||
FDatabase := Value;
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.InternalPost;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TMySQLDataset.GetClientInfo: string;
|
||||
begin
|
||||
Result := mysql_get_client_info;
|
||||
end;
|
||||
|
||||
function TMySQLDataset.MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
|
||||
var NewType: TFieldType; var NewSize: Integer): Boolean;
|
||||
begin
|
||||
@ -532,17 +528,17 @@ begin
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.LoadBufferFromData(Buffer: PChar);
|
||||
|
||||
var
|
||||
I, FC, CT: Integer;
|
||||
field: TMYSQL_FIELD;
|
||||
row: TMYSQL_ROW;
|
||||
|
||||
begin
|
||||
mysql_data_seek(FMYSQLRES, FCurrentRecord);
|
||||
|
||||
row := mysql_fetch_row(FMYSQLRES);
|
||||
if row = nil then
|
||||
DatabaseError(mysql_error(FMYSQL));
|
||||
|
||||
MySQLError(FMySQL,SErrFetchingData,Self);
|
||||
FC := mysql_num_fields(FMYSQLRES);
|
||||
for I := 0 to FC-1 do
|
||||
begin
|
||||
@ -581,10 +577,12 @@ end;
|
||||
|
||||
function TMySQLDataset.MySQLWriteFieldData(AType: enum_field_types;
|
||||
ASize: Integer; Source, Dest: PChar): Integer;
|
||||
|
||||
var
|
||||
VI: Integer;
|
||||
VF: Double;
|
||||
VD: TDateTime;
|
||||
|
||||
begin
|
||||
Result := 0;
|
||||
case AType of
|
||||
@ -655,12 +653,13 @@ begin
|
||||
end;
|
||||
|
||||
function TMySQLDataset.InternalStrToFloat(S: string): Extended;
|
||||
|
||||
var
|
||||
I: Integer;
|
||||
Tmp: string;
|
||||
|
||||
begin
|
||||
Tmp := '';
|
||||
|
||||
for I := 1 to Length(S) do
|
||||
begin
|
||||
if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
|
||||
@ -672,42 +671,45 @@ begin
|
||||
end;
|
||||
|
||||
function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
|
||||
|
||||
var
|
||||
EY, EM, ED: Word;
|
||||
|
||||
begin
|
||||
EY := StrToInt(Copy(S, 1, 4));
|
||||
EM := StrToInt(Copy(S, 6, 2));
|
||||
ED := StrToInt(Copy(S, 9, 2));
|
||||
EY := StrToInt(Copy(S,1,4));
|
||||
EM := StrToInt(Copy(S,6,2));
|
||||
ED := StrToInt(Copy(S,9,2));
|
||||
if (EY = 0) or (EM = 0) or (ED = 0) then
|
||||
Result := 0
|
||||
Result:=0
|
||||
else
|
||||
Result := EncodeDate(EY, EM, ED);
|
||||
Result:=EncodeDate(EY, EM, ED);
|
||||
end;
|
||||
|
||||
function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
|
||||
|
||||
var
|
||||
EY, EM, ED: Word;
|
||||
EH, EN, ES: Word;
|
||||
|
||||
begin
|
||||
EY := StrToInt(Copy(S, 1, 4));
|
||||
EM := StrToInt(Copy(S, 6, 2));
|
||||
ED := StrToInt(Copy(S, 9, 2));
|
||||
|
||||
EH := StrToInt(Copy(S, 11, 2));
|
||||
EN := StrToInt(Copy(S, 14, 2));
|
||||
ES := StrToInt(Copy(S, 17, 2));
|
||||
|
||||
if (EY = 0) or (EM = 0) or (ED = 0) then
|
||||
Result := 0
|
||||
else
|
||||
Result := EncodeDate(EY, EM, ED);
|
||||
|
||||
Result := Result + EncodeTime(EH, EN, ES, 0);
|
||||
end;
|
||||
|
||||
function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
|
||||
|
||||
var
|
||||
EH, EM, ES: Word;
|
||||
|
||||
begin
|
||||
EH := StrToInt(Copy(S, 1, 2));
|
||||
EM := StrToInt(Copy(S, 4, 2));
|
||||
@ -716,23 +718,22 @@ begin
|
||||
end;
|
||||
|
||||
function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
|
||||
|
||||
var
|
||||
EY, EM, ED: Word;
|
||||
EH, EN, ES: Word;
|
||||
|
||||
begin
|
||||
EY := StrToInt(Copy(S, 1, 4));
|
||||
EM := StrToInt(Copy(S, 5, 2));
|
||||
ED := StrToInt(Copy(S, 7, 2));
|
||||
|
||||
EH := StrToInt(Copy(S, 9, 2));
|
||||
EN := StrToInt(Copy(S, 11, 2));
|
||||
ES := StrToInt(Copy(S, 13, 2));
|
||||
|
||||
if (EY = 0) or (EM = 0) or (ED = 0) then
|
||||
Result := 0
|
||||
else
|
||||
Result := EncodeDate(EY, EM, ED);
|
||||
|
||||
Result := Result + EncodeTime(EH, EN, ES, 0);;
|
||||
end;
|
||||
|
||||
@ -741,37 +742,23 @@ begin
|
||||
try
|
||||
if FMYSQLRES <> nil then
|
||||
mysql_free_result(FMYSQLRES);
|
||||
if FMYSQL <> nil then
|
||||
mysql_close(FMYSQL);
|
||||
finally
|
||||
FMYSQLRES := nil;
|
||||
FMYSQL := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.DoOpen;
|
||||
begin
|
||||
FMYSQL := mysql_connect(nil, PChar(FHost), PChar(FUser), PChar(FPassword));
|
||||
if FMYSQL = nil then
|
||||
DatabaseError('Error connecting to MySQL server');
|
||||
|
||||
if FDatabase <> '' then
|
||||
if mysql_select_db(FMYSQL, PChar(FDatabase)) <> 0 then
|
||||
DatabaseError(mysql_error(FMYSQL));
|
||||
end;
|
||||
|
||||
procedure TMySQLDataset.DoQuery;
|
||||
var
|
||||
Query: PChar;
|
||||
|
||||
begin
|
||||
Query := FSQL.GetText;
|
||||
try
|
||||
if mysql_query(FMYSQL, Query) <> 0 then
|
||||
DatabaseError(mysql_error(FMYSQL));
|
||||
if mysql_query(FMySQL,Query) <> 0 then
|
||||
MySQLError(FMYSQL,SErrExecuting,Self);
|
||||
finally
|
||||
StrDispose(Query);
|
||||
end;
|
||||
|
||||
FAffectedRows := mysql_affected_rows(FMYSQL);
|
||||
FLastInsertID := mysql_insert_id(FMYSQL);
|
||||
end;
|
||||
@ -784,15 +771,142 @@ end;
|
||||
procedure TMySQLDataset.DoGetResult;
|
||||
begin
|
||||
FMYSQLRES := mysql_store_result(FMYSQL);
|
||||
if FMYSQLRES = nil then
|
||||
DatabaseError(mysql_error(FMYSQL));
|
||||
|
||||
if (FMYSQLRES=nil) then
|
||||
MySQLError(FMYSQL,SErrGettingResult,Self);
|
||||
FAffectedRows := mysql_affected_rows(FMYSQL);
|
||||
end;
|
||||
|
||||
function TMySQLDataset.GetServerStatus: string;
|
||||
function TMySQLDataset.FMySQL: PMySQL;
|
||||
begin
|
||||
CheckActive;
|
||||
Result:=(Database as TMySQLDatabase).FMySQL;
|
||||
end;
|
||||
|
||||
{ TMySQLDatabase }
|
||||
|
||||
function TMySQLDatabase.GetUserName: String;
|
||||
begin
|
||||
result:=Params.values['UserName'];
|
||||
end;
|
||||
|
||||
function TMySQLDatabase.GetHostName: String;
|
||||
begin
|
||||
Result:=Params.Values['HostName'];
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.SetHostName(const AValue: String);
|
||||
begin
|
||||
Params.Values['HostName']:=AValue;
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.SetUserName(Value: String);
|
||||
begin
|
||||
Params.Values['UserName']:=Value;
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.SetPassword(Value: String);
|
||||
begin
|
||||
Params.Values['Password']:=Value;
|
||||
end;
|
||||
|
||||
function TMySQLDatabase.GetPassword: String;
|
||||
begin
|
||||
Result:=Params.Values['Password'];
|
||||
end;
|
||||
|
||||
function TMySQLDatabase.GetClientInfo: String;
|
||||
begin
|
||||
Result:=strpas(mysql_get_client_info);
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.ConnectToServer;
|
||||
Var
|
||||
H,U,P : String;
|
||||
|
||||
begin
|
||||
H:=HostName;
|
||||
U:=UserName;
|
||||
P:=Password;
|
||||
FMySQL:=mysql_connect(FMySQL,PChar(H),PChar(U),Pchar(P));
|
||||
If (FMySQL=Nil) then
|
||||
MySQlError(Nil,SErrServerConnectFailed,Self);
|
||||
FServerInfo := strpas(mysql_get_server_info(FMYSQL));
|
||||
FHostInfo := strpas(mysql_get_host_info(FMYSQL));
|
||||
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.SelectDatabase;
|
||||
begin
|
||||
if mysql_select_db(FMySQL,pchar(DatabaseName))<>0 then
|
||||
MySQLError(FMySQL,SErrDatabaseSelectFailed,Self);
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.DoInternalConnect;
|
||||
begin
|
||||
if (FMySQL<>nil) then
|
||||
DoInternalDisconnect;
|
||||
ConnectToServer;
|
||||
SelectDatabase;
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.DoInternalDisConnect;
|
||||
begin
|
||||
mysql_close(FMySQL);
|
||||
FMySQL:=Nil;
|
||||
FServerInfo:='';
|
||||
FHostInfo:='';
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.StartTransaction;
|
||||
begin
|
||||
// Nothing yet
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.EndTransaction;
|
||||
begin
|
||||
// Nothing yet
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.CreateDatabase;
|
||||
|
||||
Var
|
||||
Disconnect : Boolean;
|
||||
|
||||
begin
|
||||
Disconnect:=(FMySQL=Nil);
|
||||
if Disconnect then
|
||||
ConnectToServer;
|
||||
try
|
||||
if mysql_create_db(FMySQL,Pchar(DatabaseName))<>0 then
|
||||
MySQLError(FMySQL,SErrDatabaseCreate,Self);
|
||||
Finally
|
||||
If Disconnect then
|
||||
DoInternalDisconnect;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMySQLDatabase.DropDatabase;
|
||||
|
||||
Var
|
||||
Disconnect : Boolean;
|
||||
|
||||
begin
|
||||
Disconnect:=(FMySQL=Nil);
|
||||
if Disconnect then
|
||||
ConnectToServer;
|
||||
If (FMySQL=Nil) then
|
||||
ConnectToServer;
|
||||
try
|
||||
if mysql_drop_db(FMySQL,Pchar(DatabaseName))<>0 then
|
||||
MySQLError(FMySQL,SErrDatabaseDrop,Self);
|
||||
Finally
|
||||
If Disconnect then
|
||||
DoInternalDisconnect;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMySQLDatabase.GetServerStatus: string;
|
||||
begin
|
||||
CheckConnected;
|
||||
Result := mysql_stat(FMYSQL);
|
||||
end;
|
||||
|
||||
@ -801,7 +915,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2002-11-07 14:27:59 sg
|
||||
Revision 1.4 2003-08-16 16:42:21 michael
|
||||
+ Fixes in TDBDataset etc. Changed MySQLDb to use database as well
|
||||
|
||||
Revision 1.3 2002/11/07 14:27:59 sg
|
||||
* AffectedRows now is a QWord (to match recent MySQL versions)
|
||||
* Result strings for enums etc. are now correctly terminated
|
||||
* Fixed a memory leak in DoQuery: The query string didn't get released
|
||||
|
||||
Loading…
Reference in New Issue
Block a user