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

📄 mainform.pas

📁 用delphi做的一个可以计算sql运行时间的系统,大家可以参考一下.
💻 PAS
📖 第 1 页 / 共 2 页
字号:
////////////////////////////////////////////////////////
//                                                    //
//                  使用控件:                        //
//                      Express Editors               //
//                      RX Control                    //
//                                                    //
////////////////////////////////////////////////////////
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, dxEditor, dxExEdtr, dxEdLib, dxCntner, DB, ADODB,
  Buttons, ExtDlgs, ExtCtrls, ImgList, Menus, RXCtrls, Animate, GIFCtrl,
  RzButton, RzBHints, RzBckgnd;

type
  TfrmMainForm = class(TForm)
    ADOConnection: TADOConnection;
    Executeqry: TADOQuery;
    Panel1: TPanel;
    OpenSQLFileDlg: TOpenDialog;
    ImageList: TImageList;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    btBrowse: TSpeedButton;
    btBuild: TSpeedButton;
    edDataLinkFile: TdxEdit;
    edConnectionString: TdxEdit;
    UseDataLinkFile: TRadioButton;
    UseConnectionString: TRadioButton;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    btSelectSQLFile: TSpeedButton;
    Label1: TLabel;
    edLoopTimes: TdxSpinEdit;
    edIntervalTime: TdxSpinEdit;
    edSQLFile: TdxEdit;
    UseSQLFile: TRadioButton;
    UseSQLEdit: TRadioButton;
    edSQLEdit: TdxMemo;
    Panel3: TPanel;
    RunTimeList: TdxMemo;
    Panel4: TPanel;
    SaveRunTimeListDlg: TSaveDialog;
    MsgImageList: TImageList;
    MsgImage: TImage;
    MsgText: TRxLabel;
    ProcessAnimator: TRxGIFAnimator;
    btRun: TRzBitBtn;
    btStop: TRzBitBtn;
    btClose: TRzBitBtn;
    btClear: TRzBitBtn;
    btSave: TRzBitBtn;
    btUserNamePwdClear: TRzBitBtn;
    RzBalloonHints1: TRzBalloonHints;
    procedure UseDataLinkFileClick(Sender: TObject);
    procedure UseConnectionStringClick(Sender: TObject);
    procedure btBrowseClick(Sender: TObject);
    procedure btBuildClick(Sender: TObject);
    procedure btSelectSQLFileClick(Sender: TObject);
    procedure btRunClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure UseSQLFileClick(Sender: TObject);
    procedure UseSQLEditClick(Sender: TObject);
    procedure btClearClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure btUserNamePwdClearClick(Sender: TObject);
  private
    { Private declarations }
    function GetConnection:Boolean;
    function TestSQLFile:Boolean;
    function GetSqlFromSQLFile:Boolean;
    function GetSqlFromSQLEdit:Boolean;
    function GetSql:Boolean;
    function ExecuteSQL:Boolean;

    function EnterUserNamePwd:Boolean;
    procedure ClearUserNamePwd;

    procedure AddRunTimeToMemo;

    procedure SaveConnectionString;
    procedure SaveConnectionFile;
    procedure SaveSQLString;
    procedure SaveUserNamePwd;
    procedure SaveInformation;

    procedure LoadConnectionString;
    procedure LoadConnectionFile;
    procedure LoadSQLString;
    procedure LoadInformation;
    
    procedure SetControlEnabled(Enable:Boolean);
    procedure ClearMsg;
    procedure ShowMsg(State:integer);
  public
    { Public declarations }
  end;

var
  frmMainForm: TfrmMainForm;

implementation

uses
  Login;

{$R *.dfm}

Const
  CONNECTIONString_FILE_NAME='ConnectionStringFile.ini';
  CONNECTIONFILE_FILE_NAME='ConnectionFile.ini';
  SQL_FILE_NAME='SQLFile.ini';

  USERNAMEPWD_FILE_NAME='UserNamePwdFile.ini';

  //运行结果
  SUCCESS=0;
  STOP=1;
  FAILURE=2;

var
  RunTime:TDateTime;            //运行时间
  StartTime,EndTime:TDateTime;  //开始时间,结束时间
  Times:integer;                //运行次数

  IsStop:Boolean;
  UserName,Pwd:string;

  OldConnectionString,OldConnectionFile:string;

procedure TfrmMainForm.UseDataLinkFileClick(Sender: TObject);
const
  EnabledColor: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  edDataLinkFile.Enabled := UseDataLinkFile.Checked;
  edDataLinkFile.Color := EnabledColor[edDataLinkFile.Enabled];
  btBrowse.Enabled := edDataLinkFile.Enabled;

  edConnectionString.Enabled := UseConnectionString.Checked;
  edConnectionString.Color := EnabledColor[edConnectionString.Enabled];
  btBuild.Enabled := edConnectionString.Enabled;

  if edDataLinkFile.Enabled then
    ActiveControl := edDataLinkFile
  else
    ActiveControl := edConnectionString;

  ClearUserNamePwd;
end;

procedure TfrmMainForm.UseConnectionStringClick(Sender: TObject);
const
  EnabledColor: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  edDataLinkFile.Enabled := UseDataLinkFile.Checked;
  edDataLinkFile.Color := EnabledColor[edDataLinkFile.Enabled];
  btBrowse.Enabled := edDataLinkFile.Enabled;

  edConnectionString.Enabled := UseConnectionString.Checked;
  edConnectionString.Color := EnabledColor[edConnectionString.Enabled];
  btBuild.Enabled := edConnectionString.Enabled;

  if edDataLinkFile.Enabled then
    ActiveControl := edDataLinkFile
  else
    ActiveControl := edConnectionString;

  ClearUserNamePwd;
