connect.pas

来自「pasa人力资源考勤管理系统」· PAS 代码 · 共 372 行

unit connect;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, Db, DBTables, ADODB, Menus ,IniFiles ,Activex,Shlobj,
  Mask, ToolEdit, ComCtrls;


type
  TFormconnect = class(TForm)
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    ComboBox1: TComboBox;
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    ADOQuery1: TADOQuery;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    ComboBox2: TComboBox;
    SpeedButton5: TSpeedButton;
    newdatabase: TDirectoryEdit;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    GroupBox1: TGroupBox;
    SpeedButton6: TSpeedButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
  private
    { Private declarations }
    mpb_cn:boolean ;
  public
    { Public declarations }
    function SelectComputer:string;
  end;

var
  Formconnect: TFormconnect;
  lan:string;
implementation

uses  OLEDB, DBLogDlg, ADOConEd;

{$R *.DFM}

procedure TFormconnect.FormCreate(Sender: TObject);
var f:textfile;
    myfile,fline:string ;
begin
  mpb_cn:=Adoconnection1.connected ;
  myfile:=extractfilepath(application.ExeName)+'data\login.ini';
  if fileexists(myfile) then
    begin
      assignfile(f,myfile);
      reset(f);
      readln(f,fline) ;
      edit5.Text :=trim(copy(fline,pos('=',fline)+1,20)) ;      //    database user
      readln(f,fline) ;
      combobox1.Text :=trim(copy(fline,pos('=',fline)+1,20)) ;   //   sql server name
      readln(f,fline) ;
      combobox2.Text :=trim(copy(fline,pos('=',fline)+1,20)) ;  // database name
      if (pos('word',fline)>0) and (length(trim(copy(fline,pos('=',fline)+1,20)))>0) then
        edit6.text :=trim(copy(fline,pos('=',fline)+1,20)) ;    //   password of database user
      readln(f,fline) ;
      readln(f,fline) ;
      if (pos('type',fline)>0) then
        case strtoint(trim(copy(fline,pos('=',fline)+1,20))) of    //   password of database user
        0:begin   //windows
            radiobutton1.Checked :=true ;
            radiobutton1.OnClick(radiobutton1) ;
          end;
        1:begin   //sql
            radiobutton2.Checked :=true ;
            radiobutton2.OnClick(radiobutton2) ;
          end;
        2:begin    //odbc
            radiobutton3.Checked :=true ;
            radiobutton3.OnClick(radiobutton3) ;
          end;
        3:begin    //other
            radiobutton4.Checked :=true ;
            radiobutton4.OnClick(radiobutton4) ;
          end;
        end ;
      readln(f,fline) ;
      if (pos('netid',fline)>0) and (trim(copy(fline,pos('=',fline)+1,20))='false') then
        checkbox1.Checked :=false
      else if (pos('netid',fline)>0) and (trim(copy(fline,pos('=',fline)+1,20))='true') then
        checkbox1.Checked :=true ;
      closefile(f) ;
     end
   else
     Application.Messagebox('无法连接！！！','Warning',mb_ok+mb_iconwarning);
end;

procedure TFormconnect.FormKeyPress(Sender: TObject; var Key: Char);
begin
   if key=#13 then
     begin
       perform(cm_dialogkey,vk_tab,0);
       key:=#0;
     end;
end;

procedure TFormconnect.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  action:=cafree;
  formconnect:=nil;
end;

function TFormconnect.SelectComputer:string;
var
  ComputerName:string;
  BrowseInfo:TBrowseInfo;
  Buffer:PChar;
  RootItemIDList,ItemIDList:PItemIDList;
  ShellMalloc:IMalloc;
  WindowList:Pointer;
