realcontrol.pas

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

unit RealControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  EastRiver, ComCtrls, StdCtrls, ExtCtrls, PrjConst;


type
  PCard=^TCard;
  TCard=record
    CardId: string;
    clock_id: Byte;
    sign_time: TDateTime;
    Reader: Integer;
    Flag: Integer;
    Mark: Integer;
    times: Integer;
    consume: Integer;
    balance: Integer;
    CardType: char;
    kind: Integer; //1: 门禁机, 2:消费机
  end;

  TfrmRealControl=class;

  TReadThread=class(TThread)
  private
    FOwner: TfrmRealControl;
    FRuning,
    FReadCard, FReadDoor, FSetDoor, FSaveRecord, FDoorChange: Boolean;
    FSelClock: Integer;
    FClocks: TList;
    FCardLists: TList;
    Card: PCard;
    bFilePrepared: Boolean;
    Last_Read_Date: TDateTime;
    CardInfo: TRealRecordInfo;
    DoorState1, DoorState2: array[0..10]of char;
    F: TextFile;
    FileName: string;
    function CreateAndOpenFiles: Boolean;
    procedure SaveTextLine(Card: PCard);
  protected
    procedure RefreshList;
    procedure RefreshDoorState;
    procedure GetDoorState;
    procedure RefreshControlState;
    procedure Execute;override;
  public
    constructor Create(AOwner: TfrmRealControl);
    destructor Destroy;override;
  end;

  TfrmRealControl = class(TForm)
    gbDoors: TGroupBox;
    cbD1: TCheckBox;
    cbD2: TCheckBox;
    cbD3: TCheckBox;
    cbD4: TCheckBox;
    GroupBox2: TGroupBox;
    btnStart: TButton;
    cbReadCard: TCheckBox;
    cbReadDoor: TCheckBox;
    cbSetDoor: TCheckBox;
    Bevel1: TBevel;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    stCardId: TStaticText;
    rbID: TRadioButton;
    rbIC: TRadioButton;
    Label2: TLabel;
    stPos: TStaticText;
    btnClose: TButton;
    cbSaveRecord: TCheckBox;
    Label3: TLabel;
    cbDevs: TComboBox;
    gbLists: TGroupBox;
    lvList: TListView;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure lvListData(Sender: TObject; Item: TListItem);
    procedure lvListDataFind(Sender: TObject; Find: TItemFind;
      const FindString: String; const FindPosition: TPoint;
      FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
      Wrap: Boolean; var Index: Integer);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure cbD1Click(Sender: TObject);
    procedure btnStartClick(Sender: TObject);
    procedure cbDevsChange(Sender: TObject);
    procedure cbReadCardClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    SaveCaption, SaveGbCaption, SaveBtnCaption: string;
    ReadThread: TReadThread;
    procedure ListViewData(Sender: TObject; Item: TListItem; List: TList);
    procedure ListViewDataFind(Sender: TObject; Find: TItemFind;
      const FindString: string; const FindPosition: TPoint; FindData: Pointer;
      StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean;
      var Index: Integer; List: TList);
  public
    { Public declarations }
    FPCLK: PClockInfo;
    ltClocks: TList;
    ltCardLists: TList;
  end;

var
  frmRealControl: TfrmRealControl;

implementation

uses Main, Functions;

{$R *.DFM}
function TReadThread.CreateAndOpenFiles: Boolean;
var
  SaveFileName: string;
begin
  Result:=False;
  SaveFileName:=FileName;
  FileName := frmMain.GetStoredFileName(frmRealControl.FPCLK);
  if not bFilePrepared or (AnsiCompareText(FileName, SaveFileName)<>0) then
  begin
    if bFilePrepared then CloseFile(F);
  {$I-}
    AssignFile(F, FileName);
    FileMode := 2;
    Reset(F);
    if IOResult=0 then
      Append(F)
    else
      ReWrite(F);
  {$I+}
    if IOResult<>0 then
    begin
      MsgBox(Screen.ActiveForm.Handle, pchar(format(SOOIASSEU, [FileName])), pchar(SIaE), MB_OK+MB_ICONERROR);
      Exit;
    end;
    bFilePrepared:=True;
    Result:=bFilePrepared;
  end;
end;

procedure TReadThread.SaveTextLine(Card: PCard);
var
  Line: string;
