timeclock.pas

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

constructor TReadThread.Create(AOwner: TfrmMain);
begin
  FOwner:=AOwner;
  RefreshControlState;
  FClocks1:=AOwner.FClocks;
  FCardLists:= TList.Create;
  inherited Create(True);
  Priority:=tpTimeCritical;//实时
end;

destructor TReadThread.Destroy;
begin
  FCardLists.Free;
  inherited;
end;

procedure TReadThread.Execute;
const
  arCardType: array[Boolean]of char=('C', 'D');
var
  bInit: Boolean;
  i, y, j: Integer;
//  year, month, day, hour, min, sec, msec: WORD;
  Ports: array[0..255]of THandle;
begin
  if FRuning then
  begin
    FRuning:=False;
    Exit;
  end;
  FRuning:=True;
  bInit:=True;
  FillChar(Ports, SizeOf(Ports), 0);
  try
    while not Terminated do
    begin
      y:=0;
      if bInit then
        for i:=0 to FClocks1.Count-1 do//循环检查所有端口上的所有机器
        with PClockInfo(FClocks1[i])^ do
        begin
          if CheckHandle(Ports[Port]) then
          begin
            hPort:=Ports[Port];
          end else
          begin
            if not CheckHandle(hPort) then
            begin
              hPort:=OpenCommPort(Port, BaudRate);
              if CheckHandle(hPort) then
              begin
                Ports[Port]:=hPort;
              end else
                hPort:=0;
            end;
          end;
          if CheckHandle(hPort) then
          begin
            if CallClock(hPort, clock_id) then
            begin
              GetClockModel(hPort, Model, fireware, cls);
              UnCallClock(hPort);
            end;
          end;
        end;


      for i:=0 to FClocks1.Count-1 do//循环检查所有端口上的所有机器
      with PClockInfo(FClocks1[i])^ do
      begin
        Application.ProcessMessages;
        if not FRuning then Break;
        if CheckHandle(hPort) then//有效端口句柄
        begin
          Inc(y);
          if  RefreshlvRealState(format(SSCOMD, [Port, clock_id,clock_place])) then continue;
          FillChar(CardInfo, SizeOf(TRealRecordInfo), 0);
          CardInfo.Size:=SizeOf(TRealRecordInfo);
          if TestCallClock(hport,clock_id,200) then
           RefreshlvRealDecive(format(SSCOMD, [Port, clock_id,clock_place]),true)
           else
           RefreshlvRealDecive(format(SSCOMD, [Port, clock_id,clock_place]),false);
          if FReadCard then
           if RealReadRecord(hPort, clock_id, @CardInfo) then//读卡片
           begin
              Connected:=True;
              if (not CardInfo.NoCard) then
              begin
                New(Card);
                FillChar(Card^, SizeOf(TCard), 0);
                if Model=690 then
                  Card.kind:=2
                else if Model=980 then
                  Card.Kind:=1
                else
                Card.Kind:=0;
                Card.CardId:=CardInfo.CardNo;
                Card.sign_time:=CardInfo.sign_time;
                Card.clock_id:=clock_id;
                Card.Reader:=CardInfo.Reader;
                Card.Flag:=CardInfo.Flag;
                Card.times:=CardInfo.times;
                Card.consume:=CardInfo.consume;
                Card.balance:=CardInfo.balance;
                Card.Mark:=CardInfo.Mark;
                Card.CardType:=arCardType[CardInfo.IsIDCard];
                FCardLists.Add(Card);
                if FSaveRecord then     SaveTextLine(Card);
               //保存记录
                Synchronize(RefreshList);
              end;
           end else if not bInit then
           begin
              if GetRecentErrCode=ERROR_IO_TIMEOUT then//响应超时
              begin
