fmregedit.pas

ODBC数据源注册小工具

unit fmRegedit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Registry;

type
  TForm1 = class(TForm)
    btn1: TSpeedButton;
    grp1: TGroupBox;
    grp2: TGroupBox;
    lbl1: TLabel;
    lbl2: TLabel;
    edt1: TEdit;
    edt2: TEdit;
    lbl3: TLabel;
    lbl4: TLabel;
    lbl5: TLabel;
    chk1: TCheckBox;
    edt5: TEdit;
    btn2: TSpeedButton;
    edt4: TEdit;
    dlgOpen: TOpenDialog;
    btn3: TSpeedButton;
    lbl6: TLabel;
    edt6: TEdit;
    btn4: TSpeedButton;
    dlgOpen1: TOpenDialog;
    cbb1: TComboBox;
    edt3: TEdit;
    btn5: TSpeedButton;
    lbl7: TLabel;
    dlgOpen2: TOpenDialog;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure chk1Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure cbb1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
Var 
  Temp:TRegistry;
  bData:array[0..0] of byte;
  sAliasName,sDescription,sPath,sUID,sPWD,sDriverPath,sSystemDB:String;
begin
  //数据完整性判断
  sAliasName:=Trim(cbb1.Text);
  sDescription:=Trim(edt4.Text);
  sPath:=Trim(edt5.Text);
  sUID:=Trim(edt1.Text);
  sPWD:=Trim(edt2.Text);
  sDriverPath:=Trim(edt6.Text);
  sSystemDB:=Trim(edt3.Text);
  if sAliasName='' then
  begin
    MessageBox(handle, '数据库别名不可为空！', '提示', MB_OK + MB_ICONINFORMATION);
    exit;
  end;
  if sPath='' then
  begin
    MessageBox(HANDLE, '尚未指定数据库！          ', '提示', MB_OK + 
      MB_ICONINFORMATION);
    exit;
  end;
  if Not FileExists(sPath) then
  begin
    MessageBox(handle, '指定的数据库不存在！       ', '提示', MB_OK +
      MB_ICONINFORMATION);
    exit;
  end;
  if (sUID<>'') and (not chk1.Checked) then
    if sPWD='' then
    begin
      Messagebox(handle,'密码不可为空！        ','提示',MB_OK +
        MB_ICONINFORMATION);
      EXIT;
    end;
  if Not FileExists(sDriverPath) then
  begin
    MessageBox(handle, '驱动文件不存在！        ', '提示', MB_OK + 
      MB_ICONINFORMATION);
    exit;  
  end;
try
  Temp:=TRegistry.Create;  //建立一个Registry实例
  With Temp do
  begin 
    RootKey:=HKEY_LOCAL_MACHINE;  //设置根键值为HKEY_LOCAL_MACHINE 
    //打开键名 software\ODBC\ODBC.ini\ODBC Data Sources,不存在则建立 
    If OpenKey('softWare\ODBC\ODBC.INI\ODBC Data Sources',True) then 
    begin 
      WriteString(sAliasName, 'Microsoft Access Driver (*.mdb)' );
    end 
    else 
    begin
      MessageBox(handle, '增加ODBC数据源失败！' + #13#10 +
        '请重试_________________' + #13#10 + '或直接在操作系统中设置．',
        '提示', MB_OK + MB_ICONINFORMATION); 
      exit; 
    end; 
    CloseKey; 
    //找到或创建Software\ODBC\ODBC.INI\dbMain,写入DSN配置信息 
    if OpenKey('Software\ODBC\ODBC.INI\'+sAliasName,True) then
    begin 
      WriteString('DBQ',sPath);
      WriteString('SystemDB',sSystemDB);
      WriteString('Description',sDescription );
      WriteString( 'Driver', sDriverPath ); //驱动程序DLL文件  ODBCJT32.DLL文件依据你的存放路径
      WriteInteger( 'DriverId', 25 );//驱动程序标识 
      WriteString( 'FIL', 'Ms Access;' ); 
      //Filter依据 
      WriteInteger( 'SafeTransaction', 0 );     //支持的事务操作数目 
      //若不存在用户,则为下面一句: 
      //WriteString( 'UID', '' );//用户名称,若存在用户,则写入用户名
      //若存在用户和密码,则为下面二句:
      //WriteString( 'UID', sUID );   //用户名
      //WriteString( 'PWD', sPWD );//口令
      if chk1.Checked then
        WriteString( 'UID', sUID )
      else
      begin
        WriteString( 'UID', sUID );
        WriteString( 'PWD', sPWD );
      end;
      bData[0] := 0;
      WriteBinaryData( 'Exclusive', bData, 1 );   //是否以独占方式打开,1为是,默认为0 
      WriteBinaryData( 'ReadOnly', bData, 1 ); //是否以只读方式打开,1为是,默认为0 
    end 
    else 
    begin 
      MessageBox(handle, '增加ODBC数据源失败！' + #13#10 +
        '请重试_________________' + #13#10 + '或直接在操作系统中设置．', 
        '提示', MB_OK + MB_ICONINFORMATION);
      exit; 
    end;

    CloseKey; 

    //找到或创建Software\ODBC\ODBC.INI\dbMain\Engines\Jet 
    //写入DSN数据库引擎配置信息 
    if OpenKey('Software\ODBC\ODBC.INI\'+sAliasName+'\Engines\Jet',True) then
    begin 
       WriteString( 'ImplicitCommitSync', 'Yes' ); //表示是否立即反映数据修改
       WriteInteger( 'MaxBufferSize', 512 );//缓冲区大小 
       WriteInteger( 'PageTimeout', 10 );//页超时 
       WriteInteger( 'Threads', 3 );//支持的线程数目 
       WriteString( 'UserCommitSync', 'Yes' ); //表示是否立即将数据修改反映到用户 
    end 
    else 
    begin 
      MessageBox(handle, '增加ODBC数据源失败！' + #13#10 +
        '请重试_________________' + #13#10 + '或直接在操作系统中设置．', 
        '提示', MB_OK + MB_ICONINFORMATION); 
      exit; 
    end; 

    CloseKey; 
    MessageBox(handle, '恭喜，注册成功了！', '恭喜！', MB_OK + MB_ICONINFORMATION); 
    Free; 
  end;     //end (With Temp do)
finally
  Temp:=nil;
  Temp.Free;
end;
end;


procedure TForm1.btn2Click(Sender: TObject);
begin
  if dlgOpen.Execute then
    edt5.Text := dlgOpen.FileName ;
end;

procedure TForm1.chk1Click(Sender: TObject);
begin
  if chk1.Checked then
  begin
    edt2.Text :='';
    edt2.Enabled := False;
    edt2.Color := cl3DLight;
  end
  else
  begin
    edt2.Enabled := True;
    edt2.Color := clWindow;
  end;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  if dlgOpen1.Execute then
    edt6.Text := dlgOpen1.FileName;
end;

procedure TForm1.btn5Click(Sender: TObject);
begin
  if dlgOpen2.Execute then
    edt3.Text := dlgOpen2.FileName ;
end;

procedure TForm1.cbb1Change(Sender: TObject);
begin
  MessageBox(handle, '       金蝶数据库中使用的是dbKingdee为        ' + #13#10 + 
    '别名，如果改为别的别名，佰信将不能        ' + #13#10 +
    '正确连接到金蝶数据库。', '提示', MB_OK + MB_ICONINFORMATION);
  cbb1.OnChange :=nil;
end;

end.