unit1.pas

自动配置数据源的简单程序；可以不用手动去配置数据源

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function getuname():string;   //用户名
    function getdrive():string;  //驱动
  end;

var
  Form1: TForm1;
  Reg:TRegistry;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  openreg=  'software\ODBC\ODBC.INI\';
begin
try
  if ((Edit1.Text='') and (Edit2.Text='') and (Edit3.Text='')) then
  begin
    Application.MessageBox('请正确添写！','提示',0);
    Exit;
  end;
  //数据源名称和数据库
  Reg:=TRegistry.Create;
  reg.RootKey:=HKEY_CURRENT_USER;
  reg.OpenKey(openreg+Edit1.Text,True);
  reg.WriteString('DataBase',Trim(Edit2.Text));
  // 服务器名称
  reg.WriteString('Server',Trim(Edit3.Text));
  // 用户名称
  reg.WriteString('LastUser',Trim(getuname()));
    //驱动
  reg.WriteString('Driver',Trim(getdrive()));
    //信任连接
  reg.WriteString('Trusted_Connection','Yes');
  reg.WriteString('DataBase',Trim(Edit2.Text));
  reg.Free;
  Reg:=TRegistry.Create;
  reg.OpenKey(openreg+'ODBC Data Sources',True);
  reg.WriteString(Trim(Edit1.Text),'SQl Server');
  reg.Free;
  Application.MessageBox('配置成功！','提示',0);
except
  Application.MessageBox('配置不成功！','提示',0);
end;
end;

function TForm1.getdrive: string;
var
  namebuff:Pchar;
  size:Dword;
begin
  getmem(namebuff,255);
  size:=255;
  GetSystemDirectory(namebuff,size);
  result:=strpas(namebuff)+'\sqlsrv32.dll';
  freemem(namebuff);
end;
function TForm1.getuname: string;
var
  namebuff:Pchar;
  size:Dword;
begin
  getmem(namebuff,255);
  size:=255;
  GetUserName(namebuff,size);
  result:=strpas(namebuff);
  freemem(namebuff);
end;

end.