//                Connected:=False;
                Continue;
              end;
           end;
        end else
          Application.ProcessMessages;
      end;
      if bInit and (y=0) then
      begin
        MessageBox(Handle, PChar(SOEOUEeOIEEAONIO), PChar(SIuI), MB_ICONERROR);
        Break;
      end;
      bInit:=False;
    end;
  finally
    Terminate;
    FRuning:=False;
   // for i:=low(Ports) to High(Ports) do
     // begin
     // if CheckHandle(Ports[i]) then CloseHandle(Ports[i]);
     // end;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i, ps: Integer;
  Strs: TStringList;
  S: string;
begin
  Application.OnDeactivate:=ADeactivate;
  Screen.OnActiveFormChange:=OnActiveFormChange;
  SetupIcon;
  cbRate.ItemIndex := 0;
  edClockType.ItemIndex := 0;
  Application.Title := SAppTitle+format(' - Ver%1.2f', [Version]);
  Application.OnMinimize := MarkTaskBarIcon;
  if FindCmdLineSwitch('n', ['-', '/'], True) then
    OnPaint := FormPaint;
  Caption:=Application.Title;
  Mconnstr.Clear;
  //Mconnstr.Lines.LoadFromFile('d:\work\dephi\2\connectStr.ini');
  Mconnstr.Lines.LoadFromFile('conn\JxtConnStr.txt');
  frmMain.ADOConnection1.ConnectionString := Mconnstr.Text;
  frmMain.ADOConnection1.Connected;
  edClockType.ItemIndex := 0;
  PageControl1.ActivePageIndex := 1;
  cbPort.ItemIndex := 0;
  FClocks := TList.Create;
  FCurrentDir := IncludeTrailingBackslash(GetCurrentDir); //目录
  FIni := TIniFile.Create(FCurrentDir+RegFile);
  Strs := TStringList.Create;
  CommPorts := GetSysCommPorts;
  cbPort.Items.Text := CommPorts;
  cbPort.ItemIndex := 0;
  cbListKind.ItemIndex := 0;
  cbCardUser.ItemIndex := 1;
   with FIni do
  begin
    begin
      cbCmdVerifyFirst.Checked:=ReadBool(SetSec, 'CmdVerifyFirst', cbCmdVerifyFirst.Checked);
      cbAutoClearClock.Checked:=ReadBool(SetSec, 'Auto Clear Device', cbAutoClearClock.Checked);
      rgOnError.ItemIndex := ReadInteger(SetSec, 'On Error Action', rgOnError.ItemIndex);
    end;
    lvClocks.Items.BeginUpdate;
      try
        clbDevs.Clear;
        lvClocks.Items.Clear;
        ReadSectionValues(DevSec, Strs);
        for i := 0 to Strs.Count-1 do
        begin
          New(pclk);
          FillChar(pclk^, SizeOf(TClockInfo), 0);
          FClocks.Add(pclk);
          ps := Pos('=', Strs[i]);
          S := Copy(Strs[i], ps+1, Length(Strs[i])-ps);
          pclk.hPort := 0;
          pclk.Fireware := 0;
          pclk.clock_type := StrToIntDef(Copy(S, 1, 4), 0);
          pclk.Model := pclk.clock_type;
          pclk.cls := StrToIntDef(Copy(S, 5, 1), 0);
          pclk.clock_id := StrToIntDef('$'+Copy(S, 6, 2), 0);
          pclk.Port := StrToIntDef(Copy(S, 8, 4), 1);
          pclk.BaudRate := StrToIntDef(Copy(S, 12, 8), 9600);
          pclk.Fireware:=StrToFloat(Copy(S, 20, 4));
