main.pas

写注册表设置软件连接数据工具,可以是多种数据库

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ExtCtrls,ComObj,Registry;

type
  TMainForm = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Bevel1: TBevel;
    Image1: TImage;
    Label5: TLabel;
    edtServer: TComboBox;
    CatalogName: TEdit;
    LoginUser: TEdit;
    Password: TEdit;
    btnExit: TButton;
    testADOConnection: TADOConnection;
    btnOk: TButton;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Label6: TLabel;
    cbDatabaseType: TComboBox;
    procedure btnExitClick(Sender: TObject);
    procedure btnOkClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    function  decrypt( EncryptText: String ): String;
    function Encrypt(tmpString: AnsiString ): String;
    procedure cbDatabaseTypeChange(Sender: TObject);

    private

    { Private declarations }

  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
var
  SQLServer: Variant;
  ServerList: Variant;
  i, nServers: integer;

begin
  try
    SQLServer := CreateOleObject('SQLDMO.Application');
//    ServerList := SQLServer.OleFunction('ListAvailableSQLServers');
//    nServers := ServerList.OlePropertyGet('Count');

    ServerList := SQLServer.ListAvailableSQLServers;
    nServers := ServerList.Count;

    edtServer.Items.Clear();
    for i := 1 to nServers do       //将检测结果放入edtServer中
//      edtServer.Items.Add(ServerList.OleFunction('Item', i));
      edtServer.Items.Add(ServerList.Item(i));
    SQLServer := Unassigned;
    ServerList := Unassigned;
  except
    edtServer.ItemIndex := 0;
  end;
end;

procedure TMainForm.FormShow(Sender: TObject);
var
  regDB: TRegistry;
begin
  regDB := TRegistry.Create;
  regDB.RootKey := HKEY_LOCAL_MACHINE;
  regDB.OpenKey('SOFTWARE\\YINJUNSOFT\\CTOP2005\\Connection',true);
  if regDB.ValueExists('DatabaseType') then
    cbDatabaseType.ItemIndex := regDB.ReadInteger('DatabaseType'); 
  edtServer.Text := regDB.ReadString('Data Source');
  CatalogName.Text := regDB.ReadString('Initial Catalog');
  LoginUser.Text := regDB.ReadString('User Name');
  Password.Text := Decrypt(regDB.ReadString('Password'));
  regDB.Free;

  cbDatabaseTypeChange(cbDatabaseType);
end;

procedure TMainForm.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.btnOkClick(Sender: TObject);
var
  regDB: TRegistry  ;
begin
  regDB := TRegistry.Create;
  if ((edtServer.Text = '') and (cbDatabaseType.ItemIndex <> 1)) or
    (CatalogName.Text = '') or (LoginUser.text = '') then
  begin
    Application.MessageBox('请输入完整项。', '错误', MB_ICONWARNING + MB_OK);
  end;
    with testADOConnection do
    begin
      if cbDatabaseType.ItemIndex = 0 then
      begin
        ConnectionString := 'Provider=SQLOLEDB.1;';
        ConnectionString := ConnectionString + 'Password=' + Password.Text +
          ';Persist Security Info=True;User ID=';
        ConnectionString := ConnectionString + LoginUser.Text +
          ';Initial Catalog=' + CatalogName.Text +
          ';Data Source=' + edtServer.Text;
      end else if cbDatabaseType.ItemIndex = 1 then
      begin
        ConnectionString := 'Provider=IBMDADB2.1;';
        ConnectionString := ConnectionString + 'Password=' + Password.Text + ';';
        ConnectionString := ConnectionString + 'Persist Security Info=True;';
        ConnectionString := ConnectionString + 'User ID=' + LoginUser.Text + ';';
        ConnectionString := ConnectionString + 'Data Source=' + CatalogName.Text + ';';
        ConnectionString := ConnectionString + 'Location=' + edtServer.Text + ';Mode=ReadWrite';
      end;

      try
        Connected := true;
        Application.MessageBox('服务器测试连接成功！', '连接成功',
          MB_ICONINFORMATION + MB_OK);
        Connected := false;
      except
        Application.MessageBox('连接失败，请检查用户名和密码是否正确！',
          '连接失败',
          MB_ICONWARNING + MB_OK);
      end;
    end;
    
    regDB.RootKey := HKEY_LOCAL_MACHINE;
    regDB.OpenKey('SOFTWARE\\YINJUNSOFT\\CTOP2005\\Connection',false);
    regDB.WriteInteger('DatabaseType', cbDatabaseType.ItemIndex); 
    regDB.WriteString('Data Source',edtServer.Text);
    regDB.WriteString('Initial Catalog',CatalogName.Text);
    regDB.WriteString('User Name',LoginUser.Text);
    regDB.WriteString('Password',Encrypt(Password.Text));
    regDB.free;
  end;

function TMainForm.decrypt(EncryptText: String): String;
var
  i,Key3: integer;
  OriginalText: String;
begin
  Key3 := 1;

  for i := 1 to Length(EncryptText) do
  begin
    OriginalText := OriginalText + CHAR(Ord(EncryptText[i]) - Key3);
  end;

  result := OriginalText;
end;

function TMainForm.Encrypt(tmpString: String): String;
var
  i, Key3: integer;
  EncryptText: String;
begin
  Key3 := 1;

  EncryptText := '';
  for i := 1 to Length(tmpString) do
  begin
    EncryptText := EncryptText + CHAR(Ord(tmpString[i]) + Key3);
  end;

  result := EncryptText;
end;

procedure TMainForm.cbDatabaseTypeChange(Sender: TObject);
begin
  case (Sender as TComboBox).ItemIndex of
    0:  begin
          Label5.Caption := '　　设定SQL Server 基本连接，请选择SQL服务器，并输入数据库名、用户名和密码。';
        end;
    1:  begin
          Label5.Caption := '　　设定DB2 基本连接，请选择SQL服务器，并输入数据库名、用户名和密码。';
        end;
  end;
end;

end.