configado.pas

一个详细功能齐全的档案管理信息系统 跟大家分享一下。这是老师给的光盘里带的

unit ConfigAdo;

interface

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

type
  TfConfigAdo = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    ADOConnection1: TADOConnection;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label4: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label5: TLabel;
    Label6: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;
type
 TCon=record
      Initial :string;
      UserID  :string;
      Password:string;
      DataSour:string;
      NT      :boolean;
 end;
const
  NTConstr='Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=%s;Data Source=%s';
  SaConstr='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=%s;Password=%s;Initial Catalog=%s;Data Source=%s';
  ConKey  ='software\IDMS\1.0';
var
  Constring:TCon=(Initial:'DL2003';UserID:'sa';Password:'';DataSour:'Server');
  procedure WriteReg(aKey:String;aName:string;WriteStr:string);
  function ReadReg(aKey:string;aName:string;var aPath:string):boolean;
  function ExistsReg(aKey:String):boolean;
  function DecodeConnestStr:boolean;
implementation

{$R *.dfm}
procedure WriteReg(aKey:String;aName:string;WriteStr:string);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(aKey,True) then
    begin
      Reg.WriteString(aName,WriteStr);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;
function ReadReg(aKey:string;aName:string;var aPath:string):boolean;
var
  Reg: TRegistry;
begin
  Result:=False;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.KeyExists(aKey) then
      if Reg.OpenKey(aKey,False) then
      begin
        if Reg.ValueExists(aName)then
        begin
           aPath:=Reg.ReadString(aName);
           Result:=True;
           Reg.CloseKey;
        end;
      end;
  finally
    Reg.Free;
  end;
end;
function ExistsReg(aKey:String):boolean;
var
  Reg: TRegistry;
begin
  result:=False;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    result:=Reg.KeyExists(aKey);
  finally
    Reg.Free;
  end;
end;
function DecodeConnestStr:boolean;
var
  str:string;
  tmpstr:string;
  finalstr:string;
  i,j:integer;
begin
  Result:=True;
  if ExistsReg(ConKey) then
  begin
      ReadReg(ConKey,'ConnectionString',str);
      ///
      i:=Pos('Integrated Security=', Str);
      if i<>0 then
      begin
         Constring.NT:=True;
      end else
         Constring.NT:=False;
      ///
      i:=Pos('Initial Catalog=', Str);
      if (i<>0)and(Not Constring.NT) then
      begin
        tmpstr:=copy(str,i+16,length(str)-i-15);
        j:=pos(';',tmpstr);
        if j<>0 then
        finalstr:=copy(tmpstr,1,j-1)
        else
        finalstr:=tmpstr;
        Constring.Initial:=finalstr;
      end else
        Result:=False;
     ///
      i:=Pos('Data Source=', Str);
      if (i<>0) then
      begin
        tmpstr:=copy(str,i+12,length(str)-i-11);
        j:=pos(';',tmpstr);
        if j<>0 then
        finalstr:=copy(tmpstr,1,j-1)
        else
        finalstr:=tmpstr;
        Constring.DataSour:=finalstr;
      end else
        Result:=False;
      ////
      i:=Pos('User ID=', Str);
      if (i<>0)and(Not Constring.NT) then
      begin
        tmpstr:=copy(str,i+8,length(str)-i-7);
        j:=pos(';',tmpstr);
        if j<>0 then
        finalstr:=copy(tmpstr,1,j-1)
        else
        finalstr:=tmpstr;
        Constring.UserID:=finalstr;
      end else
        Result:=False;
      ////
      i:=Pos('Password=', Str);
      if (i<>0)and(Not Constring.NT) then
      begin
        tmpstr:=copy(str,i+9,length(str)-i-8);
        j:=pos(';',tmpstr);
        if j<>0 then
        finalstr:=copy(tmpstr,1,j-1)
        else
        finalstr:=tmpstr;
        Constring.Password:=finalstr;
      end else
        Result:=False;
  end else
     Result:=False;
end;
procedure TfConfigAdo.FormCreate(Sender: TObject);

begin
  inherited;
  DecodeConnestStr;
  if Constring.NT then
  begin
      RadioButton1.Checked:=True;
      RadioButton2.Checked:=False;
      Edit2.Enabled:=False;
      Edit3.Enabled:=False;
  end;
  Edit1.Text:=Constring.DataSour;
  Edit2.Text:=Constring.UserID;
  Edit3.Text:=Constring.Password;
  Edit4.Text:=Constring.Initial;
end;

procedure TfConfigAdo.Button1Click(Sender: TObject);
var
   str:widestring;
begin  
      Constring.DataSour:=Edit1.Text;
      Constring.UserID  :=Edit2.Text;
      Constring.Password:=Edit3.Text;
      Constring.Initial :=Edit4.Text;
    try
      if RadioButton1.Checked then
      str:=format(NTConstr,[Constring.Initial,Constring.DataSour])
      else
      str:=format(SaConstr,[Constring.UserID,Constring.Password,Constring.Initial,Constring.DataSour]);
      ADOConnection1.Connected:=False;
      ADOConnection1.ConnectionString:=str;

      ADOConnection1.Connected:=True;
      screen.Cursor:= crHourGlass;
      if ADOConnection1.Connected=true then
      MessageDlgPos('与SQL SERVER数据库连接成功'#10#13,mtCustom, [mbOK], 0,left+70,top+230)
      else
      MessageDlgPos('与SQL SERVER数据库连接不成功'#10#13,mtCustom, [mbOK], 0,left+70,top+230);
    except
      MessageDlgPos('与SQL SERVER数据库连接不成功'#10#13, mtCustom, [mbOK], 0,left+70,top+230);
    end;
    ADOConnection1.Close;
    screen.Cursor:=crDefault;
end;

procedure TfConfigAdo.RadioButton1Click(Sender: TObject);
begin
   Edit2.Enabled:=False;
   Edit3.Enabled:=False;
end;

procedure TfConfigAdo.RadioButton2Click(Sender: TObject);
begin
   Edit2.Enabled:=True;
   Edit3.Enabled:=True;
end;

procedure TfConfigAdo.Button2Click(Sender: TObject);
var
   str:widestring;
begin
      Constring.Initial:=Edit4.Text;
      Constring.DataSour:=Edit1.Text;
      Constring.UserID:=Edit2.Text;
      Constring.Password:=Edit3.Text;
      if RadioButton1.Checked then
      str:=Format(NTConstr,[Constring.Initial,Constring.DataSour])
      else
      str:=format(SaConstr,[Constring.UserID,Constring.Password,Constring.Initial,Constring.DataSour]);
      WriteReg(ConKey,'ConnectionString',str);
end;

procedure TfConfigAdo.Button3Click(Sender: TObject);
var
   str:widestring;
begin
   if not ExistsReg(ConKey)then
   begin
      str:=format(SaConstr,[Constring.UserID,Constring.Password,Constring.Initial,Constring.DataSour]);
      WriteReg(ConKey,'ConnectionString',str);
   end;
end;

end.