//          pclk.clock_name := Trim(Copy(S, 24, 10));
          pclk.CmdVerify:=Copy(S, 34, 1)<>'0';
          pclk.clock_place:=Copy(S,35,Length(s)-34);
          clbDevs.Items.AddObject(format(SSCOMD, [pclk.Port, pclk.clock_id,pclk.clock_place]), TObject(pclk));
          cbDecive.Items.AddObject(format(SSCOMD, [pclk.Port, pclk.clock_id,pclk.clock_place]), TObject(pclk));
          with lvClocks.Items.Add do
          begin
            Data := pclk;
            Caption := IntToHex(pclk.clock_id, 2);
            SubItems.Add('');
            SubItems.Add(IntToStr(pclk.Port));
            SubItems.Add(IntToStr(pclk.BaudRate));
            if pclk.clock_type=0 then
            begin
              SubItems.Add(SOEG);
              SubItems.Add('');
            end else
            begin
              SubItems.Add(format('%d%s', [pclk.Model, arICID[pclk.cls]]));
              SubItems.Add(format('%1.2n', [pclk.Fireware]));
            end;
            SubItems.Add(format('%s',[pclk.clock_place]));
            SubItems.Add('');
          end;
        end;
      finally
        lvClocks.Items.EndUpdate;
      end;
      if Strs.Count>0 then
        clbDevs.ItemIndex := 0
      else
      begin
        btnSearchClick(nil);
      end;
    if clbDevs.Items.Count=0 then
      PageControl1.ActivePage := tsBaseOP;      
    end;
  Strs.Free;
end;

procedure TfrmMain.ADeactivate(Sender: TObject);
begin
{  if not bRuning then
  begin
    ClosePort(pclk);
  end;}
end;

procedure TfrmMain.OnActiveFormChange(Sender: TObject);
begin
  if Assigned(Screen.ActiveForm) then
  with TControlAccess(Screen.ActiveForm) do
  begin
//    DesktopFont:=True;
  end;
end;

procedure TfrmMain.FormPaint(Sender: TObject);
begin
  Hide;
end;

procedure TfrmMain.spAddClockClick(Sender: TObject);
var
  i,j,flag: Integer;
  Item: TListItem;
  pclk2: PClockInfo;