begin
  ZeroMemory(@BrowseInfo,sizeof(TBrowseInfo));
  if SUCCEEDED(SHGetMalloc(ShellMalloc)) and (ShellMalloc <> nil) then
  begin
    Buffer:=PChar(ShellMalloc.Alloc(MAX_PATH));
    RootItemIDList := nil;
    BrowseInfo.hwndOwner := Application.Handle;
    BrowseInfo.pidlRoot := RootItemIDList;
    BrowseInfo.pszDisplayName := PChar(Buffer);
    BrowseInfo.lpszTitle :='请选择服务器';
    BrowseInfo.ulFlags := BIF_BROWSEFORCOMPUTER;
    WindowList := DisableTaskWindows(0);
    SHGetSpecialFolderLocation(BrowseInfo.hwndOwner,
                               CSIDL_NETWORK,
                               BrowseInfo.pidlRoot);
    ItemIDList :=SHBrowseForFolder(BrowseInfo);
    if ItemIDList <> nil then
    begin
      ComputerName:= BrowseInfo.pszDisplayName ;
    end
    else ComputerName:='';
    EnableTaskWindows(WindowList);
    if ItemIDList<>nil then
      ShellMalloc.Free(ItemIDList);
    Result := ComputerName;
  end;
end;

procedure TFormconnect.FormShow(Sender: TObject);
begin
  combobox2.SetFocus ;
end;

procedure TFormconnect.SpeedButton1Click(Sender: TObject);
var f:textfile;
    myfile,fline:string ;
begin
try
  if length(newdatabase.Text)=0 then
    begin
      showmessage('数据库已存在,请更名!') ;
      exit ;
    end;
  adoQuery1.close;
  adoquery1.sql.text:='select name from  master.dbo.sysdatabases WHERE name = '''+combobox1.text+''' ';
  adoquery1.sql.SaveToFile('c:\addd.sql');
  adoquery1.open ;
  if not adoquery1.Eof then
   if application.messagebox(pchar('找不到'+''+combobox1.text+''+'数据库'),'系统提示',mb_okcancel+mb_iconquestion)<>idok then
    exit ;
  adoquery1.Close ;
  Screen.Cursor :=crSQLWait ;
  adoquery1.sql.clear ;
  adoquery1.SQL.Add('IF EXISTS (SELECT name FROM master.dbo.sysdatabases WHERE name = N'''+combobox1.Text+''') ') ;
  adoquery1.SQL.Add('DROP DATABASE ['+combobox1.text+']') ;
  adoquery1.execsql ;
  adoquery1.SQL.clear ;
  adoquery1.SQL.Add('CREATE DATABASE ['+combobox1.text+'] '+
    ' ON (NAME = N'''+combobox1.text+'_Data'+''','+
    ' FILENAME = N'''+newdatabase.text+'\'+''+combobox1.text+''+'_Data.MDF'+''' ,'+
    ' SIZE = 4, FILEGROWTH = 10%) LOG ON (NAME = N'''+combobox1.text+'_Log'+''', '+
    ' FILENAME = N'''+newdatabase.text+'\'+''+combobox1.text+''+'_Log.LDF'+''' , SIZE = 1, FILEGROWTH = 10%) ') ;
  adoquery1.SQL.Add('COLLATE Chinese_PRC_Stroke_CI_AS' );
  adoquery1.ExecSQL ;
  adoquery1.sql.clear ;
  Adoconnection1.Connected :=false ;
  Adoconnection1.DefaultDatabase :=combobox1.Text ;
  Adoconnection1.Connected :=true ;
  myfile:=extractfilepath(application.ExeName)+'sql\pasa.sql';
  if fileexists(myfile) then
    begin
      assignfile(f,myfile);
      reset(f);
      while not eof(f) do
       begin
         readln(f,fline);
         if trim(fline)='GO' then
           begin
             adoquery1.ExecSQL ;
             adoquery1.SQL.Clear ;
           end
         else if trim(fline)<>'' then
           adoquery1.SQL.Add (fline);
       end ;
       closefile(f) ;
    end
  else showmessage('') ;
  Screen.Cursor :=crdefault ;
  showmessage('') ;
except
  showmessage('建立数据库失败！！！') ;
  Screen.Cursor :=crdefault ;
end;
end;

procedure TFormconnect.SpeedButton2Click(Sender: TObject);
var f:textfile;
    myfile,fline:string ;
    AdoConnect:string ;
    Adoquery1 :Tadoquery ;
