realcontrol.pas

一个Delphi写的跟考勤机门禁机收款机的接品软件源码

            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 FClocks.Count-1 do//循环检查所有端口上的所有机器
      with PClockInfo(FClocks[i])^ do
      begin
        Application.ProcessMessages;
        if not FRuning then Break;
        if CheckHandle(hPort) then//有效端口句柄
        begin
          Inc(y);
          FillChar(CardInfo, SizeOf(TRealRecordInfo), 0);
          CardInfo.Size:=SizeOf(TRealRecordInfo);
          if FReadCard then
           if RealReadRecord(hPort, clock_id, @CardInfo) then//读卡片
           begin
              Connected:=True;
              if (not CardInfo.NoCard) then
              begin
                New(Card);
                FillChar(Card^, SizeOf(Card), 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;
          if FReadDoor and (FSelClock=i) and (not FDoorChange) then
            if ReadDoorStateDE(hPort, clock_id, DoorState1) then//读门锁状态
            begin
              Synchronize(RefreshDoorState);
            end else if not bInit then
            begin
              if GetRecentErrCode=ERROR_IO_TIMEOUT then//响应超时
              begin
//                Connected:=False;
                Continue;
              end;
            end;
          if FDoorChange then
          begin
            GetDoorState;
            if FSetDoor and (FSelClock=i) then
            begin
              SetDoorOpenDE(hPort, clock_id, DoorState2);//设置门锁
              FDoorChange:=False;
            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
      if CheckHandle(Ports[i]) then CloseHandle(Ports[i]);
      
    for i:=0 to FClocks.Count-1 do
      with PClockInfo(FClocks[i])^ do
      begin
        hPort:=0;
        Connected:=False;
      end;
  end;
end;

constructor TReadThread.Create(AOwner: TfrmRealControl);
begin
  FOwner:=AOwner;
  RefreshControlState;
  FClocks:=AOwner.ltClocks;
  FCardLists:=AOwner.ltCardLists;
  CreateAndOpenFiles;
  inherited Create(True);
  Priority:=tpTimeCritical;//实时
end;

destructor TReadThread.Destroy;
begin
  CloseFile(F);
  inherited;
end;

procedure TfrmRealControl.ListViewData(Sender: TObject; Item: TListItem; List: TList);
begin
  if List.Count=0 then Exit;
  if Item.Index>List.Count then Exit;
  with PCard(List[List.Count-1-Item.Index])^ do
  begin
    Item.Caption := format('%d', [flag and $0F]);
    Item.SubItems.Add(CardId);
    Item.SubItems.Add(formatDateTime(ShortDateFormat+' '+longTimeFormat, sign_time));
    Item.SubItems.Add(IntToHex(clock_id, 2));
    Item.SubItems.Add(IntToStr(Times));
    Item.SubItems.Add(FloatToStr(consume/10));
    Item.SubItems.Add(FloatToStr(balance/10));
    Item.SubItems.Add(IntToStr(Reader));
    Item.SubItems.Add(CardType);
    Item.Data := List[List.Count-1-Item.Index];
  end;
end;

procedure TfrmRealControl.ListViewDataFind(Sender: TObject; Find: TItemFind;
  const FindString: string; const FindPosition: TPoint; FindData: Pointer;
  StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
  var Index: Integer; List: TList);
var
  I: Integer;
  Found: Boolean;
begin
  I := StartIndex;
  if List.Count>0 then
    if (Find=ifExactString)or(Find=ifPartialString) then
    begin
      repeat
        if (I>List.Count-1) then
          if Wrap then
            I := 0
          else
            Exit;
        if Find=ifExactString then
          Found := UpperCase(FindString)=UpperCase(PCard(List[i])^.CardId)
        else
          Found := Pos(UpperCase(FindString), UpperCase(PCard(List[i])^.CardId))=1;
        Inc(I);
      until Found or(I=StartIndex);
      if Found then
        Index := I-1;
    end;
end;

procedure TfrmRealControl.FormDestroy(Sender: TObject);
begin
//  ClearIDList(ltClocks); 不能释放内存, 属于主窗口
  ClearIDList(ltCardLists);
  ltClocks.Free;
  ltCardLists.Free;
  frmRealControl:=nil;
end;

procedure TfrmRealControl.FormCreate(Sender: TObject);
begin
  SaveBtnCaption:=btnStart.Caption;
  SaveCaption:=Caption;
  SaveGbCaption:=gbLists.Caption;
  ltClocks:=TList.Create;
  ltCardLists:=TList.Create;
end;

procedure TfrmRealControl.btnCloseClick(Sender: TObject);
begin
  btnStart.Caption:=SaveCaption;
  btnClose.Enabled:=True;
  Close;
end;

procedure TfrmRealControl.lvListData(Sender: TObject; Item: TListItem);
begin
  ListViewData(Sender, Item, ltCardLists);
end;

procedure TfrmRealControl.lvListDataFind(Sender: TObject; Find: TItemFind;
  const FindString: String; const FindPosition: TPoint; FindData: Pointer;
  StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
  var Index: Integer);
begin
  ListViewDataFind(Sender, Find, FindString, FindPosition, FindData, StartIndex, Direction, Wrap, Index, ltCardLists);
end;

procedure TfrmRealControl.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Assigned(ReadThread) then
  begin
    if (not ReadThread.Suspended)and
      (not ReadThread.Terminated) then
    begin
      ReadThread.Terminate;
      ReadThread.WaitFor;
    end;
    CanClose:=ReadThread.Terminated;
    FreeAndNil(ReadThread);
  end;
end;

procedure TfrmRealControl.FormShow(Sender: TObject);
var
  i: Integer;
begin
  cbDevs.Items.Clear;
  for i:=0 to ltClocks.Count-1 do
    cbDevs.Items.Add(IntToHex(PClockInfo(ltClocks[i])^.clock_id, 2));
  cbDevs.ItemIndex:=0;
end;

procedure TfrmRealControl.cbD1Click(Sender: TObject);
begin
  if Assigned(ReadThread)and(Sender is TCheckBox) then
  begin
    ReadThread.FDoorChange:=TCheckBox(Sender).Checked;
  end;
end;

procedure TfrmRealControl.btnStartClick(Sender: TObject);
begin
  if not Assigned(ReadThread) then ReadThread:=TReadThread.Create(Self);
  if Assigned(ReadThread)and ReadThread.Suspended then
  begin
    ReadThread.Resume;
    btnStart.Caption:=SIO;
    stCardId.Caption:='';
    stPos.Caption:='';
    btnClose.Enabled:=False;
    Caption:=format(SRealControling, [SaveCaption]);
  end else if not ReadThread.Terminated then
  begin
    ReadThread.Terminate;
    ReadThread.WaitFor;
    FreeAndNil(ReadThread);
    Caption:=SaveCaption;
    btnStart.Caption:=SaveBtnCaption;
    btnClose.Enabled:=True;
  end;
end;

procedure TfrmRealControl.cbDevsChange(Sender: TObject);
begin
  if Assigned(ReadThread) then
    ReadThread.FSelClock:=cbDevs.ItemIndex;
end;

procedure TfrmRealControl.cbReadCardClick(Sender: TObject);
begin
  if Assigned(ReadThread) then ReadThread.RefreshControlState;
end;

procedure TfrmRealControl.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Caption:=SaveCaption;
  btnStart.Caption:=SaveBtnCaption;
end;

end.