begin
  flag := 0;
  for i:=0 to lvClocks.Items.Count-1 do
   begin
    lvClocks.Items[i].Selected:=False;
    if(lvClocks.Items[i].Caption = edClockID.Text) and (lvClocks.Items[i].SubItems[1] = copy(cbPort.Text,4,length(cbPort.Text)-3)) then
       flag := 1;
    end;
    Item := lvClocks.FindCaption(0, edClockID.Text, False, True, False);

  if flag = 0 then
  begin
    New(pclk2);
    FClocks.Add(pclk2);
    FillChar(pclk2^, SizeOf(TClockInfo), 0);
    pclk2.clock_id := StrToInt('$'+edClockID.Text);
    pclk2.Port := StrToIntDef(Copy(cbPort.Text, 4, Length(cbPort.Text)-3), 1);
    pclk2.BaudRate := StrToIntDef(cbRate.Text, 9600);
    pclk2.CmdVerify:=cbCmdVerify.Checked;
    if edClockType.ItemIndex=0 then
      pclk2.clock_type := 0
    else
    begin
      pclk2.clock_type := StrToInt(edClockType.Text);
      pclk2.Fireware:=StrToFloat(edFireware.Text);
    end;
    pclk2.Model := pclk2.clock_type;
    pclk2.cls := Byte(cbICID.Checked);
    pclk2.clock_place := edPlace.Text;
    with lvClocks.Items.Add do
    begin
      Selected := True;
      MakeVisible(True);
      Data := pclk2;
      Caption := IntToHex(pclk2.clock_id, 2);
      SubItems.Add('');
      SubItems.Add(IntToStr(pclk2.Port));
      SubItems.Add(IntToStr(pclk2.BaudRate));
      if pclk2.clock_type=0 then
      begin
        SubItems.Add(SOEG);
        SubItems.Add('');
      end else
      begin
        SubItems.Add(format('%d%s', [pclk2.Model, arICID[pclk2.cls]]));
        SubItems.Add(format('%1.2n', [pclk2.Fireware]));
      end;
      SubItems.Add(format('%s',[pclk2.clock_place]));
      SubItems.Add('');
    end;
    clbDevs.ItemIndex := clbDevs.Items.AddObject(format(SSCOMD, [pclk2.Port, pclk2.clock_id,pclk2.clock_place]), TObject(pclk2));
    cbDecive.Items.AddObject(format(SSCOMD, [pclk2.Port, pclk2.clock_id,pclk2.clock_place]), TObject(pclk2));
    msg.Caption := SADDDECIVE;
    Windows.Beep(2500, 100);
  end
  else
  begin
        for i := 0 to FClocks.Count-1 do
          with PClockInfo(FClocks[i])^ do
          begin
            if (clock_id = StrToInt('$'+edClockID.Text)) and (port = StrToIntDef(copy(cbPort.Text,4,length(cbPort.Text)-3),1)) then
            begin
                   BaudRate := StrToIntDef(cbRate.Text, 9600);
                   CmdVerify:=cbCmdVerify.Checked;
                   if edClockType.ItemIndex=0 then
                    begin
                      clock_type := 0;
                      Fireware:=0.00;
                    end
                   else
                 begin
                  clock_type := StrToInt(edClockType.Text);
                  Fireware:=StrToFloat(edFireware.Text);
                 end;
                  Model := clock_type;
                  cls := Byte(cbICID.Checked);
                  clock_place := edPlace.Text;

                for j:=0 to lvClocks.Items.Count-1 do
                 begin
                  lvClocks.Items[j].Selected:=False;
                   if(lvClocks.Items[j].Caption = edClockID.Text) and (lvClocks.Items[j].SubItems[1] = copy(cbPort.Text,4,length(cbPort.Text)-3)) then
                      begin
                       lvClocks.Items[j].SubItems[2] := cbRate.Text;
                       lvClocks.Items[j].SubItems[5] := edPlace.Text;
                      if clock_type=0 then
                        begin
                            lvClocks.Items[j].SubItems[3] := SOEG;
                            lvClocks.Items[j].SubItems[4] :='';
                         end else
                         begin
                            lvClocks.Items[j].SubItems[3] := format('%d%s', [Model, arICID[cls]]);
                            lvClocks.Items[j].SubItems[4] := format('%1.2n', [Fireware]);
                         end;
                      end;
                 end;
             end;
          end;
             clbDevs.Items.Clear;
             cbDecive.Items.Clear;
        for i:=0 to FClocks.Count-1 do
        with PClockInfo(FClocks[i])^ do
        begin
           clbDevs.Items.AddObject(format(SSCOMD, [Port, clock_id,clock_place]), TObject(FClocks[i]));
           cbDecive.Items.AddObject(format(SSCOMD, [Port, clock_id,clock_place]), TObject(FClocks[i]));
        end;

    msg.Caption := SAUOUOOEUIiOIaIUA;
    Windows.Beep(2500, 100);
  end;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: Integer;
  S: string;
begin
  bRuning := False;
  try
//    if FDeviceListModified then
//      SaveListFile(CurrentListFile, True);
    with Fini do
    begin
        EraseSection(DevSec);
        for i := 0 to FClocks.Count-1 do
          with PClockInfo(FClocks[i])^ do
          begin
            S := format(SDSSUUNSS, [clock_type, arBoolean[Boolean(cls)], clock_id, Port, BaudRate, Fireware, '', arBoolean[CmdVerify],clock_place]);
            WriteString(DevSec, IntToStr(i), S);
          end;
      begin
        WriteBool(SetSec, 'CmdVerifyFirst', cbCmdVerifyFirst.Checked);
        WriteBool(SetSec, 'Auto Clear Device', cbAutoClearClock.Checked);
        WriteInteger(SetSec, 'On Error Action', rgOnError.ItemIndex);
      end;
      UpdateFile
      end;
  except
    MsgBox(Screen.ActiveForm.Handle, PChar(SISSAEAaOAIAS), PChar(SIIo), MB_OK or MB_ICONERROR);
    Halt;