rmd_bde.pas

这是一个功能强大

procedure TRMDBDEQuery.SetFilter(Value: string);
begin
  FQuery.Active := False;
  FQuery.Filter := Value;
  FQuery.Filtered := Value <> '';
end;

function TRMDBDEQuery.GetDataSource: string;
begin
  Result := RMGetDataSetName(FQuery.Owner, FQuery.DataSource)
end;

procedure TRMDBDEQuery.SetDataSource(Value: string);
var
  liComponent: TComponent;
begin
  liComponent := RMFindComponent(FQuery.Owner, Value);
  if (liComponent <> nil) and (liComponent is TDataSet) then
    FQuery.DataSource := RMGetDataSource(FQuery.Owner, TDataSet(liComponent))
  else
    FQuery.DataSource := nil;
end;

procedure TRMDBDEQuery.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    Session.GetAliasNames(liStringList);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
end;

procedure TRMDBDEQuery.GetTableNames(DB: string; Strings: TStrings);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  try
    try
      Session.GetTableNames(DB, '', True, False, sl);
      sl.Sort;
      Strings.Assign(sl);
    except;
    end;
  finally
    sl.Free;
  end;
end;

procedure TRMDBDEQuery.GetTableFieldNames(const DB, TName: string; sl: TStrings);
var
  i: Integer;
  lStrings: TStringList;
  t: TTable;
begin
  lStrings := TStringList.Create;
  t := TTable.Create(RMDialogForm);
  try
    t.DatabaseName := DB;
    t.TableName := tName;
    try
      t.FieldDefs.UpDate;
      for i := 0 to t.FieldDefs.Count - 1 do
        lStrings.Add(t.FieldDefs.Items[i].Name);
      lStrings.Sort;
      sl.Assign(lStrings);
    except;
    end;
  finally
    lStrings.Free;
    t.Free;
  end;
end;

function TRMDBDEQuery.GetParamName(Index: Integer): string;
begin
  Result := FQuery.Params[Index].Name;
end;

function TRMDBDEQuery.GetParamType(Index: Integer): TFieldType;
begin
  Result := FQuery.Params[Index].DataType;
end;

procedure TRMDBDEQuery.SetParamType(Index: Integer; Value: TFieldType);
begin
  FQuery.Params[Index].DataType := Value;
end;

function TRMDBDEQuery.GetParamKind(Index: Integer): TRMParamKind;
begin
  Result := rmpkValue;
  if not FQuery.Params[Index].Bound then
    Result := rmpkAssignFromMaster;
end;

procedure TRMDBDEQuery.SetParamKind(Index: Integer; Value: TRMParamKind);
begin
  if Value = rmpkAssignFromMaster then
  begin
    FQuery.Params[Index].Bound := False;
    FParams.Delete(FParams.IndexOf(FQuery.Params[Index].Name));
  end
  else
  begin
    FQuery.Params[Index].Clear;
    FQuery.Params[Index].Bound := True;
    FParams[FQuery.Params[Index].Name] := '';
  end;
end;

function TRMDBDEQuery.GetParamText(Index: Integer): string;
begin
  Result := '';
  if ParamKind[Index] = rmpkValue then
    Result := FParams[FQuery.Params[Index].Name];
end;

procedure TRMDBDEQuery.SetParamText(Index: Integer; Value: string);
begin
  if ParamKind[Index] = rmpkValue then
    FParams[FQuery.Params[Index].Name] := Value;
end;

function TRMDBDEQuery.GetParamValue(Index: Integer): Variant;
begin
  Result := FQuery.Params[Index].Value;
end;

procedure TRMDBDEQuery.SetParamValue(Index: Integer; Value: Variant);
begin
  FQuery.Params[Index].Value := Value;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TDBEditForm}

procedure TRMDFormBDEDBProp.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(GroupBox1, 'Caption', rmRes + 3233);
  RMSetStrProp(Label4, 'Caption', rmRes + 3234);
  RMSetStrProp(Label1, 'Caption', rmRes + 3235);
  RMSetStrProp(Label2, 'Caption', rmRes + 3236);
  RMSetStrProp(Label3, 'Caption', rmres + 3237);
  RMSetStrProp(btnDefaultsParam, 'Caption', rmRes + 3238);
  RMSetStrProp(btnClearParam, 'Caption', rmRes + 3239);
  RMSetStrProp(btnPath, 'Caption', rmRes + 3240);

  btnOK.Caption := RMLoadStr(SOK);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

