Yes, sorry for delay on this. We added 2 new string properties to TXDataset: UpdateTableName and KeyFields
Then, upon form creation we loop through any TXDatasets that have a UpdateTablename and set their Delete/Update/Insert methods to 3 base procedures we have created.
If TXDataSet(fForm.components[iControlLoop]).UpdateTableName <> '' then
begin
TXDataSet(fForm.components[iControlLoop]).OnRecordDelete := XDataset1RecordDelete;
TXDataSet(fForm.components[iControlLoop]).OnRecordUpdate := XDataset1RecordUpdate;
TXDataSet(fForm.components[iControlLoop]).OnRecordInsert := XDataset1RecordInsert;
end else
begin
TXDataSet(fForm.components[iControlLoop]).OnRecordDelete := nil;
TXDataSet(fForm.components[iControlLoop]).OnRecordUpdate := nil;
TXDataSet(fForm.components[iControlLoop]).OnRecordInsert := nil;
end;
Here are the 3 procedures. There are some string constants you would need to replace. I'd be glad to answer any other questions. It has worked very well for us.
procedure TDM1.XDataset1RecordDelete(Sender: TObject);
Var
i1, iNewValue, iKeyFieldPos : Integer ;
sSQL, sPrimaryKey, sKey, sWhereClause : String ;
dNewValue : Double;
bFirstField : Boolean;
dtNewValue : TDateTime;
slKey, slKeyVal : TStringList;
xUpdateDataset : TXDataset;
begin
If (((Sender as TXDataset).UpdateTableName = '') or ((Sender as TXDataset).KeyFields = '')) then
begin
IndyMessageDlg(SPrimaryKeyandUpdateTableNam,mtWarning,[mbOK],0); // Primary Key and UpdateTableName Required for Live Updates
end;
// Parse Primary Keys into StringList
slKey := TStringList.Create;
slKeyVal := TStringList.Create;
Try
sPrimaryKey := (Sender as TXDataset).KeyFields;
If Pos(';',sPrimaryKey) > 0 then // Check to see if parsing necessary
begin
sKey := '';
For i1 := 1 to Length(sPrimaryKey) do
begin
If sPrimaryKey[i1] = ';' then
begin
slKey.Add(sKey);
slKeyVal.Add((Sender as TXDataset).FieldByName(sKey).AsString);
sKey := '';
end else sKey := sKey + sPrimaryKey[i1];
end;
If sKey <> '' then
begin
slKey.Add(sKey);
slKeyVal.Add((Sender as TXDataset).FieldByName(sKey).AsString);
end;
end else
begin
slKey.Add(sPrimaryKey);
slKeyVal.Add((Sender as TXDataset).FieldByName(sPrimaryKey).AsString);
end;
bFirstField := True;
sSQL := 'DELETE FROM ' + (Sender as TXDataset).UpdateTableName + ' ';
For i1 := 1 to (Sender as TXDataset).ModifiedFields.Count do
begin
iKeyFieldPos := slKey.IndexOf((Sender as TXDataset).ModifiedFields[i1-1].FieldName);
If iKeyFieldPos > -1 then // Primary Key is being modified - adjust list for Where clause accordingly
begin
slKeyVal[iKeyFieldPos] := VarToStr((Sender as TXDataset).ModifiedFields[i1-1].OldValue);
end;
end;
//Build Where Clause
bFirstField := True;
For i1 := 0 to slKey.Count-1 do
begin
If bFirstField then
begin
If (Sender as TXDataset).FieldByName(slKey[i1]).DataType in [ftFloat, ftCurrency, ftBCD, ftSmallint, ftInteger, ftWord, ftLargeint] then
sWhereClause := ' WHERE ' + slKey[i1] + '=' + FixDecimalSeparator(slKeyVal[i1]) else
sWhereClause := ' WHERE ' + slKey[i1] + '=''' + slKeyVal[i1] + '''';
bFirstField := False;
end else
begin
If (Sender as TXDataset).FieldByName(slKey[i1]).DataType in [ftFloat, ftCurrency, ftBCD, ftSmallint, ftInteger, ftWord, ftLargeint] then
sWhereClause := sWhereClause + ' AND ' + slKey[i1] + '=' + FixDecimalSeparator(slKeyVal[i1]) else
sWhereClause := sWhereClause + ' AND ' + slKey[i1] + '=''' + slKeyVal[i1] + '''';
end;
end;
sSQL := sSQL + sWhereClause;
xUpdateDataset := TXDataset.Create(Self);
Try
xUpdateDataset.Database := (Sender as TXDataset).Database;
xUpdateDataset.SQL.Text := AddN(sSQL);
xUpdateDataset.Execute;
Finally
xUpdateDataSet.Free;
end;
Finally
slKey.Free;
slKeyVal.Free;
end;
end;
procedure TDM1.XDataset1RecordInsert(Sender: TObject);
Var
i1, iNewValue, iKeyFieldPos : Integer ;
sSQL, sFields, sPrimaryKey, sKey, sWhereClause : String ;
dNewValue : Double;
bFirstField : Boolean;
dtNewValue : TDateTime;
slKey : TStringList;
xUpdateDataset : TXDataset;
procedure AddFieldName;
begin
If bFirstField then
begin
sFields := sFields + (Sender as TXDataset).ModifiedFields[i1-1].FieldName ;
bFirstField := False;
end else sFields := sFields + ',' + (Sender as TXDataset).ModifiedFields[i1-1].FieldName ;
end;
begin
If (((Sender as TXDataset).UpdateTableName = '') or ((Sender as TXDataset).KeyFields = '')) then
begin
IndyMessageDlg(SPrimaryKeyandUpdateTableNam,mtWarning,[mbOK],0); // Primary Key and UpdateTableName Required for Live Updates
end;
// Parse Primary Keys into StringList
slKey := TStringList.Create;
Try
sPrimaryKey := (Sender as TXDataset).KeyFields;
If Pos(';',sPrimaryKey) > 0 then // Check to see if parsing necessary
begin
sKey := '';
For i1 := 1 to Length(sPrimaryKey) do
begin
If sPrimaryKey[i1] = ';' then
begin
slKey.Add(sKey);
sKey := '';
end else sKey := sKey + sPrimaryKey[i1];
end;
If sKey <> '' then
begin
slKey.Add(sKey);
end;
end else
begin
slKey.Add(sPrimaryKey);
end;
sFields := ''; // default
bFirstField := True;
For i1 := 1 to (Sender as TXDataset).ModifiedFields.Count do
begin
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftString, ftFixedChar, ftWideString] then
begin
AddFieldName;
sSQL := sSQL + '''' + VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) + '''' + ',';
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftSmallint, ftInteger, ftWord, ftLargeint] then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL,' else
begin
iNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
sSQL := sSQL + IntToStr(iNewValue) + ',';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftFloat, ftCurrency, ftBCD] then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL,' else
begin
dNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
sSQL := sSQL + IndyFormatFloat('#########0.0############',dNewValue) + ',';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType = ftDate then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL,' else
begin
dtNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
if dtNewValue <= 0 then sSQL := sSQL + 'NULL,' else
sSQL := sSQL + '''' + FormatDateTime(TriDef1.sDefaultDateFormat,dtNewValue) + '''' + ',';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType = ftTime then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL,' else
begin
dtNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
sSQL := sSQL + '''' + FormatDateTime(TriDef1.sDefaultTimeFormat,dtNewValue) + '''' + ',';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType = ftDateTime then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL,' else
begin
dtNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
if dtNewValue <= 0 then sSQL := sSQL + 'NULL,' else
sSQL := sSQL + '''' + FormatDateTime(TriDef1.sDefaultDateFormat,dtNewValue) + ''''+ ',';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftMemo, ftWideMemo] then
begin
AddFieldName;
sSQL := sSQL + '''' + VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) + ''''+ ',';
end;
end;
sSQL := 'INSERT INTO ' + (Sender as TXDataset).UpdateTableName + ' (' + sFields + ') VALUES (' + sSQL;
sSQL := Copy(sSQL,1,Length(sSQL)-1);
sSQL := sSQL + ')';
xUpdateDataset := TXDataset.Create(Self);
Try
xUpdateDataset.Database := (Sender as TXDataset).Database;
xUpdateDataset.SQL.Text := AddN(sSQL);
xUpdateDataset.Execute;
Finally
xUpdateDataSet.Free;
end;
Finally
slKey.Free;
end;
end;
procedure TDM1.XDataset1RecordUpdate(Sender: TObject);
Var
i1, iNewValue, iKeyFieldPos : Integer ;
sSQL, sPrimaryKey, sKey, sWhereClause, sMemo : String ;
dNewValue : Double;
bFirstField : Boolean;
dtNewValue : TDateTime;
slKey, slKeyVal, slTemp : TStringList;
msTemp : TMemoryStream;
xUpdateDataset : TXDataset;
procedure AddFieldName;
begin
If bFirstField then
begin
sSQL := sSQL + (Sender as TXDataset).ModifiedFields[i1-1].FieldName + '=';
bFirstField := False;
end else sSQL := sSQL + ', ' + (Sender as TXDataset).ModifiedFields[i1-1].FieldName + '=';
end;
begin
If (((Sender as TXDataset).UpdateTableName = '') or ((Sender as TXDataset).KeyFields = '')) then
begin
IndyMessageDlg(SPrimaryKeyandUpdatingTableR,mtWarning,[mbOK],0); // Primary Key and UpdatingTable Required for Live Updates
end;
If (Sender as TXDataset).ModifiedFields.Count = 0 then exit;
// Parse Primary Keys into StringList
slKey := TStringList.Create;
slKeyVal := TStringList.Create;
Try
sPrimaryKey := (Sender as TXDataset).KeyFields;
If Pos(';',sPrimaryKey) > 0 then // Check to see if parsing necessary
begin
sKey := '';
For i1 := 1 to Length(sPrimaryKey) do
begin
If sPrimaryKey[i1] = ';' then
begin
slKey.Add(sKey);
slKeyVal.Add((Sender as TXDataset).FieldByName(sKey).AsString);
sKey := '';
end else sKey := sKey + sPrimaryKey[i1];
end;
If sKey <> '' then
begin
slKey.Add(sKey);
slKeyVal.Add((Sender as TXDataset).FieldByName(sKey).AsString);
end;
end else
begin
slKey.Add(sPrimaryKey);
slKeyVal.Add((Sender as TXDataset).FieldByName(sPrimaryKey).AsString);
end;
bFirstField := True;
sSQL := 'UPDATE ' + (Sender as TXDataset).UpdateTableName + ' SET ';
For i1 := 1 to (Sender as TXDataset).ModifiedFields.Count do
begin
iKeyFieldPos := slKey.IndexOf((Sender as TXDataset).ModifiedFields[i1-1].FieldName);
If iKeyFieldPos > -1 then // Primary Key is being modified - adjust list for Where clause accordingly
begin
slKeyVal[iKeyFieldPos] := VarToStr((Sender as TXDataset).ModifiedFields[i1-1].OldValue);
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftString, ftFixedChar, ftWideString] then
begin
AddFieldName;
sSQL := sSQL + '''' + VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) + '''';
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftSmallint, ftInteger, ftWord, ftLargeint] then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL' else
begin
iNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
sSQL := sSQL + IntToStr(iNewValue);
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftFloat, ftCurrency, ftBCD] then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL' else
begin
dNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
sSQL := sSQL + IndyFormatFloat('#########0.0############',dNewValue);
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType = ftDate then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL' else
begin
dtNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
if dtNewValue <= 0 then sSQL := sSQL + 'NULL' else
sSQL := sSQL + '''' + FormatDateTime(TriDef1.sDefaultDateFormat,dtNewValue) + '''';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType = ftTime then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL' else
begin
dtNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
sSQL := sSQL + '''' + FormatDateTime(TriDef1.sDefaultTimeFormat,dtNewValue) + '''';
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType = ftDateTime then
begin
AddFieldName;
If VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) = '' then sSQL := sSQL + 'NULL' else
begin
dtNewValue := (Sender as TXDataset).ModifiedFields[i1-1].NewValue;
if dtNewValue <= 0 then sSQL := sSQL + 'NULL' else
sSQL := sSQL + '''' + FormatDateTime(DM1.TriDef1.sDefaultDateFormat, dtNewValue) + '''';
end;
end;
{If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftMemo, ftWideMemo] then
begin
sSQL := sSQL + '''' + VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue) + '''';
end;}
end;
//Build Where Clause
bFirstField := True;
For i1 := 0 to slKey.Count-1 do
begin
If bFirstField then
begin
If (Sender as TXDataset).FieldByName(slKey[i1]).DataType in [ftFloat, ftCurrency, ftBCD, ftSmallint, ftInteger, ftWord, ftLargeint] then
sWhereClause := ' WHERE ' + slKey[i1] + '=' + FixDecimalSeparator(slKeyVal[i1]) else
sWhereClause := ' WHERE ' + slKey[i1] + '=''' + slKeyVal[i1] + '''';
bFirstField := False;
end else
begin
If (Sender as TXDataset).FieldByName(slKey[i1]).DataType in [ftFloat, ftCurrency, ftBCD, ftSmallint, ftInteger, ftWord, ftLargeint] then
sWhereClause := sWhereClause + ' AND ' + slKey[i1] + '=' + FixDecimalSeparator(slKeyVal[i1]) else
sWhereClause := sWhereClause + ' AND ' + slKey[i1] + '=''' + slKeyVal[i1] + '''';
end;
end;
if sSQL <> 'UPDATE ' + (Sender as TXDataset).UpdateTableName + ' SET ' then
begin
sSQL := sSQL + sWhereClause;
xUpdateDataset := TXDataset.Create(Self);
Try
xUpdateDataset.Database := (Sender as TXDataset).Database;
xUpdateDataset.SQL.Text := AddN(sSQL);
xUpdateDataset.Execute;
Finally
xUpdateDataSet.Free;
end;
end;
// already have sWhereClause - check for any blob fields
For i1 := 1 to (Sender as TXDataset).ModifiedFields.Count do
begin
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftMemo, ftWideMemo] then
begin
sMemo := VarToStr((Sender as TXDataset).ModifiedFields[i1-1].NewValue);
slTemp := TStringList.Create;
try
slTemp.Text := sMemo;
DM1.UpdateACommentWithList((Sender as TXDataset).UpdateTableName, (Sender as TXDataset).ModifiedFields[i1-1].FieldName, sWhereClause, slTemp);
finally
slTemp.Free;
end;
end;
If (Sender as TXDataset).ModifiedFields[i1-1].DataType in [ftBlob] then
begin
msTemp := TMemoryStream.Create;
try
((Sender as TXDataset).ModifiedFields[i1-1] as TBlobField).SaveToStream(msTemp);
DM1.UpdateABlobWithStream((Sender as TXDataset).UpdateTableName, (Sender as TXDataset).ModifiedFields[i1-1].FieldName, sWhereClause, msTemp);
finally
msTemp.Free;
end;
end;
end;
Finally
slKey.Free;
slKeyVal.Free;
end;
end;
Thanks,
Rhett