I have finished a first pass at creating a (not dbaware yet) database
component. This site doesn't allow upload but you can go to
http://groups.yahoo.com/group/TMySQLDatabase/ for updates. All you
need to do is add this file and the libmysql.pas to your project.
unit MySQLDatabase;
interface
uses {$IFDEF WIN32}
Windows,
{$ENDIF}
Classes, SysUtils,
libmysql;
const DEFAULT_MYSQL_PORT=3306;
type
{Misc types from Delphi vcl}
TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
ftWideString,
ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob,
ftOraClob,
ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd);
TMySQL_Version = (mvUnknown, mv3_23, mv4_0, mv4_1, mv5_0);
TSQLDataTypes = (
dtEmpty,
dtNull,
dtTinyInt,
dtInteger,
dtInt64,
dtFloat,
dtCurrency,
dtDateTime,
dtTimeStamp,
dtWideString,
dtBoolean,
dtString,
dtBlob,
dtOther,
dtUnknown
);
TMySQLDatabase = class (TComponent) //(TDataset)
private
fActive, fDLLIsLoaded :boolean;
fVersion, fVersionDesc :string;
procedure Close;
protected
MySQLHandle: MySQL;
PMySQLHandle: PMySQL;
fMySQLVersion: TMySQL_Version;
MySQLFunctions: TMySQLFunctions;
public
PortNumber: integer;
ServerName, UserName, Password, DatabaseName: string;
constructor Create;
destructor Destroy;
function LoadMySQLClient: boolean;
function Open: boolean;
property VersionDesc: string read fVersionDesc;
property Active: boolean read fActive;
published
end;
{TMySQLParam}
TBlobData = string;
TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
TParamTypes = set of TParamType;
TMySQLParam = class
private
fValueBuffer: string;
fParamNo: integer;
fTableName: string;
fParamName : string;
fParamLength: longint;
fEditMask: string;
procedure SetParamName(const Value: string);
procedure SetTableName(const Value: string);
procedure SetParamNo(const Value: integer);
procedure SetParamLength(const Value: longint);
function GetParamNo: integer;
procedure Clear;
function GetDataAsString: string;
procedure SetDataAsString(const Value: string);
//v.0.2b
function GetAsInteger: Longint;
procedure SetAsInteger(const Value: Longint);
protected
public
MySQLDB: TMySQLDatabase;
//v.0.2.b moved from private
datatype: TSQLDataTypes;
constructor Create;
destructor Destroy;
procedure SetData(Buffer: string);
property ParamNo: Integer read GetParamNo write SetParamNo;
property ParamName: string read FParamName write SetParamName;
property SourceTable: string read fTableName write SetTableName;
property ParamLength: longint read fParamLength write
SetParamLength;
property AsString: string read GetDataAsString write
SetDataAsString; //v.0.2b
property AsInteger: Longint read GetAsInteger write
SetAsInteger; //v.0.2b
end;
TMySQLParams = class(TObject)
private
fList: TList;
fDummyParam: TMySQLParam; // use this for scratch and dummy
variables
fMySQLDB: TMySQLDatabase;
function ParseSQL(SQL: String; DoCreate: Boolean): String;
protected
function GetCount: Integer;
function GetParam(Index: Integer): TMySQLParam;
procedure SetParam(Index: Integer; Value: TMySQLParam);
public
constructor Create(AMySQLDB: TMySQLDatabase);
destructor Destroy; override;
procedure Add(Param: TMySQLParam);
property Count: Integer read GetCount;
property Params[Index: Integer]: TMySQLParam read GetParam write
SetParam; default;
procedure Clear;
function FindParam(const ParamName: string): TMySQLParam;
function ParamByName(const ParamName: string): TMySQLParam;
function ParamByNumber(ParamNo: Integer): TMySQLParam;
end;
TMySQLField = class
private
fDisplayLabel: string;
fDisplayWidth: Integer;
fValueBuffer: Pointer;
fFieldNo: integer;
fTableName: string;
fMySQLDB: TMySQLDatabase;
fFieldName : string;
fFieldLength: longint;
fAlignment: TAlignment;
fDisplayFormat: string;
procedure SetFieldName(const Value: string);
procedure SetTableName(const Value: string);
procedure SetFieldNo(const Value: integer);
procedure SetFieldLength(const Value: longint);
function GetFieldNo: integer;
procedure Clear;
function GetDataAsString: string; virtual;
function GetDisplayLabel: string;
function IsDisplayLabelStored: Boolean;
function IsDisplayWidthStored: Boolean;
procedure SetDisplayLabel(const Value: string);
function GetDisplayWidth: Integer;
procedure SetDisplayWidth(const Value: Integer);
procedure SetAlignment(const Value: TAlignment);
procedure SetDisplayFormat(const Value: string);
protected
public
datatype: TSQLDataTypes;
maxlength, decimals: longint;
CantBeNull, PrimaryKey, UniqueKey, NonUniqueKey, UnSigned,
ZeroFill, IsBinary, AutoIncrement: boolean;
constructor Create; virtual;
destructor Destroy;
procedure SetData(Buffer: Pointer; NativeFormat: Boolean =
True); virtual;
property FieldNo: Integer read GetFieldNo write SetFieldNo;
property FieldName: string read FFieldName write SetFieldName;
property SourceTable: string read fTableName write SetTableName;
property FieldLength: longint read fFieldLength write
SetFieldLength;
property DisplayLabel: string read GetDisplayLabel write
SetDisplayLabel
stored IsDisplayLabelStored;
property DisplayWidth: Integer read GetDisplayWidth write
SetDisplayWidth
stored IsDisplayWidthStored;
function GetDefaultWidth: Integer; virtual;
property Alignment: TAlignment read fAlignment write
SetAlignment default taLeftJustify;
property DisplayFormat: string read fDisplayFormat write
SetDisplayFormat;
property AsString: string read GetDataAsString;
end;
TMySQLStringField = class(TMySQLField)
private
function GetDataAsString: string; override;
function GetAsBoolean: boolean;
procedure SetAsBoolean(Value: Boolean);
protected
public
property AsString: string read GetDataAsString;
property AsBoolean: boolean read GetAsBoolean write SetAsBoolean;
end;
TMySQLDateTimeField = class(TMySQLField)
private
fDateTime: TDateTime;
function GetDataAsString: string; override;
protected
public
procedure SetData(Buffer: Pointer; NativeFormat: Boolean =
True); override;
property AsString: string read GetDataAsString;
property DisplayFormat: string read fDisplayFormat write
SetDisplayFormat;
end;
TNumericField = class(TMySQLField)
//v.0.2
private
fEditFormat: string;
protected
procedure RangeError(Value, Min, Max: Extended);
procedure SetEditFormat(const Value: string);
public
published
property Alignment default taRightJustify;
property DisplayFormat: string read FDisplayFormat write
SetDisplayFormat;
property EditFormat: string read fEditFormat write SetEditFormat;
end;
TMySQLFloatField = class(TNumericField)
//v.0.2
private
fCurrency: Boolean;
fCheckRange: Boolean;
fPrecision: Integer;
fMinValue: Double;
fMaxValue: Double;
procedure SetCurrency(Value: Boolean);
procedure SetMaxValue(Value: Double);
procedure SetMinValue(Value: Double);
procedure SetPrecision(Value: Integer);
procedure UpdateCheckRange;
function GetAsFloat: Double;
procedure SetAsFloat(const Value: Double);
protected
function GetDataAsString: string; override;
public
constructor Create;
property AsString: string read GetDataAsString;
property Value: Double read GetAsFloat write SetAsFloat;
published
{ Lowercase to avoid name clash with C++ Currency type }
property currency: Boolean read FCurrency write SetCurrency
default False;
property MaxValue: Double read FMaxValue write SetMaxValue;
property MinValue: Double read FMinValue write SetMinValue;
property Precision: Integer read FPrecision write SetPrecision
default 15;
end;
TMySQLFields = class(TObject)
private
fList: TList;
fDummyField: TMySQLField; // use this for scratch and dummy
variables
fMySQLDB: TMySQLDatabase;
protected
function GetCount: Integer;
function GetField(Index: Integer): TMySQLField;
procedure SetField(Index: Integer; Value: TMySQLField);
public
constructor Create(AMySQLDB: TMySQLDatabase);
destructor Destroy; override;
procedure Add(Field: TMySQLField);
property Count: Integer read GetCount;
property Fields[Index: Integer]: TMySQLField read GetField write
SetField; default;
procedure Clear;
function FindField(const FieldName: string): TMySQLField;
function FieldByName(const FieldName: string): TMySQLField;
function FieldByNumber(FieldNo: Integer): TMySQLField;
end;
TMySQLQuery = class(TObject)
private
fAffectedRows: Int64;
fExecHandle: THandle;
fEOF: boolean;
fSQL, fSQLBinded: TStrings;
//v.0.2b
fFields: TMySQLFields;
fParams: TMySQLParams;
fMySQLDB: TMySQLDatabase;
fRecordCount: Integer;
function GetFieldCount: Integer;
function GetRecordCount: Integer;
function GetEOF: boolean;
procedure FillFieldInfo(Res: PMYSQL_RES);
function ParseSQL: boolean;
function BindParams: string;
procedure AppendToLog(LogText: string);
public
logfilename, SQLStatement: string;
OutputToLog, OutputServerResponse, ParsedSQLCmd: boolean;
//v.0.2
DataSource: TMySQLDatabase;
constructor Create(AMySQLDB: TMySQLDatabase);
destructor Destroy; override;
procedure First;
procedure Next;
function Open: boolean;
function ExecSQL: boolean;
function FieldByName(const FieldName: string): TMySQLField;
function FieldByNumber(FieldNo: Integer): TMySQLField;
function FindField(const FieldName: string): TMySQLField;
function ParamByName(const ParamName: string): TMySQLParam;
function ParamByNumber(ParamNo: Integer): TMySQLParam;
function FindParam(const ParamName: string): TMySQLParam;
property Fields: TMySQLFields read fFields;
property FieldCount: Integer read GetFieldCount;
property RecordCount: Integer read GetRecordCount;
property Eof: Boolean read GetEOF;
property SQL: TStrings read FSQL;
property AffectedRows: Int64 read fAffectedRows;
end;
-----------------------------------------------------
Home page: http://groups.yahoo.com/group/delphi-en/
To unsubscribe: [EMAIL PROTECTED]
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/delphi-en/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