begin
  if Date<>last_read_date then
  begin
    CreateAndOpenFiles;
  end;
  if frmMain.cbUseFMT.Checked then
  begin
    Line := frmMain.edFMTStr.Text;
    Line := StringReplace(Line, FDevice, IntToHex(Card.clock_id, 2), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FCard, Card.CardId, [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, Ftab, #9, [rfIgnoreCase, rfReplaceAll]); //表格符
    Line := StringReplace(Line, FYear, formatDateTime('yyyy', Card.sign_time), [rfIgnoreCase, rfReplaceAll]); //四位数年份
    Line := StringReplace(Line, FYear2, formatDateTime('yy', Card.sign_time), [rfIgnoreCase, rfReplaceAll]); //两位数年份
    Line := StringReplace(Line, Fmonth, formatDateTime('MM', Card.sign_time), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FDay, formatDateTime('dd', Card.sign_time), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FHour, formatDateTime('hh', Card.sign_time), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FMin, formatDateTime('nn', Card.sign_time), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FSec, formatDateTime('ss', Card.sign_time), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FMark, IntToStr((Card.Flag and $80) shr 7), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FFlag, IntToStr(Card.Flag and $0F), [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FEmpId, '', [rfIgnoreCase, rfReplaceAll]);
    Line := StringReplace(Line, FWeek, format('%d', [DayOfWeek(Card.sign_time)]), [rfIgnoreCase, rfReplaceAll]);
    if Card.kind=1 then
    begin
      Line := StringReplace(Line, FDoor, IntToStr((Card.Flag and $30) shr 4+1), [rfIgnoreCase, rfReplaceAll]);
    end else if Card.Kind=2 then
    begin
      Line := StringReplace(Line, FFlag, format('%.1u', [Card.Flag]), [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FTimes, format('%.3u', [Card.times]), [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FBalance, format('%.5u', [Card.balance]), [rfIgnoreCase, rfReplaceAll]);
      Line := StringReplace(Line, FConsume, format('%.5u', [Card.consume]), [rfIgnoreCase, rfReplaceAll]);
    end;
  end
  else
  begin
    if Card.Kind=2 then
    begin
      Line:=format('%s'#9'%14.14s'#9'%.2x'#9'%1.1u'#9'%1.1u'#9'%1.1u',
        [Card.CardId, formatDateTime('yyyyMMddhhnnss', Card.sign_time), Card.clock_id, 0, Card.Flag, 0]);
      Line:=Line+format(#9'%.3u'#9'%.5u'#9'%.5u', [Card.Times, Card.Balance, Card.Consume]);
    end else
    begin
      Line:=format('%s'#9'%14.14s'#9'%.2x'#9'%1.1u'#9'%1.1u'#9'%1.1u',
        [Card.CardId, formatDateTime('yyyyMMddhhnnss', Card.sign_time), Card.clock_id, (Card.Flag and $80)shr 7, Card.Flag and $0F, (Card.Flag and $30) shr 4+1]);
    end;
  end;
  WriteLn(F, Line);
  Flush(F);
  last_read_date:=Date;
end;

procedure TReadThread.RefreshList;
var
  p: Pointer;
begin
  if FCardLists.Count>10000 then
  begin
    p:=FCardLists[FCardLists.Count-1];
    FCardLists.Delete(FCardLists.Count-1);
    ClearIDList(FCardLists);
    FCardLists.Add(p);
  end;
  with frmRealControl do
  begin
    stCardId.Caption:=Card.CardId;
    rbID.Checked:=CardInfo.IsIDCard;
    rbIC.Checked:=not rbID.Checked;
    stPos.Caption:=format('%d', [CardInfo.Reader]);
    lvList.Items.Count:=ltCardLists.Count;
    lvList.Refresh;
    gbLists.Caption:=format('%s(%d)', [SaveGbCaption, FCardLists.Count]);
  end;
end;

procedure TReadThread.RefreshDoorState;
begin
  with frmRealControl do
  begin
    cbD1.Checked:=DoorState1[0]='0';
    cbD2.Checked:=DoorState1[1]='0';
    cbD3.Checked:=DoorState1[2]='0';
    cbD4.Checked:=DoorState1[3]='0';
  end;
end;

procedure TReadThread.GetDoorState;
const
  arState: array[Boolean] of char=('0', '1');
begin
  with frmRealControl do
  begin
    DoorState2[0]:=arState[cbD1.Checked];
    DoorState2[1]:=arState[cbD2.Checked];
    DoorState2[2]:=arState[cbD3.Checked];
    DoorState2[3]:=arState[cbD4.Checked];
    DoorState2[4]:=#0;
  end;
end;

procedure TReadThread.RefreshControlState;
begin
  with frmRealControl do
  begin
    FReadCard:=cbReadCard.Checked;
    FReadDoor:=cbReadDoor.Checked;
    FSetDoor:=cbSetDoor.Checked;
    FSaveRecord:=cbSaveRecord.Checked;
  end;
end;

procedure TReadThread.Execute;
const
  arCardType: array[Boolean]of char=('C', 'D');
var
  bInit: Boolean;
  i, y: 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 FClocks.Count-1 do//循环检查所有端口上的所有机器
        with PClockInfo(FClocks[i])^ do
        begin
          if CheckHandle(Ports[Port]) then
          begin
            hPort:=Ports[Port];
          end else
          begin