autoregcard.pas

上传个考勤系统,希望别人也能用.该代码只能算初级的东东,软件代码复用性不高,重复代码比较多.唯一感觉有点取鉴的可能就是端口和dll的连接,还有线程的使用,本想改一改,但是手头没有考勤机了,对应考勤机是

unit AutoRegCard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, SJListView, EastRiver, Functions, PrjConst, ActiveX;

type
  TdlgRegCard = class(TForm)
    LsCardLog: TMainListview;
    btnStart: TButton;
    btnLoop: TButton;
    btnClose: TButton;
    Label2: TLabel;
    Label1: TLabel;
    procedure btnStartClick(Sender: TObject);
    procedure btnLoopClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TCardThread = class(TThread)
  private
     CardInfo: TRealRecordInfo;
     procedure SaveData(Item: TListItem; pclk: PClockInfo);
  protected
    procedure Execute;override;
  public
     constructor Create(AOwner: TdlgRegCard);
     destructor Destroy; override;
  end;


var
  dlgRegCard: TdlgRegCard;
  btnControl: integer;
  CardThread: TCardThread;

implementation

uses timeclock;

{$R *.dfm}
procedure TCardThread.SaveData(Item:TListItem; pclk: PClockInfo);
var  sql: string;
begin
   CoInitialize(nil);
   try
   if (Item.SubItems[2] = '') then
    begin
     if (Item.SubItems[0] = '学生') then
       begin
         frmMain.ADOQuery2.Close;
         frmMain.ADOQuery2.SQL.Text := 'exec upinsert_card '+Item.Caption+','''+Item.SubItems[3]+''','''+Item.SubItems[4]+''','''+Item.SubItems[1]+''',0,0';
         frmMain.ADOQuery2.ExecSQL;
       end
     else
      if (Item.SubItems[0] = '教师') then
       begin
         frmMain.ADOQuery2.Close;
         frmMain.ADOQuery2.SQL.Text := 'exec upinsert_card '+Item.Caption+','''+Item.SubItems[3]+''','''+Item.SubItems[4]+''','''+Item.SubItems[1]+''',0,1';
         frmMain.ADOQuery2.ExecSQL;
       end;
     end
    else
     begin
     if (Item.SubItems[0] = '学生') then
       begin
         frmMain.ADOQuery2.Close;
         frmMain.ADOQuery2.SQL.Text := 'exec upinsert_card '+Item.Caption+','''+Item.SubItems[3]+''','''+Item.SubItems[4]+''','''+Item.SubItems[1]+''',1,0';
         frmMain.ADOQuery2.ExecSQL;
       end
     else
      if (Item.SubItems[0] = '教师') then
       begin
         frmMain.ADOQuery2.Close;
         frmMain.ADOQuery2.SQL.Text := 'exec upinsert_card '+Item.Caption+','''+Item.SubItems[3]+''','''+Item.SubItems[4]+''','''+Item.SubItems[1]+''',1,1';
         frmMain.ADOQuery2.ExecSQL;
       end;
      end;
   except
      MsgBox(Screen.ActiveForm.Handle,'插入错误，请重新插入，或者取消!','输入错误', MB_OK or MB_ICONERROR);
   end;
   CoUnInitialize;
end;


procedure TCardThread.Execute;
var i,j:integer;
begin
  with frmMain do
  begin
   pclk := PClockInfo(cbSelectDecive.Items.Objects[cbSelectDecive.ItemIndex]);
   btnControl := 0;
   if OpenPort1(pclk) then
   begin
   pclk.hPort := ConnectClock(Pclk.port, Pclk.baudrate, Pclk.clock_id);
   ClearAllReadCard(pclk.hPort);
   i := 0;
   j:= dlgRegCard.LsCardLog.Items.Count;
   while (i<j) do
    begin
      dlgRegCard.Label1.Caption := '实时注册操作已经开始, 请刷卡！';
      Application.ProcessMessages;
      if Terminated then break
      else
      if btnControl = 1 then
      begin
        btnControl := 0;
        inc(i);
        continue;
      end
      else
      if dlgRegCard.LsCardLog.Items[i].SubItems[3] <> '' then
      begin
         inc(i);
         continue;
      end
      else
      begin
      FillChar(CardInfo, SizeOf(TRealRecordInfo), 0);
      CardInfo.Size:=SizeOf(TRealRecordInfo);

      RealReadRecord(Pclk.hPort, Pclk.clock_id, @CardInfo);
      if (CardInfo.CardNo<>'') then
      begin
        dlgRegCard.LsCardLog.Items[i].SubItems[3] := CardInfo.CardNo;
        dlgRegCard.LsCardLog.Items[i].SubItems[4] := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now);
        SaveData(dlgRegCard.LsCardLog.Items[i], pclk);
        inc(i);
      end;
      end;
    end;
 end;
 if not Terminated then
 begin
   dlgRegCard.Label1.Caption := '操作已经完成，请停止以后再进行下一步操作！';
 end;
 DisConnectClock(pclk.hPort);
 pclk.Connected := true;
 pclk.hPort := 0; 
 end;
end;


constructor TCardThread.Create(AOwner: TdlgRegCard);
begin
  inherited Create(true);
  Priority:=tpTimeCritical;//实时
end;


destructor TCardThread.Destroy;
begin

  inherited;
end;



procedure TdlgRegCard.btnStartClick(Sender: TObject);
begin
   if btnStart.Caption = '开始' then
   begin
   if not Assigned(CardThread) then CardThread:=TCardThread.Create(Self);
  if Assigned(CardThread)and CardThread.Suspended then
  begin
    CardThread.Resume;
    btnStart.Caption := '停止'
  end
  end
  else
    if btnStart.Caption = '停止' then
    begin
    if not CardThread.Terminated then
    begin
    CardThread.Terminate;
    CardThread.WaitFor;
    FreeAndNil(CardThread);
    btnStart.Caption := '开始';
    Label1.Caption := '';
    end;
   end;
end;

procedure TdlgRegCard.btnLoopClick(Sender: TObject);
begin
 btnControl := 1;
end;

procedure TdlgRegCard.btnCloseClick(Sender: TObject);
begin
 dlgRegCard.Close;
end;

procedure TdlgRegCard.FormClose(Sender: TObject; var Action: TCloseAction);
begin
          frmMain.dbStudentShow;
          frmMain.dbTodayLogShow;
end;

end.