Back
unit Device;
interface
Uses SysUtils, Classes, Controls, Dialogs;
{$DEFINE DEBUG}
const MAX_AG_TZ=8;
MAX_HOL=16;
MAX_TZ=15;
MAX_AG=10;
MAX_TIME_DIFF=60;
MAX_TIME_OUT=5;
MAX_TIME_TIME_OUT=60;
REF_NAME=1;
REF_AG=2;
REF_TZ=4;
REF_HOL=8;
REF_DEV=16;
INIT_REF_STATE=REF_NAME OR REF_AG OR REF_TZ OR REF_HOL OR REF_DEV;
type
TCommand = record
cmd: Byte;
dev: Byte;
bcc: Byte;
body: String;
crc: Boolean;
end;
EHKError=class
private
FMsg: String;
FOnMsg: TNotifyEvent;
procedure SetMsg(const Value: string);
public
property Msg: string read FMsg write SetMsg;
property OnMsg: TNotifyEvent read FOnMsg write FOnMsg;
procedure MsgFmt(const Fmt: string; const Args: array of const);
procedure LogComm(Lab: String; p_comm: TCommand);
end;
TRekord = class
private
FCardNo: string;
Fivent: Byte;
Fvreme: TDateTime;
procedure SetVreme(hh, min, dd, mm, yy: Byte);
public
constructor Create;
property CardNo: string read FCardNo write FCardNo;
property ivent: Byte read Fivent write Fivent;
property vreme: TDateTime read Fvreme write Fvreme;
end;
TDevice = class;
TStatus = class
private
FProcess: Integer;
FProcess2: Integer;
FState: Integer;
FTimeOut: Boolean;
FT1: Integer;
FNoTimeOut: Integer;
FTimeTimeOut: TDateTime;
FNewDev: Boolean;
FRefState: Integer;
WaitForCmd: Boolean;
public
Rekordi: TList;
Owner: TDevice;
constructor Create(Value: TDevice);
destructor Destroy; override;
property Process: Integer read Fprocess write FProcess;
property Process2: Integer read Fprocess2 write FProcess2;
property State: Integer read FState write FState;
property NewDev: Boolean read FNewDev write FNewDev;
property RefState: Integer read FRefState write FRefState;
property NoTimeOut: Integer read FNoTimeOut write FNoTimeOut;
property TimeTimeOut: TDateTime read FTimeTimeOut write FTimeTimeOut;
function RecCommand(var Cmd: TCommand; TOut: Boolean): Boolean;
function RProcess100(var Cmd: TCommand; TOut: Boolean): Boolean;
function RProcess101(var Cmd: TCommand; TOut: Boolean): Boolean;
function RProcess103(var Cmd: TCommand; TOut: Boolean): Boolean;
function RProcess106(var Cmd: TCommand; TOut: Boolean): Boolean;
function RProcess110(var Cmd: TCommand; TOut: Boolean): Boolean;
procedure RProcess0001(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0003(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0005(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0100(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0101(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0103(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0200(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0201(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0203(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0300(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0301(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0303(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0401(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0403(var Cmd: TCommand; TOut: Boolean);
procedure RProcess0405(var Cmd: TCommand; TOut: Boolean);
function NextCommand(var Cmd: TCommand): Boolean;
function SCmd9(var Cmd: TCommand): Boolean;
function SCmd12(var Cmd: TCommand): Boolean;
function SCmd13(var Cmd: TCommand): Boolean;
function SCmd14(var Cmd: TCommand): Boolean;
function SCmd15(var Cmd: TCommand): Boolean;
function SCmd16(var Cmd: TCommand): Boolean;
function SCmd17(var Cmd: TCommand): Boolean;
function SCmd18(var Cmd: TCommand): Boolean;
function SCmd19(var Cmd: TCommand): Boolean;
function SCmd22(var Cmd: TCommand): Boolean;
function SCmd25(var Cmd: TCommand): Boolean;
function SCmd26(var Cmd: TCommand): Boolean;
function SCmd27(var Cmd: TCommand): Boolean;
function SNACK(var Cmd: TCommand): Boolean;
function SACK(var Cmd: TCommand): Boolean;
function SCmd11(var Cmd: TCommand): Boolean;
procedure CalcBCC(var Cmd: TCommand);
procedure NextState;
end;
TBCD = class
private
FHiLo: Byte;
function GetHi: Byte;
procedure SetHi(Value: Byte);
function GetLo: Byte;
procedure SetLo(Value: Byte);
procedure SetHiLo(Value: Byte);
function GetSHiLo: string;
procedure SetSHiLo(Value: string);
public
constructor Create;
property Hi: Byte read GetHi write SetHi;
property Lo: Byte read GetLo write SetLo;
property HiLo: Byte read FHiLo write SetHiLo;
property SHiLo: string read GetSHiLo write SetSHiLo;
function BCD2Byte: Byte;
procedure SetByte(Value: Byte);
end;
BCD = TBCD;
TDevice = class
private
FDevNo: Byte;
FComCode1: BCD;
FComCode2: BCD;
FDoorTime: Byte;
procedure SetComCode1(Value: Byte);
function GetComCode1: Byte;
procedure SetComCode2(Value: Byte);
function GetComCode2: Byte;
function GetSComCode: string;
procedure SetSComCode(Value: string);
public
FId: Integer;
FTimeZone: TList;
FHolyday: TList;
FAccessGroup: TList;
FName: TList;
Status: TStatus;
constructor Create(Value: Integer);
destructor Destroy; override;
property DevNo: Byte read FDevNo write FDevNo;
property ComCode1: Byte read GetComCode1 write SetComCode1;
property ComCode2: Byte read GetComCode2 write SetComCode2;
property SComCode: string read GetSComCode write SetSComCode;
property DoorTime: Byte read FDoorTime write FDoorTime;
procedure DoorBlock;
procedure DoorOpen;
end;
TTimeZone = class
private
FOnHour: BCD;
FOnMin: BCD;
FOffHour: BCD;
FOffMin: BCD;
FZoneDays: BCD;
FTemp: BCD;
procedure SetOnHour(Value: Byte);
function GetOnHour: Byte;
procedure SetOnMin(Value: Byte);
function GetOnMin: Byte;
procedure SetOffHour(Value: Byte);
function GetOffHour: Byte;
procedure SetOffMin(Value: Byte);
function GetOffMin: Byte;
procedure SetZoneDays(Value: Byte);
function GetZoneDays: Byte;
procedure SetFromZD(Value: Byte);
function GetFromZD: Byte;
procedure SetToZD(Value: Byte);
function GetToZD: Byte;
public
FId: Integer;
constructor Create(Value: Integer);
destructor Destroy; override;
property OnHour: Byte read GetOnHour write SetOnHour;
property OnMin: Byte read GetOnMin write SetOnMin;
property OffHour: Byte read GetOffHour write SetOffHour;
property OffMin: Byte read GetOffMin write SetOffMin;
property ZoneDays: Byte read GetZoneDays write SetZoneDays;
property FromZD: Byte read GetFromZD write SetFromZD;
property ToZD: Byte read GetToZD write SetToZD;
property id_base: Integer read FId;
end;
THolyday = class
private
FHDate: BCD;
FHMonth: BCD;
procedure SetHDate(Value: Byte);
function GetHDate: Byte;
procedure SetHMonth(Value: Byte);
function GetHMonth: Byte;
function GetDate: TDate;
procedure SetDate(Value: TDate);
public
FId: Integer;
constructor Create(Value: Integer);
destructor Destroy; override;
property HDate: Byte read GetHDate write SetHDate;
property HMonth: Byte read GetHMonth write SetHMonth;
property Date: TDate read GetDate write SetDate;
end;
TAccessGroup = class
private
FAz12, FAz34, FAz56, FAz78: Byte;
procedure SetAz12(Value: Byte);
function GetAz12: Byte;
procedure SetAz34(Value: Byte);
function GetAz34: Byte;
procedure SetAz56(Value: Byte);
function GetAz56: Byte;
procedure SetAz78(Value: Byte);
function GetAz78: Byte;
public
FId: Integer;
constructor Create(Value: Integer);
destructor Destroy; override;
property Az12: Byte read GetAz12 write SetAz12;
property Az34: Byte read GetAz34 write SetAz34;
property Az56: Byte read GetAz56 write SetAz56;
property Az78: Byte read GetAz78 write SetAz78;
property id_base: Integer read FId;
procedure SetAz(No: Integer; Value: Byte);
function GetAZ(No: Integer): Byte;
end;
TName = class
private
FCardNo: string;
FName: string;
FAG: Byte;
procedure SetCardNo(Value: string);
procedure SetName(Value: string);
procedure SetAG(Value: Byte);
public
FId: Integer;
constructor Create(Value: Integer);
destructor Destroy; override;
property CardNo: string read FCardNo write SetCardNo;
property Name: string read FName write SetName;
property AG: Byte read FAG write SetAG;
end;
function BCDByte2Byte(Value: Byte): Byte;
function BCDByte2String(Value: Byte): string;
function Str2BCDByte(Value: string; prv, vtor: Integer): Byte;
function Byte2BCDByte(Value: Byte): Byte;
procedure FreeList(Value: TList);
var HKError: EHKError;
p_MAX_AG_TZ, p_MAX_HOL, p_MAX_TZ, p_MAX_AG: Integer;
p_MAX_TIME_DIFF, p_MAX_TIME_OUT, p_MAX_TIME_TIME_OUT: Integer;
implementation
// TBCD
constructor TBCD.Create;
begin
inherited Create;
FHiLo:=0;
end;
function TBCD.GetHi: Byte;
begin
Result := FHiLo shr 4;
end;
procedure TBCD.SetHi(Value: Byte);
begin
if Value<10 then FHiLo:=(FHiLo and $0F) or (Value shl 4)
else HKError.MsgFmt('SetHi Value %d > 9',[Value]);
end;
function TBCD.GetLo: Byte;
begin
Result := FHiLo and $0F;
end;
procedure TBCD.SetLo(Value: Byte);
begin
if Value<10 then FHiLo:=(FHiLo and $F0) or Value
else HKError.MsgFmt('SetLo Value %d > 9',[Value]);
end;
procedure TBCD.SetHiLo(Value: Byte);
begin
if Value<>FHiLo then
if ((((Value and $F0) shr 4)>9) or ((Value and $0F)>9)) then
HKError.MsgFmt('SetHiLo Invalid Value %d',[Value])
else
FHiLo:=Value;
end;
function TBCD.GetSHiLo: string;
begin
Result:=IntToStr((FHiLo and $F0) shr 4)+IntToStr(FHiLo and $0F);
end;
procedure TBCD.SetSHiLo(Value: string);
begin
SetHiLo(StrToInt(Value));
end;
function TBCD.BCD2Byte: Byte;
begin
Result:=Hi*10+Lo;
end;
procedure TBCD.SetByte(Value: Byte);
begin
if Value<100 then begin
SetHi(Value div 10);
SetLo(Value mod 10);
end else
HKError.MsgFmt('SetByte Invalid Value %d',[Value]);
end;
// TTimeZone.
constructor TTimeZone.Create(Value: Integer);
begin
inherited Create;
FOnHour:=TBCD.Create;
FOnMin:=TBCD.Create;
FOffHour:=TBCD.Create;
FOffMin:=TBCD.Create;
FZoneDays:=TBCD.Create;
FTemp:=TBCD.Create;
FId:=Value;
end;
destructor TTimeZone.Destroy;
begin
FTemp.Free;
FZoneDays.Free;
FOffMin.Free;
FOffHour.Free;
FOnMin.Free;
FOnHour.Free;
inherited Destroy;
end;
procedure TTimeZone.SetOnHour(Value: Byte);
begin
if Value<>FOnHour.HiLo then begin
if BCDByte2Byte(Value)<24 then
FOnHour.HiLo:=Value
else
HKError.MsgFmt('SetOnHour Invalid Value %d',[Value]);
end;
end;
function TTimeZone.GetOnHour: Byte;
begin
Result:=FOnHour.HiLo;
end;
procedure TTimeZone.SetOnMin(Value: Byte);
begin
if Value<>FOnMin.HiLo then begin
if BCDByte2Byte(Value)<60 then
FOnMin.HiLo:=Value
else
HKError.MsgFmt('SetOnMin Invalid Value %d',[Value]);
end;
end;
function TTimeZone.GetOnMin: Byte;
begin
Result:=FOnMin.HiLo;
end;
procedure TTimeZone.SetOffHour(Value: Byte);
begin
if Value<>FOffHour.HiLo then begin
if BCDByte2Byte(Value)<24 then
FOffHour.HiLo:=Value
else
HKError.MsgFmt('SetOffHour Invalid Value %d',[Value]);
end;
end;
function TTimeZone.GetOffHour: Byte;
begin
Result:=FOffHour.HiLo;
end;
procedure TTimeZone.SetOffMin(Value: Byte);
begin
if Value<>FOffMin.HiLo then begin
if BCDByte2Byte(Value)<60 then
FOffMin.HiLo:=Value
else
HKError.MsgFmt('SetOffMin Invalid Value %d',[Value]);
end;
end;
function TTimeZone.GetOffMin: Byte;
begin
Result:=FOffMin.HiLo;
end;
procedure TTimeZone.SetZoneDays(Value: Byte);
begin
if Value<>FZoneDays.HiLo then begin
FTemp.HiLo:=Value;
if ((FTemp.Hi<8) and (FTemp.Lo<9) and (FTemp.Hi<=FTemp.Lo)) then
FZoneDays.HiLo:=Value
else
HKError.MsgFmt('SetZoneDays Invalid Value %d',[Value]);
end;
end;
procedure TTimeZone.SetFromZD(Value: Byte);
begin
if Value<>FZoneDays.Hi then
if Value < 8 then
FZoneDays.Hi:=Value
else
HKError.MsgFmt('SetFromZD Invalid Value %d',[Value]);
end;
procedure TTimeZone.SetToZD(Value: Byte);
begin
if Value<>FZoneDays.Lo then
if Value < 9 then
FZoneDays.Lo:=Value
else
HKError.MsgFmt('SetToZD Invalid Value %d',[Value]);
end;
function TTimeZone.GetZoneDays: Byte;
begin
Result:=FZoneDays.HiLo;
end;
function TTimeZone.GetFromZD: Byte;
begin
Result:=FZoneDays.Hi;
end;
function TTimeZone.GetToZD: Byte;
begin
Result:=FZoneDays.Lo;
end;
// THolyday.
constructor THolyday.Create(Value: Integer);
begin
inherited Create;
FHDate:=TBCD.Create;
FHMonth:=TBCD.Create;
FId:=Value;
end;
destructor THolyday.Destroy;
begin
FHDate.Free;
FHMonth.Free;
inherited Destroy;
end;
procedure THolyday.SetHDate(Value: Byte);
begin
if Value<>FHDate.HiLo then
if ((BCDByte2Byte(Value)>0) and (BCDByte2Byte(Value)<32)) then
FHDate.HiLo:=Value
else
HKError.MsgFmt('SetHDate Invalid Value %d',[Value]);
end;
function THolyday.GetHDate: Byte;
begin
Result:=FHDate.HiLo;
end;
procedure THolyday.SetHMonth(Value: Byte);
begin
if Value<>FHMonth.HiLo then
if ((BCDByte2Byte(Value)>0) and (BCDByte2Byte(Value)<13)) then
FHMonth.HiLo:=Value
else
HKError.MsgFmt('SetHMonth Invalid Value %d',[Value]);
end;
function THolyday.GetHMonth: Byte;
begin
Result:=FHMonth.HiLo;
end;
function THolyday.GetDate: TDate;
var Y,M,D: Word;
begin
DecodeDate(Now, Y, M, D);
Result:=EncodeDate(Y, FHMonth.BCD2Byte, FHDate.BCD2Byte);
end;
procedure THolyday.SetDate(Value: TDate);
var Y,M,D: Word;
begin
DecodeDate(Value, Y, M, D);
if (M<>FHMonth.BCD2Byte) then FHMonth.SetByte(M);
if (D<>FHDate.BCD2Byte) then FHDate.SetByte(D);
end;
// TAccessGroup.
constructor TAccessGroup.Create(Value: Integer);
begin
inherited Create;
FId:=Value;
end;
destructor TAccessGroup.Destroy;
begin
inherited Destroy;
end;
procedure TAccessGroup.SetAz12(Value: Byte);
begin
if Value<>FAz12 then FAz12:=Value;
end;
function TAccessGroup.GetAz12: Byte;
begin
Result:=FAz12;
end;
procedure TAccessGroup.SetAz34(Value: Byte);
begin
if Value<>FAz34 then FAz34:=Value;
end;
function TAccessGroup.GetAz34: Byte;
begin
Result:=FAz34;
end;
procedure TAccessGroup.SetAz56(Value: Byte);
begin
if Value<>FAz56 then FAz56:=Value;
end;
function TAccessGroup.GetAz56: Byte;
begin
Result:=FAz56;
end;
procedure TAccessGroup.SetAz78(Value: Byte);
begin
if Value<>FAz78 then FAz78:=Value;
end;
function TAccessGroup.GetAz78: Byte;
begin
Result:=FAz78;
end;
procedure TAccessGroup.SetAz(No: Integer; Value: Byte);
begin
if Value<16 then begin
case No of
1: FAz12:=(FAz12 and $0F) or (Value shl 4);
2: FAz12:=(FAz12 and $F0) or Value;
3: FAz34:=(FAz34 and $0F) or (Value shl 4);
4: FAz34:=(FAz34 and $F0) or Value;
5: FAz56:=(FAz56 and $0F) or (Value shl 4);
6: FAz56:=(FAz56 and $F0) or Value;
7: FAz78:=(FAz78 and $0F) or (Value shl 4);
8: FAz78:=(FAz78 and $F0) or Value;
end;
end else
HKError.MsgFmt('SetAz Invalid Value %d > 15',[Value]);
end;
function TAccessGroup.GetAZ(No: Integer): Byte;
begin
Result:=0;
case No of
1: Result:=FAz12 shr 4;
2: Result:=FAz12 and $0F;
3: Result:=FAz34 shr 4;
4: Result:=FAz34 and $0F;
5: Result:=FAz56 shr 4;
6: Result:=FAz56 and $0F;
7: Result:=FAz78 shr 4;
8: Result:=FAz78 and $0F;
end;
end;
// TName.
constructor TName.Create(Value: Integer);
begin
inherited Create;
FId:=Value;
end;
destructor TName.Destroy;
begin
inherited Destroy;
end;
procedure TName.SetCardNo(Value: string);
begin
if Value<>FCardNo then
FCardNo:=Value;
end;
procedure TName.SetName(Value: string);
begin
if Value<>FName then
FName:=Value;
end;
procedure TName.SetAG(Value: Byte);
begin
if FAG<>Value then
if Value>p_MAX_AG then
HKError.MsgFmt('SetAg Value %d > %d',[Value,p_MAX_AG])
else
FAG:=Value;
end;
// TStatus.
constructor TStatus.Create(Value: TDevice);
begin
inherited Create;
Owner:=Value;
FProcess:=1;
FProcess2:=0;
FState:=0;
FTimeOut:=False;
FNewDev:=False;
FRefState:=INIT_REF_STATE;
FNoTimeOut:=0;
WaitForCmd:=False;
end;
destructor TStatus.Destroy;
begin
FreeList(Rekordi);
inherited Destroy;
end;
function TStatus.RecCommand(var Cmd: TCommand; TOut: Boolean): Boolean;
begin
Result:=False;
if (Cmd.dev=Owner.DevNo) or (Tout) then begin
case Process of
0: case Process2 of
0: case State of
1: RProcess0001(Cmd, TOut);
3: RProcess0003(Cmd, TOut);
5: RProcess0005(Cmd, TOut);
else
HKError.MsgFmt('RecCommand Invalid State %d',[State]);
end;
1: case State of
0: RProcess0100(Cmd, TOut);
1: RProcess0101(Cmd, TOut);
3: RProcess0103(Cmd, TOut);
else
HKError.MsgFmt('RecCommand Invalid State %d',[State]);
end;
2: case State of
0: RProcess0200(Cmd, TOut);
1: RProcess0201(Cmd, TOut);
3: RProcess0203(Cmd, TOut);
else
HKError.MsgFmt('RecCommand Invalid State %d',[State]);
end;
3: case State of
0: RProcess0300(Cmd, TOut);
1: RProcess0301(Cmd, TOut);
3: RProcess0303(Cmd, TOut);
else
HKError.MsgFmt('RecCommand Invalid State %d',[State]);
end;
4: case State of
1: RProcess0401(Cmd, TOut);
3: RProcess0403(Cmd, TOut);
5: RProcess0405(Cmd, TOut);
else
HKError.MsgFmt('RecCommand Invalid State %d',[State]);
end;
else
HKError.MsgFmt('RecCommand Invalid Process2 %d',[Process2]);
end;
1: case State of
0: Result:=RProcess100(Cmd, TOut);
1: Result:=RProcess101(Cmd, TOut);
3: Result:=RProcess103(Cmd, TOut);
6: Result:=RProcess106(Cmd, TOut);
10: Result:=RProcess110(Cmd, TOut);
end;
else
HKError.MsgFmt('RecCommand Invalid State %d',[State]);
end;
end;
end;
function TStatus.RProcess100(var Cmd: TCommand; TOut: Boolean): Boolean;
begin
Result:=False;
NewDev:=False;
NextState;
end;
function TStatus.RProcess101(var Cmd: TCommand; TOut: Boolean): Boolean;
begin
Result:=False;
State:=1;
Process:=1;
NewDev:=True;
if not TOut then begin
if Cmd.cmd=9 then begin
FT1:=0;
FT1:=(ord(Cmd.body[2]) shl 8) or (ord(Cmd.body[1]));
Process:=1;
if FT1>0 then
begin
State:=3;
NewDev:=False;
FreeList(Rekordi);
Rekordi:=TList.Create;
end
else begin
Result:=RProcess110(Cmd,TOut);
end;
end else
HKError.Msg:='RP101 Not CMD9';
end else
NextState;
end;
function TStatus.RProcess103(var Cmd: TCommand; TOut: Boolean): Boolean;
var i,j: Integer;
begin
Result:=False;
State:=1;
Process:=1;
NewDev:=True;
if not TOut then begin
if FT1>0 then begin
if Cmd.cmd=10 then begin
i:=Rekordi.Add(TRekord.Create);
with TRekord(Rekordi.Items[i]) do begin
CardNo:='';
for j:=1 to 7 do
CardNo:=CardNo+BCDByte2String(ord(Cmd.body[j]));
ivent:=BCDByte2Byte(ord(Cmd.body[8]));
SetVreme(ord(Cmd.body[9]),ord(Cmd.body[10]),ord(Cmd.body[12]),ord(Cmd.body[13]),ord(Cmd.body[14]));
end;
Process:=1;
State:=3;
NewDev:=False;
Dec(FT1);
end else
HKError.Msg:='RP103 Not CMD10';
end else begin
if Cmd.cmd=14 then begin
Process:=1;
State:=6;
NewDev:=False;
Result:=False;
end else
HKError.Msg:='RP103 Not CMD14';
end;
end;
end;
function TStatus.RProcess106(var Cmd: TCommand; TOut: Boolean): Boolean;
begin
Result:=False;
State:=6;
Process:=1;
NewDev:=False;
Inc(FT1);
if not TOut then begin
if (Cmd.cmd=$F3) then begin
RProcess110(Cmd,TOut);
Result:=True;
end else
begin
if FT1>3 then begin
Result:=RProcess110(Cmd,TOut);
end;
HKError.Msg:='RP106 Not ACK';
end;
end else
begin
if FT1>3 then begin
Result:=RProcess110(Cmd,TOut);
end;
end;
end;
function TStatus.RProcess110(var Cmd: TCommand; TOut: Boolean): Boolean;
begin
Result:=False;
NextState;
end;
procedure TStatus.RProcess0001(var Cmd: TCommand; TOut: Boolean);
var cas, min, sec, den, mes, god: Word;
sega: TDateTime;
dev_sega: TDateTime;
begin
RefState:=(RefState and (not REF_DEV));
if not TOut then begin
if (Cmd.cmd=16) then begin
sega:=Now;
cas:=BCDByte2Byte(ord(Cmd.body[1]));
min:=BCDByte2Byte(ord(Cmd.body[2]));
sec:=BCDByte2Byte(ord(Cmd.body[3]));
den:=BCDByte2Byte(ord(Cmd.body[5]));
mes:=BCDByte2Byte(ord(Cmd.body[6]));
god:=BCDByte2Byte(ord(Cmd.body[7]));
if god>80 then
god:=god+1900
else
god:=god+2000;
dev_sega:=EncodeDate(god, mes, den)+EncodeTime(cas,min,sec,0);
if Trunc(abs(sega-dev_sega)*86400)>p_MAX_TIME_DIFF then
begin
State:=3;
Process:=0;
Process2:=0;
NewDev:=False;
end else begin
State:=5;
Process:=0;
Process2:=0;
NewDev:=False;
end;
end else
begin
HKError.Msg:='RP0001 Not CMD16';
State:=1;
Process:=0;
Process2:=0;
NewDev:=False;
end;
end else begin
State:=1;
Process:=0;
Process2:=0;
NewDev:=True;
end;
end;
procedure TStatus.RProcess0003(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if not (Cmd.cmd=$F3) then
HKError.Msg:='RP0003 Not ACK';
end else
begin
HKError.Msg:='RP0003 TimeOut';
end;
State:=1;
Process:=0;
Process2:=0;
NewDev:=True;
end;
procedure TStatus.RProcess0005(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if not (Cmd.cmd=$F3) then
begin
State:=5;
Process:=0;
Process2:=0;
NewDev:=True;
HKError.Msg:='RP0005 Not ACK';
end else
begin
NextState;
end;
end else
begin
State:=5;
Process:=0;
Process2:=0;
NewDev:=True;
HKError.Msg:='RP0005 TimeOut';
end;
end;
procedure TStatus.RProcess0100(var Cmd: TCommand; TOut: Boolean);
begin
NewDev:=True;
Process:=0;
Process2:=1;
State:=1;
FT1:=0;
end;
procedure TStatus.RProcess0101(var Cmd: TCommand; TOut: Boolean);
begin
RefState:=(RefState and (not REF_HOL));
if not TOut then begin
if (Cmd.cmd=27) and (ord(Cmd.body[1])=FT1+1) then begin
if (ord(Cmd.body[2])=THolyday(owner.FHolyday.Items[FT1]).HDate) and
(ord(Cmd.body[3])=THolyday(owner.FHolyday.Items[FT1]).HMonth) then
begin
if FT1=p_MAX_HOL-1 then begin
NextState;
end else begin
Inc(FT1);
State:=1;
Process:=0;
Process2:=1;
NewDev:=False;
end;
end else
begin
State:=3;
Process:=0;
Process2:=1;
NewDev:=False;
end;
end else
begin
State:=1;
Process:=0;
Process2:=1;
NewDev:=False;
HKError.Msg:='RP0101 Not CMD27';
end;
end else begin
State:=1;
Process:=0;
Process2:=1;
NewDev:=True;
end;
end;
procedure TStatus.RProcess0103(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if not (Cmd.cmd=$F3) then
HKError.Msg:='RP0103 Not ACK';
end else
begin
HKError.Msg:='RP0103 TimeOut';
end;
State:=1;
Process:=0;
Process2:=1;
NewDev:=False;
end;
procedure TStatus.RProcess0200(var Cmd: TCommand; TOut: Boolean);
begin
NewDev:=True;
Process:=0;
Process2:=2;
State:=1;
FT1:=0;
end;
procedure TStatus.RProcess0201(var Cmd: TCommand; TOut: Boolean);
begin
RefState:=(RefState and (not REF_TZ));
if not TOut then begin
if (Cmd.cmd=25) and (ord(Cmd.body[1])=FT1+1) then begin
if (ord(Cmd.body[2])=TTimeZone(owner.FTimeZone.Items[FT1]).OnHour) and
(ord(Cmd.body[3])=TTimeZone(owner.FTimeZone.Items[FT1]).OnMin) and
(ord(Cmd.body[4])=TTimeZone(owner.FTimeZone.Items[FT1]).OffHour) and
(ord(Cmd.body[5])=TTimeZone(owner.FTimeZone.Items[FT1]).OffMin) and
(ord(Cmd.body[6])=TTimeZone(owner.FTimeZone.Items[FT1]).ZoneDays) then
begin
if FT1=p_MAX_TZ-1 then begin
NextState;
end else begin
Inc(FT1);
State:=1;
Process:=0;
Process2:=2;
NewDev:=False;
end;
end else
begin
State:=3;
Process:=0;
Process2:=2;
NewDev:=False;
end;
end else
begin
State:=1;
Process:=0;
Process2:=2;
NewDev:=False;
HKError.Msg:='RP0201 Not CMD25';
end;
end else begin
State:=1;
Process:=0;
Process2:=2;
NewDev:=True;
end;
end;
procedure TStatus.RProcess0203(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if not (Cmd.cmd=$F3) then
HKError.Msg:='RP0203 Not ACK';
end else
begin
HKError.Msg:='RP0203 TimeOut';
end;
State:=1;
Process:=0;
Process2:=2;
NewDev:=False;
end;
procedure TStatus.RProcess0300(var Cmd: TCommand; TOut: Boolean);
begin
NewDev:=True;
Process:=0;
Process2:=3;
State:=1;
FT1:=0;
end;
procedure TStatus.RProcess0301(var Cmd: TCommand; TOut: Boolean);
begin
RefState:=(RefState and (not REF_AG));
if not TOut then begin
if (Cmd.cmd=26) and (ord(Cmd.body[1])=FT1+1) then begin
{$ifdef debug}
HKError.Msg:=Format('dev12=%x dev34=%x dev56=%x dev78=%x my12=%x my34=%x my56=%x my78=%x',
[ord(Cmd.body[2]),ord(Cmd.body[3]),ord(Cmd.body[4]),ord(Cmd.body[5]),TAccessGroup(owner.FAccessGroup.Items[FT1]).Az12,
TAccessGroup(owner.FAccessGroup.Items[FT1]).Az34,TAccessGroup(owner.FAccessGroup.Items[FT1]).Az56,
TAccessGroup(owner.FAccessGroup.Items[FT1]).Az78]);
{$endif}
if (ord(Cmd.body[2])=TAccessGroup(owner.FAccessGroup.Items[FT1]).Az12) and
(ord(Cmd.body[3])=TAccessGroup(owner.FAccessGroup.Items[FT1]).Az34) and
(ord(Cmd.body[4])=TAccessGroup(owner.FAccessGroup.Items[FT1]).Az56) and
(ord(Cmd.body[5])=TAccessGroup(owner.FAccessGroup.Items[FT1]).Az78) then
begin
if FT1=p_MAX_AG-1 then begin
NextState;
end else begin
Inc(FT1);
State:=1;
Process:=0;
Process2:=3;
NewDev:=False;
end;
end else
begin
State:=3;
Process:=0;
Process2:=3;
NewDev:=False;
end;
end else
begin
State:=1;
Process:=0;
Process2:=3;
NewDev:=False;
HKError.Msg:='RP0301 Not CMD26';
end;
end else begin
State:=1;
Process:=0;
Process2:=3;
NewDev:=True;
end;
end;
procedure TStatus.RProcess0303(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if not (Cmd.cmd=$F3) then
HKError.Msg:='RP0303 Not ACK';
end else
begin
HKError.Msg:='RP0303 TimeOut';
end;
State:=1;
Process:=0;
Process2:=3;
NewDev:=False;
end;
procedure TStatus.RProcess0401(var Cmd: TCommand; TOut: Boolean);
begin
RefState:=(RefState and (not REF_NAME));
if not TOut then begin
if (Cmd.cmd=$F3) then begin
FT1:=0;
State:=3;
Process:=0;
Process2:=4;
NewDev:=False;
end else
begin
State:=1;
Process:=0;
Process2:=4;
NewDev:=True;
HKError.Msg:='RP0401 Not ACK';
end;
end else begin
State:=1;
Process:=0;
Process2:=4;
NewDev:=True;
HKError.Msg:='RP0401 TimeOut';
end;
end;
procedure TStatus.RProcess0403(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if (Cmd.cmd=$F3) then begin
if (FT1+1) < Owner.FName.Count then begin
Inc(FT1);
State:=3;
Process:=0;
Process2:=4;
NewDev:=False;
end else
begin
State:=5;
Process:=0;
Process2:=4;
NewDev:=False;
end;
end else
begin
State:=1;
Process:=0;
Process2:=4;
NewDev:=True;
HKError.Msg:='RP0403 Not ACK';
end;
end else begin
State:=1;
Process:=0;
Process2:=4;
NewDev:=True;
HKError.Msg:='RP0403 TimeOut';
end;
end;
procedure TStatus.RProcess0405(var Cmd: TCommand; TOut: Boolean);
begin
if not TOut then begin
if (Cmd.cmd=$F3) then begin
NextState;
end else
begin
State:=1;
Process:=0;
Process2:=4;
NewDev:=True;
HKError.Msg:='RP0405 Not ACK';
end;
end else begin
State:=1;
Process:=0;
Process2:=4;
NewDev:=True;
HKError.Msg:='RP0405 TimeOut';
end;
end;
procedure TStatus.NextState;
begin
if (RefState and REF_DEV)<>0 then
begin
State:=1;
Process:=0;
Process2:=0;
FT1:=0;
NewDev:=True;
end else
if (RefState and REF_HOL)<>0 then
begin
State:=1;
Process:=0;
Process2:=1;
FT1:=0;
NewDev:=True;
end else
if (RefState and REF_TZ)<>0 then
begin
State:=1;
Process:=0;
Process2:=2;
FT1:=0;
NewDev:=True;
end else
if (RefState and REF_AG)<>0 then
begin
State:=1;
Process:=0;
Process2:=3;
FT1:=0;
NewDev:=True;
end else
if (RefState and REF_NAME)<>0 then
begin
State:=1;
Process:=0;
Process2:=4;
FT1:=0;
NewDev:=True;
end else
begin
FT1:=0;
State:=1;
Process:=1;
Process2:=0;
NewDev:=True;
end;
end;
function TStatus.NextCommand(var Cmd: TCommand): Boolean;
begin
Result:=True;
case Process of
0: case Process2 of
0: case State of
0: SCmd16(Cmd);
1: SCmd16(Cmd);
3: SCmd15(Cmd);
5: SCmd22(Cmd);
else
begin
Result:=False;
HKError.MsgFmt('NextCommand State=%d',[State]);
end;
end;
1: case State of
0: SCmd27(Cmd);
1: SCmd27(Cmd);
3: SCmd19(Cmd);
else
begin
Result:=False;
HKError.MsgFmt('NextCommand State=%d',[State]);
end;
end;
2: case State of
0: SCmd25(Cmd);
1: SCmd25(Cmd);
3: SCmd17(Cmd);
else
begin
Result:=False;
HKError.MsgFmt('NextCommand State=%d',[State]);
end;
end;
3: case State of
0: SCmd26(Cmd);
1: SCmd26(Cmd);
3: SCmd18(Cmd);
else
begin
Result:=False;
HKError.MsgFmt('NextCommand State=%d',[State]);
end;
end;
4: case State of
1: SCmd12(Cmd);
3: SCmd13(Cmd);
5: SCmd14(Cmd);
else
begin
Result:=False;
HKError.MsgFmt('NextCommand State=%d',[State]);
end;
end;
else
begin
Result:=False;
HKError.MsgFmt('NextCommand Process2=%d',[Process2]);
end;
end;
1: case State of
0: SCmd9(Cmd);
1: SCmd9(Cmd);
3: SACK(Cmd);
6: SCmd11(Cmd);
10: SCmd9(Cmd);
end;
else
begin
Result:=False;
HKError.MsgFmt('NextCommand State=%d',[State]);
end;
end;
end;
function TStatus.SCmd9(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=9;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
CalcBCC(Cmd);
end;
function TStatus.SCmd12(var Cmd: TCommand): Boolean;
var temp: Word;
begin
Result:=True;
Cmd.cmd:=12;
Cmd.dev:=Owner.DevNo;
temp:=Owner.FName.Count;
Cmd.body:=chr(Byte(temp and $00FF))+chr(Byte(temp shl 8));
CalcBCC(Cmd);
end;
function TStatus.SCmd13(var Cmd: TCommand): Boolean;
var temp: string;
ime: TName;
begin
Result:=True;
Cmd.cmd:=13;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
ime:=TName(Owner.FName.Items[FT1]);
if Length(ime.CardNo)<14 then
begin
Result:=False;
HKError.Msg:='Bad CardNo';
end else
begin
Cmd.body:=chr(Str2BCDByte(ime.CardNo,1,2))+chr(Str2BCDByte(ime.CardNo,3,4))+
chr(Str2BCDByte(ime.CardNo,5,6))+chr(Str2BCDByte(ime.CardNo,7,8))+
chr(Str2BCDByte(ime.CardNo,9,10))+chr(Str2BCDByte(ime.CardNo,11,12))+
chr(Str2BCDByte(ime.CardNo,13,14))+#$0F;
temp:=Copy(ime.Name,1,16);
while Length(temp)<16 do temp:=temp+' ';
Cmd.body:=Cmd.body+#0+chr(Ime.AG)+temp+#$FF;
end;
CalcBCC(Cmd);
end;
function TStatus.SCmd14(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=14;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
CalcBCC(Cmd);
end;
function TStatus.SCmd15(var Cmd: TCommand): Boolean;
var vrs: string;
vreme: TDateTime;
dw: Integer;
begin
Result:=True;
Cmd.cmd:=15;
Cmd.dev:=Owner.DevNo;
vreme:=Now;
vrs:=FormatDateTime('hhnnssddmmyy',vreme);
Cmd.body:=chr(Byte2BCDByte(StrToInt(Copy(vrs,1,2))));
Cmd.body:=Cmd.body+chr(Byte2BCDByte(StrToInt(Copy(vrs,3,2))));
Cmd.body:=Cmd.body+chr(Byte2BCDByte(StrToInt(Copy(vrs,5,2))));
dw:=DayOfWeek(vreme);
if dw=1 then dw:=7 else Dec(dw);
Cmd.body:=Cmd.body+chr(Byte2BCDByte(dw));
Cmd.body:=Cmd.body+chr(Byte2BCDByte(StrToInt(Copy(vrs,7,2))));
Cmd.body:=Cmd.body+chr(Byte2BCDByte(StrToInt(Copy(vrs,9,2))));
Cmd.body:=Cmd.body+chr(Byte2BCDByte(StrToInt(Copy(vrs,11,2))));
CalcBCC(Cmd);
end;
function TStatus.SCmd16(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=16;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
CalcBCC(Cmd);
end;
function TStatus.SCmd17(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=17;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(FT1+1);
if owner.FTimeZone.Count > FT1 then begin
with TTimeZone(owner.FTimeZone.Items[FT1]) do begin
Cmd.body:=Cmd.body+chr(OnHour);
Cmd.body:=Cmd.body+chr(OnMin);
Cmd.body:=Cmd.body+chr(OffHour);
Cmd.body:=Cmd.body+chr(OffMin);
Cmd.body:=Cmd.body+chr(ZoneDays);
end;
end else
begin
Cmd.body:=Cmd.body+chr(0); Cmd.body:=Cmd.body+chr(0);
Cmd.body:=Cmd.body+chr(0); Cmd.body:=Cmd.body+chr(0);
Cmd.body:=Cmd.body+chr(0);
end;
CalcBCC(Cmd);
end;
function TStatus.SCmd18(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=18;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(FT1+1);
if owner.FAccessGroup.Count > FT1 then begin
with TAccessGroup(owner.FAccessGroup.Items[FT1]) do begin
Cmd.body:=Cmd.body+chr(Az12);
Cmd.body:=Cmd.body+chr(Az34);
Cmd.body:=Cmd.body+chr(Az56);
Cmd.body:=Cmd.body+chr(Az78);
end;
end else
Cmd.body:=Cmd.body+chr(0)+chr(0)+chr(0)+chr(0);
CalcBCC(Cmd);
end;
function TStatus.SCmd19(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=19;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(FT1+1);
if owner.FHolyday.Count > FT1 then begin
with THolyday(owner.FHolyday.Items[FT1]) do begin
Cmd.body:=Cmd.body+chr(HDate);
Cmd.body:=Cmd.body+chr(HMonth);
end;
end else
Cmd.body:=Cmd.body+chr(0)+chr(0);
CalcBCC(Cmd);
end;
function TStatus.SCmd22(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=22;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(owner.DoorTime);
CalcBCC(Cmd);
end;
function TStatus.SCmd25(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=25;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(FT1+1);
CalcBCC(Cmd);
end;
function TStatus.SCmd26(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=26;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(FT1+1);
CalcBCC(Cmd);
end;
function TStatus.SCmd27(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=27;
Cmd.dev:=Owner.DevNo;
Cmd.body:=chr(FT1+1);
CalcBCC(Cmd);
end;
function TStatus.SNACK(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=$F6;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
CalcBCC(Cmd);
end;
function TStatus.SACK(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=$F3;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
CalcBCC(Cmd);
end;
function TStatus.SCmd11(var Cmd: TCommand): Boolean;
begin
Result:=True;
Cmd.cmd:=11;
Cmd.dev:=Owner.DevNo;
Cmd.body:='';
CalcBCC(Cmd);
end;
procedure TStatus.CalcBCC(var Cmd: TCommand);
var i: Integer;
begin
Cmd.bcc:=Cmd.cmd xor Cmd.dev;
for i:=1 to Length(Cmd.body) do
Cmd.bcc:=Cmd.bcc xor ord(Cmd.body[i]);
end;
// TRekord.
constructor TRekord.Create;
begin
inherited Create;
end;
procedure TRekord.SetVreme(hh, min, dd, mm, yy: Byte);
var i: Word;
begin
try
i:=BCDByte2Byte(yy);
if i>80 then
i:=i+1900
else
i:=i+2000;
Fvreme:=EncodeDate(i,BCDByte2Byte(mm),BCDByte2Byte(dd))+
EncodeTime(BCDByte2Byte(hh),BCDByte2Byte(min),0,0);
except
FVreme:=Now;
end;
end;
// TDevice
constructor TDevice.Create(Value: Integer);
begin
inherited Create;
FTimeZone:=TList.Create;
FHolyday:=TList.Create;
FAccessGroup:=TList.Create;
FName:=TList.Create;
FComCode1:=TBCD.Create;
FComCode2:=TBCD.Create;
Status:=TStatus.Create(self);
FId:=Value;
end;
destructor TDevice.Destroy;
begin
Status.Free;
FComCode2.Free;
FComCode1.Free;
FreeList(FName);
FreeList(FAccessGroup);
FreeList(FHolyday);
FreeList(FTimeZone);
inherited Destroy;
end;
procedure TDevice.SetComCode1(Value: Byte);
begin
if Value<>FComCode1.HiLo then
FComCode1.HiLo:=Value;
end;
function TDevice.GetComCode1: Byte;
begin
Result:=FComCode1.HiLo;
end;
procedure TDevice.SetComCode2(Value: Byte);
begin
if Value<>FComCode2.HiLo then
FComCode2.HiLo:=Value;
end;
function TDevice.GetComCode2: Byte;
begin
Result:=FComCode2.HiLo;
end;
function TDevice.GetSComCode: string;
begin
Result:=Format('%2d%2d',[FComCode1.BCD2Byte, FComCode2.BCD2Byte]);
end;
procedure TDevice.SetSComCode(Value: string);
var temp1, temp2: BCD;
begin
Value:=Trim(Value);
if Length(Value)=4 then begin
temp1.Create;
temp2.Create;
try
try
temp1.Hi:=StrToInt(Value[1]);
temp1.Lo:=StrToInt(Value[2]);
temp2.Hi:=StrToInt(Value[3]);
temp2.Lo:=StrToInt(Value[4]);
FComCode1.HiLo:=temp1.HiLo;
FComCode2.HiLo:=temp2.HiLo;
except
HKError.Msg:='SetSComCode Error';
end;
finally
temp1.Free;
temp2.Free;
end;
end;
end;
procedure TDevice.DoorBlock;
begin
//
end;
procedure TDevice.DoorOpen;
begin
//
end;
// Misc
function BCDByte2Byte(Value: Byte): Byte;
begin
Result:=(Value shr 4)*10+(Value and $0F);
end;
function BCDByte2String(Value: Byte): String;
begin
Result:=IntToStr(ord(Value shr 4))+IntToStr(ord(Value and $0F));;
end;
function Str2BCDByte(Value: string; prv, vtor: Integer): Byte;
var tmp: string;
begin
Result:=0;
try
tmp:=Value[prv]+Value[vtor];
Result:=Byte2BCDByte(StrToInt(tmp));
except
HKError.MsgFmt('Str2BCDByte Invalid Value %s Prv %d Vtor $d',[Value,prv,vtor]);
end;
end;
function Byte2BCDByte(Value: Byte): Byte;
begin
Result:=0;
if Value<100 then
Result:=((Value div 10) shl 4) or (Value mod 10)
else
HKError.MsgFmt('Byte2BCDByte Invalid Value %d',[Value]);
end;
procedure FreeList(Value: TList);
var i: Integer;
begin
if Value<>nil then begin
i:=Value.Count;
while i>0 do begin
TObject(Value.Items[Value.Count-1]).Free;
Value.Delete(Value.Count-1);
i:=Value.Count;
end;
Value.Free;
end;
end;
procedure EHKError.SetMsg(const Value: string);
begin
if FMsg<>Value then begin
FMsg:=Copy(Value,1,$FFFF);
if FMsg<>'' then
if Assigned(OnMsg) then OnMsg(self);
end;
end;
procedure EHKError.MsgFmt(const Fmt: string; const Args: array of const);
begin
Msg:=Format(Fmt,Args);
end;
procedure EHKError.LogComm(Lab: String; p_comm: TCommand);
var tmp: string;
i: Integer;
begin
tmp:=Lab+' cmd='+IntToStr(p_comm.cmd)+' dev='+IntToStr(p_comm.dev)+' bcc='+IntToStr(p_comm.bcc);
for i:=1 to Length(p_comm.body) do
tmp:=tmp+Format(' %x',[ord(p_comm.body[i])]);
Msg:=tmp;
end;
end.
Back
