fpc/packages/fcl-db/examples/tsamytable.pp
2018-08-15 10:54:36 +00:00

601 lines
18 KiB
ObjectPascal

Unit tsamytable;
{$mode objfpc}{$H+}
Interface
Uses Classes, SysUtils, db, fieldmap, sqldb;
Const
IID_MyTypeSafeAccess = '{1258E169-56C8-4846-8BAF-928C06B89487}';
// Field names
FLD_MyTypeSafeAccess_MyString = 'MyString';
FLD_MyTypeSafeAccess_MyFixedChar = 'MyFixedChar';
FLD_MyTypeSafeAccess_MyWideString = 'MyWideString';
FLD_MyTypeSafeAccess_MyDateTime = 'MyDateTime';
FLD_MyTypeSafeAccess_MyUnicodeString = 'MyUnicodeString';
FLD_MyTypeSafeAccess_MyUTF8String = 'MyUTF8String';
FLD_MyTypeSafeAccess_MyFixedWideString = 'MyFixedWideString';
FLD_MyTypeSafeAccess_MyInteger = 'MyInteger';
FLD_MyTypeSafeAccess_MyByteInteger = 'MyByteInteger';
FLD_MyTypeSafeAccess_MySmallintInteger = 'MySmallintInteger';
FLD_MyTypeSafeAccess_MyShortIntInteger = 'MyShortIntInteger';
FLD_MyTypeSafeAccess_MyCardinalInteger = 'MyCardinalInteger';
FLD_MyTypeSafeAccess_MyFloat = 'MyFloat';
FLD_MyTypeSafeAccess_MyWord = 'MyWord';
FLD_MyTypeSafeAccess_MyBoolean = 'MyBoolean';
FLD_MyTypeSafeAccess_MyInt64 = 'MyInt64';
FLD_MyTypeSafeAccess_MyQWordLargeInt = 'MyQWordLargeInt';
FLD_MyTypeSafeAccess_MyBlob = 'MyBlob';
SQLMyTypeSafeAccess =
'SELECT' + sLineBreak +
'MyString' + sLineBreak +
', MyFixedChar' + sLineBreak +
', MyWideString' + sLineBreak +
', MyDateTime' + sLineBreak +
', MyUnicodeString' + sLineBreak +
', MyUTF8String' + sLineBreak +
', MyFixedWideString' + sLineBreak +
', MyInteger' + sLineBreak +
', MyByteInteger' + sLineBreak +
', MySmallintInteger' + sLineBreak +
', MyShortIntInteger' + sLineBreak +
', MyCardinalInteger' + sLineBreak +
', MyFloat' + sLineBreak +
', MyWord' + sLineBreak +
', MyBoolean' + sLineBreak +
', MyInt64' + sLineBreak +
', MyQWordLargeInt' + sLineBreak +
', MyBlob' + sLineBreak +
'FROM MyTable';
Type
{$INLINE ON}
{ IMyTypeSafeAccess }
IMyTypeSafeAccess = Interface(ITypeSafeDatasetAccess) [IID_MyTypeSafeAccess]
Function GetMyString : AnsiString;
Procedure SetMyString (aValue : AnsiString);
Function GetMyFixedChar : AnsiString;
Procedure SetMyFixedChar (aValue : AnsiString);
Function GetMyWideString : WideString;
Procedure SetMyWideString (aValue : WideString);
Function GetMyDateTime : TDateTime;
Procedure SetMyDateTime (aValue : TDateTime);
Function GetMyUnicodeString : UnicodeString;
Procedure SetMyUnicodeString (aValue : UnicodeString);
Function GetMyUTF8String : Utf8String;
Procedure SetMyUTF8String (aValue : Utf8String);
Function GetMyFixedWideString : WideString;
Procedure SetMyFixedWideString (aValue : WideString);
Function GetMyInteger : Longint;
Procedure SetMyInteger (aValue : Longint);
Function GetMyByteInteger : Byte;
Procedure SetMyByteInteger (aValue : Byte);
Function GetMySmallintInteger : SmallInt;
Procedure SetMySmallintInteger (aValue : SmallInt);
Function GetMyShortIntInteger : ShortInt;
Procedure SetMyShortIntInteger (aValue : ShortInt);
Function GetMyCardinalInteger : Cardinal;
Procedure SetMyCardinalInteger (aValue : Cardinal);
Function GetMyFloat : Double;
Procedure SetMyFloat (aValue : Double);
Function GetMyWord : Word;
Procedure SetMyWord (aValue : Word);
Function GetMyBoolean : Boolean;
Procedure SetMyBoolean (aValue : Boolean);
Function GetMyInt64 : Int64;
Procedure SetMyInt64 (aValue : Int64);
Function GetMyQWordLargeInt : QWord;
Procedure SetMyQWordLargeInt (aValue : QWord);
Function GetMyBlob : TStream;
Property MyString : AnsiString Read GetMyString Write SetMyString;
Property MyFixedChar : AnsiString Read GetMyFixedChar Write SetMyFixedChar;
Property MyWideString : WideString Read GetMyWideString Write SetMyWideString;
Property MyDateTime : TDateTime Read GetMyDateTime Write SetMyDateTime;
Property MyUnicodeString : UnicodeString Read GetMyUnicodeString Write SetMyUnicodeString;
Property MyUTF8String : Utf8String Read GetMyUTF8String Write SetMyUTF8String;
Property MyFixedWideString : WideString Read GetMyFixedWideString Write SetMyFixedWideString;
Property MyInteger : Longint Read GetMyInteger Write SetMyInteger;
Property MyByteInteger : Byte Read GetMyByteInteger Write SetMyByteInteger;
Property MySmallintInteger : SmallInt Read GetMySmallintInteger Write SetMySmallintInteger;
Property MyShortIntInteger : ShortInt Read GetMyShortIntInteger Write SetMyShortIntInteger;
Property MyCardinalInteger : Cardinal Read GetMyCardinalInteger Write SetMyCardinalInteger;
Property MyFloat : Double Read GetMyFloat Write SetMyFloat;
Property MyWord : Word Read GetMyWord Write SetMyWord;
Property MyBoolean : Boolean Read GetMyBoolean Write SetMyBoolean;
Property MyInt64 : Int64 Read GetMyInt64 Write SetMyInt64;
Property MyQWordLargeInt : QWord Read GetMyQWordLargeInt Write SetMyQWordLargeInt;
Property MyBlob : TStream Read GetMyBlob;
end;
{ TMyTypeSafeAccess }
TMyTypeSafeAccess = Class(TTypeSafeDatasetAccess,IMyTypeSafeAccess)
Private
FBlobMyBlob : TBlobProxyStream;
Procedure DoMyBlobChanged(Sender : TObject);
Private
Function GetMyString : AnsiString;
Procedure SetMyString (AValue : AnsiString);
Function GetMyFixedChar : AnsiString;
Procedure SetMyFixedChar (AValue : AnsiString);
Function GetMyWideString : WideString;
Procedure SetMyWideString (AValue : WideString);
Function GetMyDateTime : TDateTime;
Procedure SetMyDateTime (AValue : TDateTime);
Function GetMyUnicodeString : UnicodeString;
Procedure SetMyUnicodeString (AValue : UnicodeString);
Function GetMyUTF8String : Utf8String;
Procedure SetMyUTF8String (AValue : Utf8String);
Function GetMyFixedWideString : WideString;
Procedure SetMyFixedWideString (AValue : WideString);
Function GetMyInteger : Longint;
Procedure SetMyInteger (AValue : Longint);
Function GetMyByteInteger : Byte;
Procedure SetMyByteInteger (AValue : Byte);
Function GetMySmallintInteger : SmallInt;
Procedure SetMySmallintInteger (AValue : SmallInt);
Function GetMyShortIntInteger : ShortInt;
Procedure SetMyShortIntInteger (AValue : ShortInt);
Function GetMyCardinalInteger : Cardinal;
Procedure SetMyCardinalInteger (AValue : Cardinal);
Function GetMyFloat : Double;
Procedure SetMyFloat (AValue : Double);
Function GetMyWord : Word;
Procedure SetMyWord (AValue : Word);
Function GetMyBoolean : Boolean;
Procedure SetMyBoolean (AValue : Boolean);
Function GetMyInt64 : Int64;
Procedure SetMyInt64 (AValue : Int64);
Function GetMyQWordLargeInt : QWord;
Procedure SetMyQWordLargeInt (AValue : QWord);
Function GetMyBlob : TStream;
Protected
Class Function FieldMapClass : TFieldMapClass; override;
Public
Destructor Destroy; Override;
Procedure ApplyUpdates; override;
Class Function CreateQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess; overload;
Class Function CreateQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess; overload;
Class Function GetQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess; overload;
Class Function GetQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess; overload;
Published
Property MyString : AnsiString Read GetMyString Write SetMyString;
Property MyFixedChar : AnsiString Read GetMyFixedChar Write SetMyFixedChar;
Property MyWideString : WideString Read GetMyWideString Write SetMyWideString;
Property MyDateTime : TDateTime Read GetMyDateTime Write SetMyDateTime;
Property MyUnicodeString : UnicodeString Read GetMyUnicodeString Write SetMyUnicodeString;
Property MyUTF8String : Utf8String Read GetMyUTF8String Write SetMyUTF8String;
Property MyFixedWideString : WideString Read GetMyFixedWideString Write SetMyFixedWideString;
Property MyInteger : Longint Read GetMyInteger Write SetMyInteger;
Property MyByteInteger : Byte Read GetMyByteInteger Write SetMyByteInteger;
Property MySmallintInteger : SmallInt Read GetMySmallintInteger Write SetMySmallintInteger;
Property MyShortIntInteger : ShortInt Read GetMyShortIntInteger Write SetMyShortIntInteger;
Property MyCardinalInteger : Cardinal Read GetMyCardinalInteger Write SetMyCardinalInteger;
Property MyFloat : Double Read GetMyFloat Write SetMyFloat;
Property MyWord : Word Read GetMyWord Write SetMyWord;
Property MyBoolean : Boolean Read GetMyBoolean Write SetMyBoolean;
Property MyInt64 : Int64 Read GetMyInt64 Write SetMyInt64;
Property MyQWordLargeInt : QWord Read GetMyQWordLargeInt Write SetMyQWordLargeInt;
Property MyBlob : TStream Read GetMyBlob;
end;
Implementation
Type
{ TMyFieldMap }
TMyFieldMap = Class(TFieldMap)
Private
FMyString : TField;
FMyFixedChar : TField;
FMyWideString : TField;
FMyDateTime : TField;
FMyUnicodeString : TField;
FMyUTF8String : TField;
FMyFixedWideString : TField;
FMyInteger : TField;
FMyByteInteger : TField;
FMySmallintInteger : TField;
FMyShortIntInteger : TField;
FMyCardinalInteger : TField;
FMyFloat : TField;
FMyWord : TField;
FMyBoolean : TField;
FMyInt64 : TField;
FMyQWordLargeInt : TField;
FMyBlob : TField;
Public
Procedure InitFields; Override;
Property MyString : TField read FMyString;
Property MyFixedChar : TField read FMyFixedChar;
Property MyWideString : TField read FMyWideString;
Property MyDateTime : TField read FMyDateTime;
Property MyUnicodeString : TField read FMyUnicodeString;
Property MyUTF8String : TField read FMyUTF8String;
Property MyFixedWideString : TField read FMyFixedWideString;
Property MyInteger : TField read FMyInteger;
Property MyByteInteger : TField read FMyByteInteger;
Property MySmallintInteger : TField read FMySmallintInteger;
Property MyShortIntInteger : TField read FMyShortIntInteger;
Property MyCardinalInteger : TField read FMyCardinalInteger;
Property MyFloat : TField read FMyFloat;
Property MyWord : TField read FMyWord;
Property MyBoolean : TField read FMyBoolean;
Property MyInt64 : TField read FMyInt64;
Property MyQWordLargeInt : TField read FMyQWordLargeInt;
Property MyBlob : TField read FMyBlob;
end;
{ TMyTypeSafeAccess }
{ Constructor and destructor }
Destructor TMyTypeSafeAccess.Destroy;
begin
FreeAndNil(FBlobMyBlob);
Inherited;
end;
{ Property Getters }
Function TMyTypeSafeAccess.GetMyString : AnsiString;
begin
Result:=TMyFieldMap(FieldMap).MyString.AsAnsiString;
end;
Function TMyTypeSafeAccess.GetMyFixedChar : AnsiString;
begin
Result:=TMyFieldMap(FieldMap).MyFixedChar.AsAnsiString;
end;
Function TMyTypeSafeAccess.GetMyWideString : WideString;
begin
Result:=TMyFieldMap(FieldMap).MyWideString.AsWideString;
end;
Function TMyTypeSafeAccess.GetMyDateTime : TDateTime;
begin
Result:=TMyFieldMap(FieldMap).MyDateTime.AsDateTime;
end;
Function TMyTypeSafeAccess.GetMyUnicodeString : UnicodeString;
begin
Result:=TMyFieldMap(FieldMap).MyUnicodeString.AsUnicodeString;
end;
Function TMyTypeSafeAccess.GetMyUTF8String : Utf8String;
begin
Result:=TMyFieldMap(FieldMap).MyUTF8String.AsUtf8String;
end;
Function TMyTypeSafeAccess.GetMyFixedWideString : WideString;
begin
Result:=TMyFieldMap(FieldMap).MyFixedWideString.AsWideString;
end;
Function TMyTypeSafeAccess.GetMyInteger : Longint;
begin
Result:=TMyFieldMap(FieldMap).MyInteger.AsInteger;
end;
Function TMyTypeSafeAccess.GetMyByteInteger : Byte;
begin
Result:=TMyFieldMap(FieldMap).MyByteInteger.AsInteger;
end;
Function TMyTypeSafeAccess.GetMySmallintInteger : SmallInt;
begin
Result:=TMyFieldMap(FieldMap).MySmallintInteger.AsInteger;
end;
Function TMyTypeSafeAccess.GetMyShortIntInteger : ShortInt;
begin
Result:=TMyFieldMap(FieldMap).MyShortIntInteger.AsInteger;
end;
Function TMyTypeSafeAccess.GetMyCardinalInteger : Cardinal;
begin
Result:=TMyFieldMap(FieldMap).MyCardinalInteger.AsInteger;
end;
Function TMyTypeSafeAccess.GetMyFloat : Double;
begin
Result:=TMyFieldMap(FieldMap).MyFloat.AsFLoat;
end;
Function TMyTypeSafeAccess.GetMyWord : Word;
begin
Result:=TMyFieldMap(FieldMap).MyWord.AsInteger;
end;
Function TMyTypeSafeAccess.GetMyBoolean : Boolean;
begin
Result:=TMyFieldMap(FieldMap).MyBoolean.AsBoolean;
end;
Function TMyTypeSafeAccess.GetMyInt64 : Int64;
begin
Result:=TMyFieldMap(FieldMap).MyInt64.AsLargeInt;
end;
Function TMyTypeSafeAccess.GetMyQWordLargeInt : QWord;
begin
Result:=TMyFieldMap(FieldMap).MyQWordLargeInt.AsLargeInt;
end;
Procedure TMyTypeSafeAccess.DoMyBlobChanged(Sender : TObject);
begin
If Dataset.State in dsEditModes then
TBlobField(TMyFieldMap(FieldMap).MyBlob).LoadFromStream(TStream(Sender));
end;
Function TMyTypeSafeAccess.GetMyBlob : TStream;
begin
if not Assigned(FBlobMyBlob) then
begin
FBlobMyBlob:=TBlobProxyStream.Create;
FBlobMyBlob.OnChange:=@DoMyBlobChanged;
end;
FBlobMyBlob.Size:=0;
FBlobMyBlob.Position:=0;
if not FBlobMyBlob.Updating then
begin
TBlobField(TMyFieldMap(FieldMap).MyBlob).SaveToStream(FBlobMyBlob);
FBlobMyBlob.Position:=0;
end;
Result:=FBlobMyBlob;
end;
{ Property Setters }
Procedure TMyTypeSafeAccess.SetMyString (AValue : AnsiString);
begin
TMyFieldMap(FieldMap).MyString.AsAnsiString:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyFixedChar (AValue : AnsiString);
begin
TMyFieldMap(FieldMap).MyFixedChar.AsAnsiString:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyWideString (AValue : WideString);
begin
TMyFieldMap(FieldMap).MyWideString.AsWideString:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyDateTime (AValue : TDateTime);
begin
TMyFieldMap(FieldMap).MyDateTime.AsDateTime:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyUnicodeString (AValue : UnicodeString);
begin
TMyFieldMap(FieldMap).MyUnicodeString.AsUnicodeString:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyUTF8String (AValue : Utf8String);
begin
TMyFieldMap(FieldMap).MyUTF8String.AsUtf8String:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyFixedWideString (AValue : WideString);
begin
TMyFieldMap(FieldMap).MyFixedWideString.AsWideString:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyInteger (AValue : Longint);
begin
TMyFieldMap(FieldMap).MyInteger.AsInteger:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyByteInteger (AValue : Byte);
begin
TMyFieldMap(FieldMap).MyByteInteger.AsInteger:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMySmallintInteger (AValue : SmallInt);
begin
TMyFieldMap(FieldMap).MySmallintInteger.AsInteger:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyShortIntInteger (AValue : ShortInt);
begin
TMyFieldMap(FieldMap).MyShortIntInteger.AsInteger:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyCardinalInteger (AValue : Cardinal);
begin
TMyFieldMap(FieldMap).MyCardinalInteger.AsInteger:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyFloat (AValue : Double);
begin
TMyFieldMap(FieldMap).MyFloat.AsFLoat:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyWord (AValue : Word);
begin
TMyFieldMap(FieldMap).MyWord.AsInteger:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyBoolean (AValue : Boolean);
begin
TMyFieldMap(FieldMap).MyBoolean.AsBoolean:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyInt64 (AValue : Int64);
begin
TMyFieldMap(FieldMap).MyInt64.AsLargeInt:=aValue;
end;
Procedure TMyTypeSafeAccess.SetMyQWordLargeInt (AValue : QWord);
begin
TMyFieldMap(FieldMap).MyQWordLargeInt.AsLargeInt:=aValue;
end;
Class Function TMyTypeSafeAccess.FieldMapClass : TFieldMapClass;
begin
Result:=TMyFieldMap;
end;
{ TMyFieldMap }
Procedure TMyFieldMap.InitFields;
begin
FMyString:=FieldByName('MyString');
FMyFixedChar:=FieldByName('MyFixedChar');
FMyWideString:=FieldByName('MyWideString');
FMyDateTime:=FieldByName('MyDateTime');
FMyUnicodeString:=FieldByName('MyUnicodeString');
FMyUTF8String:=FieldByName('MyUTF8String');
FMyFixedWideString:=FieldByName('MyFixedWideString');
FMyInteger:=FieldByName('MyInteger');
FMyByteInteger:=FieldByName('MyByteInteger');
FMySmallintInteger:=FieldByName('MySmallintInteger');
FMyShortIntInteger:=FieldByName('MyShortIntInteger');
FMyCardinalInteger:=FieldByName('MyCardinalInteger');
FMyFloat:=FieldByName('MyFloat');
FMyWord:=FieldByName('MyWord');
FMyBoolean:=FieldByName('MyBoolean');
FMyInt64:=FieldByName('MyInt64');
FMyQWordLargeInt:=FieldByName('MyQWordLargeInt');
FMyBlob:=FieldByName('MyBlob');
end;
Class Function TMyTypeSafeAccess.CreateQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess;
begin
Result:=CreateQuery(SQLMyTypeSafeAccess,aConnection,aTransaction);
end;
Class Function TMyTypeSafeAccess.CreateQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : TMyTypeSafeAccess;
Var
Q : TSQLQuery;
MySQL : String;
begin
If aSQL='' then
MySQL:=SQLMyTypeSafeAccess
else
MySQL:=aSQL;
Q:=TSQLQuery.Create(aConnection);
If aTransaction<>Nil then
Q.Transaction:=aTransaction;
Q.Database:=aConnection;
Q.SQL.Text:=MySQL;
Result:=TMyTypeSafeAccess.Create(Q,True);
end;
Class Function TMyTypeSafeAccess.GetQuery(aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess;
begin
Result:=CreateQuery(aConnection,aTransaction);
end;
Class Function TMyTypeSafeAccess.GetQuery(aSQL : String; aConnection : TSQLConnection; aTransaction : TSQLTransaction) : IMyTypeSafeAccess;
begin
Result:=CreateQuery(aSQL,aConnection,aTransaction);
end;
Procedure TMyTypeSafeAccess.ApplyUpdates;
begin
If Dataset is TSQLQuery then
(Dataset as TSQLQuery).ApplyUpdates;
end;
end.