u_childloaddata.pas

中控800型号考勤机的自动采集数据程序。能够手动采集

unit u_ChildLoadData;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, ImgList, OleCtrls, zkemkeeper_TLB, StdCtrls,
  ExtCtrls,u_MainThread;

type
  TUserInfo = Record
   UserID: integer;
   UserName: string;
   CardNo: integer;
  end;
  UUserInfo = array of TUserInfo;
  Tfrm_ChildLoadData = class(TForm)
    ToolbarImages3: TImageList;
    ToolbarImages1: TImageList;
    DevTreeImage: TImageList;
    tbChild: TToolBar;
    btnSetPort: TToolButton;
    ToolButton1: TToolButton;
    btnColl: TToolButton;
    btnGrant: TToolButton;
    btnStop: TToolButton;
    ToolButton2: TToolButton;
    btnClose: TToolButton;
    CZKEM1: TCZKEM;
    TabControl: TTabControl;
    DevLV: TListView;
    Splitter1: TSplitter;
    StatusBar1: TStatusBar;
    TabControl1: TTabControl;
    PunchList: TListView;
    edAllMsg: TRichEdit;
    edErrMsg: TRichEdit;
    AlarmList: TListView;
    MsgImageList: TImageList;
    ImageList1: TImageList;
    Timer2: TTimer;
    procedure btnCollClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    aUserInfo: UUserInfo;
    DevID: integer;
    { Private declarations }
    function GetDeviceUserInfo:boolean;
    procedure GetAllAttLog;
  public
    { Public declarations }
    //读取状态
    procedure ReadDeviceStatus;
    //增加信息列表
    procedure AddInfo(aTime,aCaption: string;aType: integer);//1：代表正常2：代表异常3：代表报警4：代表打卡记录
    //增加状态列表 NetSate 0正在连接1:连接成功2：连接失败 aGetState 0：空闲 1：正在采集 2：采集完毕
    procedure AddInfo_List1(atype: integer;aDevID:integer;DevInfo:string;DevV:string;NetState:integer;
    RecordCount,aCurRrecordCount: integer;aGetState:integer);
    function DeviceConnected(aConType: integer;aDevID: integer;aCom:integer;aIP: string;
     aPort: integer;aPassWord:integer;aBT: integer;var aErrorCode: integer): boolean;//连接设备       
  end;

var
  frm_ChildLoadData: Tfrm_ChildLoadData;

implementation
uses u_DM, u_MainForm,ShareUnit;
const
  HexOfNum: array[0..15] of char=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

  StatusNames: array[1..12] of string=(
    'Tatal administrator',
    'Tatal users',
    'Tatal FP',
    'Tatal Password',
    'Tatal manage record',
    'Tatal In and out record',
    'Nominal FP number',
    'Nominal user number',
    'Nominal In and out record number',
    'Remain FP number',
    'Remain user number',
    'Remain In and out record number');
  Languages: array[0..2] of string=(
    'English',
    'Simplified Chinese',
    'Traditional Chinese');
  BaudRates: array[0..6] of string=(
    '1200 bps',
    '2400 bps',
    '4800 bps',
    '9600 bps',
    '19200 bps',
    '38400 bps',
    '115200 bps');
  CRCs: array[0..2] of string=(
    'Nothing',
    'Even',
    'Odd');
  StopBits: array[0..1] of string=(
    'One',
    'Two');
  DateSps: array[0..1] of string=(
    '"/"',
    '"-"');
  MSpeeds: array[0..2] of string=(
    'Low speed',
    'High speed',
    'Auto');
  OnOffs: array[0..1] of string=(
    'Off',
    'On');
  YesNos: array[0..1] of string=(
    'No',
    'Yes');
  DateFormats: array[0..9] of string=(
    'YY-MM-DD','YY/MM/DD','YY.MM.DD',
    'MM-DD-YY','MM/DD/YY','MM.DD.YY',
    'DD-MM-YY','DD/MM/YY','DD.MM.YY',
    'YYYYMMDD');
  NetSpeeds: array[0..4] of string=
    ('10M_H','100M_H','10M_F','100M_F','AUTO');
  NetSpeedValues: array[0..4] of integer=(0,1,4,5,8);
{$R *.dfm}
procedure Tfrm_ChildLoadData.GetAllAttLog;
begin
 
