comsdktest.pas

脱机通讯开发包.可以支持VC,VB及多种编程语言.

  end
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(format('! GetDeviceInfo(%d) ErrorNo.=%d',[i, ErrorCode]));
  end;
}
end;

procedure TForm1.btnSaveDevInfoClick(Sender: TObject);
var
  ErrorCode, Value, i: integer;
begin
  for i:=1 to vleDevInfo.RowCount-1 do
  if Modified[i]='1' then
  begin
    if i=29 then
    begin
      Value := BNetSpeedDecode(vleDevInfo.Strings.ValueFromIndex[i-1]);
    end
    else if vleDevInfo.ItemProps[i-1].HasPickList then
    begin
      for value:=0 to vleDevInfo.ItemProps[i-1].PickList.Count-1 do
      if vleDevInfo.ItemProps[i-1].PickList[value]=vleDevInfo.Strings.ValueFromIndex[i-1] then
        break;
      if value>=vleDevInfo.ItemProps[i-1].PickList.Count then
        value:=0;
    end
    else if (i>=19) and (i<=22) then
      Value := BTimeDecode(vleDevInfo.Strings.ValueFromIndex[i-1])
    else
      value:=strtoint(vleDevInfo.Strings.ValueFromIndex[i-1]);
    if not CZKEM1.SetDeviceInfo(devid, i, value) then
    begin
      CZKEM1.GetLastError(ErrorCode);
      AddInfo(format('! SetDeviceInfo(%d) ErrorNo.=%d',[i, ErrorCode]));
      exit;
    end
    else
      Modified[i]:=#0;
    if i=2 then
    begin
      edtNetAddress.Text := vleDevInfo.Strings.ValueFromIndex[i-1];
      DevId:=value;
    end;
  end;
  AddInfo('SetDeviceInfo OK');

end;

procedure TForm1.btnSetTimeClick(Sender: TObject);
var
  ErrorCode,
  dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond: integer;
begin
  if CZKEM1.SetDeviceTime(devid) then
  begin
    AddInfo('SetDeviceTime OK.');
    if CZKEM1.GetDeviceTime(devid, dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond) then
      AddInfo(Format('DeviceTime=%d-%d-%d %d:%d:%d',[dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond]))
    else
    begin
      CZKEM1.GetLastError(ErrorCode);
      AddInfo(format('! GetDeviceTime ErrorNo.=%d',[ErrorCode]));
    end;
  end
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(format('! SetDeviceTime ErrorNo.=%d',[ErrorCode]));
  end;
end;

procedure TForm1.btnClearDataClick(Sender: TObject);
begin
  CZKEM1.ClearKeeperData(devid);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  CZKEM1.ClearGLog(devid);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  CZKEM1.ClearAdministrators(DevId);
end;

procedure TForm1.Button9Click(Sender: TObject);
var
  dwTMachine, dwEnrollNumber,dwEMachineNumber,dwVerifyMode: Integer;
  dwInOutMode,dwYear,dwMonth,dwDay,dwHour,dwMinute: Integer;
  s: string;
  f: tfilestream;
begin
  if SaveDialog1.Execute then
  begin
    f:=tfilestream.Create(SaveDialog1.FileName, fmOpenWrite or fmCreate);
    try
    if CZKEM1.ReadGeneralLogData(DevId) then
    while CZKEM1.GetGeneralLogData(DevId,dwTMachine, dwEnrollNumber,dwEMachineNumber,dwVerifyMode,
      dwInOutMode,dwYear,dwMonth,dwDay,dwHour,dwMinute) do
    begin
      s:=format('%5d %d %d %4d-%2d-%2d %2d:%2d'#13#10, [dwEnrollNumber,dwVerifyMode,
        dwInOutMode,dwYear,dwMonth,dwDay,dwHour,dwMinute]);
      f.Write(s[1],length(s));
    end;
    finally
      f.Free;
    end;
  end;
end;

function NumOfHex(c: Char): integer;
begin
  result := 0;
  if c>='a' then result := ord(c)-ord('a')+10
  else if c>='A' then result := ord(c)-ord('A')+10
  else if c>='0' then result := ord(c)-ord('0');
  if result>16 then
    raise exception.Create('Error of Integer: '+c);
end;

type
  TByteArray=array[0..0] of byte;
  PByteArray=^TByteArray;

function encodedata(const BinData; size: integer): string;
var
  i: integer;
  da: pbytearray;
begin
  setlength(result, size*2);
  da:=@BinData;
  for i:= 0 to size-1 do
  begin
    result[i*2+1]:=HexOfNum[da[i] div 16];
    result[i*2+2]:=HexOfNum[da[i] mod 16];
  end;
end;

function decodedata(const s: string): string;
var
  i: integer;
  da: pbytearray;
begin
  setlength(result, length(s) div 2);
  for i:= 1 to length(result) do
  begin
    result[i]:=char(NumOfHex(s[i*2-1])*16+NumOfHex(s[i*2]));
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  CZKEM1.PowerOffDevice(DevID);
end;

procedure TForm1.BackupUser(const fn: string);
var
  f: tinifile;
  dwEnrollNumber,dwBackupNumber,Password,
  dwMachinePrivilege,i,c,Len: integer;
  EnrollData: array[0..2047] of byte;
  s: string;
  Enable: WordBool;
  UName, UPwd: widestring;
