⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cn700_del234745235.txt

📁 delphi
💻 TXT
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Db, ADODB, DBTables;

type
  TForm1 = class(TForm)
    ADOConnection: TADOConnection;
    ADOQry1: TADOQuery;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    lbServerName: TLabel;
    Label6: TLabel;
    edtUserName: TEdit;
    edtPassword: TEdit;
    edtServerName: TEdit;
    edtExchgFile: TEdit;
    btnExport: TButton;
    btnInport: TButton;
    btnClose: TButton;
    Label3: TLabel;
    Label5: TLabel;
    edtDbName: TEdit;
    edtTblname: TEdit;
    rbtnaccess: TRadioButton;
    rbtnsql: TRadioButton;
    btnConnect: TButton;
    Query1: TQuery;
    Database1: TDatabase;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Button1: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure rbtnsqlClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure btnExportClick(Sender: TObject);
    procedure btnInportClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Function sysconnect:Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Function TForm1.sysconnect:Boolean;
var mids:string;
    Safer:TCursor;
begin
   if rbtnSql.Checked then
   begin
     mids:='Provider=SQLOLEDB.1;';
     if trim(edtPassword.Text)='' then
       mids:=mids+'Persist Security Info=False;'
     else
       mids:=mids+'Password='+Trim(edtPassword.Text)+';Persist Security Info=True;';
       mids:=mids+'User ID=SA;';
       mids:=mids+'Initial Catalog= '+Trim(edtDbName.Text)+';';
       mids:=mids+'Data Source='+Trim(edtServerName.Text);
   end
   else
   Begin
     mids:='Provider=Microsoft.Jet.OLEDB.4.0;';
     mids:=mids+'Data Source='+ Trim(edtDbName.Text)+';';
     mids:=mids+'Persist Security Info=False;Jet OLEDB:Database Password='+Trim(edtPassword.Text);
   End;
    try
       Safer:=Screen.Cursor;
       try
          Screen.Cursor:=crHourGlass;
           With ADOConnection Do
           Begin
             Close;
             ConnectionString:=mids;
             Connected:=True;
           End;
       finally
          Screen.Cursor:=Safer;
       end;
    except
       on e: Exception do begin
          ADOConnection.Close;
          Showmessage('数据库连接失败!'+#13+e.message);
       end;
    end;
    if not ADOConnection.Connected then
      Result:=False
    else
      Result:=True;
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
     Close;
end;

procedure TForm1.rbtnsqlClick(Sender: TObject);
begin
  if rbtnSql.Checked then
  begin
    edtServerName.Enabled:=True;
    lbServerName.Enabled:=True;
  end
  else
  begin
    edtServerName.Enabled:=False;
    lbServerName.Enabled:=False;
  end;
end;

procedure TForm1.btnConnectClick(Sender: TObject);
begin
  if sysconnect then
    Showmessage('数据库连接成功!')
  else
    Showmessage('数据库连接失败!');
end;

procedure TForm1.btnExportClick(Sender: TObject);
begin
  //edtExchgFile 包括文件名全路经和扩展名。扩展名必须是xml,否则会出错误;
  If FileExists(edtExchgFile.Text) Then
  Begin
    Showmessage('文件已经存在,请删除后发送');
    Exit;
  End;
  try
    With ADOQry1 Do
      Begin
        Close;
        Connection := ADOConnection;
        locktype := ltreadonly;
        CacheSize := 1000;
        Sql.Clear;
        Sql.Add('Select * from '+edtTblname.Text);
        Open;

        if RecordCount>0 then
          SavetoFile(edtExchgFile.Text, pfADTG);
      End;
      Showmessage('数据导出成功!');
  except
    on e: Exception do
      begin
        Showmessage('数据发送失败!'+#13+e.message);
        Exit;
      end;
  end;

end;

procedure TForm1.btnInportClick(Sender: TObject);
var mids:String;
    i:integer;
begin
    DataBase1.LoginPrompt:=False;
    DataBase1.Close;
    DataBase1.Params.Values['Server Name']    :=edtServerName.Text ;
    DataBase1.Params.Values['Database Name']  :=edtDbName.Text;
    DataBase1.Params.Values['User Name']      :=edtUserName.Text;
    DataBase1.Params.Values['Password']       :=edtPassword.Text;
    DataBase1.Open;

  //edtExchgFile 包括文件名全路经和扩展名。扩展名必须是xml,否则会出错误;
  If Not FileExists(edtExchgFile.Text) Then
  Begin
    Showmessage('文件不存在,请确认重新接收!');
    Exit;
  End;
  With ADOQry1 Do LoadFromFile(edtExchgFile.Text);
  ADOQry1.Open ;
  Database1.StartTransaction ;
  try
      ADOQry1.First;
      while not ADOQry1.Eof do
      begin
           with Query1 do
           begin
                Close;
                Sql.Clear ;
                Sql.Add (' Insert Into tXtOption(Section,SysOption,DefaultValue,'
                        +' OptionValue,OptionType,IsVerify,VerifyValue,Remark) '
                        +' Values ( '
                        +' "'+ADOQry1.FieldByName('Section').AsString+'", '
                        +' "'+ADOQry1.FieldByName('SysOption').AsString+'",'
                        +' "'+ADOQry1.FieldByName('DefaultValue').AsString+'",'
                        +' "'+ADOQry1.FieldByName('OptionValue').AsString+'",'
                        +' "'+ADOQry1.FieldByName('OptionType').AsString+'",'
                        +' "'+ADOQry1.FieldByName('IsVerify').AsString+'",'
                        +' "'+ADOQry1.FieldByName('VerifyValue').AsString+'",'
                        +' "'+ADOQry1.FieldByName('Remark').AsString+'" '
                        +' )');
                ExecSql;
           end;
           ADOQry1.Next;
      end;
      Database1.Commit ;
      ShowMessage('XML Files >> Database Tablse Import Successfully!');
  except
      on e:Exception do
      begin
         Showmessage('XML Files >> Database Tablse Import Failed!'+#13+e.message);
         Database1.Rollback ;
         Exit;
      end;
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    DataBase1.LoginPrompt:=False;
    DataBase1.Close;
    DataBase1.Params.Values['Server Name']    :=edtServerName.Text ;
    DataBase1.Params.Values['Database Name']  :='master';
    DataBase1.Params.Values['User Name']      :=edtUserName.Text;
    DataBase1.Params.Values['Password']       :=edtPassword.Text;
    DataBase1.Open;
    Combobox1.Items.Clear ;
    with Query1 do
    begin
        Close;
        Sql.Clear ;
        Sql.Add ('Select Name From SysDatabases Order By Name');
        Open;
        First;
        while not eof do
        begin
            Combobox1.Items.Add (Fields[0].AsString);
            Next;
        end;
        Combobox1.ItemIndex :=-1;
    end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -