timeclock.pas

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

procedure TfrmMain.btnSetTimeClick(Sender: TObject);
var
  Right: Boolean;
  i, y, SaveIdx: Integer;
begin
  y:=0;
  SaveIdx:=clbDevs.ItemIndex;
  for i:=0 to clbDevs.Items.Count-1 do
    if clbDevs.Checked[i] and Assigned(clbDevs.Items.Objects[i]) then
    begin
      pclk:=PClockInfo(clbDevs.Items.Objects[i]);
      clbDevs.ItemIndex:=i;
      clbDevs.Refresh;
      if OpenPort(pclk) then
      begin
        Right := SetClockTime(pclk.hPort, Now);
        if Right then
          msg.Caption := Format(SSSEAEeOAE, [pclk.Port, pclk.clock_id])
        else
          msg.Caption := Format(SSSEAEeOAEU, [pclk.Port, pclk.clock_id]);
      end;
      Windows.Beep(2500, 150);
      ClosePort(pclk);
      Sleep(100);
      inc(y);
    end;
  clbDevs.ItemIndex:=SaveIdx;

  if y=0 then
  begin
    if clbDevs.ItemIndex=-1 then
      ChooseDev;
    begin
      pclk := PClockInfo(clbDevs.Items.Objects[clbDevs.ItemIndex]);
      if not OpenPort(pclk) then
      begin
        pclk.Connected := False;
        pclk.hPort := OpenCommPort(pclk.Port, pclk.BaudRate);
        if pclk.clock_type<>0 then
          SetClockModel(pclk.hPort, pclk.Model, pclk.Fireware, pclk.cls)
        else
        begin
          SetCmdVerify(cbCmdVerifyFirst.Checked);
        end;
      end
      else
        pclk.Connected := True;
      if CheckHandle(pclk.hPort) then
      begin
        if not pclk.Connected then
        begin
          if MsgBox(Handle, pchar(format(SISSAUECNEOOOAEEeOACOMDEUEIAEuOGEeAEA, [pclk.Port])), msg_confirm, MB_YESNO or MB_ICONQUESTION)<>IDYES then
          begin
            ClosePort(pclk);
            Exit;
          end;
          Right := SetPortAllClockTime(pclk.hPort, Now);
          for i:=0 to 2 do
          begin
            if i<>((pclk.baudrate div 9600) div 2) then
            begin
              if i=0 then InitCommPort(pclk.hPort, 9600, 255) else
                InitCommPort(pclk.hPort, i*2*9600, 255);
              Right := SetPortAllClockTime(pclk.hPort, Now);
            end;
          end;
          if InitCommPort(pclk.hPort, pclk.baudrate, 255) then
          ClosePort(pclk);
        end
        else
          Right := SetClockTime(pclk.hPort, Now);
        if Right then
          msg.Caption := Format(SSSEAEeOAE, [pclk.Port, pclk.clock_id])
        else
          msg.Caption := Format(SSSEAEeOAEU, [pclk.Port, pclk.clock_id]);
        if not pclk.Connected then
        begin
          if CheckHandle(pclk.hPort) then
            CloseHandle(pclk.hPort);
          pclk.hPort:=0;
        end;
      end;
      ClosePort(pclk);
      Windows.Beep(2500, 150);
    end;
  end;
end;



procedure TfrmMain.btnSetMarkClick(Sender: TObject);
var
  Mark: Char;
  S: string;
begin
  if clbDevs.ItemIndex=-1 then
    ChooseDev
  else
  begin
    pclk := PClockInfo(clbDevs.Items.Objects[clbDevs.ItemIndex]);
    if OpenPort(pclk) then
    begin
      if ReadClockMark(pclk.hPort, Mark) then S:=mark;
      if (InputQuery(SCeEaEe, SCeEaEeIGAUAEEEOU, S, 1))and(S<>'') then
      begin
        if SetClockMark(pclk.hPort, S[1]) then
        begin
          pclk.Mark := S[1];
          msg.Caption := SOK;
        end
        else
        begin
          msg.Caption := SERROR;
        end;
        Windows.Beep(2500, 150);
      end;
    end;
    ClosePort(pclk);
  end;
end;

procedure TfrmMain.btnSetClockIDClick(Sender: TObject);
var
  Connected, Right: Boolean;
  i,j : Integer;
  S: string;
  Item:TListItem;
begin
  if clbDevs.ItemIndex=-1 then
    ChooseDev
  else
  begin
    pclk := PClockInfo(clbDevs.Items.Objects[clbDevs.ItemIndex]);
    if not OpenPort(pclk) then
    begin
      Connected := False;
      pclk.hPort := OpenCommPort(pclk.Port, pclk.BaudRate);
      if pclk.clock_type<>0 then
        SetClockModel(pclk.hPort, pclk.Model, pclk.Fireware, pclk.cls)
      else
      begin
        SetCmdVerify(cbCmdVerifyFirst.Checked);
      end;
    end
    else
      Connected := True;


    if CheckHandle(pclk.hPort) then
    begin
      S:=IntToHex(pclk.clock_id, 2);
      if (InputQuery(SCeEaEe, SCeEaEeIEyOGAUA, S, 2, [#8, '0'..'9', 'A'..'F', 'a'..'f']))and(S<>'') then
      begin
        if pclk.VerOrd>1 then
          Right := SetClockID(pclk.hPort, StrToInt('$'+S))
        else if MsgBox(Handle, pchar(format(SCeEOUCOMDEUEIOAOOGOIEeNOoEuOGEeAAIIOOUAECNIGEeOAUA, [pclk.Port])), msg_confirm, MB_YESNO or
          MB_ICONQUESTION)=IDYES then
        begin
          if Connected then
            UnCallClock(pclk.hPort);
          Right := SetClockID(pclk.hPort, StrToInt('$'+S));
          for i:=0 to 2 do
          begin
            if i<>((pclk.baudrate div 9600) div 2) then
            begin
              if i=0 then InitCommPort(pclk.hPort, 9600, 255) else
                InitCommPort(pclk.hPort, i*2*9600, 255);
              Right := SetClockID(pclk.hPort, StrToInt('$'+S));
            end;
          end;
          if InitCommPort(pclk.hPort, pclk.baudrate, 255) then
          if Connected then
            ClosePort(pclk)
          else
          begin
            CloseHandle(pclk.hPort);
            pclk.hPort:=0;
          end;
          pclk.hPort := 0;
        end
        else
        begin
          if Connected then
            ClosePort(pclk)
          else
          begin
            CloseHandle(pclk.hPort);
            pclk.hPort:=0;
          end;
          Exit;
        end;
        if Right then
        begin
          for j:= 0 to lvClocks.Items.Count-1 do
          if (lvClocks.Items[j].Caption = IntToHex(pclk.clock_id, 2)) and (lvClocks.Items[j].SubItems[1] = IntToStr(pclk.Port)) then
          lvClocks.Items[j].Caption := S;
          pclk.clock_id := StrToInt('$'+S);
          msg.Caption := SOK;
             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;
        end
        else
        begin
          msg.Caption := SERROR;
        end;
        ClosePort(pclk);
        Windows.Beep(2500, 150);
      end else
      begin
        if Connected then
          ClosePort(pclk)
        else
        begin
          CloseHandle(pclk.hPort);
          pclk.hPort:=0;
        end;
      end;
    end;
  end;
end;

procedure TfrmMain.btnClockModeClick(Sender: TObject);
begin
  if clbDevs.ItemIndex=-1 then
    ChooseDev;
  with clbDevs do
  begin
    pclk := PClockInfo(Items.Objects[ItemIndex]);
    OpenPort(pclk);
    if pclk.Connected then
    begin
      if not Assigned(dlgOptions) then
        dlgOptions := TdlgOptions.Create(Self);
      Self.Update;
      bRuning:=True;
      try
        dlgOptions.pclk^ := pclk^;
        if dlgOptions.ShowModal=mrOK then
          msg.Caption := dlgOptions.msg.Caption;
         pclk^:=dlgOptions.pclk^;
      finally
        bRuning:=False;
        ClosePort(pclk);
      end;
    end;
  end;
end;




procedure TfrmMain.btnReadClick(Sender: TObject);
var
  I, x, y: Integer;
  Right: Boolean;
  SaveCursor: TCursor;
  SaveCaption: string;
  WindowList: Pointer;
  ActiveWindow : Hwnd;
begin
  if bRuning=True then
  begin
    bRuning := False;
    Exit;
  end;
  ActiveWindow := GetActiveWindow;
  WindowList := DisableTaskWindows(0);
  x := clbDevs.ItemIndex;
  SaveCursor := Screen.Cursor;
  Screen.Cursor := crAppStart;
  if not Assigned(dlgProgress) then dlgProgress:=TdlgProgress.Create(Self);
  try
    ClosePort(pclk);
    begin
      bRuning := True;
      SaveCaption := btnRead.Caption;
      btnRead.Caption := SIO;
      y:=0;
      for I := 0 to clbDevs.Items.Count-1 do
        if clbDevs.Checked[i] then
          Inc(y);

      if (clbDevs.ItemIndex<>-1) and (y<2) then
      begin
        pclk := PClockInfo(clbDevs.Items.Objects[clbDevs.ItemIndex]);
        if OpenPort(pclk) then
        begin
          if (Sender=btnRead)and(not btnRead.Enabled) then Exit;
          ReadData(pclk, True, False); //快速下载数据
          ClosePort(pclk);
        end;
      end else if y=0 then
        MsgBox(Screen.ActiveForm.Handle, PChar(SCeNOnUAEEAN), PChar(SIaE), MB_OK or MB_ICONINFORMATION)
      else
        for I := 0 to clbDevs.Items.Count-1 do
        begin
          if clbDevs.Checked[i] then
          begin
            clbDevs.ItemIndex := i;
            clbDevs.Update;
            pclk := PClockInfo(clbDevs.Items.Objects[i]);
            if OpenPort(pclk) then
            begin
              if (Sender=btnRead)and(not btnRead.Enabled) then Continue;
              ReadData(pclk, True, True); //快速下载数据
              ClosePort(pclk);
            end;
          end;
        end;
      end;
  finally
    Screen.Cursor := SaveCursor;
    EnableTaskWindows(WindowList);
    if ActiveWindow <> 0 then SetActiveWindow(ActiveWindow);
    dlgProgress.Close;
    clbDevs.ItemIndex := x;
    btnRead.Caption := SaveCaption;
    bRuning := False;
  end;
end;


procedure TfrmMain.ReadData(pclk: PClockInfo; bFast: Boolean; MultiClock: Boolean);
type
  TLine=record
    Card: string;
    EmpId: string;
    TimeStr: string;
    mark: char;
    Flag: Integer;
    CardTimes: Integer;
    consume: Integer;
    balance: Integer;
  end;
var
  i, nLine,
    Count, ERCount, ErrorCount: Integer; //正确数据总数, 错误数据总数, 重试次数
  Right: Boolean;
  Mark: Char;
  ERRFile: string;
  Lines: array[0..20] of TLine;//新门禁机允许一次读400条记录

  function ReadTextLine: Integer;
  var
    i, Flag, CardTimes, CardGroup: Integer;
    CardBuf, TimeBuf: array[0..50] of char;
    Buf: array[0..$10] of TICRecord;
  begin
    Result := 0;
    if ((pclk.VerOrd>2) or
        ((ClockVerOrd(pclk.Model)=2) and (pclk.Fireware>=FW128))) then //是否支持快速读数据
    begin
      Flag := 0;
      FillChar(Buf, SizeOf(Buf), 0);
      Result := BatchReadRecord(pclk.hPort, Buf);
      if Result>=0 then
      begin
        Right := True;
        for i := 0 to Result-1 do
        begin
          SetString(Lines[i].Card, PChar(@Buf[i].Card), StrLen(@Buf[i].Card));
          SetString(Lines[i].TimeStr, PChar(@buf[i].TimeString), StrLen(@Buf[i].TimeString));
          SetString(Lines[i].EmpId, PChar(@Buf[i].EmpId), StrLen(@Buf[i].EmpId));
          if (pclk.Fireware>FW128)or(Chr(lo(Buf[i].mark))in [#20..#255]) then
            Lines[i].Mark := chr(lo(Buf[i].mark))
          else
            Lines[i].Mark := Mark; //chr(lo(Buf[i].mark));//批读卡没有Mark
          Lines[i].Flag := Buf[i].flag;
          Lines[i].CardTimes := Buf[i].cardTimes;
          Lines[i].consume := Buf[i].consume;
          Lines[i].balance := buf[i].balance;
        end;
      end;
    end
    else //普通读数据
    begin
      Flag := 0;
      if ((ClockVerOrd(pclk.Model)=2) and(pclk.Fireware>=FW125)) or
         (pclk.VerOrd>2) then
        Right := ReadStandardRecord(pclk.hPort, CardBuf, TimeBuf, Mark, Flag, CardTimes, CardGroup)//880专用
      else
        Right := ReadRecord(pclk.hPort, CardBuf, TimeBuf, Mark, true); //读第一条记录
      if (Right)and(StrPos(CardBuf, 'OVER')=nil) then
      begin
        Result := 1;
        Lines[0].Card := PChar(@CardBuf);
        Lines[0].TimeStr := PChar(@TimeBuf);
        Lines[0].EmpId := '';
        Lines[0].mark := Mark;
        Lines[0].Flag := Flag;
        Lines[0].CardTimes := CardTimes;
        Lines[0].consume := 0;
        Lines[0].balance := 0;
      end;
    end;
    if not Right then
      Result := -1;
  end;

  procedure SaveTextLine(Value: Integer);
  var
    Line, sYear, sMonth, sDay, sHour, sMin, sSec, sWeek: string;