function TRMDFormBDEDBProp.Edit: Boolean;
begin
  edtDBName.Text := FDatabase.DatabaseName;
  cmbAliasName.Text := FDatabase.AliasName;
  cmbDriverName.Text := FDatabase.DriverName;
  memDatabaseParams.Lines := FDatabase.Params;
  Result := False;
  if ShowModal = mrOk then
  begin
    FDatabase.DatabaseName := edtDBName.Text;
    if cmbDriverName.Text <> '' then
      FDatabase.DriverName := cmbDriverName.Text
    else
      FDatabase.AliasName := cmbAliasName.Text;
    FDatabase.Params := memDatabaseParams.Lines;
    Result := True;
  end;
end;

procedure TRMDFormBDEDBProp.cmbAliasNameChange(Sender: TObject);
begin
  cmbDriverName.Text := '';
end;

procedure TRMDFormBDEDBProp.cmbAliasNameDropDown(Sender: TObject);
begin
  cmbAliasName.Items.Clear;
  FDatabase.Session.GetAliasNames(cmbAliasName.Items);
end;

procedure TRMDFormBDEDBProp.cmbDriverNameChange(Sender: TObject);
begin
  cmbAliasName.Text := '';
end;

procedure TRMDFormBDEDBProp.cmbDriverNameDropDown(Sender: TObject);
begin
  cmbDriverName.Items.Clear;
  FDatabase.Session.GetDriverNames(cmbDriverName.Items);
end;

procedure TRMDFormBDEDBProp.btnDefaultsParamClick(Sender: TObject);
var
  AddPassword: Boolean;
begin
  memDatabaseParams.Clear;
  AddPassword := False;
  if cmbDriverName.Text <> '' then
  begin
    FDatabase.Session.GetDriverParams(cmbDriverName.Text, memDatabaseParams.Lines);
    AddPassword := cmbDriverName.Text <> szCFGDBSTANDARD;
  end
  else if cmbAliasName.Text <> '' then
  begin
    FDatabase.Session.GetAliasParams(cmbAliasName.Text, memDatabaseParams.Lines);
    AddPassword := FDatabase.Session.GetAliasDriverName(cmbAliasName.Text) <> szCFGDBSTANDARD;
  end;

  if AddPassword then memDatabaseParams.Lines.Add('PASSWORD=');
end;

procedure TRMDFormBDEDBProp.btnClearParamClick(Sender: TObject);
begin
  memDatabaseParams.Clear;
end;

procedure TRMDFormBDEDBProp.btnPathClick(Sender: TObject);
var
  str: string;
begin
  if RMSelectDirectory(RMLoadStr(rmRes + 3252), '', str) then
    memDatabaseParams.Lines.Values['PATH'] := str;
//  if SelectDirectory(str, [], 0) then
//    memDatabaseParams.Lines.Values['PATH'] := str;
end;

procedure TRMDFormBDEDBProp.btnOKClick(Sender: TObject);
begin
  ModalResult := mrNone;
  try
    FDatabase.ValidateName(edtDBName.Text);
  except
    edtDBName.SetFocus;
    raise;
  end;
  if FDatabase.Connected then
  begin
    if MessageDlg(SDisconnectDatabase, mtConfirmation,
      mbOkCancel, 0) <> mrOk then Exit;
    FDatabase.Close;
  end;
  ModalResult := mrOk;
end;

procedure TRMDFormBDEDBProp.FormCreate(Sender: TObject);
begin
  Localize;
end;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
type
  TAliasNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TDriverNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TDatabaseNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TDatabaseEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TIndexNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TIndexFieldNamesEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TTableNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TAliasNameEditor }

function TAliasNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TAliasNameEditor.GetValues(AValues: TStrings);
begin
  Session.GetAliasNames(aValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDriverNameEditor }

function TDriverNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TDriverNameEditor.GetValues(AValues: TStrings);
begin
  Session.GetDriverNames(aValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDatabaseNameEditor }

function TDatabaseNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praDialog];
end;

procedure TDatabaseNameEditor.Edit;
begin
  TRMDBDEDatabase(GetInstance(0)).ShowEditor;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDatabaseEditor }

function TDatabaseEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TDatabaseEditor.GetValues(AValues: TStrings);
begin
  Session.GetAliasNames(aValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TIndexNameEditor }

function TIndexNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TIndexNameEditor.GetValues(AValues: TStrings);
var
  liTable: TRMDBDETable;
begin
  liTable := TRMDBDETable(GetInstance(0));
  liTable.GetIndexNames(aValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TIndexFieldNamesEditor }

function TIndexFieldNamesEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TIndexFieldNamesEditor.GetValues(AValues: TStrings);
var
  lTable: TRMDBDETable;
  i: Integer;
begin
  lTable := TRMDBDETable(GetInstance(0));
  lTable.IndexDefs.Update;
  for i := 0 to lTable.IndexDefs.Count - 1 do
  begin
    aValues.Add(lTable.IndexDefs[i].Fields);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TTableNameEditor }

function TTableNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TTableNameEditor.GetValues(AValues: TStrings);
var
  liTable: TTable;
begin
  liTable := TRMDBDETable(GetInstance(0)).FTable;
  if liTable.DatabaseName <> '' then
  begin
    Session.GetTableNames(liTable.DatabaseName, '', True, False, aValues);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

procedure TRMDBDEQuery_ExecSql(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMDBDEQuery(Args.Obj).OnBeforeOpenQueryEvent(TRMDBDEQuery(Args.Obj).FQuery);
  TRMDBDEQuery(Args.Obj).FQuery.ExecSQL;
end;

const
	cReportMachine = 'RMD_BDE';

procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass(cReportMachine, TRMDBDEDatabase, 'TRMDBDEDataSet');
    AddClass(cReportMachine, TRMDBDETable, 'TRMDBDETable');
    AddClass(cReportMachine, TRMDBDEQuery, 'TRMDBDEQuery');

    { TRMDBDEQuery }
    AddGet(TRMDDataset, 'ExecSql', TRMDBDEQuery_ExecSql, 0, [0], varEmpty);
  end;
end;

initialization
//  RMRegisterControl(TRMDBDEDatabase, 'RMD_BDEDB', RMLoadStr(SInsertDB) + '(BDE)');
//  RMRegisterControl(TRMDBDETable, 'RMD_BDETABLE', RMLoadStr(SInsertTable) + '(BDE)');
//  RMRegisterControl(TRMDBDEQuery, 'RMD_BDEQUERY', RMLoadStr(SInsertQuery) + '(BDE)');
  RMRegisterControls('BDE', 'RMD_BDEPATH', True,
    [TRMDBDEDatabase, TRMDBDETable, TRMDBDEQuery],
    ['RMD_BDEDB', 'RMD_BDETABLE', 'RMD_BDEQUERY'],
    [RMLoadStr(SInsertDB), RMLoadStr(SInsertTable), RMLoadStr(SInsertQuery)]);

  RMRegisterPropEditor(TypeInfo(string), TRMDBDEDatabase, 'AliasName', TAliasNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDBDEDatabase, 'DriverName', TDriverNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDBDEDatabase, 'DatabaseName', TDatabaseNameEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDBDETable, 'DatabaseName', TDatabaseEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDBDETable, 'IndexName', TIndexNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDBDETable, 'IndexFieldNames', TIndexFieldNamesEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDBDETable, 'TableName', TTableNameEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDBDEQuery, 'DatabaseName', TDatabaseEditor);

{$IFDEF USE_INTERNAL_JVCL}
  rm_JvInterpreter_DbTables.RegisterJvInterpreterAdapter(GlobalJvInterpreterAdapter);
{$ELSE}
  JvInterpreter_DbTables.RegisterJvInterpreterAdapter(GlobalJvInterpreterAdapter);
{$ENDIF}
  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

finalization

{$ENDIF}
end.