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

📄 unit1.pas

📁 Navision ERP 极品补丁
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, ComCtrls, Buttons, ExtCtrls, RpCon,
  RpConDS, RpDefine, RpRave, RpRender, RpRenderPDF, RpRenderText,
  RpRenderHTML, RarBar;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    BitBtn1: TBitBtn;
    Edit1: TEdit;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DBGrid1: TDBGrid;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    DBGrid2: TDBGrid;
    TabSheet3: TTabSheet;
    DBGrid3: TDBGrid;
    Label3: TLabel;
    Label4: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    Label5: TLabel;
    Edit3: TEdit;
    CheckBox3: TCheckBox;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    TabSheet4: TTabSheet;
    DBGrid4: TDBGrid;
    Timer1: TTimer;
    Edit4: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    ProgressBar1: TProgressBar;
    SpeedButton1: TSpeedButton;
    Label10: TLabel;
    RvProject1: TRvProject;
    RvRenderPDF1: TRvRenderPDF;
    RvRenderHTML1: TRvRenderHTML;
    RvRenderText1: TRvRenderText;
    RvDataSetConnection1: TRvDataSetConnection;
    Panel3: TPanel;
    RarBar1: TRarBar;
    Label11: TLabel;
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CheckBox3Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit3Change(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    mm,ss:integer;
  end;

var
  Form1: TForm1;
  n:integer;
  s:string;
  u:integer;
implementation

uses Unit2, mainunit;

{$R *.dfm}

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  dm.ADOQ1.Close;
  dm.ADOQ1.SQL.Clear;
  dm.ADOQ1.SQL.Add('select "用户 ID","登录时间","当前会话","主机名","空闲时间" from "RadianceFinal"."dbo"."会话" ');
  if checkbox1.Checked then
    begin
      dm.ADOQ1.SQL.Add('where "用户 ID" not in(:a,:b,:c,:d,:e,:f)');
      dm.ADOQ1.Parameters.ParamByName('a').Value:='sa';
      dm.ADOQ1.Parameters.ParamByName('b').Value:='RESH\ClusterAdmin';
      dm.ADOQ1.Parameters.ParamByName('c').Value:='a2308';
      dm.ADOQ1.Parameters.ParamByName('d').Value:='A2308';
      dm.ADOQ1.Parameters.ParamByName('e').Value:='SA';
      dm.ADOQ1.Parameters.ParamByName('f').Value:='Sa';
    end;
  dm.ADOQ1.Open;
  label4.Caption:=inttostr(dm.ADOQ1.RecordCount);
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  n:=n+1;
 // pagecontrol1.ActivePageIndex:=2;
  dm.ADOQ2.Close;
  dm.ADOQ2.SQL.Clear;
  dm.ADOQ2.SQL.Add('use RadianceFinal');
  dm.ADOQ2.SQL.Add('select "连接 ID","用户 ID","登录时间","当前会话","主机名","空闲时间" from "RadianceFinal"."dbo"."会话" ');
  dm.ADOQ2.SQL.Add('where "用户 ID" not in(:a,:b,:d,:e,:f,:g) and cast("空闲时间" as int(4))>:c');
  dm.ADOQ2.Parameters.ParamByName('a').Value:='sa';
  dm.ADOQ2.Parameters.ParamByName('b').Value:='RESH\ClusterAdmin';
  dm.ADOQ2.Parameters.ParamByName('c').Value:=strtoint(edit2.Text)*60000;
  dm.ADOQ2.Parameters.ParamByName('d').Value:='a2308';
  dm.ADOQ2.Parameters.ParamByName('e').Value:='A2308';
  dm.ADOQ2.Parameters.ParamByName('f').Value:='SA';
  dm.ADOQ2.Parameters.ParamByName('g').Value:='Sa' ;
  dm.ADOQ2.Open;
  if not dm.ADOQ2.Eof then
    bitbtn4.Enabled:=true
  else
    bitbtn4.Enabled:=false;
  s:=trim(dm.ADOQ2.Fieldbyname('连接 ID').AsString);
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
 { dm.ADOQ4.Close;
  dm.ADOQ4.SQL.Clear;
  dm.ADOQ4.SQL.Add('insert dbo.timetemp ( select "用户 ID","登录时间","空闲时间" from "RadianceFinal"."dbo"."会话" where "连接 ID"='+s+')');
  //dm.ADOQ4.Parameters[0].Value:=s;
  dm.ADOQ4.Open;}

  dm.ADOQ3.Close;
  dm.ADOQ3.SQL.Clear;
  dm.ADOQ3.SQL.Add('use master');
  dm.ADOQ3.SQL.Add('kill  '+s+'');
  dm.ADOQ3.ExecSQL;
  bitbtn1.OnClick(self);
  dm.ADOQ1.Close;
  dm.ADOQ1.open;
  showmessage('Delete ID '+s+' success!')  ;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
  if edit2.Text<>'' then
    bitbtn1.Enabled:=true
  else
    bitbtn1.Enabled:=false;
    n:=0;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if dm.ADOC.Connected=false then  dm.ADOC.Connected;
  n:=0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if dm.ADOC.Connected then dm.ADOC.Connected:=false;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  if checkbox3.Checked then
    begin
      edit1.Enabled:=false;
      edit2.Enabled:=false;
      edit3.Enabled:=false;
      edit4.Enabled:=false;
      bitbtn1.Enabled:=false;
      bitbtn2.Enabled:=false;
      bitbtn3.Enabled:=false;
      bitbtn4.Enabled:=false;
      bitbtn5.Enabled:=false;
      bitbtn6.Enabled:=false;
      checkbox1.Enabled:=false;
      checkbox2.Enabled:=false;
    end
  else
    begin
      if checkbox2.Checked=false then
        begin
          edit1.Enabled:=true;
          edit4.Enabled:=true;
          if edit2.Text<>'' then
            begin
              bitbtn4.Enabled:=true;
              bitbtn1.Enabled:=true;
            end;
        end;
      edit2.Enabled:=true;
      edit3.Enabled:=true;
      bitbtn2.Enabled:=true;
      bitbtn3.Enabled:=true;
      if edit1.Text<>'' then bitbtn5.Enabled:=true;
      bitbtn6.Enabled:=true;
      checkbox1.Enabled:=true;
      checkbox2.Enabled:=true;
    end;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
var i,n,m:integer;
begin
  n:=strtoint(edit1.Text)*60000;
  dm.ADOQ5.Close;
  dm.ADOQ5.SQL.Clear;
  dm.ADOQ5.SQL.Add('use RadianceFinal');
  dm.ADOQ5.SQL.Add('select "连接 ID","用户 ID","空闲时间" from .dbo.会话 ');
  dm.ADOQ5.SQL.Add('where "用户 ID" NOT IN(''SA'',''sa'',''RESH\ClusterAdmin'',''A2308'',''a2308'')');
  dm.ADOQ5.Open;
  dm.ADOQ5.First;
  for i:=0 to dm.ADOQ5.RecordCount-1 do
    begin
      if not dm.ADOQ5.Eof then
        begin
          m:=strtoint(dm.ADOQ5.Fieldbyname('空闲时间').AsString)-n;
          if m>0 then
            begin
              s:=dm.ADOQ5.Fieldbyname('连接 ID').AsString;
              dm.ADOQ3.Close;
              dm.ADOQ3.SQL.Clear;
              dm.ADOQ3.SQL.Add('use master');
              dm.ADOQ3.SQL.Add('kill  '+s+'');
              dm.ADOQ3.ExecSQL;
              dm.ADOQ5.Next;
            end
          else
            begin
              dm.ADOQ5.Next;
            end;
       end;
    end;
  dm.ADOQ2.close;
  dm.ADOQ2.Open;
  dm.ADOQ1.Close;
  dm.ADOQ1.open;
  dm.ADOQ5.Close;
  dm.ADOQ5.Open;
  //showmessage('Delete success!')  ;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if edit1.Text='' then
    bitbtn5.Enabled:=false
  else
    bitbtn5.Enabled:=true;
end;

procedure TForm1.Edit3Change(Sender: TObject);
begin
  if edit3.Text<>'' then
    s:=edit3.Text;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
VAR ii:integer;
begin
  if checkbox2.Checked then
    begin
      if (edit4.Text<>'') and (edit1.Text<>'') then
       begin
        edit1.Enabled:=false;
        edit4.Enabled:=false;
        bitbtn4.Enabled:=false;
        bitbtn5.Enabled:=false;
        timer1.Enabled:=true;
        mm:=strtoint(edit4.Text);
        ii:=mm*60;
        ss:=0;
        {progressbar1.Enabled:=true;
        self.ProgressBar1.Max:=ii;
        self.ProgressBar1.Position:=0; }  //滚动条1,目前不用
        //self.RarBar1.Enabled:=true; //t
        self.RarBar1.Max:=ii;   //t
        self.RarBar1.InitiateAction;  //t
        u:=0;
       end
      else
       begin
         showmessage('定时和最大时间不能为空!请填写有效整数后重试!');
         checkbox2.Checked:=false;
         //progressbar1.Enabled:=false;
         self.ProgressBar1.Position:=0;
         self.RarBar1.InitiateAction;  //t
       end;
    end;
  if checkbox2.Checked=false then
    begin
      timer1.Enabled:=false;
      edit1.Enabled:=true;
      edit4.Enabled:=true;
      bitbtn4.Enabled:=true;
      bitbtn5.Enabled:=true;
     // progressbar1.Enabled:=false;
     // self.ProgressBar1.Position:=0;
      self.RarBar1.InitiateAction;  //t
      self.RarBar1.Enabled:=false; //t
    end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if (mm=0) and (ss=0) then
    begin
      timer1.Enabled:=false;
      showmessage('定时已到,自动截断停止!');
     // self.ProgressBar1.Position:=0;
      self.RarBar1.InitiateAction;  //t
      checkbox2.Checked:=false;
      if checkbox3.Checked=false then
        begin
          edit1.Enabled:=true;
          edit4.Enabled:=true;
          bitbtn4.Enabled:=true;
          bitbtn5.Enabled:=true;
        end;
      //progressbar1.Enabled:=false;
      self.RarBar1.Enabled:=false; //t
      messagebeep(0);
    end;
  if ss=0 then
    begin
      mm:=mm-1;
      ss:=59;
    end
  else
    begin
      ss:=ss-1;
    end;
  u:=u+1;
  bitbtn5.OnClick(self);
  bitbtn3.OnClick(self);
  if edit2.Text<>'' then
    begin
      bitbtn1.OnClick(self);
    end;
  label4.Caption:=inttostr(dm.ADOQ1.RecordCount);
 { if self.ProgressBar1.Position<self.ProgressBar1.Max then
    self.ProgressBar1.Position:=u
  else
    begin
      self.ProgressBar1.Position:=0;
    end; }
  if self.RarBar1.Progress<self.RarBar1.Max then //t
     self.RarBar1.Progress:=u                    //t
  else                                           //t
    begin                                        //t
      self.RarBar1.Progress:=0;                  //t
    end;                                         //t
   //showmessage('Test ok! +'+inttostr(u)+' +次');  //测试用
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  form1.Hide;
  nhide.Show;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var dir1:string;
begin
  if pagecontrol1.ActivePageIndex=2 then
    begin
      getdir(0,dir1);
      rvproject1.ProjectFile:=dir1+'\filter.rav';
      rvproject1.Execute;
    end;
end;

end.

⌨️ 快捷键说明

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