آموزش: تغيير ليست فيلدها در ADODataSet

[A.Nemati]

سلام به همه دوستان
چند روز پيش يكي از دوستان سوالي تحت عنوان "Update کردن لیست فیلدها در ADO" مطرح كرده بودند، خود من هم سوالي تحت عنوان "تغییر مقدار KeyField در ltBatchOptimistic DataS" داشتم، با كمي دقت مي‌شه فهميد كه هردو سوال به يك جواب ختم مي‌شن: تغيير ليست فيلدها در ADODataSet.
من در آن موقع راه حلي كه به ذهنم رسيد، استفاده از يك جدول كمكي و Clone كردن بود كه نمونه كدي هم نوشتم و در پاسخ ارايه كردم. وقتي نمونه كد خودم رو با دقت بيشتري تست كردم، متوجه شدم كه اشكالات جالبي داره، براي همين تصميم گرفتم راه حل اصولي‌تري پيدا كنم. براي اين منظور به سورس‌هاي خود زبان دلفي مراجعه كردم و نتيجه حاصله چيز جالب و كاملي از آب درآمد.
اولين كاري كه لازمه، ساختن ليست فيلدهاست (همانطور كه شما روي كامپوننت ADODataSet دابل كليك كرده، در Field Editor راست كليك كرده، گزينه "Add all fields" رو انتخاب مي‌كنيد):



procedure TForm1.btnChangeTblClick(Sender: TObject);
var
i: Integer;
fieldsList: TStringList;
begin
try
{ Change Table }
ADODataSet1.Close;
ADODataSet1.Fields.Clear;
if ADODataSet1.CommandText:= 'Employees' then
ADODataSet1.CommandText:= 'Customers'
else
ADODataSet1.‍CommandText:= 'Employees';
ADODataSet1.Open;

{ Create Fileds }
fieldsList:= TStringList.Create;
try
fieldsList.Assign(ADODataSet1.FieldDefList);
ADODataSet1.Close;
for i:= 0 to fieldsList.Count - 1 do
DoCreateField(ADODataSet1, fieldsList[i], '');
finally
FreeAndNil(fieldsList);
end;

// Create custom fields (such as Calc field)
// Remove sum fields (if necessary)

ADODataSet1.Open;
except
end;
end;

function TForm1.DoCreateField(Dataset: TDataset; const FieldName: string;
Origin: string): TField;
var
fieldDef: TFieldDef;
parentField: TField;
subScript,
shortName,
parentFullName: String;
begin
fieldDef:= Dataset.FieldDefList.FieldByName(FieldName);
parentField:= nil;
if Dataset.ObjectView then
begin
if fieldDef.ParentDef <> nil then
begin
if fieldDef.ParentDef.DataType = ftArray then
begin
{ Strip off the subscript to determine the parent's full name }
subScript := Copy(FieldName, AnsiPos('[', FieldName), MaxInt);
parentFullName := Copy(FieldName, 1, Length(FieldName) - Length(subScript));
shortName := fieldDef.ParentDef.Name + subScript;
end
else
begin
if faUnNamed in fieldDef.ParentDef.Attributes then
parentFullName := fieldDef.ParentDef.Name
else
parentFullName := ChangeFileExt(FieldName, '');
shortName := fieldDef.Name;
end;
parentField := Dataset.FieldList.Find(parentFullName);
if parentField = nil then
parentField := DoCreateField(Dataset, parentFullName, Origin);
end
else
shortName := fieldDef.Name;
end
else
shortName := FieldName;
Result := fieldDef.CreateField(Dataset.Owner, parentField as TObjectField, shortName, False);
try
Result.Origin := Origin;
Result.Name := CreateUniqueName(Dataset, FieldName, TFieldClass(ClassType), nil);
except
Result.Free;
raise;
end;
end;

function CreateUniqueName(Dataset: TDataset;
const FieldName: string; FieldClass: TFieldClass;
Component: TComponent): string;
var
i: Integer;

function IsUnique(const AName: string): Boolean;
var
i: Integer;
begin
Result := False;
with Dataset.Owner do
for i := 0 to ComponentCount - 1 do
if (Component <> Components[i]) and (CompareText(AName, Components[i].Name) = 0) then Exit;
Result := True;
end;

begin
for i := 1 to MaxInt do
begin
Result := GenerateName(Dataset, FieldName, FieldClass, i);
if IsUnique(Result) then Exit;
end;
end;

function GenerateName(Dataset: TDataset; FieldName: string;
FieldClass: TFieldClass; Number: Integer): string;
var
Fmt: string;

procedure CrunchFieldName;
var
i: Integer;
begin
i := 1;
while i <= Length(FieldName) do
begin
if FieldName[i] in ['A'..'Z','a'..'z','_','0'..'9'] then
Inc(i)
else if FieldName[i] in LeadBytes then
Delete(FieldName, i, 2)
else
Delete(FieldName, i, 1);
end;
end;

begin
CrunchFieldName;
if (FieldName = '') or (FieldName[1] in ['0'..'9']) then
begin
if FieldClass <> nil then
FieldName := FieldClass.ClassName + FieldName else
FieldName := 'Field' + FieldName;
if FieldName[1] = 'T' then Delete(FieldName, 1, 1);
CrunchFieldName;
end;
Fmt := '%s%s%d';
if Number < 2 then Fmt := '%s%s';
Result := Format(Fmt, [Dataset.Name, FieldName, Number]);
end;

حالا اگر لازم بود فيلدي اضافه كنيد مي‌توانيد در همان تابع اصلي (در اينجا btnChangeTblClick در قسمتي كه "(Create custom fields (such as Calc field" نوشتم) تابع زير رو فراخواني كنيد يا مستقيما كدش رو بنويسيد


procedure AddMyFields;
var
fld: TField;
begin
if ADODataSet1.Active then
ADODataSet1.Close;
fld:= TIntegerField.Create(ADODataSet1);
fld.FieldKind := fkCalculated;
fld.FieldName := 'CField';
fld.Calculated := True;
fld.DataSet := ADODataSet1;
end;


يا اگه لازم بود فيلدي رو پاك كنيد، در جايي كه نوشتم "(Remove sum fields (if necessary"، تابع زير رو فراخواني كنيد.


procedure RemoveField(FieldName: String);
begin
if ADODataSet1.Active then
ADODataSet1.Close;
ADODataSet1.FindField(FieldName).Free;
end;


ضمنا با اين كار، مشكل خودمم حل شد. يعني فيلد كليد رو حذف مي‌كنم و يك فيلد ديگه به همون اسم مي‌سازم.

موفق باشيد