unit1.pas

用ping 的方法实现日常的考勤工作

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
  IdIcmpClient, ExtCtrls, DB, ADODB, Menus, Grids, DBGrids, StdCtrls,
  Buttons, ComCtrls;

type
  ST_ipSTATUS = record
    ip: string;
    status: byte; ////0：初始化 ，1:拼通，2：拼通有记录，3：拼不通，4：拼不通无记录
  end;


type
  TForm1 = class(TForm)
    Timer1: TTimer;
    icmp: TIdIcmpClient;
    ADOQuery1: TADOQuery;
    ADOQuery2: TADOQuery;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    starttime: TDateTimePicker;
    endtime: TDateTimePicker;
    Label2: TLabel;
    BitBtndate: TBitBtn;
    DBGrid1: TDBGrid;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    edname: TEdit;
    BitBtnname: TBitBtn;
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    cmblater: TComboBox;
    cmbearly: TComboBox;
    BitBtn1: TBitBtn;
    tpdate: TDateTimePicker;
    procedure icmpReply(ASender: TComponent;
      const AReplyStatus: TReplyStatus);
    procedure Timer1Timer(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure BitBtndateClick(Sender: TObject);
    procedure BitBtnnameClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    CuruserIp: array[0..19] of ST_ipSTATUS;
    { Private declarations }
  public
    { Public declarations }
  end;

const
  time1: string = '8:30:00';

  time3: string = '17:30:00';

var
  Form1: TForm1;
  ping_ok: integer;
implementation
uses unit2;
{$R *.dfm}

procedure TForm1.icmpReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
var
  sTime: string;

begin //检测Ping的回复错误
  if (AReplyStatus.MsRoundTripTime = 0) then
    sTime := '<1'
  else
    sTime := '='; //在列表框中显示Ping消息
  ping_ok := AReplyStatus.TimeToLive;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
  sSql: string;
  i: integer;
  flag: byte;
  Iislater: integer;
  Iisearly: integer;
begin
//状态初始化
  if (time() > strtotime('23:50:00')) and (time() < strtotime('24:00:00')) then
  begin

    for i := 0 to ADOQuery1.RecordCount - 1 do
    begin
    //ZeroMemory(CuruserIp[i],20);
    //sizeof(ST_ipSTATUS
      CuruserIp[i].ip := adoquery1.Fields[1].AsString;
      CuruserIp[i].status := 0;
      adoquery1.Next;
    end;
  end
  else
  begin
    adoquery1.First;
    for i := 0 to ADOQuery1.RecordCount - 1 do
    begin


      icmp.Host := adoquery1.Fields[1].AsString;
      icmp.Ping;

      if ping_ok > 0 then //拼通
      begin
        if CuruserIp[i].status = 0 then CuruserIp[i].status := 1; //状态变迁的规则：
        if CuruserIp[i].status = 4 then CuruserIp[i].status := 2; // 0->1, 4->2,  2->3 。
      end;
      if ping_ok = 0 then //拼不通
      begin
        if CuruserIp[i].status = 2 then CuruserIp[i].status := 3;
      end;
      if CuruserIp[i].status = 1 then
      begin
        if time() > strtotime(time1) then Iislater := 1;
        if time() < strtotime(time1) then Iislater := 0;
        with ADOQuery2 do begin
          Close;
          SQL.Clear;
          sSql := ' insert into  dutymessage(ip,ddate,timeon,islater) values ( ' + '''' + icmp.host + ''''
            + ',' + '''' + datetostr(date()) + ''''
            + ',' + '''' + timetostr(time()) + ''''
            + ',' + '''' + inttostr(Iislater) + '''' + ')';

          SQL.Add(sSql);
          ExecSQL;
        end; //插入上班时间 ，和状态
        CuruserIp[i].status := 2;
      end;
    //if flag = 2 then contiune;
      if CuruserIp[i].status = 3 then
      begin
        if time() > strtotime(time3) then Iisearly := 0;
        if time() < strtotime(time3) then Iisearly := 1;
        with ADOQuery2 do begin
          Close;
          SQL.Clear;
          sSql := ' update dutymessage set timeout=  ' + '''' + timetostr(time()) + ''''

          + ',isearly=''' + inttostr(Iisearly) + ''''


          + 'where ip=''' + icmp.host + '''and ddate=''' + datetostr(date()) + '''';

          SQL.Add(sSql);
          ExecSQL;
        end; //更新下班时间和状态
        CuruserIp[i].status := 4;
      end;
      if CuruserIp[i].status = 4 then exit;
      if (CuruserIp[i].status = 0) and (time > strtotime('17:30:00')) then
      begin
        with ADOQuery2 do begin
          Close;
          SQL.Clear;
          sSql := ' insert into  dutymessage(ip,ddate,islater) values ( ' + '''' + icmp.host + ''''
            + ',' + '''' + datetostr(date()) + ''''

          + ',2)';


          SQL.Add(sSql);
          ExecSQL;
        end;
        CuruserIp[i].status := 4;
      //插入缺勤记录

      end;
      adoquery1.Next;
    end;
  end;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  timer1.Enabled := false;
end;

procedure TForm1.N9Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.N10Click(Sender: TObject);
begin
  form2.ShowModal;
end;

procedure TForm1.BitBtndateClick(Sender: TObject); //按日期查询
var
  sSql: string;
  stime: string;
  etime: string;
begin

  sTime := FormatDateTime('yyyy-mm-dd', StartTime.DateTime);
  eTime := FormatDateTime('yyyy-mm-dd', EndTime.DateTime);


  with adoQuery2 do
  begin
    Close;
    SQL.Clear;

    sSql := ' select  dutymessage.ip,username,ddate,timeon,timeout,' + 'islater=case when islater=0 then ''否'' when islater=1 then ''是'' when islater=2 then ''缺勤'' end,'
      + 'isearly =case when isearly=0 then ''否'' when isearly=1 then ''是'' end ' + ' from  dutymessage ,usermessage where dutymessage.ip=usermessage.ip and ddate >=''' + sTime + ''''
      + ' and   ddate <=''' + eTime + '''';

    SQL.Add(sSql);
    Open;
    if IsEmpty then
    begin
      showMessage('没有相应记录，请重新设置查询条件！');
      exit;
    end;
  end;
  dbgrid1.Visible := true;
end;


procedure TForm1.BitBtnnameClick(Sender: TObject); //按姓名查询
var
  sSql: string;
begin
  with adoQuery2 do
  begin
    Close;
    SQL.Clear;

    sSql := ' select  dutymessage.ip,username,ddate,timeon,timeout,' + 'islater=case when islater=0 then ''否'' when islater=1 then ''是'' when islater=2 then ''缺勤'' end,'
      + 'isearly =case when isearly=0 then ''否'' when isearly=1 then ''是'' end ' + '  from  dutymessage ,usermessage where dutymessage.ip=usermessage.ip and usermessage.username= '
      + '''' + trim(edname.Text) + '''';

    SQL.Add(sSql);
    Open;
    if IsEmpty then
    begin
      showMessage('没有相应记录，请重新设置查询条件！');
      exit;
    end;
  end;
  dbgrid1.Visible := true;
end;

procedure TForm1.BitBtn1Click(Sender: TObject); //按状态查询
var
  early: integer;
  sSql: string;
  later: integer;
  ttime: string;
begin
  if cmbearly.Text = '是' then early := 1;
  if cmbearly.Text = '否' then early := 0;
  if cmblater.Text = '是' then later := 1;
  if cmblater.Text = '否' then later := 0;
  if cmblater.Text = '缺勤' then later := 2;
  tTime := FormatDateTime('yyyy-mm-dd', tpdate.DateTime);
  with adoQuery2 do
  begin
    Close;
    SQL.Clear;

    sSql := ' select  dutymessage.ip,username,ddate,timeon,timeout,' + 'islater=case when islater=0 then ''否'' when islater=1 then ''是'' when islater=2 then ''缺勤'' end,'
      + 'isearly =case when isearly=0 then ''否'' when isearly=1 then ''是'' end ' + '  from  dutymessage ,usermessage where dutymessage.ip=usermessage.ip and ddate= '
      + '''' + datetostr(date()) + '''' + 'and (islater=''' + inttostr(later) + '''' + 'or isearly=''' + inttostr(early) + '''' + ')';

    SQL.Add(sSql);
    Open;
    if IsEmpty then
    begin
      showMessage('没有相应记录，请重新设置查询条件！');
      exit;
    end;
  end;
  dbgrid1.Visible := true;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if time() > strtotime('11:00:00') then timer1.Enabled := false;
  groupbox1.Visible := false;
  groupbox2.Visible := false;
  groupbox3.Visible := false;

end;

procedure TForm1.N4Click(Sender: TObject);
begin

  groupbox2.Visible := false;
  groupbox3.Visible := false;
  groupbox1.Visible := true;
  dbgrid1.Visible := false;
end;

procedure TForm1.N5Click(Sender: TObject);
begin

  groupbox2.Visible := true;
  groupbox3.Visible := false;
  groupbox1.Visible := false;
  dbgrid1.Visible := false;
end;

procedure TForm1.N6Click(Sender: TObject);
begin

  groupbox2.Visible := false;
  groupbox3.Visible := true;
  groupbox1.Visible := false;
  dbgrid1.Visible := false;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
  groupbox1.Visible := false;
  groupbox2.Visible := false;
  groupbox3.Visible := false;

  dbgrid1.Visible := false;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  timer1.Enabled := true;
end;

end.