timeclock.pas

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

unit timeclock;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ADODB, DB, ComCtrls, EastRiver, PrjConst, Functions, IniFiles,
  ExtCtrls, CheckLst, Buttons, Hints, SearchPort, ClockOptions, Progress,
  Mask, Menus, SJListView, ListCard, FindListItem, ImgList, EnhListView,
  ExtListView, ActiveX, GridsEh, DBGridEh, DBCtrlsEh, PersonCard, AutoRegCard,
  tempmingdan, SearchCard, SearchLog, ShellAPI;
const
  WM_READLIST=WM_USER+101;
  WM_READALLDATA=WM_USER+102;
  xorch=$555555;
  UniqueAppStr='EastRiver 980';
  arICID: array[0..2] of string=('D', 'C', ' ');
  arBoolean: array[Boolean]of char=('0', '1');
  arWeek: array[Boolean]of string=('', '*');
  MI_ICONEVENT= WM_USER+ 1;


type
  TControlAccess=class(TControl);
  t1=^TProgressProc;
  PCardList=^TCardList;
  TCardList=record
     Cols: array[1..5] of string;
    end;
  (*
  PCard1List=^TCard1List;
  TCard1List = record
     Cols: array[0..4] of string;
    Auts: Integer;
    bNew: Boolean;
  end; *)
 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;


  TfrmMain = class(TForm)
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    Panel1: TPanel;
    Label2: TLabel;
    msg: TLabel;
    edInspector: TStaticText;
    PageControl1: TPageControl;
    tsBaseOP: TTabSheet;
    spAddClock: TButton;
    sbDelClock: TButton;
    btnSearch: TButton;
    GroupBox3: TGroupBox;
    Label28: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    Label47: TLabel;
    Label12: TLabel;
    cbPort: TComboBox;
    cbRate: TComboBox;
    edClockID: TEdit;
    edClockType: TComboBox;
    cbICID: TCheckBox;
    edFireware: TComboBox;
    Mconnstr: TMemo;
    cbCmdVerify: TCheckBox;
    lvClocks: TListView;
    tsLists: TTabSheet;
    Label10: TLabel;
    btnOpen: TSpeedButton;
    cbCmdVerifyFirst: TCheckBox;
    cbCardStyle: TComboBox;
    btnRead: TButton;
    btnGetTime: TButton;
    btnSetTime: TButton;
    btnSetClockID: TButton;
    btnSetMark: TButton;
    btnClearData: TButton;
    btnClockMode: TButton;
    clbDevs: TCheckListBox;
    tsFileSet: TTabSheet;
    rgOnError: TRadioGroup;
    cbAutoClearClock: TCheckBox;
    tsMingdan: TTabSheet;
    cbListKind: TComboBox;
    Label1: TLabel;
    Label3: TLabel;
    cbDecive: TComboBox;
    btnDeviceAdd: TButton;
    btnDeviceDelete: TButton;
    btnClearDeviceList: TButton;
    btnFindCard: TButton;
    btnReadFile: TButton;
    OpenDlg: TOpenDialog;
    pmLoad: TPopupMenu;
    btnWriteDeviceCardList: TButton;
    popClearMD: TPopupMenu;
    pmLists: TPopupMenu;
    pmDelete: TPopupMenu;
    tsRealDevice: TTabSheet;
    lvRealDecive: TMainListview;
    ImageList1: TImageList;
    btnStart: TButton;
    lvDeviceCards: TdfsExtListView;
    cbReadCard: TCheckBox;
    cbSaveRecord: TCheckBox;
    lvList: TMainListview;
    popDecive: TPopupMenu;
    btnRefreshList: TButton;
    tsRegCard: TTabSheet;
    dbStudent: TDBGridEh;
    DataSource1: TDataSource;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    rbStudent: TRadioButton;
    rbTeacher: TRadioButton;
    GroupBox4: TGroupBox;
    rbOpenUser: TRadioButton;
    rbModifyCard: TRadioButton;
    btnSearchCard: TButton;
    btnRefresh: TButton;
    btnGuashi: TButton;
    btnOpenUser: TButton;
    btnChangeUser: TButton;
    Button7: TButton;
    GroupBox5: TGroupBox;
    cbSelectDecive: TComboBox;
    ADOQuery2: TADOQuery;
    cbDepart: TComboBox;
    popOpenCard: TPopupMenu;
    popModifyCard: TPopupMenu;
    ADOQuery3: TADOQuery;
    DataSource2: TDataSource;
    GroupBox6: TGroupBox;
    dbTodayLog: TDBGridEh;
    cbCardUser: TComboBox;
    Label5: TLabel;
    Label6: TLabel;
    popSearchCard: TPopupMenu;
    btnIfOnline: TBitBtn;
    popNotify: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    edPlace: TEdit;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ClosePort(pclk: PClockInfo);
    procedure spAddClockClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure sbDelClockClick(Sender: TObject);
    procedure lvClocksDeletion(Sender: TObject; Item: TListItem);
    procedure lvClocksSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure btnSearchClick(Sender: TObject);
    procedure edInspectorDblClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnGetTimeClick(Sender: TObject);
    procedure btnSetTimeClick(Sender: TObject);
    procedure btnSetMarkClick(Sender: TObject);
    procedure btnSetClockIDClick(Sender: TObject);
    procedure btnClockModeClick(Sender: TObject);
    procedure btnReadClick(Sender: TObject);
    procedure btnOpenClick(Sender: TObject);
    procedure cbDeciveChange(Sender: TObject);
    procedure cbListKindChange(Sender: TObject);
    procedure btnReadFileClick(Sender: TObject);
    procedure newLoadClick(Sender: TObject);
    procedure oldLoadClick(Sender: TObject);
    procedure btnClearDeviceListClick(Sender: TObject);
    procedure DeleteTableClick(Sender: TObject);
    procedure DeleteDeciveClick(Sender: TObject);
    procedure DeleteDeciveAndTableClick(Sender: TObject);
    procedure miSetSelectListsClick(Sender: TObject);
    procedure btnWriteDeviceCardListClick(Sender: TObject);
    procedure miSetAllListsClick(Sender: TObject);
    procedure btnDeviceDeleteClick(Sender: TObject);
    procedure miDeleteSelectDeciveClick(Sender: TObject);
    procedure miDeleteSelectDeciveAndListClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure btnDeviceAddClick(Sender: TObject);
    procedure btnFindCardClick(Sender: TObject);
    procedure lvDeviceCardsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnStartClick(Sender: TObject);
    procedure miPauseMoniterClick(Sender: TObject);
    procedure miContinueMoniterClick(Sender: TObject);
    procedure lvRealDeciveSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure btnRefreshListClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure rbStudentClick(Sender: TObject);
    procedure rbTeacherClick(Sender: TObject);
    procedure cbDepartChange(Sender: TObject);
    procedure rbOpenUserClick(Sender: TObject);
    procedure rbModifyCardClick(Sender: TObject);
    procedure dbStudentTitleClick(Column: TColumnEh);
    procedure cbSelectDeciveChange(Sender: TObject);
    procedure btnOpenUserClick(Sender: TObject);
    procedure miHandOpenCardClick(Sender: TObject);
    procedure miHandModifyCardClick(Sender: TObject);
    procedure btnChangeUserClick(Sender: TObject);
    procedure dbTodayLogDrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure miMachineOpenCardClick(Sender: TObject);
    procedure miMachineModifyCardClick(Sender: TObject);
    procedure cbCardUserChange(Sender: TObject);
    procedure newTableLoadClick(Sender: TObject);
    procedure oldTableLoadClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure btnSearchCardClick(Sender: TObject);
    procedure midbStudentClick(Sender: TObject);
    procedure midbLogClick(Sender: TObject);
    procedure btnGuashiClick(Sender: TObject);
    procedure btnIfOnlineClick(Sender: TObject);
    procedure SetupIcon;
    procedure FreeIcon;
    procedure MarkTaskBarIcon(Sender: TObject);
    procedure IconOnClick(var Msg: TMessage); message MI_ICONEVENT;
    procedure FormPaint(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure btnClearDataClick(Sender: TObject);
  private
    { Private declarations }

        DeviceList: TList;
        FClocks: TList;
    FCurrentDir, Dir, FileName: string;        
        bRuning: Boolean;
    lstAllowCard, lstBlackCard: array of TDownloadCardStruct;
    AllowCardNumber, BlackCardNumber: Integer;        
    procedure ADeactivate(Sender: TObject);
    procedure OnActiveFormChange(Sender: TObject);
    procedure cbDecive_show;
    procedure lvRealDeciveShow;
    function DownloadCardLists(Kind,XiazaiKind: Integer): Boolean;
  public
    { Public declarations }

    pclk: PClockInfo;
    FPCLK: PClockInfo;
    ltClocks: TList;
    ltCardLists: TList;
    procedure ChooseDev;
    procedure rbStudentShow;
    procedure dbStudentShow;
    procedure dbTodayLogShow;
    procedure ReadData(pclk: PClockInfo; bFast: Boolean; MultiClock: Boolean);
    function OpenPort(pclk: PClockInfo): Boolean;
    function OpenPort1(pclk: PClockInfo): Boolean;

  end;

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

var
  frmMain: TfrmMain;
  fIni: TIniFile;
  dlgProgress: TdlgProgress;
  ReadThread: TReadThread;
  F, F2, FLog: TextFile;
  NormalIcon: TIcon;
  CommPorts: string;
      bRuning: Boolean;

      FDeviceSortAsc: Boolean;
  FDeviceSortIndex: Integer;
procedure WaitProc(p: Pointer; dwMilliseconds: Integer);stdcall;
function DataProgressProc(p: Pointer; lpReadData: PReadData): Boolean;stdcall;



implementation

uses temprecord;



{$R *.dfm}
procedure TReadThread.RefreshlvRealDecive(s: string; t: Boolean );
var
 Item: TListItem;
begin
      with frmMain do
        with lvRealDecive do
        begin
        Item := lvRealDecive.FindCaption(0,s, False, True, False);
        if t then
        Item.ImageIndex := 1
        else
        Item.ImageIndex := 0;
        //lvRealDecive.Selected := Item;
        //lvRealDecive.Selected.ImageIndex := 1;
        //lvRealDecive.Selected := nil;
        end;
end;

function TReadThread.RefreshlvRealState(s: string): Boolean;
var
  Item: TListItem;
begin
     Result := false;
     with frmMain do
       begin
         Item := lvRealDecive.FindCaption(0,s,False,True,False);
         if (Item.ImageIndex = 2) then
         Result := true;
       end;
end;


procedure TReadThread.SaveTextLine(Card: PCard);
begin
       CoInitialize( nil );
        if (formatDateTime('yyyyMMddhhnnss', Now)<='20070501010101') then
       begin
       frmMain.ADOQuery1.Close;
       frmMain.ADOQuery1.SQL.Text := 'exec insert_kqjlu '''+format('%s',[Card.CardId])+''','''+format('%14.14s',[formatDateTime('yyyyMMddhhnnss', Card.sign_time)])+''','+inttostr(Card.clock_id)+'';
       frmMain.ADOQuery1.ExecSQL;
       end;
       CoUnInitialize;
  with frmMain do
  begin
    with lvList.Items.Add do
     begin
       caption := format('%d', [Card.flag and $0F]);
       subItems.Add(format('%s',[Card.CardId]));
       SubItems.Add(formatDateTime(ShortDateFormat+' '+longTimeFormat, Card.sign_time));
       SubItems.Add(IntToHex(Card.clock_id, 2));
       SubItems.Add(IntToStr(Card.Reader));
       SubItems.Add(format('I%s',[Card.CardType]));
       Case (Card.flag and $0F) of
       0:
       subItems.Add('正常刷卡');
       3:
       SubItems.Add('白名单刷卡');
       4:
       SubItems.Add('黑名单刷卡');
       end;
      end;
    lvList.Refresh;
  end;
end;


procedure TReadThread.RefreshControlState;
begin
  with frmMain do
  begin
    FReadCard:=cbReadCard.Checked;
    FSaveRecord:=cbSaveRecord.Checked;
  end;
end;

procedure TReadThread.RefreshList;
var
  p: Pointer;
begin
  if FCardLists.Count>500 then
  begin
    frmMain.lvList.Items.Clear;
    frmMain.lvList.Refresh;
    p:=FCardLists[FCardLists.Count-1];
    FCardLists.Delete(FCardLists.Count-1);
    ClearIDList(FCardLists);
    FCardLists.Add(p);
  end;

end;