1 | unit UTerminalBF630;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, UBinarySerializer, UCommTCPServer, UCommPin, SyncObjs,
|
---|
9 | SpecializedList, SpecializedStream, Forms, UCommTCPClient, Dialogs, DateUtils,
|
---|
10 | UAccessControler, UAttendance;
|
---|
11 |
|
---|
12 | const
|
---|
13 | ResultCodeSuccess = 0;
|
---|
14 | ResultCodeUnknownError = 2;
|
---|
15 | ResultCodeCheckSumError = 4;
|
---|
16 | ResultCodeOtherPacketError = 5;
|
---|
17 | ResultCodeUnknownCommand = 8;
|
---|
18 |
|
---|
19 | const
|
---|
20 | CodeSTX = $2;
|
---|
21 | CodeETX = $3;
|
---|
22 | CodeACK = $6;
|
---|
23 | CodeBS = $8;
|
---|
24 |
|
---|
25 | type
|
---|
26 | ETimeout = class(Exception);
|
---|
27 |
|
---|
28 | TTerminalOperation = (toNone = $0, toUserDelete = $1, toUserDeleteAll = $2,
|
---|
29 | toIsUserRegistred = $3, toGetRegUserCount = $4, toGetMaxUserCount = $5,
|
---|
30 | toGetDate = $10, toSetDate = $11, toGetTime = $12, toSetTime = $13,
|
---|
31 | toSetWebLogonPass = $14, toGetWebLogonPass = $15,
|
---|
32 | toSetAdminID = $16, toGetAdminID = $17, toSaveConfiguration = $18,
|
---|
33 | toCheckSecurityLevel = $24, toSetSecurityLevel = $25,
|
---|
34 | toSetSystemParam = $26,
|
---|
35 | toSetTerminalId = $27, toTerminalReboot = $28, toSetFuncKey = $29,
|
---|
36 | toDelFuncKey = $2a, toChangeTerminalPassword = $2b, toDuplicateFPEnrolled = $2c,
|
---|
37 | toGetSystemParam = $2d, toGetTerminalPassword = $2e,
|
---|
38 | toLogGetOldest = $2f,
|
---|
39 | toLogGetDelete = $30, toLogGet = $31, toLogGetAll = $32, toLogDelAll = $33,
|
---|
40 | toLogDel = $34, toLogGetCount = $37, toLogGetCapacity = $38,
|
---|
41 | toLogGetAllNoAck = $39, toGetUserIDList = $40,
|
---|
42 | toDoorSensorGetStatus = $54,
|
---|
43 | toGetSerialNumber = $61, toPassCodeGet = $62, toPassCodeSet = $63,
|
---|
44 | toGetSlaveList = $64, toEventOnRelayTriggerSet = $69,
|
---|
45 | toEventOnRelayTriggerGetAll = $79, toAntiDuressSet = $96,
|
---|
46 | toAntiDuressGet = $97, toSrcurityBypassGetStatus = $98,
|
---|
47 | toTimeSet = $a6, toTimeZoneAdd = $a7, toGroupAdd = $a8,
|
---|
48 | toDoorSettingSet = $a9, toHolidayAdd = $aa,
|
---|
49 | toUserAdd = $ab, toDesignationAdd = $ac, toDepartmentAdd = $ad,
|
---|
50 | toTimeDel = $b6, toTimeZoneDel = $b7, toGroupDel = $b8,
|
---|
51 | toSecurityBypass = $b9, toHolidayDel = $ba,
|
---|
52 | toDesignationDel = $bc, toDepartmentDel = $bd,
|
---|
53 | toTimeDelAll = $c6, toZimeZoneDelAll = $c7, toGroupDelAll = $c8,
|
---|
54 | toHolidayDelAll = $ca, toDesignationDelAll = $cc, toDepartmentDelAll = $cd,
|
---|
55 | toTimeGet = $d6, toTimeZoneGet = $d7, toGroupGet = $d8,
|
---|
56 | toDoorSettingGet = $d9, toHolidayGetAll = $da, toUserDataGet = $db,
|
---|
57 | toDesignationGetAll = $dc, toDepartmentGetAll = $dd,
|
---|
58 | toDoorAntiPassbackSet = $e9, toDoorAntiPassbackGet = $f9
|
---|
59 | );
|
---|
60 |
|
---|
61 | { TTerminalBF630 }
|
---|
62 |
|
---|
63 | TTerminalBF630 = class(TAccessControler)
|
---|
64 | private
|
---|
65 | ReceiveData: TListByte;
|
---|
66 | ReceiveDataThread: TListByte;
|
---|
67 | ReceiveDataLock: TCriticalSection;
|
---|
68 | SendTime: TDateTime;
|
---|
69 | procedure ReceiveDataHandler(Sender: TCommPin; AList: TListByte);
|
---|
70 | procedure WaitForBytes(Count: Integer);
|
---|
71 | protected
|
---|
72 | procedure SetActive(AValue: Boolean); override;
|
---|
73 | public
|
---|
74 | CommSocket: TCommTCPClient;
|
---|
75 | AccessKey: array[0..5] of Byte;
|
---|
76 | UseAccessKey: Boolean;
|
---|
77 | Timeout: TDateTime;
|
---|
78 | Address: string;
|
---|
79 | Port: Word;
|
---|
80 | function SendPacket(Command: TTerminalOperation; Request: TListByte = nil; Response: TListByte = nil): Byte;
|
---|
81 | function ReadDateTime: TDateTime;
|
---|
82 | function GetUserCount: Integer; override;
|
---|
83 | function GetUser(Index: Integer; User: TUser): Boolean; override;
|
---|
84 | function GetPassageCount: Integer; override;
|
---|
85 | function GetPassage(Index: Integer; Passage: TUserPassage): Boolean; override;
|
---|
86 | constructor Create; override;
|
---|
87 | destructor Destroy; override;
|
---|
88 | end;
|
---|
89 |
|
---|
90 | TVirtualTerminalBF630 = class;
|
---|
91 |
|
---|
92 | { TVirtualTerminalBF630Session }
|
---|
93 |
|
---|
94 | TVirtualTerminalBF630Session = class
|
---|
95 | private
|
---|
96 | Parent: TVirtualTerminalBF630;
|
---|
97 | procedure ReceiveData(Sender: TCommPin; List: TListByte);
|
---|
98 | public
|
---|
99 | Pin: TCommPin;
|
---|
100 | constructor Create;
|
---|
101 | destructor Destroy; override;
|
---|
102 | end;
|
---|
103 |
|
---|
104 | TVirtualTerminalBF630User = class
|
---|
105 | Id: Integer;
|
---|
106 | FirstName: string;
|
---|
107 | SecondName: string;
|
---|
108 | end;
|
---|
109 |
|
---|
110 | TVirtualTerminalBF630Passage = class
|
---|
111 | Id: Integer;
|
---|
112 | Time: TDateTime;
|
---|
113 | User: Integer;
|
---|
114 | Key: Integer;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | { TVirtualTerminalBF630 }
|
---|
118 |
|
---|
119 | TVirtualTerminalBF630 = class
|
---|
120 | private
|
---|
121 | FActive: Boolean;
|
---|
122 | FOnLogData: TOnLogDataEvent;
|
---|
123 | function CommandReadDate(Request: TListByte; Response: TListByte): Byte;
|
---|
124 | function CommandGetRegUserCount(Request: TListByte; Response: TListByte): Byte;
|
---|
125 | function CommandGetUserIDList(Request: TListByte; Response: TListByte): Byte;
|
---|
126 | function CommandGetUserData(Request: TListByte; Response: TListByte): Byte;
|
---|
127 | function CommandLogGet(Request: TListByte; Response: TListByte): Byte;
|
---|
128 | function CommandLogGetCount(Request: TListByte; Response: TListByte): Byte;
|
---|
129 | procedure SetActive(AValue: Boolean);
|
---|
130 | procedure NewConnection(Sender: TCommTCPServer; Pin: TCommPin);
|
---|
131 | procedure CloseConnection(Sender: TCommTCPServer; Pin: TCommPin);
|
---|
132 | public
|
---|
133 | Users: TListObject; // TListObject<TVirtualTerminalBF630User>
|
---|
134 | Passages: TListObject; // TListObject<TVirtualTerminalBF630Passage>
|
---|
135 | Sessions: TListObject; // TListObject<TVirtualTerminalBF630Session>
|
---|
136 | AccessKey: array[0..5] of Byte;
|
---|
137 | UseAccessKey: Boolean;
|
---|
138 | Id: Integer;
|
---|
139 | CommSocket: TCommTCPServer;
|
---|
140 | Address: string;
|
---|
141 | Port: Word;
|
---|
142 | procedure InitDemoData;
|
---|
143 | property OnLogData: TOnLogDataEvent read FOnLogData write FOnLogData;
|
---|
144 | property Active: Boolean read FActive write SetActive;
|
---|
145 | constructor Create;
|
---|
146 | destructor Destroy; override;
|
---|
147 | end;
|
---|
148 |
|
---|
149 |
|
---|
150 | implementation
|
---|
151 |
|
---|
152 | resourcestring
|
---|
153 | SCommunicatiomTimeout = 'Communication timeout';
|
---|
154 | SWrongId = 'Wrong id';
|
---|
155 |
|
---|
156 | { TVirtualTerminalBF630Session }
|
---|
157 |
|
---|
158 | procedure TVirtualTerminalBF630Session.ReceiveData(Sender: TCommPin; List: TListByte);
|
---|
159 | var
|
---|
160 | SendData: TListByte;
|
---|
161 | SendDataSerializer: TBinarySerializer;
|
---|
162 | RecDataSerializer: TBinarySerializer;
|
---|
163 | Request: TListByte;
|
---|
164 | Response: TListByte;
|
---|
165 | CheckSum: Byte;
|
---|
166 | ExpectedCheckSum: Byte;
|
---|
167 | I: Integer;
|
---|
168 | DataLength: Cardinal;
|
---|
169 | Command: Byte;
|
---|
170 | ResultCode: Byte;
|
---|
171 | begin
|
---|
172 | with Parent do
|
---|
173 | try
|
---|
174 | Request := TListByte.Create;
|
---|
175 | Response := TListByte.Create;
|
---|
176 | SendData := TListByte.Create;
|
---|
177 | RecDataSerializer := TBinarySerializer.Create;
|
---|
178 | RecDataSerializer.List := List;
|
---|
179 | SendDataSerializer := TBinarySerializer.Create;
|
---|
180 | SendDataSerializer.List := SendData;
|
---|
181 | with List, RecDataSerializer do begin
|
---|
182 | Endianness := enBig;
|
---|
183 | if ReadByte <> CodeACK then Exit; // ACK
|
---|
184 | if ReadByte <> CodeSTX then Exit; // STX
|
---|
185 | DataLength := ReadCardinal; // Length
|
---|
186 | if Id <> ReadByte then Exit; // TID
|
---|
187 | Command := ReadByte; // Command
|
---|
188 | if UseAccessKey then begin
|
---|
189 | AccessKey[0] := ReadByte;
|
---|
190 | AccessKey[1] := ReadByte;
|
---|
191 | AccessKey[2] := ReadByte;
|
---|
192 | AccessKey[3] := ReadByte;
|
---|
193 | AccessKey[4] := ReadByte;
|
---|
194 | AccessKey[5] := ReadByte;
|
---|
195 | Dec(DataLength, 6);
|
---|
196 | end;
|
---|
197 | if (DataLength - 10) > 0 then begin
|
---|
198 | Request.Count := 0;
|
---|
199 | ReadList(Request, 0, DataLength - 10);
|
---|
200 | end;
|
---|
201 | ExpectedCheckSum := 0;
|
---|
202 | for I := 0 to Position - 1 do
|
---|
203 | ExpectedCheckSum := (ExpectedCheckSum + List[I]) and $ff;
|
---|
204 | CheckSum := ReadByte; // byte sum from ACK to DATA
|
---|
205 | if CheckSum <> ExpectedCheckSum then Exit;
|
---|
206 | if ReadByte <> CodeETX then Exit; // ETX
|
---|
207 |
|
---|
208 | if Command = Byte(toGetRegUserCount) then ResultCode := CommandGetRegUserCount(Request, Response)
|
---|
209 | else if Command = Byte(toGetUserIDList) then ResultCode := CommandGetUserIDList(Request, Response)
|
---|
210 | else if Command = Byte(toGetDate) then ResultCode := CommandReadDate(Request, Response)
|
---|
211 | else if Command = Byte(toUserDataGet) then ResultCode := CommandGetUserData(Request, Response)
|
---|
212 | else if Command = Byte(toLogGet) then ResultCode := CommandLogGet(Request, Response)
|
---|
213 | else if Command = Byte(toLogGetCount) then ResultCode := CommandLogGetCount(Request, Response)
|
---|
214 | else ResultCode := ResultCodeUnknownCommand;
|
---|
215 |
|
---|
216 | with SendData, SendDataSerializer do begin
|
---|
217 | Count := 0;
|
---|
218 | Endianness := enBig;
|
---|
219 | WriteByte(CodeBS); // BS
|
---|
220 | WriteByte(CodeSTX); // STX
|
---|
221 | WriteCardinal(Response.Count + 10); // LENGTH
|
---|
222 | WriteByte(Id); // TERMINAL ID
|
---|
223 | WriteByte(ResultCode);
|
---|
224 | List.AddListPart(Response, 0, Response.Count);
|
---|
225 | SendDataSerializer.Position := SendDataSerializer.Position + Response.Count;
|
---|
226 | CheckSum := 0;
|
---|
227 | for I := 0 to Count - 1 do
|
---|
228 | CheckSum := (CheckSum + SendData[I]) and $ff;
|
---|
229 | Position := Count;
|
---|
230 | WriteByte(CheckSum); // byte sum from BS to DATA
|
---|
231 | WriteByte(CodeETX); // ETX
|
---|
232 | end;
|
---|
233 | Pin.Send(SendData);
|
---|
234 | end;
|
---|
235 | finally
|
---|
236 | Request.Free;
|
---|
237 | Response.Free;
|
---|
238 | SendData.Free;
|
---|
239 | end;
|
---|
240 | end;
|
---|
241 |
|
---|
242 | constructor TVirtualTerminalBF630Session.Create;
|
---|
243 | begin
|
---|
244 | Pin := TCommPin.Create;
|
---|
245 | Pin.OnReceive := ReceiveData;
|
---|
246 | end;
|
---|
247 |
|
---|
248 | destructor TVirtualTerminalBF630Session.Destroy;
|
---|
249 | begin
|
---|
250 | Pin.Free;
|
---|
251 | inherited Destroy;
|
---|
252 | end;
|
---|
253 |
|
---|
254 | { TVirtualTerminalBF630 }
|
---|
255 |
|
---|
256 | function TVirtualTerminalBF630.CommandReadDate(Request: TListByte;
|
---|
257 | Response: TListByte): Byte;
|
---|
258 | var
|
---|
259 | Year, Month, Day: Word;
|
---|
260 | begin
|
---|
261 | DecodeDate(Now, Year, Month, Day);
|
---|
262 | Response.Count := 4;
|
---|
263 | Response[0] := Year;
|
---|
264 | Response[1] := Month;
|
---|
265 | Response[2] := Day;
|
---|
266 | Response[3] := 0;
|
---|
267 | Result := ResultCodeSuccess;
|
---|
268 | end;
|
---|
269 |
|
---|
270 | function TVirtualTerminalBF630.CommandGetRegUserCount(Request: TListByte;
|
---|
271 | Response: TListByte): Byte;
|
---|
272 | begin
|
---|
273 | Response.Count := 2;
|
---|
274 | Response[0] := 0;
|
---|
275 | Response[1] := Users.Count;
|
---|
276 | Result := ResultCodeSuccess;
|
---|
277 | end;
|
---|
278 |
|
---|
279 | function TVirtualTerminalBF630.CommandGetUserIDList(Request: TListByte;
|
---|
280 | Response: TListByte): Byte;
|
---|
281 | var
|
---|
282 | I: Integer;
|
---|
283 | begin
|
---|
284 | Response.Count := Users.Count * 4;
|
---|
285 | for I := 0 to Users.Count - 1 do
|
---|
286 | with TVirtualTerminalBF630User(Users[I]) do begin
|
---|
287 | Response[I * 4 + 0] := 0;
|
---|
288 | Response[I * 4 + 1] := 0;
|
---|
289 | Response[I * 4 + 2] := 0;
|
---|
290 | Response[I * 4 + 3] := Id;
|
---|
291 | end;
|
---|
292 | Result := ResultCodeSuccess;
|
---|
293 | end;
|
---|
294 |
|
---|
295 | function TVirtualTerminalBF630.CommandGetUserData(Request: TListByte;
|
---|
296 | Response: TListByte): Byte;
|
---|
297 | var
|
---|
298 | UserId: Integer;
|
---|
299 | RequestSerializer: TBinarySerializer;
|
---|
300 | ResponseSerializer: TBinarySerializer;
|
---|
301 | I: Integer;
|
---|
302 | begin
|
---|
303 | try
|
---|
304 | RequestSerializer := TBinarySerializer.Create;
|
---|
305 | RequestSerializer.List := Request;
|
---|
306 | UserId := RequestSerializer.ReadInteger;
|
---|
307 |
|
---|
308 | ResponseSerializer := TBinarySerializer.Create;
|
---|
309 | ResponseSerializer.List := Response;
|
---|
310 | with ResponseSerializer do begin
|
---|
311 | WriteInteger(UserId);
|
---|
312 | WriteByte(0);
|
---|
313 | WriteByte(0);
|
---|
314 | for I := 0 to 7 do WriteByte(0);
|
---|
315 | with TVirtualTerminalBF630User(Users[UserId]) do
|
---|
316 | for I := 1 to 15 do
|
---|
317 | if I < Length(FirstName) then WriteByte(Ord(FirstName[I]))
|
---|
318 | else WriteByte(0);
|
---|
319 | with TVirtualTerminalBF630User(Users[UserId]) do
|
---|
320 | for I := 1 to 15 do
|
---|
321 | if I < Length(SecondName) then WriteByte(Ord(SecondName[I]))
|
---|
322 | else WriteByte(0);
|
---|
323 | end;
|
---|
324 | finally
|
---|
325 | RequestSerializer.Free;
|
---|
326 | ResponseSerializer.Free;
|
---|
327 | end;
|
---|
328 | end;
|
---|
329 |
|
---|
330 | function TVirtualTerminalBF630.CommandLogGet(Request: TListByte;
|
---|
331 | Response: TListByte): Byte;
|
---|
332 | var
|
---|
333 | UserId: Integer;
|
---|
334 | RequestSerializer: TBinarySerializer;
|
---|
335 | ResponseSerializer: TBinarySerializer;
|
---|
336 | I: Integer;
|
---|
337 | Day, Month, Year: Word;
|
---|
338 | MSec, Sec, Min, Hour: Word;
|
---|
339 | FunctionKey: Integer;
|
---|
340 | begin
|
---|
341 | try
|
---|
342 | RequestSerializer := TBinarySerializer.Create;
|
---|
343 | RequestSerializer.List := Request;
|
---|
344 | //UserId := RequestSerializer.ReadInteger;
|
---|
345 |
|
---|
346 | ResponseSerializer := TBinarySerializer.Create;
|
---|
347 | ResponseSerializer.List := Response;
|
---|
348 | DecodeDateTime(TVirtualTerminalBF630Passage(Passages[0]).Time,
|
---|
349 | Year, Month, Day, Hour, Min, Sec, MSec);
|
---|
350 | with ResponseSerializer do begin
|
---|
351 | WriteByte(Sec);
|
---|
352 | WriteByte(Min);
|
---|
353 | WriteByte(Hour);
|
---|
354 | WriteByte(Day);
|
---|
355 | WriteByte(Month);
|
---|
356 | WriteByte(Year mod 100);
|
---|
357 | WriteByte(0);
|
---|
358 | WriteByte(0);
|
---|
359 | WriteByte(0);
|
---|
360 | WriteByte(TVirtualTerminalBF630Passage(Passages[0]).Key);
|
---|
361 | WriteInteger(TVirtualTerminalBF630Passage(Passages[0]).User);
|
---|
362 | WriteByte(0);
|
---|
363 | WriteByte(0);
|
---|
364 | end;
|
---|
365 | finally
|
---|
366 | RequestSerializer.Free;
|
---|
367 | ResponseSerializer.Free;
|
---|
368 | end;
|
---|
369 | end;
|
---|
370 |
|
---|
371 | function TVirtualTerminalBF630.CommandLogGetCount(Request: TListByte;
|
---|
372 | Response: TListByte): Byte;
|
---|
373 | var
|
---|
374 | ResponseSerializer: TBinarySerializer;
|
---|
375 | begin
|
---|
376 | try
|
---|
377 | ResponseSerializer := TBinarySerializer.Create;
|
---|
378 | ResponseSerializer.List := Response;
|
---|
379 | ResponseSerializer.WriteInteger(Passages.Count);
|
---|
380 | Result := ResultCodeSuccess;
|
---|
381 | finally
|
---|
382 | ResponseSerializer.Free;
|
---|
383 | end;
|
---|
384 | end;
|
---|
385 |
|
---|
386 | procedure TVirtualTerminalBF630.SetActive(AValue: Boolean);
|
---|
387 | begin
|
---|
388 | if FActive = AValue then Exit;
|
---|
389 | inherited;
|
---|
390 | CommSocket.Active := AValue;
|
---|
391 | end;
|
---|
392 |
|
---|
393 | procedure TVirtualTerminalBF630.NewConnection(Sender: TCommTCPServer;
|
---|
394 | Pin: TCommPin);
|
---|
395 | var
|
---|
396 | NewSession: TVirtualTerminalBF630Session;
|
---|
397 | begin
|
---|
398 | NewSession := TVirtualTerminalBF630Session.Create;
|
---|
399 | NewSession.Parent := Self;
|
---|
400 | NewSession.Pin.Connect(Pin);
|
---|
401 | Pin.OnLogData := FOnLogData;
|
---|
402 | Sessions.Add(NewSession);
|
---|
403 | end;
|
---|
404 |
|
---|
405 | procedure TVirtualTerminalBF630.CloseConnection(Sender: TCommTCPServer;
|
---|
406 | Pin: TCommPin);
|
---|
407 | var
|
---|
408 | I: Integer;
|
---|
409 | begin
|
---|
410 | // Delete all not connected sessions
|
---|
411 | for I := Sessions.Count - 1 downto 0 do
|
---|
412 | if not TVirtualTerminalBF630Session(Sessions[I]).Pin.Connected then
|
---|
413 | Sessions.Delete(I);
|
---|
414 | end;
|
---|
415 |
|
---|
416 | procedure TVirtualTerminalBF630.InitDemoData;
|
---|
417 | begin
|
---|
418 | with TVirtualTerminalBF630User(Users.AddNew(TVirtualTerminalBF630User.Create)) do begin
|
---|
419 | Id := Users.Count;
|
---|
420 | FirstName := 'User ' + IntToStr(Id);
|
---|
421 | SecondName := 'Second ' + IntToStr(Id);
|
---|
422 | end;
|
---|
423 | with TVirtualTerminalBF630User(Users.AddNew(TVirtualTerminalBF630User.Create)) do begin
|
---|
424 | Id := Users.Count;
|
---|
425 | FirstName := 'User ' + IntToStr(Id);
|
---|
426 | SecondName := 'Second ' + IntToStr(Id);
|
---|
427 | end;
|
---|
428 | with TVirtualTerminalBF630Passage(Passages.AddNew(TVirtualTerminalBF630Passage.Create)) do begin
|
---|
429 | Id := Passages.Count;
|
---|
430 | Time := Now;
|
---|
431 | User := 1;
|
---|
432 | Key := 2;
|
---|
433 | end;
|
---|
434 | end;
|
---|
435 |
|
---|
436 | constructor TVirtualTerminalBF630.Create;
|
---|
437 | begin
|
---|
438 | Sessions := TListObject.Create;
|
---|
439 | Users := TListObject.Create;
|
---|
440 | Passages := TListObject.Create;
|
---|
441 | CommSocket := TCommTCPServer.Create(nil);
|
---|
442 | CommSocket.Address := 'localhost';
|
---|
443 | CommSocket.Port := 2000;
|
---|
444 | CommSocket.OnConnect := NewConnection;
|
---|
445 | Id := 1;
|
---|
446 | end;
|
---|
447 |
|
---|
448 | destructor TVirtualTerminalBF630.Destroy;
|
---|
449 | begin
|
---|
450 | Active := False;
|
---|
451 | FreeAndNil(CommSocket);
|
---|
452 | FreeAndNil(Users);
|
---|
453 | FreeAndNil(Passages);
|
---|
454 | FreeAndNil(Sessions);
|
---|
455 | inherited Destroy;
|
---|
456 | end;
|
---|
457 |
|
---|
458 | { TTerminalBF630 }
|
---|
459 |
|
---|
460 | procedure TTerminalBF630.ReceiveDataHandler(Sender: TCommPin; AList: TListByte);
|
---|
461 | begin
|
---|
462 | try
|
---|
463 | ReceiveDataLock.Acquire;
|
---|
464 | ReceiveDataThread.AddList(AList);
|
---|
465 | finally
|
---|
466 | ReceiveDataLock.Release;
|
---|
467 | end;
|
---|
468 | end;
|
---|
469 |
|
---|
470 | procedure TTerminalBF630.SetActive(AValue: Boolean);
|
---|
471 | begin
|
---|
472 | if Active = AValue then Exit;
|
---|
473 | inherited;
|
---|
474 | CommSocket.Address := Address;
|
---|
475 | CommSocket.Port := Port;
|
---|
476 | CommSocket.Active := AValue;
|
---|
477 | end;
|
---|
478 |
|
---|
479 | procedure TTerminalBF630.WaitForBytes(Count: Integer);
|
---|
480 | var
|
---|
481 | Buffer: array of Byte;
|
---|
482 | OldPos: Integer;
|
---|
483 | begin
|
---|
484 | try
|
---|
485 | ReceiveDataLock.Acquire;
|
---|
486 | while ReceiveDataThread.Count < Count do begin
|
---|
487 | if (Now - Timeout) > SendTime then raise ETimeout.Create(SCommunicatiomTimeout);
|
---|
488 | try
|
---|
489 | ReceiveDataLock.Release;
|
---|
490 | Sleep(1);
|
---|
491 | Application.ProcessMessages;
|
---|
492 | finally
|
---|
493 | ReceiveDataLock.Acquire;
|
---|
494 | end;
|
---|
495 | end;
|
---|
496 | // Copy requested count to another buffer and remove count from beginning of stream
|
---|
497 | ReceiveData.AddListPart(ReceiveDataThread, 0, Count);
|
---|
498 | ReceiveDataThread.DeleteItems(0, Count);
|
---|
499 | finally
|
---|
500 | ReceiveDataLock.Release;
|
---|
501 | end;
|
---|
502 | end;
|
---|
503 |
|
---|
504 | function TTerminalBF630.SendPacket(Command: TTerminalOperation;
|
---|
505 | Request: TListByte = nil; Response: TListByte = nil): Byte;
|
---|
506 | var
|
---|
507 | SendData: TListByte;
|
---|
508 | SendDataSerializer: TBinarySerializer;
|
---|
509 | SendDataStream: TMemoryStream;
|
---|
510 | // ResponseData: TListByte;
|
---|
511 | ResponseSerializer: TBinarySerializer;
|
---|
512 | CheckSum: Byte;
|
---|
513 | ExpectedCheckSum: Byte;
|
---|
514 | I: Integer;
|
---|
515 | DataLength: Cardinal;
|
---|
516 | DataByte: Byte;
|
---|
517 | begin
|
---|
518 | try
|
---|
519 | SendData := TListByte.Create;
|
---|
520 | SendDataSerializer := TBinarySerializer.Create;
|
---|
521 | SendDataSerializer.List := SendData;
|
---|
522 | SendDataStream := TMemoryStream.Create;
|
---|
523 | //ResponseData := TListByte.Create;
|
---|
524 | ResponseSerializer := TBinarySerializer.Create;
|
---|
525 | ResponseSerializer.List := ReceiveData;
|
---|
526 |
|
---|
527 | // Clear buffer
|
---|
528 | ReceiveData.Count := 0;
|
---|
529 | try
|
---|
530 | ReceiveDataLock.Acquire;
|
---|
531 | ReceiveDataThread.Count := 0;
|
---|
532 | finally
|
---|
533 | ReceiveDataLock.Release;
|
---|
534 | end;
|
---|
535 |
|
---|
536 | with SendData, SendDataSerializer do begin
|
---|
537 | Endianness := enBig;
|
---|
538 | WriteByte(CodeACK); // ACK
|
---|
539 | WriteByte(CodeSTX); // STX
|
---|
540 | DataLength := 10;
|
---|
541 | if UseAccessKey then DataLength := DataLength + 6;
|
---|
542 | if Assigned(Request) then
|
---|
543 | Inc(DataLength, Request.Count);
|
---|
544 | WriteCardinal(DataLength); // Lenght
|
---|
545 | WriteByte(Id); // TID
|
---|
546 | WriteByte(Byte(Command));
|
---|
547 | if Assigned(Request) then begin
|
---|
548 | SendDataSerializer.WriteList(Request, 0, Request.Count);
|
---|
549 | end;
|
---|
550 | if UseAccessKey then begin
|
---|
551 | WriteByte(AccessKey[0]);
|
---|
552 | WriteByte(AccessKey[1]);
|
---|
553 | WriteByte(AccessKey[2]);
|
---|
554 | WriteByte(AccessKey[3]);
|
---|
555 | WriteByte(AccessKey[4]);
|
---|
556 | WriteByte(AccessKey[5]);
|
---|
557 | end;
|
---|
558 | CheckSum := 0;
|
---|
559 | for I := 0 to Count - 1 do
|
---|
560 | CheckSum := (CheckSum + SendData[I]) and $ff;
|
---|
561 | Position := Count;
|
---|
562 | WriteByte(CheckSum); // byte sum from ACK to DATA
|
---|
563 | WriteByte(CodeETX); // ETX
|
---|
564 | SendDataStream.Size := 0;
|
---|
565 | SendData.WriteToStream(SendDataStream);
|
---|
566 | Pin.Send(SendData);
|
---|
567 | SendTime := Now;
|
---|
568 |
|
---|
569 | with ReceiveData, ResponseSerializer do begin
|
---|
570 | Endianness := enBig;
|
---|
571 | ExpectedCheckSum := 0;
|
---|
572 | WaitForBytes(8);
|
---|
573 | DataByte := ReadByte;
|
---|
574 | if DataByte <> CodeBS then raise Exception.Create('Expected BS($8) but found $' + IntToHex(DataByte, 2)); // BS
|
---|
575 | if ReadByte <> CodeSTX then raise Exception.Create('Expected STX'); // STX
|
---|
576 | DataLength := ReadCardinal;
|
---|
577 | if ReadByte <> Id then raise Exception.Create('Wrong Id'); // STX
|
---|
578 | Result := ReadByte;
|
---|
579 | if Assigned(Response) then begin
|
---|
580 | WaitForBytes(DataLength - 10);
|
---|
581 | Response.Count := 0;
|
---|
582 | Response.AddListPart(ReceiveData, Position, DataLength - 10);
|
---|
583 | Position := Position + (DataLength - 10);
|
---|
584 | end;
|
---|
585 | WaitForBytes(2);
|
---|
586 | for I := 0 to Position - 1 do
|
---|
587 | ExpectedCheckSum := (ExpectedCheckSum + ReceiveData[I]) and $ff;
|
---|
588 | CheckSum := ReadByte; // byte sum from BS to DATA
|
---|
589 | if CheckSum <> ExpectedCheckSum then
|
---|
590 | raise Exception.Create('Bad receive checksum');
|
---|
591 | if ReadByte <> CodeETX then
|
---|
592 | raise Exception.Create('Expected ETX'); // ETX
|
---|
593 | end;
|
---|
594 | end;
|
---|
595 | finally
|
---|
596 | ResponseSerializer.Free;
|
---|
597 | //ResponseData.Free;
|
---|
598 | SendDataStream.Free;
|
---|
599 | SendDataSerializer.Free;
|
---|
600 | SendData.Free;
|
---|
601 | end;
|
---|
602 | end;
|
---|
603 |
|
---|
604 | function TTerminalBF630.ReadDateTime: TDateTime;
|
---|
605 | var
|
---|
606 | Response: TListByte;
|
---|
607 | begin
|
---|
608 | try
|
---|
609 | Response := TListByte.Create;
|
---|
610 | SendPacket(toGetDate, nil, Response);
|
---|
611 | Result := EncodeDate(Response[0], Response[1], Response[2]);
|
---|
612 | finally
|
---|
613 | Response.Free;
|
---|
614 | end;
|
---|
615 | end;
|
---|
616 |
|
---|
617 | function TTerminalBF630.GetUserCount: Integer;
|
---|
618 | var
|
---|
619 | Response: TListByte;
|
---|
620 | begin
|
---|
621 | try
|
---|
622 | Response := TListByte.Create;
|
---|
623 | SendPacket(toGetRegUserCount, nil, Response);
|
---|
624 | Result := Response[0] shl 8 + Response[1];
|
---|
625 | finally
|
---|
626 | Response.Free;
|
---|
627 | end;
|
---|
628 | end;
|
---|
629 |
|
---|
630 | function TTerminalBF630.GetUser(Index: Integer; User: TUser): Boolean;
|
---|
631 | var
|
---|
632 | Request: TListByte;
|
---|
633 | RequestSerializer: TBinarySerializer;
|
---|
634 | Response: TListByte;
|
---|
635 | I: Integer;
|
---|
636 | Title: Integer;
|
---|
637 | Department: Integer;
|
---|
638 | begin
|
---|
639 | try
|
---|
640 | Response := TListByte.Create;
|
---|
641 | Request := TListByte.Create;
|
---|
642 | RequestSerializer := TBinarySerializer.Create;
|
---|
643 | RequestSerializer.List := Request;
|
---|
644 | RequestSerializer.WriteInteger(Index);
|
---|
645 | SendPacket(toUserDataGet, Request, Response);
|
---|
646 | if Response[0] <> Id then raise Exception.Create(SWrongId);
|
---|
647 | Title := Response[4];
|
---|
648 | Department := Response[5];
|
---|
649 | User.FirstName := '';
|
---|
650 | for I := 0 to 14 do begin
|
---|
651 | if Response[14 + I] < 32 then Break;
|
---|
652 | User.FirstName := User.FirstName + Chr(Response[14 + I]);
|
---|
653 | end;
|
---|
654 | User.SecondName := '';
|
---|
655 | for I := 0 to 14 do begin
|
---|
656 | if Response[29 + I] < 32 then Break;
|
---|
657 | User.SecondName := User.SecondName + Chr(Response[29 + I]);
|
---|
658 | end;
|
---|
659 |
|
---|
660 | finally
|
---|
661 | Request.Free;
|
---|
662 | RequestSerializer.Free;
|
---|
663 | Response.Free;
|
---|
664 | end;
|
---|
665 | end;
|
---|
666 |
|
---|
667 | function TTerminalBF630.GetPassageCount: Integer;
|
---|
668 | var
|
---|
669 | Response: TListByte;
|
---|
670 | ResponseSerializer: TBinarySerializer;
|
---|
671 | begin
|
---|
672 | try
|
---|
673 | Response := TListByte.Create;
|
---|
674 | ResponseSerializer := TBinarySerializer.Create;
|
---|
675 | ResponseSerializer.List := Response;
|
---|
676 | SendPacket(toLogGetCount, nil, Response);
|
---|
677 | Result := ResponseSerializer.ReadInteger;
|
---|
678 | finally
|
---|
679 | Response.Free;
|
---|
680 | end;
|
---|
681 | end;
|
---|
682 |
|
---|
683 | function TTerminalBF630.GetPassage(Index: Integer; Passage: TUserPassage): Boolean;
|
---|
684 | var
|
---|
685 | Request: TListByte;
|
---|
686 | RequestSerializer: TBinarySerializer;
|
---|
687 | Response: TListByte;
|
---|
688 | ResponseSerializer: TBinarySerializer;
|
---|
689 | I: Integer;
|
---|
690 | Title: Integer;
|
---|
691 | Department: Integer;
|
---|
692 | Sec, Min, Hour: Byte;
|
---|
693 | Day, Month, Year: Byte;
|
---|
694 | FunctionKey: BYte;
|
---|
695 | Verify: Byte;
|
---|
696 | UserId: Integer;
|
---|
697 | InOutIndication: Byte;
|
---|
698 | VerificationSource: Byte;
|
---|
699 | begin
|
---|
700 | try
|
---|
701 | Response := TListByte.Create;
|
---|
702 | ResponseSerializer := TBinarySerializer.Create;
|
---|
703 | ResponseSerializer.List := Response;
|
---|
704 | Request := TListByte.Create;
|
---|
705 | RequestSerializer := TBinarySerializer.Create;
|
---|
706 | RequestSerializer.List := Request;
|
---|
707 | //RequestSerializer.WriteInteger(Id);
|
---|
708 | SendPacket(toLogGet, Request, Response);
|
---|
709 | with ResponseSerializer do begin
|
---|
710 | Sec := ReadByte;
|
---|
711 | Min := ReadByte;
|
---|
712 | Hour := ReadByte;
|
---|
713 | Day := ReadByte;
|
---|
714 | Month := ReadByte;
|
---|
715 | Year := ReadByte;
|
---|
716 | InOutIndication := ReadByte;
|
---|
717 | VerificationSource := ReadByte;
|
---|
718 | Verify := ReadByte;
|
---|
719 | FunctionKey := ReadByte;
|
---|
720 | UserId := ReadInteger;
|
---|
721 | end;
|
---|
722 |
|
---|
723 | Passage.Terminal := Id;
|
---|
724 | Passage.Time := EncodeDateTime(2000 + Year, Month, Day, Hour, Min, Sec, 0);
|
---|
725 | Passage.Operation := FunctionKey;
|
---|
726 | Passage.User := UserId;
|
---|
727 | finally
|
---|
728 | ResponseSerializer.Free;
|
---|
729 | Request.Free;
|
---|
730 | RequestSerializer.Free;
|
---|
731 | Response.Free;
|
---|
732 | end;
|
---|
733 | end;
|
---|
734 |
|
---|
735 | constructor TTerminalBF630.Create;
|
---|
736 | begin
|
---|
737 | inherited;
|
---|
738 | ReceiveData := TListByte.Create;
|
---|
739 | ReceiveDataThread := TListByte.Create;
|
---|
740 | ReceiveDataLock := TCriticalSection.Create;
|
---|
741 | CommSocket := TCommTCPClient.Create(nil);
|
---|
742 | Pin.Connect(CommSocket.Pin);
|
---|
743 | Pin.OnReceive := ReceiveDataHandler;
|
---|
744 | Timeout := 3 * OneSecond;
|
---|
745 | Address := 'localhost';
|
---|
746 | Port := 2000;
|
---|
747 | end;
|
---|
748 |
|
---|
749 | destructor TTerminalBF630.Destroy;
|
---|
750 | begin
|
---|
751 | Active := False;
|
---|
752 | FreeAndNil(CommSocket);
|
---|
753 | FreeAndNil(ReceiveDataLock);
|
---|
754 | FreeAndNil(ReceiveDataThread);
|
---|
755 | FreeAndNil(ReceiveData);
|
---|
756 | inherited Destroy;
|
---|
757 | end;
|
---|
758 |
|
---|
759 | end.
|
---|
760 |
|
---|