end;
procedure Tfrm_ChildLoadData.AddInfo_List1(atype: integer;aDevID:integer;DevInfo:string;DevV:string;
NetState:integer;RecordCount,aCurRrecordCount: integer;aGetState:integer);
var aNetState,cGetState: string;
    i:integer;
begin
 if NetState=0 then aNetState := '正在连接'
 else if NetState=1 then aNetState := '连接成功'
 else aNetState := '连接失败';
 if aGetState=0 then cGetState := '空闲'
 else if aGetState=1 then cGetState := '正在采集'
 else cGetState := '采集完毕';
 if atype=1 then
 begin
 DevLV.Items.Clear;
 with DevLV.Items.Add do
 begin
  caption := IntToStr(aDevID);
  subitems.Add(DevInfo);
  subitems.Add(DevV);
  subitems.Add(aNetState);
  subitems.Add('');
  subitems.Add('');
  subitems.Add('');
 for i:=0 to MainForm.DevList.Items.Count-1 do
 begin
  if StrToInt(MainForm.DevList.Items.Item[i].Caption)=aDevID then
   begin
   MainForm.DevList.Items.Item[i].SubItems[1] := cGetState;
   break;
   end;
 end;
  //subitems.Add(IntToStr(Rec))
 end;
 end
 else
 begin
  if DevLv.Items.Count>0 then
  begin
   DevLv.Items.Item[0].Caption := IntToStr(aDevID);
   DevLv.Items.Item[0].SubItems[0] := DevInfo;
   DevLv.Items.Item[0].SubItems[1] := DevV;
   DevLv.Items.Item[0].SubItems[2] := aNetState;
   DevLv.Items.Item[0].SubItems[3] := IntToStr(RecordCount);
   DevLv.Items.Item[0].SubItems[4] := IntToStr(aCurRrecordCount);;
   DevLv.Items.Item[0].SubItems[5] := cGetState;
   for i:=0 to MainForm.DevList.Items.Count-1 do
   begin
    if StrToInt(MainForm.DevList.Items.Item[i].Caption)=aDevID then
     begin
     MainForm.DevList.Items.Item[i].SubItems[1] := cGetState;
     break;
     end;
   end;
  end;
 end;
end;
procedure Tfrm_ChildLoadData.AddInfo(aTime,aCaption: string;aType: integer);
begin
 with AlarmList.Items.Add do
 begin
  Caption := aTime;
  subitems.Add(aCaption);
  subitems.Add(IntToStr(aType));
 end;
end;
function Tfrm_ChildLoadData.DeviceConnected(aConType: integer;aDevID: integer;aCom:integer;aIP: string;
aPort: integer;aPassWord:integer;aBT: integer;var aErrorCode: integer):boolean;
var aResult: boolean;
    cErrorCode: integer;
begin
 Result := false;
 AddInfo_List1(1,aDevID,'','',0,0,0,0);
 cErrorCode := 8888;
 try
 CZKEM1.SetCommPassword(aPassword);
 except
  aResult := false;
  AddInfo(ForMatDateTime('hh:mm:ss',now),'Set PassWord Error!',2);
 end;
 if aConType=1 then
  begin
    CZKEM1.CommPort := aCom;
    aResult:= CZKEM1.Connect_Com(aCom,aDevID,aBT);
    AddInfo(ForMatDateTime('hh:mm:ss',now),'Connect Success!',1);
    //ReadDeviceStatus;
  end
 else
  begin
    aResult := CZKEM1.Connect_Net(aIP,aPort);
    AddInfo(ForMatDateTime('hh:mm:ss',now),'Connect Success!',1);
    //ReadDeviceStatus;
  end;
 DevID := aDevID;
 if not aResult then
  begin
   CZKEM1.GetLastError(cErrorCode);
   aErrorCode := cErrorCode;
   AddInfo(ForMatDateTime('hh:mm:ss',now),'Disconnect ErrorCode'+IntToStr(aErrorCode),2);
   AddInfo_List1(1,aDevID,'','',2,0,0,0);
  end
 else
  AddInfo_List1(2,aDevID,'','',1,0,0,0);
  //ReadDeviceStatus;

 Result := aResult;
