Quote
Anantha Sreenivasulu <anan...@visioncomputers.com> wrote:
>Hello,
> I had loaded data from the Memdataset to treelist.Now i want to save
>the changes from the tree list to Memtable and from Memtable to
>Database(Interbase 5.6).
> How do i can achieve this?
>Any piece of code highly appreciated
>TIA,
>Regards,
>Anantha
I use memory tables in 99% of my applications with ibx ( the other 1%
is BDE TTables that IBX or IBO doesn't have).
I use a custom child class of kbmMemTable (
http://www.egroups.com/group/memtable )
The source was made to my personal use, so is not very clean but maybe
give you some ideas.
Best regards
Luis Forra
----
-----------------------------------------
unit ibxutils;
interface
uses
ibsql,classes;
function SetParamsExec(AQry : TIBSql;const ANomeParams :
TStrings;const ALstValor : array of const) : TIBSql; overload;
function SetParamsExec(AQry : TIBSql;const ANomeParams: array of
string;const ALstValor : array of const) : TIBSql; overload;
procedure SetParams(ALstParam : TIBXSQLDA;const ANomeParams :
TStrings;const ALstValor : array of const); overload;
procedure SetParams(ALstParam : TIBXSQLDA;const ANomeParams: array of
string;const ALstValor : array of const); overload;
implementation
uses
sysutils;
function SetParamsExec(AQry : TIBSql;const ANomeParams :
TStrings;const ALstValor : array of const) : TIBSql;
begin
result := AQry;
SetParams(AQry.Params,ANomeParams,ALstValor);
result.ExecQuery;
end;
function SetParamsExec(AQry : TIBSql;const ANomeParams: array of
string;const ALstValor : array of const) : TIBSql;
begin
result := AQry;
SetParams(AQry.Params,ANomeParams,ALstValor);
result.ExecQuery;
end;
procedure SetParams(ALstParam : TIBXSQLDA;const ANomeParams :
TStrings;const ALstValor : array of const);
var
a : array of string;
i : integer;
begin
SetLength(a,ANomeParams.Count);
for i := 0 to ANomeParams.Count-1 do
a[i] := ANomeParams.Strings[i];
SetParams(ALstParam,a,ALstValor);
end;
procedure SetParams(ALstParam : TIBXSQLDA;const ANomeParams: array of
string;const ALstValor : array of const);
var
i : integer;
FParam : TIBXSQLVAR;
procedure error;
begin
raise Exception.Create('Tipo de parametro nao suportado');
end;
begin
if High(ANomeParams) <> High(ALstValor) then raise
Exception.Create('Numero de parametros incorrecto.');
for i := 0 to High(ALstValor) do
begin
FParam := ALstParam.ByName(ANomeParams[i]);
with ALstValor[i] do // Roubado do TField.AssignValue
case VType of
vtInteger:
FParam.AsInteger := VInteger;
vtBoolean:
error;
vtChar:
FParam.AsString := VChar;
vtExtended:
//FParam.AsFloat := VExtended^; o float no IBExpress e' uma
coisa esquesita
FParam.AsDouble := VExtended^;
vtString:
FParam.AsString := VString^;
vtPointer:
if VPointer <> nil then Error;
vtPChar:
FParam.AsString := VPChar;
vtObject:
Error;
vtAnsiString:
FParam.AsString := string(VAnsiString);
vtCurrency:
FParam.AsCurrency := VCurrency^;
vtVariant:
if not VarIsEmpty(VVariant^) then FParam.AsVariant :=
VVariant^;
else
Error;
end;
end;
end;
end.
-----------------------------------------
unit IBProxyMemTable;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
Db, kbmMemTable, IBDatabase, IBSQL,IBCustomDataset;
type
TTipoParam = (tpNenhum,tpVariant,tpInt64,tpString,tpDouble);
TOnGetSqlEvent = procedure (const ASql : TStrings) of object;
TIBProxyMemTableCustom = class;
TCopyAuxAss = record
FTo : TField;
FFrom : TIBXSQLVAR;
SqlType : short;
Blob : boolean;
end;
PCopyAuxAss = ^ TCopyAuxAss;
TCopyAux = class
private
FFrom : TIBSql;
FTo : TIBProxyMemTableCustom;
FCopyAux : pointer;
FFieldCount : integer;
public
procedure Rebuild;
procedure Copy(AFrom : TIBSql; ATo : TIBProxyMemTableCustom);
constructor Create(AFrom : TIBSql; ATo : TIBProxyMemTableCustom);
destructor Destroy; override;
end;
TIBProxyMemTableCustom = class(TkbmCustomMemTable)
private
{ Private declarations }
FCopyAux : TCopyAux;
FFields : TStringList;
FParamLst : TStringList;
FSqlCreated : boolean;
FDatabase : TIBDatabase;
FTrans : TIBTransaction;
FOnGetSqlSelect,FOnGetSqlInsert,FOnGetSqlDelete : TOnGetSqlEvent;
FSqlDel,FSqlSel,FSqlIns : TIBSql;
FActiveField : string;
FSqlReadOnly: boolean;
FSqlAutoTrans: boolean;
FLoading: boolean;
FSqlInsert: TStrings;
FSqlSelect: TStrings;
FSqlDelete: TStrings;
FAutoCreateFields: boolean;
FSqlSelectLimit: integer;
procedure SetAutoCreateFields(const Value: boolean);
procedure SetDatabase(const Value: TIBDatabase);
procedure SetSqlReadOnly(const Value: boolean);
procedure CheckRw;
procedure SetSqlAutoTrans(const Value: boolean);
procedure UpdateFFields;
procedure SqlChanging(Sender: TObject);
procedure SetSqlDelete(const Value: TStrings);
procedure SetSqlInsert(const Value: TStrings);
procedure SetSqlSelect(const Value: TStrings);
function CanUpdateFieldDefs : boolean;
// procedure UpdateFieldDefs;
protected
{ Protected declarations }
procedure UpdateParams;
procedure InternalSqlDelete(const AParams : array of const);
procedure InternalSqlSelect(const AParams : array of const;Add :
boolean = false);
procedure InternalSetParams(AQuery : TIBSql;const AParams : array
of const);
procedure DoGetSqlSelect; virtual;
procedure DoGetSqlDelete; virtual;
procedure DoGetSqlInsert; virtual;
// procedure InternalCreateFields;
public
{ Public declarations }
procedure SyncStructure;
procedure LoadStructure(const ASql : TStrings);
procedure DestroySql;
procedure NeedSql;
property Trans : TIBTransaction read FTrans;
property Loading : boolean read FLoading write FLoading;
procedure SqlInsertRec;
procedure SqlInsertAll;
procedure SqlDelete(const AValue : array of const);
procedure SqlDeleteByValue(const AFields : array of string;ATabela
: string);
procedure SqlSelect(const AValue : array of const;Add : boolean =
false);
destructor Destroy; override;
constructor Create(AOwner : TComponent); override;
property SqlSelectLimit : integer read FSqlSelectLimit write
FSqlSelectLimit;
property LstSqlSelect : TStrings read FSqlSelect write
SetSqlSelect;
property LstSqlInsert : TStrings read FSqlInsert write
SetSqlInsert;
property LstSqlDelete : TStrings read FSqlDelete write
SetSqlDelete;
property OnGetSqlSelect : TOnGetSqlEvent read FOnGetSqlSelect
write FOnGetSqlSelect;
property OnGetSqlInsert : TOnGetSqlEvent read FOnGetSqlInsert
write FOnGetSqlInsert;
property OnGetSqlDelete : TOnGetSqlEvent read FOnGetSqlDelete
write FOnGetSqlDelete;
published
{ Published declarations }
property AutoCreateFields : boolean read FAutoCreateFields write
SetAutoCreateFields;
property SqlDatabase : TIBDatabase read FDatabase write
SetDatabase;
property SqlActiveField : string read FActiveField write
FActiveField;
property SqlReadOnly : boolean read FSqlReadOnly write
SetSqlReadOnly;
property SqlAutoTrans : boolean read FSqlAutoTrans write
SetSqlAutoTrans;
property Filtered;
property EnableIndexes;
property IndexFieldNames;
property IndexName;
property IndexDefs;
property RecalcOnIndex;
property RecalcOnFetch;
property SortFields;
property SortOptions;
property FieldDefs;
property Active;
property ReadOnly;
property OnLoadRecord;
property OnLoadField;
property OnSaveRecord;
property OnSaveField;
property OnCompressSave;
property OnDecompressLoad;
property OnCompressBlobStream;
property OnDecompressBlobStream;
property OnSave;
property OnLoad;
property BeforeOpen;
property AfterOpen;
property BeforeClose;
property AfterClose;
property BeforeInsert;
property AfterInsert;
property BeforeEdit;
property AfterEdit;
property BeforePost;
property AfterPost;
property BeforeCancel;
property AfterCancel;
property BeforeDelete;
property AfterDelete;
property BeforeScroll;
property AfterScroll;
property OnCalcFields;
property OnDeleteError;
property OnEditError;
property OnFilterRecord;
property OnNewRecord;
property OnPostError;
end;
TIBProxyMemTable = class(TIBProxyMemTableCustom)
private
FTableName : string;
FOrderBy : string;
procedure SetTableName(const Value: string);
procedure SetOrderBy(const Value: string);
protected
procedure DoGetSqlSelect; override;
procedure DoGetSqlDelete; override;
procedure DoGetSqlInsert; override;
public
procedure UpdateStructure(ATableName : string = '');
published
property SqlTableName : string read FTableName write SetTableName;
property SqlOrderBy : string read FOrderBy write SetOrderBy;
end;
TIBProxySql = class(TIBProxyMemTableCustom)
published
property AutoCreateFields;
property LstSqlSelect;
property LstSqlInsert;
property LstSqlDelete;
property OnGetSqlSelect;
property OnGetSqlInsert;
property OnGetSqlDelete;
end;
TCreateUniqueName = function (Dataset: TDataset; const FieldName:
string;
FieldClass: TFieldClass; Component: TComponent): string;
var
FCreateUniqueName : TCreateUniqueName = nil;
SafeMode : boolean = true; // por causa do delete sem parametros
implementation
uses
IBTable,stutils,strutils,contnrs,IBHeader,ibxutils;
const
OriginIgnore = '_IGNORA_';
function CheckSep(var s : string;sep : string = ',') : string;
begin
Trim(s);
if s <> '' then
if s[Length(s)] = sep then
s := Copy(s,1,Length(s)-1);
result := s;
end;
destructor
...
read more »
