Changeset 24 for trunk/Modules


Ignore:
Timestamp:
Nov 19, 2012, 12:31:19 PM (12 years ago)
Author:
chronos
Message:
  • Opraveno: Ladění komunikačního protokolu s terminálem BF-630.
Location:
trunk/Modules
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/Modules/Attendance/UAccessControler.pas

    r20 r24  
    66
    77uses
    8   Classes, SysUtils;
     8  Classes, SysUtils, UAttendance, UCommPin;
    99
    1010type
    11 
    1211  { TAccessControler }
    1312
    1413  TAccessControler = class
    15 (*    function GetUser(Id: Integer): TUser;
    16     function GetUserCount: Integer;
    17     function GetPassage(Id: Integer): TPassage;
    18     function GetPassageCount: Integer;*)
     14  private
     15    FActive: Boolean;
     16  protected
     17    procedure SetActive(AValue: Boolean); virtual;
     18  public
     19    Id: Integer;
     20    Pin: TCommPin;
     21    constructor Create; virtual;
     22    destructor Destroy; override;
     23    function GetUser(Id: Integer; User: TUser): Boolean; virtual;
     24    function GetUserCount: Integer; virtual;
     25    function GetPassage(Id: Integer; Passage: TUserPassage): Boolean; virtual;
     26    function GetPassageCount: Integer; virtual;
     27    property Active: Boolean read FActive write SetActive;
    1928  end;
    2029
    … …  
    2332{ TAccessControler }
    2433
    25 (*function TAccessControler.GetUser(Id: Integer): TUser;
     34procedure TAccessControler.SetActive(AValue: Boolean);
     35begin
     36  if FActive = AValue then Exit;
     37  FActive := AValue;
     38end;
     39
     40constructor TAccessControler.Create;
     41begin
     42  Pin := TCommPin.Create;
     43  Id := 1;
     44end;
     45
     46destructor TAccessControler.Destroy;
     47begin
     48  FreeAndNil(Pin);
     49  inherited Destroy;
     50end;
     51
     52function TAccessControler.GetUser(Id: Integer; User: TUser): Boolean;
    2653begin
    2754
    … …  
    3360end;
    3461
    35 function TAccessControler.GetPassage(Id: Integer): TPassage;
     62function TAccessControler.GetPassage(Id: Integer; Passage: TUserPassage): Boolean;
    3663begin
    3764
    … …  
    4168begin
    4269
    43 end;*)
     70end;
    4471
    4572end.

  • trunk/Modules/Attendance/UFormVirtualTerminal.lfm

    r20 r24  
    55  Width = 353
    66  Caption = 'Virtual Access Controler'
     7  ClientHeight = 276
     8  ClientWidth = 353
    79  LCLVersion = '1.1'
     10  object SpinEditUser: TSpinEdit
     11    Left = 72
     12    Height = 21
     13    Top = 8
     14    Width = 83
     15    TabOrder = 0
     16  end
     17  object Label1: TLabel
     18    Left = 6
     19    Height = 13
     20    Top = 10
     21    Width = 37
     22    Caption = 'User id:'
     23    ParentColor = False
     24  end
     25  object Label2: TLabel
     26    Left = 7
     27    Height = 13
     28    Top = 41
     29    Width = 33
     30    Caption = 'Key id:'
     31    ParentColor = False
     32  end
     33  object SpinEditKey: TSpinEdit
     34    Left = 72
     35    Height = 21
     36    Top = 40
     37    Width = 82
     38    TabOrder = 1
     39  end
     40  object Label3: TLabel
     41    Left = 9
     42    Height = 13
     43    Top = 72
     44    Width = 26
     45    Caption = 'Time:'
     46    ParentColor = False
     47  end
     48  object LabelTime: TLabel
     49    Left = 72
     50    Height = 13
     51    Top = 72
     52    Width = 12
     53    Caption = '    '
     54    ParentColor = False
     55  end
     56  object ButtonPress: TButton
     57    Left = 72
     58    Height = 25
     59    Top = 113
     60    Width = 75
     61    Caption = 'Press'
     62    TabOrder = 2
     63  end
     64  object Timer1: TTimer
     65    OnTimer = Timer1Timer
     66    left = 241
     67    top = 78
     68  end
    869end

  • trunk/Modules/Attendance/UFormVirtualTerminal.lrt

    r20 r24  
    11TFORMVIRTUALACCESSCONTROLER.CAPTION=Virtual Access Controler
     2TFORMVIRTUALACCESSCONTROLER.LABEL1.CAPTION=User id:
     3TFORMVIRTUALACCESSCONTROLER.LABEL2.CAPTION=Key id:
     4TFORMVIRTUALACCESSCONTROLER.LABEL3.CAPTION=Time:
     5TFORMVIRTUALACCESSCONTROLER.LABELTIME.CAPTION=   
     6TFORMVIRTUALACCESSCONTROLER.BUTTONPRESS.CAPTION=Press

  • trunk/Modules/Attendance/UFormVirtualTerminal.pas

    r20 r24  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;
     8  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Spin,
     9  StdCtrls, ExtCtrls;
    910
    1011type
    … …  
    1213  end;
    1314
     15  { TFormVirtualAccessControler }
     16
    1417  TFormVirtualAccessControler = class(TForm)
     18    ButtonPress: TButton;
     19    Label1: TLabel;
     20    Label2: TLabel;
     21    Label3: TLabel;
     22    LabelTime: TLabel;
     23    SpinEditUser: TSpinEdit;
     24    SpinEditKey: TSpinEdit;
     25    Timer1: TTimer;
     26    procedure Timer1Timer(Sender: TObject);
    1527  private
    1628    { private declarations }
    … …  
    2638{$R *.lfm}
    2739
     40{ TFormVirtualAccessControler }
     41
     42procedure TFormVirtualAccessControler.Timer1Timer(Sender: TObject);
     43begin
     44  LabelTime.Caption := DateTimeToStr(Now);
     45end;
     46
    2847end.
    2948

  • trunk/Modules/Attendance/UModuleAttendance.lfm

    r20 r24  
    77  object ActionList1: TActionList
    88    Images = FormMain.ImageList1
    9     left = 300
    10     top = 104
     9    left = 160
     10    top = 56
    1111    object AReadFromTerminal: TAction
    1212      Caption = 'Read from terminal'
    … …  
    1515    end
    1616  end
     17  object PopupMenu1: TPopupMenu
     18    Images = FormMain.ImageList1
     19    left = 56
     20    top = 56
     21    object MenuItem1: TMenuItem
     22      Action = AReadFromTerminal
     23    end
     24  end
    1725end

  • trunk/Modules/Attendance/UModuleAttendance.pas

    r20 r24  
    77uses
    88  Classes, SysUtils, FileUtil, UModularSystem, UFormList, UFormEdit, Controls,
    9   SpecializedList, Forms, ActnList, UDataModel;
     9  SpecializedList, Forms, ActnList, Menus, UDataModel, Dialogs, SpecializedDictionary;
    1010
    1111type
    … …  
    1616    AReadFromTerminal: TAction;
    1717    ActionList1: TActionList;
     18    MenuItem1: TMenuItem;
     19    PopupMenu1: TPopupMenu;
    1820    procedure AReadFromTerminalExecute(Sender: TObject);
    1921  private
    … …  
    6870
    6971uses
    70   UFormMain, UCore;
     72  UFormMain, UCore, UTerminalBF630, UAccessControler, UAttendance;
    7173
    7274resourcestring
    … …  
    100102  SHoliday = 'Holiday';
    101103  SLog = 'Log';
     104  SUsersRead = 'User read: %s';
    102105
    103106{ TDataModuleAttendance }
    104107
    105108procedure TDataModuleAttendance.AReadFromTerminalExecute(Sender: TObject);
    106 begin
    107 
     109var
     110  AccessControler: TAccessControler;
     111  VirtualAccessControler: TVirtualTerminalBF630;
     112  UserCount: Integer;
     113  UserRec: TUser;
     114  Data: TDictionaryStringString;
     115  I: Integer;
     116begin
     117  Data := nil;
     118  UserRec := nil;
     119  AccessControler := nil;
     120  try
     121    VirtualAccessControler := TVirtualTerminalBF630.Create;
     122    VirtualAccessControler.InitDemoData;
     123    VirtualAccessControler.Active := True;
     124
     125    AccessControler := TTerminalBF630.Create;
     126    AccessControler.Active := True;
     127    UserCount := AccessControler.GetUserCount;
     128
     129    UserRec := TUser.Create;
     130    Data := TDictionaryStringString.Create;
     131    for I := 0 to UserCount - 1 do begin
     132      Data.Clear;
     133      AccessControler.GetUser(I, UserRec);
     134      Data.Add('FirstName', UserRec.FirstName);
     135      Data.Add('SecondName', UserRec.SecondName);
     136      Core.Database.Insert('User', Data);
     137    end;
     138    ShowMessage(SUsersRead + IntToStr(UserCount));
     139  finally
     140    if Assigned(Data) then Data.Free;
     141    if Assigned(UserRec) then UserRec.Free;
     142    if Assigned(AccessControler) then AccessControler.Free;
     143    VirtualAccessControler.Free;
     144  end;
    108145end;
    109146

  • trunk/Modules/ChiyuAccessControlers/UTerminalBF630.pas

    r23 r24  
    66
    77uses
    8   Classes, SysUtils, UBinarySerializer, UCommTCPServer, UCommPin, SyncObjs, DateUtils,
    9   SpecializedList, SpecializedStream, Forms, UCommTCPClient, Dialogs;
     8  Classes, SysUtils, UBinarySerializer, UCommTCPServer, UCommPin, SyncObjs,
     9  SpecializedList, SpecializedStream, Forms, UCommTCPClient, Dialogs, DateUtils,
     10  UAccessControler, UAttendance;
    1011
    1112const
    … …  
    4546    toAntiDuressGet = $97, toSrcurityBypassGetStatus = $98,
    4647    toTimeSet = $a6, toTimeZoneAdd = $a7, toGroupAdd = $a8,
    47     toDoorSettingSet = $a9, toHolidayAdd = $aa, toDesignationAdd = $ac,
     48    toDoorSettingSet = $a9, toHolidayAdd = $aa,
     49    toUserAdd = $ab, toDesignationAdd = $ac, toDepartmentAdd = $ad,
    4850    toTimeDel = $b6, toTimeZoneDel = $b7,  toGroupDel = $b8,
    4951    toSecurityBypass = $b9, toHolidayDel = $ba,
    50     toDesignationDel = $bc, toDepartmentAdd = $bd,
     52    toDesignationDel = $bc, toDepartmentDel = $bd,
    5153    toTimeDelAll = $c6, toZimeZoneDelAll = $c7, toGroupDelAll = $c8,
    5254    toHolidayDelAll = $ca, toDesignationDelAll = $cc, toDepartmentDelAll = $cd,
    … …  
    5961  { TTerminalBF630 }
    6062
    61   TTerminalBF630 = class
     63  TTerminalBF630 = class(TAccessControler)
    6264  private
    63     FActive: Boolean;
    6465    ReceiveData: TListByte;
    6566    ReceiveDataThread: TListByte;
    … …  
    6768    SendTime: TDateTime;
    6869    procedure ReceiveDataHandler(Sender: TCommPin; AList: TListByte);
    69     procedure SetActive(AValue: Boolean);
    7070    procedure WaitForBytes(Count: Integer);
     71  protected
     72    procedure SetActive(AValue: Boolean); override;
    7173  public
    72     Id: Integer;
    7374    CommSocket: TCommTCPClient;
    74     Pin: TCommPin;
    7575    AccessKey: array[0..5] of Byte;
    7676    UseAccessKey: Boolean;
    … …  
    8080    function SendPacket(Command: TTerminalOperation; Request: TListByte = nil; Response: TListByte = nil): Byte;
    8181    function ReadDateTime: TDateTime;
    82     function GetUserCount: Integer;
    83     property Active: Boolean read FActive write SetActive;
    84     constructor Create;
     82    function GetUserCount: Integer; override;
     83    function GetUser(Id: Integer; User: TUser): Boolean; override;
     84    constructor Create; override;
    8585    destructor Destroy; override;
    8686  end;
    … …  
    102102  TVirtualTerminalBF630User = class
    103103    Id: Integer;
    104     Name: string;
     104    FirstName: string;
     105    SecondName: string;
    105106  end;
    106107
    … …  
    139140resourcestring
    140141  SCommunicatiomTimeout = 'Communication timeout';
     142  SWrongId = 'Wrong id';
    141143
    142144{ TVirtualTerminalBF630Session }
    … …  
    155157  Command: Byte;
    156158  ResultCode: Byte;
    157   OldPos: Integer;
    158159begin
    159160  with Parent do
    … …  
    182183        Dec(DataLength, 6);
    183184      end;
    184       Request.Count := 0;
    185       Request.AddListPart(List, RecDataSerializer.Position, DataLength - 10);
    186       OldPos := Position;
     185      if (DataLength - 10) > 0 then begin
     186        Request.Count := 0;
     187        ReadList(Request, 0, DataLength - 10);
     188      end;
    187189      ExpectedCheckSum := 0;
    188       for I := 0 to OldPos - 1 do
     190      for I := 0 to Position - 1 do
    189191        ExpectedCheckSum := (ExpectedCheckSum + List[I]) and $ff;
    190       Position := OldPos;
    191192      CheckSum := ReadByte; // byte sum from ACK to DATA
    192193      if CheckSum <> ExpectedCheckSum then Exit;
    … …  
    282283var
    283284  UserId: Integer;
    284   RequestStream: TMemoryStreamByte;
    285   ResponseStream: TMemoryStreamByte;
    286   S: TStream;
    287 begin
    288   try
    289     RequestStream := TMemoryStreamByte.Create(Request);
    290     ResponseStream := TMemoryStreamByte.Create(Response);
    291     //UserId := RequestStream.ReadInteger;
    292     //ResponseStream.WriteInteger(UserId);
    293   finally
    294     RequestStream.Free;
    295     ResponseStream.Free;
     285  RequestSerializer: TBinarySerializer;
     286  ResponseSerializer: TBinarySerializer;
     287  I: Integer;
     288begin
     289  try
     290    RequestSerializer := TBinarySerializer.Create;
     291    RequestSerializer.List := Request;
     292    UserId := RequestSerializer.ReadInteger;
     293
     294    ResponseSerializer := TBinarySerializer.Create;
     295    ResponseSerializer.List := Response;
     296    with ResponseSerializer do begin
     297      WriteInteger(UserId);
     298      WriteByte(0);
     299      WriteByte(0);
     300      for I := 0 to 7 do WriteByte(0);
     301      with TVirtualTerminalBF630User(Users[UserId]) do
     302      for I := 1 to 15 do
     303        if I < Length(FirstName) then WriteByte(Ord(FirstName[I]))
     304         else WriteByte(0);
     305      with TVirtualTerminalBF630User(Users[UserId]) do
     306      for I := 1 to 15 do
     307        if I < Length(SecondName) then WriteByte(Ord(SecondName[I]))
     308          else WriteByte(0);
     309    end;
     310  finally
     311    RequestSerializer.Free;
     312    ResponseSerializer.Free;
    296313  end;
    297314end;
    … …  
    300317begin
    301318  if FActive = AValue then Exit;
    302   FActive := AValue;
     319  inherited;
    303320  CommSocket.Active := AValue;
    304321end;
    … …  
    331348  with TVirtualTerminalBF630User(Users.AddNew(TVirtualTerminalBF630User.Create)) do begin
    332349    Id := Users.Count;
    333     Name := 'User ' + IntToStr(Id);
     350    FirstName := 'User ' + IntToStr(Id);
     351    SecondName := 'Second ' + IntToStr(Id);
    334352  end;
    335353  with TVirtualTerminalBF630User(Users.AddNew(TVirtualTerminalBF630User.Create)) do begin
    336354    Id := Users.Count;
    337     Name := 'User ' + IntToStr(Id);
     355    FirstName := 'User ' + IntToStr(Id);
     356    SecondName := 'Second ' + IntToStr(Id);
    338357  end;
    339358end;
    … …  
    352371destructor TVirtualTerminalBF630.Destroy;
    353372begin
    354   CommSocket.Free;
    355   Users.Free;
    356   Sessions.Free;
     373  Active := False;
     374  FreeAndNil(CommSocket);
     375  FreeAndNil(Users);
     376  FreeAndNil(Sessions);
    357377  inherited Destroy;
    358378end;
    … …  
    372392procedure TTerminalBF630.SetActive(AValue: Boolean);
    373393begin
    374   if FActive = AValue then Exit;
     394  if Active = AValue then Exit;
     395  inherited;
    375396  CommSocket.Address := Address;
    376397  CommSocket.Port := Port;
    377398  CommSocket.Active := AValue;
    378   FActive := AValue;
    379399end;
    380400
    … …  
    410430  SendDataSerializer: TBinarySerializer;
    411431  SendDataStream: TMemoryStream;
    412   ResponseData: TListByte;
     432//  ResponseData: TListByte;
    413433  ResponseSerializer: TBinarySerializer;
    414434  CheckSum: Byte;
    … …  
    417437  DataLength: Cardinal;
    418438  DataByte: Byte;
    419   OldPos: Integer;
    420439begin
    421440  try
    … …  
    424443    SendDataSerializer.List := SendData;
    425444    SendDataStream := TMemoryStream.Create;
    426     ResponseData := TListByte.Create;
     445    //ResponseData := TListByte.Create;
    427446    ResponseSerializer := TBinarySerializer.Create;
    428     ResponseSerializer.List := ResponseData;
     447    ResponseSerializer.List := ReceiveData;
    429448
    430449    // Clear buffer
    … …  
    448467      WriteByte(Id); // TID
    449468      WriteByte(Byte(Command));
    450       if Assigned(Request) then
     469      if Assigned(Request) then begin
    451470        SendDataSerializer.WriteList(Request, 0, Request.Count);
     471      end;
    452472      if UseAccessKey then begin
    453473        WriteByte(AccessKey[0]);
    … …  
    471491      with ReceiveData, ResponseSerializer do begin
    472492        Endianness := enBig;
     493        ExpectedCheckSum := 0;
    473494        WaitForBytes(8);
    474495        DataByte := ReadByte;
    … …  
    478499        if ReadByte <> Id then raise Exception.Create('Wrong Id'); // STX
    479500        Result := ReadByte;
    480         OldPos := Position;
    481501        if Assigned(Response) then begin
     502          WaitForBytes(DataLength - 10);
    482503          Response.Count := 0;
    483           WaitForBytes(DataLength - 10);
    484 
    485           Response.AddListPart(ReceiveData, 0, DataLength - 10);
     504          Response.AddListPart(ReceiveData, Position, DataLength - 10);
     505          Position := Position + (DataLength - 10);
    486506        end;
    487         OldPos := Position;
    488         ExpectedCheckSum := 0;
    489         for I := 0 to OldPos - 1 do
     507        WaitForBytes(2);
     508        for I := 0 to Position - 1 do
    490509          ExpectedCheckSum := (ExpectedCheckSum + ReceiveData[I]) and $ff;
    491         Position := OldPos;
    492         WaitForBytes(2);
    493510        CheckSum := ReadByte; // byte sum from BS to DATA
    494         if CheckSum <> ExpectedCheckSum then raise Exception.Create('Bad receive checksum');
    495         if ReadByte <> CodeETX then raise Exception.Create('Expected ETX'); // ETX
     511        if CheckSum <> ExpectedCheckSum then
     512          raise Exception.Create('Bad receive checksum');
     513        if ReadByte <> CodeETX then
     514          raise Exception.Create('Expected ETX'); // ETX
    496515      end;
    497516    end;
    498517  finally
    499518    ResponseSerializer.Free;
    500     ResponseData.Free;
     519    //ResponseData.Free;
    501520    SendDataStream.Free;
    502521    SendDataSerializer.Free;
    … …  
    531550end;
    532551
     552function TTerminalBF630.GetUser(Id: Integer; User: TUser): Boolean;
     553var
     554  Request: TListByte;
     555  RequestSerializer: TBinarySerializer;
     556  Response: TListByte;
     557  I: Integer;
     558  Title: Integer;
     559  Department: Integer;
     560begin
     561  try
     562    Response := TListByte.Create;
     563    Request := TListByte.Create;
     564    RequestSerializer := TBinarySerializer.Create;
     565    RequestSerializer.List := Request;
     566    RequestSerializer.WriteInteger(Id);
     567    SendPacket(toUserDataGet, Request, Response);
     568    if Response[0] <> Id then raise Exception.Create(SWrongId);
     569    Title := Response[4];
     570    Department := Response[5];
     571    User.FirstName := '';
     572    for I := 0 to 14 do begin
     573      if Response[14 + I] < 32 then Break;
     574      User.FirstName := User.FirstName + Chr(Response[14 + I]);
     575    end;
     576    User.SecondName := '';
     577    for I := 0 to 14 do begin
     578      if Response[29 + I] < 32 then Break;
     579      User.SecondName := User.SecondName + Chr(Response[29 + I]);
     580    end;
     581
     582  finally
     583    Request.Free;
     584    RequestSerializer.Free;
     585    Response.Free;
     586  end;
     587end;
     588
    533589constructor TTerminalBF630.Create;
    534590begin
     591  inherited;
    535592  ReceiveData := TListByte.Create;
    536593  ReceiveDataThread := TListByte.Create;
    537594  ReceiveDataLock := TCriticalSection.Create;
    538595  CommSocket := TCommTCPClient.Create(nil);
    539   Pin := TCommPin.Create;
    540596  Pin.Connect(CommSocket.Pin);
    541597  Pin.OnReceive := ReceiveDataHandler;
    542598  Timeout := 3 * OneSecond;
    543   Id := 1;
     599  Address := 'localhost';
     600  Port := 2000;
    544601end;
    545602
    546603destructor TTerminalBF630.Destroy;
    547604begin
    548   Pin.Free;
    549   CommSocket.Free;
    550   ReceiveDataLock.Free;
    551   ReceiveDataThread.Free;
    552   ReceiveData.Free;
     605  Active := False;
     606  FreeAndNil(CommSocket);
     607  FreeAndNil(ReceiveDataLock);
     608  FreeAndNil(ReceiveDataThread);
     609  FreeAndNil(ReceiveData);
    553610  inherited Destroy;
    554611end;
Note: See TracChangeset for help on using the changeset viewer.