end;
//读取机器状态
procedure Tfrm_ChildLoadData.ReadDeviceStatus;
var
  s: widestring;
  ErrorCode, Value, i,
  dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond: integer;
begin
  if CZKEM1.GetFirmwareVersion(devid, s) then
   begin
    AddInfo(ForMatDateTime('hh:mm:ss',now),'Firmware Version: '+s,1);
    AddInfo_List1(1,DevID,'',s,0,0,0,0) ;
   end
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(ForMatDateTime('hh:mm:ss',now),format('! GetFirmwareVersion ErrorNo.=%d',[ErrorCode]),1);
  end;
  if CZKEM1.GetSerialNumber(devid, s) then
    AddInfo(ForMatDateTime('hh:mm:ss',now),'Serial Number: '+s,1)
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(ForMatDateTime('hh:mm:ss',now),format('! GetSerialNumber ErrorNo.=%d',[ErrorCode]),1);
  end;

  if CZKEM1.GetProductCode(devid, s) then
    AddInfo(ForMatDateTime('hh:mm:ss',now),'ProductCode: '+s,1)
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(ForMatDateTime('hh:mm:ss',now),format('! GetProductCode ErrorNo.=%d',[ErrorCode]),1);
  end;

  if CZKEM1.GetDeviceTime(devid, dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond) then
    AddInfo(ForMatDateTime('hh:mm:ss',now),Format('DeviceTime=%d-%d-%d %d:%d:%d',[dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond]),1)
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(ForMatDateTime('hh:mm:ss',now),format('! GetDeviceTime ErrorNo.=%d',[ErrorCode]),1);
  end;

  for i:=1 to length(StatusNames) do
  if CZKEM1.GetDeviceStatus(devid, i, value) then
    AddInfo(ForMatDateTime('hh:mm:ss',now),format('%s: %d', [StatusNames[i],value]),1)
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(ForMatDateTime('hh:mm:ss',now),format('! GetDeviceStatus(%d) ErrorNo.=%d',[i, ErrorCode]),2);
  end;
end;

function Tfrm_ChildLoadData.GetDeviceUserInfo: boolean;
begin
// CZKEM1.GetUserInfo()
end;
procedure Tfrm_ChildLoadData.btnCollClick(Sender: TObject);
var aErrorID,i:integer;
    cDevID: UDevID;
    aSelected: boolean;
    aHigh: integer;
    aDevID: string;
    sDevID: integer;
begin
 aSelected := false;
 setLength(cDevID,0);
 for i:=0 to MainForm.DevList.Items.Count-1 do
 begin
  if MainForm.DevList.Items.Item[i].Checked then
   begin
    SetLength(cDevID,Length(cDevID)+1);
    aHigh := High(cDevID);
    aDevID:=trim(MainForm.DevList.Items.Item[i].caption);
    if tryStrToInt(aDevID,sDevID) then
    cDevID[aHigh] := sDevID
    else
    cDevID[aHigh] := 0;
    aSelected := true;
   end;
 end;
 if not aSelected then
 begin
 application.MessageBox('请选择设备','提示',MB_OK);
 exit;
 end;
 TLoadThread.Create(cDevID,aConnectRecord);
end;

procedure Tfrm_ChildLoadData.Timer2Timer(Sender: TObject);
begin
//StatusBar1.Panels.Items[1].Text := 'Windows XP';
StatusBar1.Panels.Items[4].Text := ForMatDateTime('yyy-mm-dd',Date());
StatusBar1.Panels.Items[6].Text := ForMatDateTime('hh:mm:ss',time());
end;

procedure Tfrm_ChildLoadData.FormCreate(Sender: TObject);
begin
StatusBar1.Panels.Items[1].Text := ForMatDateTime('yyy/mm/dd hh:mm:ss',now());
end;

end.