Changeset 24 for trunk


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
Files:
1 added
20 edited

Legend:

Unmodified
Added
Removed

  • trunk/ChronIS.lpi

    r23 r24  
    118118      </Item11>
    119119    </RequiredPackages>
    120     <Units Count="17">
     120    <Units Count="18">
    121121      <Unit0>
    122122        <Filename Value="ChronIS.lpr"/>
    … …  
    230230        <UnitName Value="UTerminalBF630"/>
    231231      </Unit16>
     232      <Unit17>
     233        <Filename Value="Application/UMenu.pas"/>
     234        <IsPartOfProject Value="True"/>
     235        <UnitName Value="UMenu"/>
     236      </Unit17>
    232237    </Units>
    233238  </ProjectOptions>

  • trunk/ChronIS.lpr

    r23 r24  
    1313  PrintPreview, UFormConnection, UModuleAttendance, UDataModel,
    1414  UFormVirtualTerminal, UAccessControler, UModuleChiyuAccessControlers,
    15   UTerminalBF630;
     15  UTerminalBF630, UMenu;
    1616
    1717{$R *.res}

  • trunk/Forms/UFormEdit.lfm

    r16 r24  
    11object FormEdit: TFormEdit
    2   Left = 368
    3   Height = 341
    4   Top = 172
    5   Width = 553
     2  Left = 297
     3  Height = 368
     4  Top = 145
     5  Width = 664
    66  Caption = 'Edit item'
    7   ClientHeight = 341
    8   ClientWidth = 553
     7  ClientHeight = 368
     8  ClientWidth = 664
    99  OnCreate = FormCreate
    1010  OnDestroy = FormDestroy
    1111  LCLVersion = '1.1'
    1212  object ButtonOk: TButton
    13     Left = 471
     13    Left = 582
    1414    Height = 25
    15     Top = 305
     15    Top = 291
    1616    Width = 75
    1717    Anchors = [akRight, akBottom]
    … …  
    2121  end
    2222  object ButtonCancel: TButton
    23     Left = 383
     23    Left = 582
    2424    Height = 25
    25     Top = 305
     25    Top = 251
    2626    Width = 75
    2727    Anchors = [akRight, akBottom]
    … …  
    3030    TabOrder = 1
    3131  end
    32   object Bevel1: TBevel
    33     Left = 8
    34     Height = 2
    35     Top = 297
    36     Width = 538
    37     Anchors = [akLeft, akRight, akBottom]
    38   end
    3932  object PanelControls: TPanel
    4033    Left = 8
    41     Height = 282
     34    Height = 308
    4235    Top = 8
    43     Width = 537
    44     Align = alTop
     36    Width = 567
     37    Align = alLeft
    4538    Anchors = [akTop, akLeft, akRight, akBottom]
    4639    BorderSpacing.Around = 8
    … …  
    4841    TabOrder = 2
    4942  end
     43  object ToolBarActions: TToolBar
     44    Left = 0
     45    Height = 44
     46    Top = 324
     47    Width = 664
     48    Align = alBottom
     49    ButtonHeight = 40
     50    ButtonWidth = 44
     51    Images = FormMain.ImageList1
     52    ParentShowHint = False
     53    ShowCaptions = True
     54    ShowHint = True
     55    TabOrder = 3
     56  end
    5057end

  • trunk/Forms/UFormEdit.pas

    r17 r24  
    4646
    4747  TFormEdit = class(TForm)
    48     Bevel1: TBevel;
    4948    ButtonOk: TButton;
    5049    ButtonCancel: TButton;
    5150    PanelControls: TPanel;
     51    ToolBarActions: TToolBar;
    5252    procedure FormCreate(Sender: TObject);
    5353    procedure FormDestroy(Sender: TObject);

  • trunk/Forms/UFormList.lfm

    r23 r24  
    345345  object PrintPreview1: TPrintPreview
    346346    Zoom = 1
     347    OnPrint = PrintPreview1Print
    347348    left = 240
    348349    top = 112

  • trunk/Forms/UFormList.pas

    r23 r24  
    8282    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
    8383      Selected: Boolean);
     84    procedure PrintPreview1Print(Sender: TObject);
    8485  private
    8586    FView: TDataViewList;
    … …  
    249250end;
    250251
     252procedure TFormList.PrintPreview1Print(Sender: TObject);
     253begin
     254
     255end;
     256
    251257procedure TFormList.SetView(AValue: TDataViewList);
    252258begin

  • trunk/Forms/UFormMain.lfm

    r14 r24  
    276276      end
    277277    end
     278    object MenuItem10: TMenuItem
     279      Caption = 'Test'
     280      object MenuItem11: TMenuItem
     281        Action = DataModuleAttendance.AReadFromTerminal
     282      end
     283    end
    278284    object MenuItem7: TMenuItem
    279285      Caption = 'Help'

  • trunk/Forms/UFormMain.lrt

    r14 r24  
    33TFORMMAIN.MENUITEM3.CAPTION=Database
    44TFORMMAIN.MENUITEM6.CAPTION=View
     5TFORMMAIN.MENUITEM10.CAPTION=Test
    56TFORMMAIN.MENUITEM7.CAPTION=Help
    67TFORMMAIN.AEXIT.CAPTION=Exit

  • trunk/Forms/UFormMain.pas

    r23 r24  
    2525    MainMenu1: TMainMenu;
    2626    MenuItem1: TMenuItem;
     27    MenuItem10: TMenuItem;
     28    MenuItem11: TMenuItem;
    2729    MenuItem3: TMenuItem;
    2830    MenuItem4: TMenuItem;
    … …  
    155157procedure TFormMain.FormShow(Sender: TObject);
    156158begin
     159  Core.CoolTranslator1.TranslateComponentRecursive(Application);
    157160  UpdateInterface;
    158161  AConnect.Execute;

  • trunk/Languages/ChronIS.cs.po

    r23 r24  
    195195msgstr "ChronIS"
    196196
     197#: tformmain.menuitem10.caption
     198msgid "Test"
     199msgstr ""
     200
    197201#: tformmain.menuitem3.caption
    198202msgid "Database"
    … …  
    217221msgstr "Nastavení"
    218222
     223#: tformvirtualaccesscontroler.buttonpress.caption
     224msgid "Press"
     225msgstr ""
     226
    219227#: tformvirtualaccesscontroler.caption
    220228msgid "Virtual Access Controler"
     229msgstr ""
     230
     231#: tformvirtualaccesscontroler.label1.caption
     232msgid "User id:"
     233msgstr ""
     234
     235#: tformvirtualaccesscontroler.label2.caption
     236msgid "Key id:"
     237msgstr ""
     238
     239#: tformvirtualaccesscontroler.label3.caption
     240msgid "Time:"
     241msgstr ""
     242
     243#: tformvirtualaccesscontroler.labeltime.caption
     244msgid "    "
    221245msgstr ""
    222246
    … …  
    533557msgstr "UÅŸivatel"
    534558
     559#: umoduleattendance.susersread
     560msgid "User read: %s"
     561msgstr ""
     562
    535563#: umoduleattendance.syear
    536564msgctxt "umoduleattendance.syear"
    … …  
    546574msgstr ""
    547575
     576#: uterminalbf630.swrongid
     577msgid "Wrong id"
     578msgstr ""
     579

  • trunk/Languages/ChronIS.po

    r23 r24  
    176176msgstr ""
    177177
     178#: tformmain.menuitem10.caption
     179msgid "Test"
     180msgstr ""
     181
    178182#: tformmain.menuitem3.caption
    179183msgid "Database"
    … …  
    196200msgstr ""
    197201
     202#: tformvirtualaccesscontroler.buttonpress.caption
     203msgid "Press"
     204msgstr ""
     205
    198206#: tformvirtualaccesscontroler.caption
    199207msgid "Virtual Access Controler"
     208msgstr ""
     209
     210#: tformvirtualaccesscontroler.label1.caption
     211msgid "User id:"
     212msgstr ""
     213
     214#: tformvirtualaccesscontroler.label2.caption
     215msgid "Key id:"
     216msgstr ""
     217
     218#: tformvirtualaccesscontroler.label3.caption
     219msgid "Time:"
     220msgstr ""
     221
     222#: tformvirtualaccesscontroler.labeltime.caption
     223msgid "    "
    200224msgstr ""
    201225
    … …  
    511535msgstr ""
    512536
     537#: umoduleattendance.susersread
     538msgid "User read: %s"
     539msgstr ""
     540
    513541#: umoduleattendance.syear
    514542msgctxt "umoduleattendance.syear"
    … …  
    524552msgstr ""
    525553
     554#: uterminalbf630.swrongid
     555msgid "Wrong id"
     556msgstr ""
     557

  • 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;

  • trunk/Packages/PinConnection/UCommTCPServer.pas

    r23 r24  
    7575    Mem := TMemoryStream.Create;
    7676    Stream.WriteToStream(Mem);
     77    Mem.Position := 0;
    7778    Socket.SendStreamRaw(Mem);
    7879  finally

  • trunk/Packages/TemplateGenerics/Additional/UBinarySerializer.pas

    r12 r24  
    3131    procedure WriteByte(Data: Byte);
    3232    procedure WriteWord(Data: Word);
     33    procedure WriteInteger(Data: Integer);
    3334    procedure WriteCardinal(Data: Cardinal);
    3435    procedure WriteInt64(Data: Int64);
    … …  
    4445    function ReadByte: Byte;
    4546    function ReadWord: Word;
     47    function ReadInteger: Integer;
    4648    function ReadCardinal: Cardinal;
    4749    function ReadInt64: Int64;
    … …  
    169171  Buffer: array of Byte;
    170172begin
    171   if Count > (List.Count - StartIndex) then Count := (List.Count - StartIndex); // Limit max. stream size
     173  //if Count > (List.Count - StartIndex) then
     174  //  Count := (List.Count - StartIndex); // Limit max. stream size
     175  List.Count := Count;
    172176  if Count > 0 then begin
    173177    SetLength(Buffer, Count);
    … …  
    242246  Result := 0;
    243247  Read(Result, SizeOf(Word));
     248  if SwapData then Result := SwapEndian(Result);
     249end;
     250
     251function TBinarySerializer.ReadInteger: Integer;
     252begin
     253  Result := 0;
     254  Read(Result, SizeOf(Integer));
    244255  if SwapData then Result := SwapEndian(Result);
    245256end;
    … …  
    376387end;
    377388
     389procedure TBinarySerializer.WriteInteger(Data: Integer);
     390begin
     391  if SwapData then Data := SwapEndian(Data);
     392  Write(Data, SizeOf(Integer));
     393end;
     394
    378395end.
    379396
Note: See TracChangeset for help on using the changeset viewer.