end;

procedure TfrmMainForm.btBrowseClick(Sender: TObject);
begin
  edDataLinkFile.Text := PromptDataLinkFile(Handle, edDataLinkFile.Text);
end;

procedure TfrmMainForm.btBuildClick(Sender: TObject);
begin
  edConnectionString.Text := PromptDataSource(Handle, edConnectionString.Text);
end;

function TfrmMainForm.GetConnection:Boolean;
var
  testqry:TADOQuery;
begin
  result:=False;
  Application.ProcessMessages;

  //采用链接字符串
  if UseConnectionString.Checked then
  begin
    if trim(edConnectionString.Text) <> '' then
    begin
      if ((OldConnectionString <> trim(edConnectionString.Text)) or
         (trim(ADOConnection.ConnectionString) = '')) then
      begin
        ADOConnection.Close;
        ADOConnection.ConnectionString:= edConnectionString.Text;
        OldConnectionString:=edConnectionString.Text;
      end
    end
    else
    begin
      {
      if messagedlg('连接字符串为空,是否建立连接?',mtwarning,[mbYes, mbNo],0)=mrYes  then
        btBuild.Click
      else
      }
        Application.MessageBox('连接字符串为空,请先建立连接!','错误');
        Exit;
    end;
  end
  //采用链接文件
  else
  begin
    if trim(edDataLinkFile.Text) <> '' then
    begin
      if ((OldConnectionFile <> trim(edDataLinkFile.Text)) or
         (trim(ADOConnection.ConnectionString) = '')) then
      begin
        ADOConnection.Close;
        ADOConnection.ConnectionString:= 'FILE NAME='+edDataLinkFile.Text;
        OldConnectionFile:=edDataLinkFile.Text;
      end
    end
    else
    begin
      {
      if messagedlg('连接文件为空,是否建立连接?',mtwarning,[mbYes, mbNo],0)=mrYes  then
        btBrowse.Click
      else
      }
        Application.MessageBox('连接文件为空,请先建立连接!','错误');
        Exit;
    end;
  end;

  //test connection
  if not EnterUserNamePwd then
    Exit;

  Application.ProcessMessages;

  try
    ADOConnection.Open(UserName,Pwd);
    if not ADOConnection.Connected  then
    begin
      Application.MessageBox('连接失败,请重新连接!','错误');
      Exit;
    end;
  except
    Application.MessageBox('连接失败,请重新连接!','错误');
    Exit;
  end;

  Executeqry.Connection:=ADOConnection;
  result:=true;
end;
/////////////
function TfrmMainForm.TestSQLFile: Boolean;
var
  SQLFileName:String;
  isFileExist:Boolean;
begin
  result:=False;

  SQLFileName:=edSQLFile.Text;

  if trim(SQLFileName) = '' then
    if messagedlg('未选择sql文件,是否现在选择?',mtwarning,[mbYes, mbNo],0)=mrYes  then
      btSelectSQLFile.Click
    else
      Exit;

  isFileExist:=FileExists(SQLFileName);
  if not isFileExist then
    if messagedlg('sql文件不存在,是否重新选择?',mtwarning,[mbYes, mbNo],0)=mrYes  then
      btSelectSQLFile.Click
    else
      Exit;

   result:=isFileExist;
end;

function TfrmMainForm.GetSqlFromSQLFile: Boolean;
var
  SQLFileName:String;
begin
  result:=False;

  //检查文件
  if not TestSQLFile then
    Exit;

  //清空sql
  Executeqry.SQL.Clear;

  //载入文件
  SQLFileName:=edSQLFile.Text;
  Executeqry.SQL.LoadFromFile(SQLFileName);

  result:=True;
end;

function TfrmMainForm.GetSqlFromSQLEdit: Boolean;
begin
  result:=False;

  //是否有sql语句
  if edSQLEdit.Lines.Count <= 0 then
  begin
    Application.MessageBox('没有SQL语句!','错误');
    Exit;
  end;

  //清空sql
  Executeqry.SQL.Clear;

  //载入sql
  Executeqry.SQL.AddStrings(edSQLEdit.Lines);

  result:=True;
end;

function TfrmMainForm.GetSql: Boolean;
begin
  result:=False;

  if UseSQLFile.Checked then
    result:=GetSQLFromSQLFile;
  if UseSQLEdit.Checked then
    result:=GetSQLFromSQLEdit;
end;
///////
function TfrmMainForm.ExecuteSQL: Boolean;
var
  Loop,ExecuteTimes:integer;
  IntervalTime:integer;
begin
  result:=False;

  //Query链接
  if not GetConnection then
    Exit;

  ProcessAnimator.Visible:=True;    

  //载入SQL
  if not GetSql then
    Exit;

  //得到执行次数
  ExecuteTimes:=edLoopTimes.IntValue;
  //得到间隔时间
  IntervalTime:=edIntervalTime.IntValue;

  //得到开始运行时间
  StartTime:=Time();

  //执行sql
  try
    for Loop:=1 to ExecuteTimes do
    begin
      Executeqry.ExecSQL;
      Sleep(IntervalTime*1000);
      Application.ProcessMessages;
      if IsStop then
        Break;
    end;
  except
    Exit;
  end;

  //得到结束运行时间按
  EndTime:=Time();

  Executeqry.Close;
  //ADOConnection.Close;

⌨️ 快捷键说明

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