begin
  DeleteFile(fn);
  f := tinifile.Create(fn);
  try
    if CZKEM1.ReadAllUserID(DevID) then
    begin
      c:=0;
      while CZKEM1.GetAllUserInfo(DevID, dwEnrollNumber, UName, UPwd,
        dwMachinePrivilege, Enable) do
      begin
        s:=format('Users_%d',[dwEnrollNumber]);
        f.WriteInteger(s,'Privilege',dwMachinePrivilege);
        f.WriteBool(s,'Enabled', Enable);
        f.WriteString(s, 'Name', UName);
        f.WriteString(s, 'Password', UPwd);
        //Try get every fingerprint template
        for i:=0 to 9 do
        begin
          zeromemory(@EnrollData[0], 2048);
          Len:=2048;
          if CZKEM1.GetUserTmp(DevId, dwEnrollNumber, i, EnrollData[0], Len) then
            f.WriteString(s, 'FPT_'+inttostr(i), encodedata(EnrollData[0], Len));
        end;
        inc(c);
      end;

    end;
  finally
    f.Free;
  end;
end;

procedure TForm1.ReadDeviceStatus;
var
  s: widestring;
  ErrorCode, Value, i,
  dwYear, dwMonth, dwDay, dwHour, dwMinute, dwSecond: integer;
begin
  if CZKEM1.GetFirmwareVersion(devid, s) then
    AddInfo('Firmware Version: '+s)
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(format('! GetFirmwareVersion ErrorNo.=%d',[ErrorCode]));
  end;
  if CZKEM1.GetSerialNumber(devid, s) then
    AddInfo('Serial Number: '+s)
  else
  begin
    CZKEM1.GetLastError(ErrorCode);
    AddInfo(format('! GetSerialNumber ErrorNo.=%d',[ErrorCode]));
  end;

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

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

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

procedure TForm1.RestoreUser(const fn: string);
var
  f: tinifile;
  eno,i: integer;
  dwEnrollNumber,dwBackupNumber,Password,
  dwMachinePrivilege, dwEnable, c: integer;
  fpt, s, UName, UPwd: string;
  Sections: Tstrings;
begin
    f:=tinifile.Create(fn);
    try
    Sections := tstringlist.Create;
      try
        f.ReadSections(Sections);
        for i:=1 to 65534 do
        begin
          s:=format('Users_%d',[i]);
          if Sections.IndexOf(s)>=0 then
          begin
            Application.ProcessMessages;
            dwMachinePrivilege := f.ReadInteger(s, 'Privilege', 0);
            dwEnable := f.ReadInteger(s, 'Enabled', 1);
            UPwd := f.ReadString(s, 'Password', '');
            if UPwd='-1' then
              UPwd:='';
            UName := f.ReadString(s, 'Name','');
            CZKEM1.SetUserInfo(DevId, i, UName, UPwd, dwMachinePrivilege, dwEnable<>0);
            for dwBackupNumber:=0 to 9 do
            begin
              fpt:=f.ReadString(s, 'FPT_'+inttostr(dwBackupNumber), '');
              if fpt>'' then
              begin
                fpt:=decodedata(fpt);
                if CZKEM1.SetUserTmp(DevId, i, dwBackupNumber, pbyte(@fpt[1])^) then
                  AddInfo(format('SetEnrollData OK: User=%d,FP=%d', [i,dwBackupNumber]))
                else
                begin
                  CZKEM1.GetLastError(eno);
                  AddInfo(format('SetEnrollData Fail: User=%d,FP=%d, Error=%d', [i,dwBackupNumber,eno]));
                end;
              end;
            end;

          end;
        end;
      finally
        sections.Free;
      end;
    finally
      f.free;
    end;
end;

procedure TForm1.vleDevInfoValidate(Sender: TObject; ACol, ARow: Integer;
  const KeyName, KeyValue: String);
begin
  Modified[ARow] := '1';
end;

procedure TForm1.btnSetNameClick(Sender: TObject);
begin
  ShowUserForm(CZKEM1, DevID);
end;

procedure TForm1.btnDeleteUserClick(Sender: TObject);
begin
  CZKEM1.DeleteEnrollData(DevId, 69, DevId, 0);
  CZKEM1.DeleteEnrollData(DevId, 69, DevId, 1);
end;

var
  Testing: Boolean=false;

procedure TForm1.btnAutoTestClick(Sender: TObject);
var
  i: integer;
begin
  Testing:=not Testing;
  if Testing then
    btnAutoTest.Caption := 'End Test'
  else
    btnAutoTest.Caption := 'Start Test';
  i:=0;
  while Testing do
  begin
    AddInfo(Format('-----------Testing %d--------',[i]));
    inc(i);
    btnConnect.Click;
    if btnConnect.Tag=0 then
    begin
      Testing:=not Testing;
      if Testing then
        btnAutoTest.Caption := 'End Test'
      else
        btnAutoTest.Caption := 'Start Test';
      break;
    end;
//    sleep(1000);
    Addinfo('Clear Data...');
    btnClearData.Click;
    if FileExists(OpenDialog1.FileName) then
      RestoreUser(OpenDialog1.FileName);
    Application.ProcessMessages;
    Addinfo('Delete User 69...');
    btnDeleteUser.Click;
    Sleep(2000);
    ReadDeviceStatus;
    Application.ProcessMessages;
    if FileExists(OpenDialog1.FileName) then
      RestoreUser(OpenDialog1.FileName);
    ReadDeviceStatus;
    Addinfo('Clear Data...');
    btnClearData.Click;
    Addinfo('Disconnect...');
    btnConnect.Click;
    Application.ProcessMessages;
  end;
end;

procedure TForm1.btnBackupUserClick(Sender: TObject);
begin
  if savedialog1.Execute then
    BackupUser(savedialog1.FileName);
end;

procedure TForm1.btnRestoreClick(Sender: TObject);
begin
  if OpenDialog1.Execute then