begin
  try
    adoconnection1.Connected :=false;
    adoconnection1.LoginPrompt :=false;
    if Radiobutton1.checked then
      Adoconnect:='Integrated Security=SSPI;Provider=SQLOLEDB.1;';
    if Radiobutton2.checked then
      If checkbox1.Checked then
       AdoConnect:='Integrated Security=SSPI;Provider=SQLOLEDB.1;'  //驱动程式
      else
       AdoConnect:='Provider=SQLOLEDB.1;' ;
    if Radiobutton3.checked then
      Adoconnect :='Provider=MSDASQL;' ;  //odbc
     myfile:=extractfilepath(application.ExeName)+'data\login.ini';
     if fileexists(myfile) then
      begin
        assignfile(f,myfile);
        reset(f);
         if length(trim(edit6.text))>0 then
           AdoConnect:=AdoConnect+'password='+edit6.text+';Persist Security Info=True;'    //用户密码      password of database user
         else
           AdoConnect:=AdoConnect+'Persist Security Info=false;';
        readln(f,fline);
        AdoConnect:=AdoConnect+'User ID='+edit5.text+';' ;      //    database user
        readln(f,fline);
        AdoConnect:=AdoConnect+'Initial Catalog='+combobox1.text+';' ;  // database name
        readln(f,fline);
        AdoConnect:=AdoConnect+'Data Source='+combobox2.text+';' ;   //   sql server name
        closefile(f);
        if not radiobutton3.checked then
          adoconnection1.ConnectionString:=AdoConnect+'Auto Translate=True'
        else
          adoconnection1.ConnectionString:=AdoConnect ;
        adoconnection1.Connected :=true;
        showmessage('连接成功！！') ;
      end
    else
      Application.Messagebox('无法连接数据库','Warning',mb_ok+mb_iconwarning);
 except
    Application.Messagebox('连接数据库失败！！','Error',mb_ok+mb_iconerror);
  end;
  Adoconnection1.Connected :=false ;
end;

procedure TFormconnect.SpeedButton3Click(Sender: TObject);
var login:TextFile;
    path:string;
begin
  path:=Extractfilepath(application.exename)+'data\login.ini';
  if fileexists(path) then
    begin
      if (trim(combobox1.text)='') and (trim(combobox2.text)='') then
       begin
         application.messagebox('''New Database Name'' and ''New Server Name'' must have value.','Error',mb_iconerror);
         exit;
       end;
    Assignfile(login,path);
    Rewrite(login);
    writeln(login,'User Name='+Edit5.text);
    writeln(login,'Database Name='+combobox1.text);
    writeln(login,'Server Name='+combobox2.text);
    writeln(login,'Password='+Edit6.text);
    if radiobutton4.Checked then
      writeln(login,'type=3')
    else if radiobutton3.Checked then
      writeln(login,'type=2')            //ODBC
    else if radiobutton2.Checked then  
      writeln(login,'type=1')              //SQL
    else if radiobutton1.Checked then  
      writeln(login,'type=0') ;            //windows
    if checkbox1.Checked then          //呼办
      writeln(login,'netid=true')
    else
      writeln(login,'netid=false');
    Closefile(login);
  end;
end;

procedure TFormconnect.SpeedButton4Click(Sender: TObject);
begin
  close ;
end;

procedure TFormconnect.RadioButton1Click(Sender: TObject);
begin
  if RadioButton1.Checked then
    begin
      edit5.Enabled :=false ;
      edit6.Enabled :=false ;
    end;
end;

procedure TFormconnect.RadioButton2Click(Sender: TObject);
begin
  if RadioButton2.Checked then
    begin
      edit5.Enabled :=true ;
      edit6.Enabled :=true ;
    end;
end;

procedure TFormconnect.SpeedButton5Click(Sender: TObject);
var c:string;
begin
  c:=SelectComputer;
  if c<>'' then
    combobox2.text:=c;
end;
procedure TFormconnect.SpeedButton6Click(Sender: TObject);
var login:TextFile;
    path:string;
    cn:string;
begin
  if EditConnectionString(AdoConnection1) then
    begin
      path:=Extractfilepath(application.exename)+'data\loginother.ini';
      if fileexists(path) then
        begin
         Assignfile(login,path);
         Rewrite(login);
         cn :=AdoConnection1.connectionstring ;
         writeln(login,'other='+cn) ;
         closefile(login) ;
        end
      else begin
        showmessage('写入文件失败！！!') ;
        exit ;
      end;
    end;
end;
end.