function TForm1.CompareField(DataSet1, DataSet2: TDataSet): String;
var
  I, J : Integer;
  aStr: String;
  aNotFind: Boolean;
begin
  aStr := '';
  for I := 0 to DataSet1.FieldCount - 1 do
  begin
    aNotFind := True;
    for J := 0 to DataSet2.FieldCount - 1 do
    begin
      if DataSet1.Fields[I].FieldName = DataSet2.Fields[J].FieldName then
      begin
        aNotFind := False;
        Break;
      end;
    end;
    if aNotFind then
      if aStr = '' then
        aStr := DataSet1.Fields[I].FieldName
      else
        aStr := aStr   ','  DataSet1.Fields[I].FieldName;
  end;
  Result := aStr;
end;    procedure TForm1.WriteMemo(xStr: String; DataSet: TDataSet);
var
  I: Integer;
  aSL: TStringList;
begin
  aSL := TStringList.Create;
  try
    aSL.CommaText := xStr;
    for I := 0 to aSL.Count - 1 do
    with DataSet do
      begin
        Close;
        Open;
        First;
        while not Eof do
        begin
          Memo1.Lines.Add(FieldByName(aSL.Strings[I]).AsString);
          Next;
        end;
      end;
  finally
    FreeAndNil(aSL);
  end;
end;    procedure TForm1.Button1Click(Sender: TObject);
var
  aSL: TStringList;
begin
  if Table1.FieldCount > Table2.FieldCount then
    WriteMemo(CompareField(Table1,Table2), Table1)
  else
    WriteMemo(CompareField(Table2,Table1), Table2);
end;