1 unit mainclient;
2 
3 {$IFDEF FPC}
4   {$MODE Delphi}
5 {$ENDIF}
6 
7 interface
8 uses
9 {$IFNDEF FPC}
10   Windows,
11 {$ELSE}
12   LCLIntf, LCLType, LMessages,
13 {$ENDIF}
14   SyncObjs, SysUtils, DateUtils, Variants, Classes, Graphics, Controls,
15   Forms, Dialogs,  StdCtrls, ComCtrls, Grids,
16   ExtCtrls, Buttons, sc_info, cp_info,
17   snap7;
18 
19 const
20   amPolling  = 0;
21   amEvent    = 1;
22   amCallBack = 2;
23 
24 type
25 
26   { TFormClient }
27 
28   TFormClient = class(TForm)
29     CBConnType: TComboBox;
30     CBPing: TCheckBox;
31     EdIp: TEdit;
32     BtnConnect: TButton;
33     EdLocTsapHI: TEdit;
34     EdRemTsapHI: TEdit;
35     EdLocTsapLO: TEdit;
36     EdRemTsapLO: TEdit;
37     EdRack: TEdit;
38     EdSlot: TEdit;
39     Label1: TLabel;
40     BtnDisconnect: TButton;
41     Label2: TLabel;
42     Label3: TLabel;
43     Label58: TLabel;
44     Label59: TLabel;
45     Label60: TLabel;
46     Label61: TLabel;
47     Label62: TLabel;
48     Label63: TLabel;
49     Label64: TLabel;
50     Label65: TLabel;
51     Label7: TLabel;
52     EdPDUSize: TStaticText;
53     PageControl: TPageControl;
54     PCC: TPageControl;
55     StatusBar: TStatusBar;
56     TabSheet1: TTabSheet;
57     Label4: TLabel;
58     LblDBNum: TLabel;
59     Label5: TLabel;
60     Label6: TLabel;
61     DataGrid: TStringGrid;
62     CbArea: TComboBox;
63     EdDBNum: TEdit;
64     EdStart: TEdit;
65     EdAmount: TEdit;
66     BtnRead: TButton;
67     BtnWrite: TButton;
68     BtnAsyncRead: TButton;
69     BtnAsyncWrite: TButton;
70     TabSheet2: TTabSheet;
71     TabSheet3: TTabSheet;
72     Label9: TLabel;
73     Label10: TLabel;
74     Label11: TLabel;
75     Label12: TLabel;
76     Label13: TLabel;
77     Label14: TLabel;
78     Label15: TLabel;
79     Label16: TLabel;
80     Label17: TLabel;
81     Label18: TLabel;
82     ComboArea_1: TComboBox;
83     EdDBNum_1: TEdit;
84     EdStart_1: TEdit;
85     EdAmount_1: TEdit;
86     EdData_1: TEdit;
87     ComboArea_2: TComboBox;
88     EdDBNum_2: TEdit;
89     EdStart_2: TEdit;
90     EdAmount_2: TEdit;
91     EdData_2: TEdit;
92     ComboArea_3: TComboBox;
93     EdDBNum_3: TEdit;
94     EdStart_3: TEdit;
95     EdAmount_3: TEdit;
96     EdData_3: TEdit;
97     ComboArea_4: TComboBox;
98     EdDBNum_4: TEdit;
99     EdStart_4: TEdit;
100     EdAmount_4: TEdit;
101     EdData_4: TEdit;
102     ComboArea_5: TComboBox;
103     EdDBNum_5: TEdit;
104     EdStart_5: TEdit;
105     EdAmount_5: TEdit;
106     EdData_5: TEdit;
107     MultiReadBtn: TButton;
108     TabSheet4: TTabSheet;
109     TabSheet8: TTabSheet;
110     TabZSL: TTabSheet;
111     TabClock: TTabSheet;
112     TabSheet7: TTabSheet;
113     TabSecurity: TTabSheet;
114     TabControl: TTabSheet;
115     RGMode: TRadioGroup;
116     CbWLen: TComboBox;
117     Label19: TLabel;
118     LblArea: TLabel;
119     MultiWriteBtn: TButton;
120     Label20: TLabel;
121     EdResult_1: TEdit;
122     Label21: TLabel;
123     EdResult_2: TEdit;
124     Label22: TLabel;
125     EdResult_3: TEdit;
126     Label23: TLabel;
127     EdResult_4: TEdit;
128     Label24: TLabel;
129     EdResult_5: TEdit;
130     Label25: TLabel;
131     GroupBox1: TGroupBox;
132     Label26: TLabel;
133     txtOB: TStaticText;
134     Label28: TLabel;
135     txtFB: TStaticText;
136     Label29: TLabel;
137     txtFC: TStaticText;
138     Label30: TLabel;
139     txtSFB: TStaticText;
140     Label31: TLabel;
141     txtSFC: TStaticText;
142     Label32: TLabel;
143     txtDB: TStaticText;
144     Label27: TLabel;
145     Label33: TLabel;
146     txtSDB: TStaticText;
147     BtnBlockList: TButton;
148     GroupBox2: TGroupBox;
149     cbBlock: TComboBox;
150     EdBlkNum: TEdit;
151     MemoBlk: TMemo;
152     BlkInfoBtn: TButton;
153     GroupBox3: TGroupBox;
154     CbBot: TComboBox;
155     BoTBtn: TButton;
156     ReadSZLBtn: TButton;
157     MemoSZL: TMemo;
158     EdID: TEdit;
159     Label34: TLabel;
160     Label35: TLabel;
161     EdIndex: TEdit;
162     AsReadSZLBtn: TButton;
163     lblSZLdump: TLabel;
164     TimClock: TTimer;
165     GrPGDateTime: TGroupBox;
166     ChkGetDateTime: TCheckBox;
167     grAGDateTime: TGroupBox;
168     Button7: TButton;
169     Label37: TLabel;
170     EdDBNumGet: TEdit;
171     LblDBDump: TLabel;
172     MemoDB: TMemo;
173     DBGetBtn: TButton;
174     AsDBGetBtn: TButton;
175     TabSheet6: TTabSheet;
176     GroupBox5: TGroupBox;
177     Label44: TLabel;
178     EdPdu: TEdit;
179     Label45: TLabel;
180     EdConnections: TEdit;
181     Label46: TLabel;
182     EdMpiRate: TEdit;
183     Label47: TLabel;
184     EdBusRate: TEdit;
185     GroupBox6: TGroupBox;
186     Label41: TLabel;
187     EdModuleTypeName: TEdit;
188     Label42: TLabel;
189     EdSerialNumber: TEdit;
190     Label43: TLabel;
191     EdCopyright: TEdit;
192     GroupBox7: TGroupBox;
193     Label40: TLabel;
194     edOrderCode: TEdit;
195     ListBot: TListBox;
196     LblDblClick: TLabel;
197     lbSZL: TListBox;
198     lblSZLCount: TLabel;
199     lblSZL: TLabel;
200     Label49: TLabel;
201     TimStatus: TTimer;
202     Button12: TButton;
203     Button13: TButton;
204     TabSheet5: TTabSheet;
205     cbBlkType: TComboBox;
206     EdNum: TEdit;
207     Label48: TLabel;
208     Label50: TLabel;
209     lblUpld: TLabel;
210     MemoUpload: TMemo;
211     UpBtn: TButton;
212     AsUpBtn: TButton;
213     ChkFull: TCheckBox;
214     MemoBlkInfo: TMemo;
215     lblNewNumber: TLabel;
216     EdNewNumber: TEdit;
217     DnBtn: TButton;
218     AsDnBtn: TButton;
219     BlkSaveBtn: TButton;
220     SaveDialog: TSaveDialog;
221     Button4: TButton;
222     OpenDialog: TOpenDialog;
223     Button14: TButton;
224     GroupBox4: TGroupBox;
225     lblStatus: TLabel;
226     Button9: TButton;
227     Button10: TButton;
228     Button11: TButton;
229     ChkStatusRefresh: TCheckBox;
230     BtnStatus: TButton;
231     EdVersion: TEdit;
232     Label36: TLabel;
233     Shape1: TShape;
234     Label51: TLabel;
235     EdASName: TEdit;
236     Label52: TLabel;
237     EdModuleName: TEdit;
238     Button1: TButton;
239     ChkSecurity: TCheckBox;
240     GroupBox8: TGroupBox;
241     EdPassword: TEdit;
242     Button5: TButton;
243     Button8: TButton;
244     TimSecurity: TTimer;
245     Panel1: TPanel;
246     RG_sch_schal: TRadioGroup;
247     RG_sch_par: TRadioGroup;
248     RG_sch_rel: TRadioGroup;
249     RG_bart_sch: TRadioGroup;
250     RG_anl_sch: TRadioGroup;
251     AsBotBtn: TButton;
252     GroupBox9: TGroupBox;
253     Label8: TLabel;
254     EdTimeout: TEdit;
255     Button3: TButton;
256     Button15: TButton;
257     Button16: TButton;
258     Button17: TButton;
259     ChEd_1: TEdit;
260     Label53: TLabel;
261     ChEd_2: TEdit;
262     ChEd_3: TEdit;
263     ChEd_4: TEdit;
264     ChEd_5: TEdit;
265     Label54: TLabel;
266     Label55: TLabel;
267     GroupBox10: TGroupBox;
268     Label56: TLabel;
269     Label57: TLabel;
270     EdDBFill: TEdit;
271     EdFill: TEdit;
272     FillBtn: TButton;
273     AsFillBtn: TButton;
274     Label38: TLabel;
275     Label39: TLabel;
276     edPGDate: TEdit;
277     edPGTime: TEdit;
278     edAGDate: TEdit;
279     edAGTime: TEdit;
280     procedure Button2Click(Sender: TObject);
281     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
282     procedure FormCreate(Sender: TObject);
283     procedure FormDestroy(Sender: TObject);
284     procedure BtnConnectClick(Sender: TObject);
285     procedure BtnDisconnectClick(Sender: TObject);
286     procedure CbAreaChange(Sender: TObject);
287     procedure DataGridDrawCell(Sender: TObject; ACol, ARow: Integer;
288       Rect: TRect; State: TGridDrawState);
289     procedure EdRackKeyPress(Sender: TObject; var Key: Char);
290     procedure DataGridExit(Sender: TObject);
291     procedure DataGridKeyPress(Sender: TObject; var Key: Char);
292     procedure BtnReadClick(Sender: TObject);
293     procedure BtnWriteClick(Sender: TObject);
294     procedure BtnAsyncReadClick(Sender: TObject);
295     procedure Label63Click(Sender: TObject);
296     procedure Label64Click(Sender: TObject);
297     procedure MultiReadBtnClick(Sender: TObject);
298     procedure RGModeClick(Sender: TObject);
299     procedure BtnAsyncWriteClick(Sender: TObject);
300     procedure MultiWriteBtnClick(Sender: TObject);
301     procedure BtnBlockListClick(Sender: TObject);
302     procedure BlkInfoBtnClick(Sender: TObject);
303     procedure ReadSZLBtnClick(Sender: TObject);
304     procedure EdIDKeyPress(Sender: TObject; var Key: Char);
305     procedure AsReadSZLBtnClick(Sender: TObject);
306     procedure PageControlChange(Sender: TObject);
307     procedure TimClockTimer(Sender: TObject);
308     procedure ChkGetDateTimeClick(Sender: TObject);
309     procedure Button7Click(Sender: TObject);
310     procedure DBGetBtnClick(Sender: TObject);
311     procedure AsDBGetBtnClick(Sender: TObject);
312     procedure BoTBtnClick(Sender: TObject);
313     procedure ListBotDblClick(Sender: TObject);
314     procedure CbBotCloseUp(Sender: TObject);
315     procedure lbSZLDblClick(Sender: TObject);
316     procedure Button9Click(Sender: TObject);
317     procedure Button10Click(Sender: TObject);
318     procedure Button11Click(Sender: TObject);
319     procedure txtOBDblClick(Sender: TObject);
320     procedure TimStatusTimer(Sender: TObject);
321     procedure Button12Click(Sender: TObject);
322     procedure Button13Click(Sender: TObject);
323     procedure UpBtnClick(Sender: TObject);
324     procedure AsUpBtnClick(Sender: TObject);
325     procedure ChkFullClick(Sender: TObject);
326     procedure DnBtnClick(Sender: TObject);
327     procedure AsDnBtnClick(Sender: TObject);
328     procedure BlkSaveBtnClick(Sender: TObject);
329     procedure Button4Click(Sender: TObject);
330     procedure Button5Click(Sender: TObject);
331     procedure Button8Click(Sender: TObject);
332     procedure Button14Click(Sender: TObject);
333     procedure BtnStatusClick(Sender: TObject);
334     procedure ChkStatusRefreshClick(Sender: TObject);
335     procedure Button1Click(Sender: TObject);
336     procedure TimSecurityTimer(Sender: TObject);
337     procedure ChkSecurityClick(Sender: TObject);
338     procedure AsBotBtnClick(Sender: TObject);
339     procedure Button3Click(Sender: TObject);
340     procedure Button15Click(Sender: TObject);
341     procedure Button16Click(Sender: TObject);
342     procedure Button17Click(Sender: TObject);
343     procedure FillBtnClick(Sender: TObject);
344     procedure AsFillBtnClick(Sender: TObject);
345     procedure MultiVarReadBtnClick(Sender: TObject);
346     procedure MultiVarWriteBtnClick(Sender: TObject);
347   private
348     { Private declarations }
349     Client : TS7Client;
350     FConnected: boolean;
351     FLastError: integer;
352     FLastOP: string;
353     Buffer : TS7Buffer;
354     BlkBuffer  : TS7Buffer;
355     BlkBufSize : integer;
356     DataItems : TS7DataItems;
357     BlocksList : TS7BlocksList;
358     BlockInfo : TS7BlockInfo;
359     AsMode : integer;
360     AsOpResult : integer;
WordSizenull361     function WordSize(Amount, WordLength : integer) : integer;
362     procedure CheckArea;
363     procedure SetFConnected(const Value: boolean);
364     procedure SetFLastError(const Value: integer);
365     procedure ValidateGrid;
366     procedure ClientConnect;
367     procedure ClientDisconnect;
368     procedure FillBlockInfo(Memo : TMemo; Info : PS7BlockInfo);
369     procedure DataToGrid(Amount : integer);
370     procedure GridToData(Amount : integer);
371     procedure DumpData(P : PS7Buffer; Memo : TMemo; Count : integer);
372     procedure Read(Async : boolean);
373     procedure Write(Async : boolean);
374     procedure DBFill(ASync : boolean);
375     procedure MultiRead;
376     procedure MultiWrite;
377     procedure DBGet(Async : boolean);
378     procedure ListBlocks;
379     procedure GetBlockInfo;
380     procedure ListBlocksOfType(Async : boolean);
381     procedure Upload(Full, Async : boolean);
382     procedure GetSysInfo;
383     procedure ReadSZL(Async : boolean);
384     procedure ReadSZLList(Async : boolean);
385     procedure SetFLastOP(const Value: string);
386     procedure Elapse; overload;
387     procedure Elapse(TotTime : cardinal); overload;
388     procedure WaitCompletion(Const Timeout : integer = 1500);
389     procedure ClearPages;
390     procedure ClearSystemInfo;
391     procedure ClearMultiReadWrite;
392     procedure ClearDirectory;
393     procedure ClearSZL;
394     procedure ClearDBGet;
395     procedure ClearUpDownload;
396     procedure ClearProtection;
397     procedure GetStatus;
398     procedure GetProtection(const DoShowInfo : boolean = true);
399     procedure SetPassword;
400     procedure ClearPassword;
401     procedure CopyRamToRom(Async : boolean);
402     procedure Compress(Async : boolean);
403     procedure FillBlkBuffer(p : pointer; Size : integer);
404     procedure ClearBlkBuffer;
405     procedure SaveToFile(Const FileName : string; P : pointer; Size : integer);
406     procedure DeleteBlock;
LoadFromFilenull407     function LoadFromFile(Const FileName : string; P : pointer; var Size : integer) : boolean;
CliErrornull408     function CliError(Error : integer) : string;
CliTimenull409     function CliTime : cardinal;
CliPDULengthnull410     function CliPDULength : integer;
411   public
412     EvJob : TEvent;
413     JobDone : boolean;
414     { Public declarations }
415     property Connected : boolean read FConnected write SetFConnected;
416     property LastOP : string read FLastOP write SetFLastOP;
417     property LastError : integer read FLastError write SetFLastError;
418   end;
419 
420 var
421   FormClient: TFormClient;
422 
423 implementation
424 
425 {$R *.lfm}
426 
427 // This procedure is called by client when AsyncMode = amCallBack
428 procedure ClientCompletion(usrPtr : pointer; opCode, opResult : integer);
429 {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
430 begin
431   // in this demo we have nothing to do : set an event
432   TFormClient(usrPtr).AsOpResult:=opResult;
433 end;
434 
435 const
436   AreaOf : array[0..5] of byte = (
437     S7AreaDB, S7AreaPE, S7AreaPA, S7AreaMK, S7AreaTM, S7AreaCT
438   );
439 
440   WLenOf : array[0..14] of integer = (
441     S7WLBit,
442     S7WLByte,
443     S7WLChar,
444     S7WLWord,
445     S7WLInt,
446     S7WLDWord,
447     S7WLDInt,
448     S7WLReal,
449     S7WLDate,
450     S7WLTOD,
451     S7WLTime,
452     S7WLS5Time,
453     S7WLDT,
454     S7WLCounter,
455     S7WLTimer
456   );
457 
458   SizeByte : array[0..14] of integer = (
459     1, 1, 1, 2, 2, 4, 4, 4, 2, 4, 4, 2, 8, 2, 2
460   );
461 
462   BlockOf : array[0..6] of integer = (
463     Block_OB, Block_FB, Block_FC, Block_DB, Block_SFB, Block_SFC, Block_SDB
464   );
465 
LangOfnull466 function LangOf(Lang : integer) : string;
467 begin
468   case Lang of
469     BlockLangAWL   : Result:='AWL';
470     BlockLangKOP   : Result:='KOP';
471     BlockLangFUP   : Result:='FUP';
472     BlockLangSCL   : Result:='SCL';
473     BlockLangDB    : Result:='DB';
474     BlockLangGRAPH : Result:='GRAPH';
475   else
476     Result:='Unknown';
477   end;
478 end;
479 
SubBlkOfnull480 function SubBlkOf(SubBlk : integer) : string;
481 begin
482   case SubBlk of
483     SubBlk_OB  : Result:='OB';
484     SubBlk_DB  : Result:='DB';
485     SubBlk_SDB : Result:='SDB';
486     SubBlk_FC  : Result:='FC';
487     SubBlk_SFC : Result:='SFC';
488     SubBlk_FB  : Result:='FB';
489     SubBlk_SFB : Result:='SFB';
490   else
491     Result:='Unknown';
492   end;
493 end;
494 
495 procedure TFormClient.BtnConnectClick(Sender: TObject);
496 begin
497   ClientConnect;
498 end;
499 
500 procedure TFormClient.BtnDisconnectClick(Sender: TObject);
501 begin
502   ClientDisconnect;
503 end;
504 
505 procedure TFormClient.BtnReadClick(Sender: TObject);
506 begin
507   Read(false);
508 end;
509 
510 procedure TFormClient.BtnWriteClick(Sender: TObject);
511 begin
512   Write(false);
513 end;
514 
515 procedure TFormClient.AsReadSZLBtnClick(Sender: TObject);
516 begin
517   ReadSZL(true);
518 end;
519 
520 procedure TFormClient.Button10Click(Sender: TObject);
521 begin
522   Client.PlcHotStart;
523 end;
524 
525 procedure TFormClient.Button11Click(Sender: TObject);
526 begin
527   Client.PlcColdStart;
528 end;
529 
530 procedure TFormClient.Button12Click(Sender: TObject);
531 begin
532   ReadSZLList(false);
533 end;
534 
535 procedure TFormClient.Button13Click(Sender: TObject);
536 begin
537   GetSysInfo;
538 end;
539 
540 procedure TFormClient.Button14Click(Sender: TObject);
541 begin
542   DeleteBlock;
543 end;
544 
545 procedure TFormClient.Button15Click(Sender: TObject);
546 begin
547   CopyRamToRom(true);
548 end;
549 
550 procedure TFormClient.Button16Click(Sender: TObject);
551 begin
552   Compress(false);
553 end;
554 
555 procedure TFormClient.Button17Click(Sender: TObject);
556 begin
557   Compress(true);
558 end;
559 
560 procedure TFormClient.Button1Click(Sender: TObject);
561 begin
562   GetProtection;
563 end;
564 
565 procedure TFormClient.BtnStatusClick(Sender: TObject);
566 begin
567   GetStatus;
568 end;
569 
570 procedure TFormClient.ClearPages;
571 begin
572   ClearSystemInfo;
573   ClearMultiReadWrite;
574   ClearDirectory;
575   ClearSZL;
576   ClearDBGet;
577   ClearUpDownload;
578   ClearProtection;
579 end;
580 
581 procedure TFormClient.ClearPassword;
582 begin
583   LastOp:='Clear Session password';
584   LastError:=Client.ClearSessionPassword;
585   Elapse;
586 end;
587 
588 procedure TFormClient.ClearProtection;
589 begin
590   RG_sch_schal.ItemIndex:=0;
591   RG_sch_par.ItemIndex:=0;
592   RG_sch_rel.ItemIndex:=0;
593   RG_bart_sch.ItemIndex:=0;
594   RG_anl_sch.ItemIndex:=0;
595 end;
596 
597 procedure TFormClient.UpBtnClick(Sender: TObject);
598 begin
599   Upload(ChkFull.Checked,false);
600 end;
601 
602 procedure TFormClient.AsUpBtnClick(Sender: TObject);
603 begin
604   Upload(ChkFull.Checked,true);
605 end;
606 
607 procedure TFormClient.BtnBlockListClick(Sender: TObject);
608 begin
609   ListBlocks;
610 end;
611 
612 procedure TFormClient.Button3Click(Sender: TObject);
613 begin
614   CopyRamToRom(false)
615 end;
616 
617 procedure TFormClient.Button4Click(Sender: TObject);
618 Var
619   Size : integer;
620 begin
621   if OpenDialog.Execute then
622   begin
623     if LoadFromFile(OpenDialog.FileName,@BlkBuffer,Size) then
624     begin
625       FillBlkBuffer(@BlkBuffer,Size);
626       Client.GetPgBlockInfo(@BlkBuffer,@BlockInfo,Size);
627       FillBlockInfo(MemoBlkInfo,@BlockInfo);
628       DumpData(@BlkBuffer,MemoUpload,Size);
629       lblUpld.Caption:='Block Dump : '+IntToStr(Size)+' byte'
630     end;
631   end;
632 end;
633 
634 
635 procedure TFormClient.Button5Click(Sender: TObject);
636 begin
637   SetPassword;
638 end;
639 
640 procedure TFormClient.BlkSaveBtnClick(Sender: TObject);
641 begin
642   if SaveDialog.Execute then
643     SaveToFile(SaveDialog.FileName,@BlkBuffer,BlkBufSize);
644 end;
645 
646 procedure TFormClient.Button7Click(Sender: TObject);
647 Var
648   DT : TDateTime;
649   AGDate : TDateTime;
650   AGTime : TDateTime;
651 begin
652   TimClock.Enabled:=false;
653   LastOp:='Set PLC Date and Time';
654   if not ChkGetDateTime.Checked then
655   begin
656     if TryStrToDate(edAGDate.Text,AGDate) and TryStrToTime(edAGTime.Text,AGTime) then
657     begin
658       DT:=AGDate+AGTime;
659       LastError:=Client.SetPlcDateTime(DT);
660     end
661     else
662       MessageDlg('Date and/or Time format error',mtError,[mbOk],0);
663   end
664   else
665     LastError:=Client.SetPlcSystemDateTime;
666   Elapse;
667   ChkGetDateTime.Checked:=true;
668   TimClock.Enabled:=true;
669 end;
670 
671 procedure TFormClient.Button8Click(Sender: TObject);
672 begin
673   ClearPassword;
674 end;
675 
676 procedure TFormClient.ReadSZLBtnClick(Sender: TObject);
677 begin
678   ReadSZL(false);
679 end;
680 
681 procedure TFormClient.ReadSZLList(Async: boolean);
682 Var
683   SZLList : TS7SZLList;
684   Count : integer;
685   c: Integer;
686 begin
687   LastOp:='Read SZL List';
688   lblSZL.Visible:=false;
689   lbSZL.Items.Clear;
690   Count:=SizeOf(SZLList);
691   LastError:=Client.ReadSZLList(@SZLList,Count);
692   if LastError=0 then
693   begin
694     for c := 0 to Count - 1 do
695       lbSZL.Items.Add('$'+IntToHex(SZLList.List[c],4));
696     lblSZL.Visible:=lbSZL.Items.Count>0;
697   end;
698   lblSZLCount.Caption:='List of All SZL IDs : '+inttostr(Count);
699   Elapse;
700 end;
701 
702 procedure TFormClient.Button9Click(Sender: TObject);
703 begin
704   Client.PlcStop;
705 end;
706 
707 procedure TFormClient.AsBotBtnClick(Sender: TObject);
708 begin
709   ListBlocksOfType(true);
710 end;
711 
712 procedure TFormClient.AsDBGetBtnClick(Sender: TObject);
713 begin
714   DBGet(true);
715 end;
716 
717 procedure TFormClient.AsDnBtnClick(Sender: TObject);
718 Var
719   BlockNum : integer;
720 begin
721   LastOp:='Async Download';
722   BlockNum:=StrToIntDef(EdNewNumber.Text,0);EdNewNumber.Text:=IntToStr(BlockNum);
723   LastError:=Client.AsDownload(BlockNum,@BlkBuffer,BlkBufSize);
724   if LastError=0 then
725     WaitCompletion;
726   Elapse;
727 end;
728 
729 procedure TFormClient.AsFillBtnClick(Sender: TObject);
730 begin
731   DBFill(true);
732 end;
733 
734 procedure TFormClient.GetBlockInfo;
735 Var
736   BlockType : integer;
737   BlockNum  : integer;
738 
739 begin
740   BlockType:=BlockOf[cbBlock.ItemIndex];
741   BlockNum:=StrToIntDef(EdBlkNum.Text,0);
742   fillchar(BlockInfo,SizeOf(TS7BlockInfo),#0);
743   MemoBlk.Lines.Clear;
744   LastOP:='Block Info';
745   LastError:=Client.GetAgBlockInfo(BlockType,BlockNum,@BlockInfo);
746 
747   if LastError=0 then
748   begin
749     if LastError=0 then
750       FillBlockInfo(MemoBlk,@BlockInfo);
751   end;
752   Elapse;
753 end;
754 
755 procedure TFormClient.GetProtection(const DoShowInfo : boolean = true);
756 Var
757   Info : TS7Protection;
758 
759   procedure SetRGValue(RG : TRadioGroup; Value : word);
760   begin
761     if Value>RG.Items.Count-1 then
762       RG.ItemIndex:=0
763     else
764       RG.ItemIndex:=Value;
765   end;
766 
767 begin
768   if DoShowInfo then
769     LastOp:='Get Protection Info';
770 
771   LastError:=Client.GetProtection(@Info);
772   if LastError=0 then
773   begin
774     SetRGValue(RG_sch_schal,Info.sch_schal);
775     SetRGValue(RG_sch_par,Info.sch_par);
776     SetRGValue(RG_sch_rel,Info.sch_rel);
777     SetRGValue(RG_bart_sch,Info.bart_sch);
778     SetRGValue(RG_anl_sch,Info.anl_sch);
779   end;
780   if DoShowInfo then
781     Elapse;
782 end;
783 
784 procedure TFormClient.GetStatus;
785 Var
786   Status : integer;
787 
788   procedure Run;
789   begin
790     lblStatus.Font.Color:=clGreen;
791     lblStatus.Caption:='RUN';
792   end;
793 
794   procedure Stop;
795   begin
796     lblStatus.Font.Color:=clRed;
797     lblStatus.Caption:='STOP';
798   end;
799 
800   procedure Unknown;
801   begin
802     lblStatus.Font.Color:=clGray;
803     lblStatus.Caption:='Unknown';
804   end;
805 
806 begin
807   LastOp:='Get Plc Status';
808   LastError:=Client.GetPlcStatus(Status);
809   if LastError=0 then
810   begin
811     case Status of
812       S7CpuStatusUnknown : Unknown;
813       S7CpuStatusRun     : Run;
814       S7CpuStatusStop    : Stop;
815     end;
816   end
817   else
818     Unknown;
819   Elapse;
820 end;
821 
822 procedure TFormClient.GetSysInfo;
823 Var
824   OrderCode : TS7OrderCode;
825   CpuInfo : TS7CpuInfo;
826   CpInfo  : TS7CpInfo;
827   TotTime : Cardinal;
828 begin
829   LastOp:='Get System Info';
830   ClearSystemInfo;
831   TotTime:=0;
832 
833   LastError:=Client.GetOrderCode(@OrderCode);
834   if LastError=0 then
835   begin
836     EdOrderCode.Text:=String(OrderCode.Code);
837     EdVersion.Text:='V '+IntToStr(OrderCode.V1)+'.'+
838                        IntToStr(OrderCode.V2)+'.'+
839                        IntToStr(OrderCode.V3);
840   end
841   else begin
842     EdOrderCode.Text:='NO INFO AVAILABLE';
843     EdVersion.Text:='';
844   end;
845 
846   Inc(TotTime,CliTime);
847 
848   LastError:=Client.GetCpuInfo(@CpuInfo);
849   if LastError=0 then
850   begin
851     EdModuleTypeName.Text :=String(CpuInfo.ModuleTypeName);
852     EdSerialNumber.Text   :=String(CpuInfo.SerialNumber);
853     EdCopyright.Text      :=String(CpuInfo.Copyright);
854     EdASName.Text         :=String(CpuInfo.ASName);
855     EdModuleName.Text     :=String(CpuInfo.ModuleName);
856   end;
857 
858   Inc(TotTime,CliTime);
859 
860   LastError:=Client.GetCPInfo(@CpInfo);
861   if LastError=0 then
862   begin
863     EdPdu.Text:=IntToStr(CpInfo.MaxPduLengt);
864     EdConnections.Text:=IntToStr(CpInfo.MaxConnections);
865     EdMpiRate.Text:=IntToStr(CpInfo.MaxMpiRate);
866     EdBusRate.Text:=IntToStr(CpInfo.MaxBusRate);
867   end;
868 
869   Inc(TotTime,CliTime);
870   Elapse(TotTime);
871 end;
872 
873 procedure TFormClient.BlkInfoBtnClick(Sender: TObject);
874 begin
875   GetBlockInfo;
876 end;
877 
878 procedure TFormClient.BoTBtnClick(Sender: TObject);
879 begin
880   ListBlocksOfType(false);
881 end;
882 
883 procedure TFormClient.BtnAsyncReadClick(Sender: TObject);
884 begin
885   Read(true);
886 end;
887 
888 procedure TFormClient.Label63Click(Sender: TObject);
889 begin
890   SmartConnectInfo.ShowModal;
891 end;
892 
893 procedure TFormClient.Label64Click(Sender: TObject);
894 begin
895   ParamsConnectInfo.ShowModal;
896 end;
897 
898 procedure TFormClient.BtnAsyncWriteClick(Sender: TObject);
899 begin
900   Write(true);
901 end;
902 
903 procedure TFormClient.ClearBlkBuffer;
904 begin
905   fillchar(BlkBuffer,SizeOf(BlkBuffer),#0);
906   BlkBufSize:=0;
907   DnBtn.Enabled:=false;
908   AsDnBtn.Enabled:=false;
909   BlkSaveBtn.Enabled:=false;
910   EdNewNumber.Enabled:=false;
911 end;
912 
913 procedure TFormClient.ClearDBGet;
914 begin
915   EdDBNumGet.Text:='1';
916   LblDBDump.Caption:='DB Dump : 0 bytes';
917   MemoDB.Lines.Clear;
918 end;
919 
920 procedure TFormClient.ClearDirectory;
921 begin
922   txtOB.Caption:='0';
923   txtFB.Caption:='0';
924   txtFC.Caption:='0';
925   txtDB.Caption:='0';
926   txtSFB.Caption:='0';
927   txtSFC.Caption:='0';
928   txtSDB.Caption:='0';
929   cbBot.ItemIndex:=0;
930   cbBlock.ItemIndex:=0;
931   EdBlkNum.Text:='1';
932   ListBot.Items.Clear;
933   MemoBlk.Lines.Clear;
934 end;
935 
936 procedure TFormClient.ClearMultiReadWrite;
937 begin
938   fillchar(DataItems,SizeOf(TS7DataItems),#0);
939   EdData_1.Text:='';EDResult_1.Text:='';
940   EdData_2.Text:='';EDResult_2.Text:='';
941   EdData_3.Text:='';EDResult_3.Text:='';
942   EdData_4.Text:='';EDResult_4.Text:='';
943   EdData_5.Text:='';EDResult_5.Text:='';
944 end;
945 
946 procedure TFormClient.ClearSystemInfo;
947 begin
948   EdOrderCode.Text       :='INFO NOT AVAILABLE';
949   EdVersion.Text         :='';
950   EdModuleTypeName.Text  :='INFO NOT AVAILABLE';
951   EdSerialNumber.Text    :='INFO NOT AVAILABLE';
952   EdCopyright.Text       :='INFO NOT AVAILABLE';
953   EdModuleName.Text      :='INFO NOT AVAILABLE';
954   EdASName.Text          :='INFO NOT AVAILABLE';
955   EdPdu.Text             :='INFO NOT AVAILABLE';
956   EdConnections.Text     :='INFO NOT AVAILABLE';
957   EdMpiRate.Text         :='INFO NOT AVAILABLE';
958   EdBusRate.Text         :='INFO NOT AVAILABLE';
959 end;
960 
961 procedure TFormClient.ClearSZL;
962 begin
963   lbSZL.Items.Clear;
964   MemoSZL.Lines.Clear;
965   EdID.Text:='$0011';
966   EdIndex.Text:='$0000';
967 end;
968 
969 procedure TFormClient.ClearUpDownload;
970 begin
971   cbBlkType.ItemIndex:=0;
972   EdNum.Text:='1';
973   lblUpld.Caption:='Block Dump : 0 byte';
974   MemoUpload.Lines.Clear;
975   MemoBlkInfo.Lines.Clear;
976   EdNewNumber.Text:='1';
977 end;
978 
979 procedure TFormClient.ClientConnect;
980 Var
981   Rack, Slot : integer;
982   ConnType   : word;
983   RemoteAddress : AnsiString;
984   LocalTsapHI  : integer;
985   LocalTsapLO  : integer;
986   RemoteTsapHI : integer;
987   RemoteTsapLO : integer;
988   LocalTsap    : word;
989   RemoteTsap   : word;
990   PingTime     : integer;
991 
GetCharnull992   function GetChar(ED : TEdit) : integer;
993   Var
994     B : byte;
995   begin
996     B:=StrToIntDef('$'+Ed.Text,0);
997     Ed.Text:=IntToHex(B,2);
998     Result:=B;
999   end;
1000 
1001 begin
1002   LastOP:='Connection';
1003   RemoteAddress:=AnsiString(EdIp.Text);
1004 
1005   if not CBPing.Checked then
1006   begin
1007     PingTime:=0;
1008     LastError:=Client.SetParam(p_i32_PingTimeout,@PingTime);
1009     if LastError<>0 then
1010       exit;
1011   end;
1012 
1013 
1014   if PCC.PageIndex=0 then
1015   begin
1016     ConnType:=CBConnType.ItemIndex+1;
1017     Rack:=StrToIntDef(EdRack.Text,0);
1018     Slot:=StrToIntDef(EdSlot.Text,0);
1019     Client.SetConnectionType(ConnType);
1020     LastError:=Client.ConnectTo(RemoteAddress,Rack,Slot);
1021   end
1022   else begin
1023     LocalTsapHI  :=GetChar(EdLocTsapHI);
1024     LocalTsapLO  :=GetChar(EdLocTsapLO);
1025     RemoteTsapHI :=GetChar(EdRemTsapHI);
1026     RemoteTsapLO :=GetChar(EdRemTsapLO);
1027     LocalTsap    :=LocalTsapHI shl 8 + LocalTsapLO;
1028     RemoteTsap   :=RemoteTsapHI shl 8 + RemoteTsapLO;
1029     Client.SetConnectionParams(RemoteAddress, LocalTSAP, RemoteTSAP);
1030     LastError    :=Client.Connect;
1031   end;
1032 
1033   Elapse;
1034   Connected:=LastError=0;
1035   if Connected then
1036     EdPduSize.Caption:=' '+IntToStr(CliPDULength);
1037 end;
1038 
1039 procedure TFormClient.ClientDisconnect;
1040 begin
1041   LastOP:='Disconnection';
1042   Client.Disconnect;
1043   Elapse;
1044   LastError:=0;
1045   Connected:=false;
1046   EdPduSize.Caption:=' 0';
1047 end;
1048 
TFormClient.CliPDULengthnull1049 function TFormClient.CliPDULength: integer;
1050 begin
1051   Result:=Client.PDULength;
1052 end;
1053 
CliTimenull1054 function TFormClient.CliTime: cardinal;
1055 begin
1056   Result:=Client.Time;
1057 end;
1058 
1059 procedure TFormClient.Compress(Async: boolean);
1060 Var
1061   Timeout : integer;
1062 begin
1063   if ChkStatusRefresh.Checked then
1064   begin
1065     ShowMessage('First switch off the Status cyclic refresh');
1066     exit;
1067   end;
1068 
1069   Timeout:=StrToIntDef(EdTimeout.Text,0);EdTimeout.Text:=IntToStr(Timeout);
1070   if Timeout<1 then
1071   begin
1072     MessageDlg('Invalid Timeout value', mtError,[mbOk],0);
1073     exit;
1074   end;
1075 
1076   if ASync then
1077     LastOp:='Async Compress'
1078   else
1079     LastOp:='Compress';
1080 
1081   if ASync then
1082     LastError:=Client.AsCompress(Timeout)
1083   else
1084     LastError:=Client.Compress(Timeout);
1085 
1086   if ASync then
1087     WaitCompletion(Timeout);
1088 
1089   Elapse;
1090 end;
1091 
1092 procedure TFormClient.CopyRamToRom(Async: boolean);
1093 Var
1094   Timeout : integer;
1095 begin
1096   if ChkStatusRefresh.Checked then
1097   begin
1098     ShowMessage('First switch off the Status cyclic refresh');
1099     exit;
1100   end;
1101 
1102   ShowMessage('Remember that this function works only if the CPU is in STOP');
1103 
1104   Timeout:=StrToIntDef(EdTimeout.Text,0);EdTimeout.Text:=IntToStr(Timeout);
1105   if Timeout<1 then
1106   begin
1107     MessageDlg('Invalid Timeout value', mtError,[mbOk],0);
1108     exit;
1109   end;
1110 
1111   if ASync then
1112     LastOp:='Async Copy Ram to Rom'
1113   else
1114     LastOp:='Copy Ram to Rom';
1115 
1116   if ASync then
1117     LastError:=Client.AsCopyRamToRom(Timeout)
1118   else
1119     LastError:=Client.CopyRamToRom(Timeout);
1120 
1121   if ASync then
1122     WaitCompletion(Timeout);
1123 
1124   Elapse;
1125 end;
1126 
1127 procedure TFormClient.CbAreaChange(Sender: TObject);
1128 Var
1129   Cb : TComboBox;
1130 begin
1131   Cb:=TComboBox(Sender);
1132 
1133   if Cb=CbArea then
1134   begin
1135     LblDBNum.Visible:=Cb.ItemIndex=0;
1136     EdDBNum.Visible :=Cb.ItemIndex=0;
1137     CheckArea;
1138   end;
1139 
1140   if Cb=CbWLen then
1141     CheckArea;
1142 
1143   if Cb=ComboArea_1 then
1144     EdDBNum_1.Visible:=Cb.ItemIndex=0;
1145   if Cb=ComboArea_2 then
1146     EdDBNum_2.Visible:=Cb.ItemIndex=0;
1147   if Cb=ComboArea_3 then
1148     EdDBNum_3.Visible:=Cb.ItemIndex=0;
1149   if Cb=ComboArea_4 then
1150     EdDBNum_4.Visible:=Cb.ItemIndex=0;
1151   if Cb=ComboArea_5 then
1152     EdDBNum_5.Visible:=Cb.ItemIndex=0;
1153 end;
1154 
1155 procedure TFormClient.CbBotCloseUp(Sender: TObject);
1156 begin
1157   ListBot.Items.Clear;
1158   LblDblClick.Visible:=false;
1159 end;
1160 
1161 procedure TFormClient.CheckArea;
1162 begin
1163   LblArea.Visible:=((CbArea.ItemIndex=4) and (cbWLen.ItemIndex<>14)) or
1164                    ((CbArea.ItemIndex=5) and (cbWLen.ItemIndex<>13)) or
1165                    ((CbArea.ItemIndex<>4) and (cbWLen.ItemIndex=14)) or
1166                    ((CbArea.ItemIndex<>5) and (cbWLen.ItemIndex=13));
1167 end;
1168 
1169 procedure TFormClient.ChkFullClick(Sender: TObject);
1170 begin
1171   DnBtn.Visible       :=ChkFull.Checked;
1172   AsDnBtn.Visible     :=ChkFull.Checked;
1173   EdNewNumber.Visible :=ChkFull.Checked;
1174   lblNewNumber.Visible:=ChkFull.Checked;
1175 end;
1176 
1177 procedure TFormClient.ChkGetDateTimeClick(Sender: TObject);
1178 begin
1179   if ChkGetDateTime.Checked then
1180   begin
1181     edAGDate.Color:=clWindow;
1182     edAGTime.Color:=clWindow;
1183     grAGDateTime.Enabled:=false;
1184   end
1185   else begin
1186     edAGDate.Color:=clYellow;
1187     edAGTime.Color:=clYellow;
1188     grAGDateTime.Enabled:=true;
1189   end;
1190 end;
1191 
1192 procedure TFormClient.ChkSecurityClick(Sender: TObject);
1193 begin
1194   TimSecurity.Enabled:=ChkSecurity.Checked;
1195 end;
1196 
1197 procedure TFormClient.ChkStatusRefreshClick(Sender: TObject);
1198 begin
1199   BtnStatus.Enabled:=not ChkStatusRefresh.Checked;
1200 end;
1201 
1202 procedure TFormClient.DataGridDrawCell(Sender: TObject; ACol, ARow: Integer;
1203   Rect: TRect; State: TGridDrawState);
1204 Var
1205   aRect : TRect;
1206   aText : string;
1207   Style : TTextStyle;
1208 begin
1209   with Sender as TStringGrid do
1210   begin
1211     ARect:=Rect;
1212     AText:=Cells[ACol,ARow];
1213     if (ACol=0) or (ARow=0) then
1214       Canvas.Brush.Color:=clbtnface
1215     else
1216       Canvas.Brush.Color:=clWhite;
1217 
1218     Canvas.FillRect(Rect);
1219     Style.Alignment:=taCenter;
1220     Style.Clipping:=true;
1221     Style.ExpandTabs:=false;
1222     Style.Layout:=tlCenter;
1223     Style.ShowPrefix:=false;
1224     Style.Wordbreak:=false;
1225     Style.SystemFont:=false;
1226     Style.RightToLeft:=false;
1227 
1228     Canvas.TextRect(ARect, 0,0, AText,Style);
1229 
1230     if gdfocused in State then
1231     begin
1232       Canvas.Brush.Color:=clRed;
1233       Canvas.FrameRect(ARect);
1234     end;
1235 
1236   end;
1237 end;
1238 
1239 procedure TFormClient.DataGridExit(Sender: TObject);
1240 begin
1241   ValidateGrid;
1242 end;
1243 
1244 procedure TFormClient.DataGridKeyPress(Sender: TObject; var Key: Char);
1245 begin
1246   if Key=#13 then
1247     ValidateGrid;
1248 end;
1249 
1250 procedure TFormClient.DataToGrid(Amount: integer);
1251 Var
1252  x, c, r : integer;
1253 begin
1254   with DataGrid do
1255   begin
1256     c:=1;r:=1;
1257     for x := 0 to Amount - 1 do
1258     begin
1259       Cells[c,r]:='$'+IntToHex(Buffer[x],2);
1260       inc(c);
1261       if c=ColCount then
1262       begin
1263         c:=1;
1264         inc(r);
1265       end;
1266     end;
1267     Row:=1;
1268     Col:=1;
1269     SetFocus;
1270   end;
1271 end;
1272 
1273 procedure TFormClient.DBFill(ASync: boolean);
1274 Var
1275   B : byte;
1276   DBNum : integer;
1277 begin
1278   if ASync then
1279     LastOp:='Async DB Fill'
1280   else
1281     LastOp:='DB Fill';
1282 
1283   B:=StrToIntDef(EdFill.Text,0);
1284   EdFill.Text:='$'+IntToHex(B,2);
1285   DBNum:=StrToIntDef(EdDBFill.Text,0);
1286   EdDBFill.Text:=IntToStr(DBNum);
1287 
1288   if ASync then
1289     LastError:=Client.AsDBFill(DBNum,B)
1290   else
1291     LastError:=Client.DBFill(DBNum,B);
1292 
1293   if LastError=0 then
1294   begin
1295     if Async then
1296       WaitCompletion;
1297   end;
1298   Elapse;
1299 end;
1300 
1301 procedure TFormClient.DBGet(Async: boolean);
1302 Var
1303   DBNum : integer;
1304   Size : integer;
1305 begin
1306   if ASync then
1307     LastOP:='Async DB Get'
1308   else
1309     LastOP:='DB Get';
1310   MemoDB.Lines.Clear;
1311   LblDBDump.Caption:='DB Dump : 0 bytes';
1312   DBNum:=StrToIntDef(EdDBNumGet.Text,0);EdDBNumGet.Text:=IntToStr(DBNum);
1313   Size:=SizeOf(Buffer);
1314   if Async then
1315     LastError:=Client.AsDBGet(DBNum,@Buffer,Size)
1316   else
1317     LastError:=Client.DBGet(DBNum,@Buffer,Size);
1318 
1319   if LastError=0 then
1320   begin
1321     if Async then
1322       WaitCompletion;
1323     if LastError=0 then
1324     begin
1325       LblDBDump.Caption:='DB Dump : '+IntToStr(Size)+' bytes';
1326       DumpData(@Buffer,MemoDB,Size);
1327     end;
1328     Elapse;
1329   end
1330   else
1331     Elapse;
1332 
1333 end;
1334 
1335 procedure TFormClient.DBGetBtnClick(Sender: TObject);
1336 begin
1337   DBGet(false);
1338 end;
1339 
1340 procedure TFormClient.DeleteBlock;
1341 Var
1342   BlockType, BlockNumber : integer;
1343 begin
1344   if MessageDlg('Are you sure ?',mtWarning,[mbYes,mbNo],0)<>mrYes then
1345     exit;
1346 
1347   ClearBlkBuffer;
1348   LastOp :='Delete Block';
1349 
1350   MemoUpload.Lines.Clear;
1351   MemoBlkInfo.Lines.Clear;
1352 
1353   BlockType:=BlockOf[cbBlkType.ItemIndex];
1354   BlockNumber:=StrToIntDef(EdNum.Text,0);EdNum.Text:=IntToStr(BlockNumber);
1355   LastError:=Client.Delete(BlockType,BlockNumber);
1356   Elapse;
1357 end;
1358 
1359 procedure TFormClient.DnBtnClick(Sender: TObject);
1360 Var
1361   BlockNum : integer;
1362 begin
1363   LastOp:='Download';
1364   BlockNum:=StrToIntDef(EdNewNumber.Text,0);EdNewNumber.Text:=IntToStr(BlockNum);
1365   LastError:=Client.Download(BlockNum,@BlkBuffer,BlkBufSize);
1366   Elapse;
1367 end;
1368 
1369 procedure TFormClient.DumpData(P : PS7Buffer; Memo: TMemo; Count: integer);
1370 Var
1371   SHex, SChr : string;
1372   Ch : AnsiChar;
1373   c, cnt : integer;
1374 begin
1375   Memo.Lines.Clear;
1376   Memo.Lines.BeginUpdate;
1377   SHex:='';SChr:='';cnt:=0;
1378   try
1379     for c := 0 to Count - 1 do
1380     begin
1381       SHex:=SHex+IntToHex(P^[c],2)+' ';
1382       Ch:=AnsiChar(P^[c]);
1383       if not (Ch in ['a'..'z','A'..'Z','0'..'9','_','$','-',#32]) then
1384         Ch:='.';
1385       SChr:=SChr+String(Ch);
1386       inc(cnt);
1387       if cnt=16 then
1388       begin
1389         Memo.Lines.Add(SHex+'  '+SChr);
1390         SHex:='';SChr:='';
1391         cnt:=0;
1392       end;
1393     end;
1394     // Dump remainder
1395     if cnt>0 then
1396     begin
1397       while Length(SHex)<48 do
1398         SHex:=SHex+' ';
1399       Memo.Lines.Add(SHex+'  '+SChr);
1400     end;
1401   finally
1402     Memo.Lines.EndUpdate;
1403   end;
1404 end;
1405 
1406 procedure TFormClient.EdIDKeyPress(Sender: TObject; var Key: Char);
1407 begin
1408   if not (Key in [#8,'0'..'9','$','A','a','B','b','C','c','D','d','E','e','F','f']) then
1409     Key:=#0;
1410 end;
1411 
1412 procedure TFormClient.EdRackKeyPress(Sender: TObject; var Key: Char);
1413 begin
1414   if not (Key in [#8,'0'..'9']) then
1415      Key:=#0;
1416 end;
1417 
1418 procedure TFormClient.Elapse(TotTime: cardinal);
1419 begin
1420   StatusBar.Panels[1].Text:=IntToStr(TotTime)+' ms';
1421 end;
1422 
1423 procedure TFormClient.Elapse;
1424 begin
1425   Elapse(CliTime);
1426 end;
1427 
CliErrornull1428 function TFormClient.CliError(Error: integer): string;
1429 begin
1430    Result:=CliErrorText(Error);
1431 end;
1432 
1433 procedure TFormClient.FillBlkBuffer(p: pointer; Size: integer);
1434 begin
1435   move(P^,BlkBuffer,Size);
1436   BlkBufSize:=Size;
1437   DnBtn.Enabled:=true;
1438   AsDnBtn.Enabled:=true;
1439   EdNewNumber.Enabled:=true;
1440   BlkSaveBtn.Enabled:=true;
1441 end;
1442 
1443 procedure TFormClient.FillBlockInfo(Memo: TMemo; Info: PS7BlockInfo);
1444 
ByteToBinnull1445   function ByteToBin(B : Byte) : string;
1446   Const
1447     Mask : array[1..8] of byte = ($80,$40,$20,$10,$08,$04,$02,$01);
1448   var
1449     c: Integer;
1450   begin
1451     Result:='00000000';
1452     for c := 8 downto 1 do
1453       if (B and Mask[c])<>0 then
1454         Result[c]:='1';
1455   end;
1456 
1457 begin
1458   with Memo.Lines do
1459   begin
1460     Clear;
1461     BeginUpdate;
1462     Add('Block Type   : '+SubBlkOf(Info^.BlkType));
1463     Add('Block Number : '+IntToStr(Info^.BlkNumber));
1464     Add('Block Lang   : '+LangOf(Info^.BlkLang));
1465     Add('Block Flags  : '+ByteToBin(Info^.BlkFlags));
1466     Add('MC7 Size     : '+IntToStr(Info^.MC7Size));
1467     Add('Load Size    : '+IntToStr(Info^.LoadSize));
1468     Add('Local Data   : '+IntToStr(Info^.LocalData));
1469     Add('SBB Length   : '+IntToStr(Info^.SBBLength));
1470     Add('CheckSum     : '+'$'+IntToHex(Info^.CheckSum,4));
1471     Add('Version      : '+IntToHex((Info^.Version and $F0) shr 4,1)+'.'+IntToHex((Info^.Version and $0F),1));
1472     Add('Code Date    : '+Info^.CodeDate);
1473     Add('Intf.Date    : '+Info^.IntfDate);
1474     Add('Author       : '+Info^.Author);
1475     Add('Family       : '+Info^.Family);
1476     Add('Header       : '+Info^.Header);
1477     EndUpdate;
1478   end;
1479 end;
1480 
1481 procedure TFormClient.FillBtnClick(Sender: TObject);
1482 begin
1483   DBFill(False);
1484 end;
1485 
1486 procedure TFormClient.FormCreate(Sender: TObject);
1487 var
1488   c: Integer;
1489   ThePlatform : string;
1490   Wide : string;
1491 begin
1492   // Infamous trick to get the platform size
1493   // Maybe it could not work ever, but we need only a form caption....
1494   case SizeOf(NativeUint) of
1495      4 : Wide := ' [32 bit]';
1496      8 : Wide := ' [64 bit]';
1497     else Wide := ' [?? bit]';
1498   end;
1499   {$IFDEF MSWINDOWS}
1500      ThePlatform:='Windows platform';
1501   {$ELSE}
1502      ThePlatform:='Unix platform';
1503      CBPing.Visible:=false;
1504   {$ENDIF}
1505      Caption:='Snap7 Client Demo - '+ThePlatform+Wide+
1506   {$IFDEF FPC}
1507     ' [Lazarus]';
1508   {$ELSE}
1509     ' [Delphi/RAD studio]';
1510   {$ENDIF}
1511 
1512   EvJob:=TEvent.Create(nil,false,false,'');
1513   Client := TS7Client.Create;
1514   RGMode.ItemIndex:=0;
1515   Connected:=false;
1516   ClearBlkBuffer;
1517   // Init Grid
1518   with DataGrid do
1519   begin
1520     DefaultColWidth:=32;
1521     ColWidths[0]:=48;
1522     DefaultRowHeight:=18;
1523     ColCount:=17;
1524     RowCount:=4097;
1525     for c := 1 to ColCount - 1 do
1526       Cells[c,0]:=inttohex(c-1,2);
1527 
1528     for c := 1 to RowCount - 1 do
1529       Cells[0,c]:=inttohex((c-1)*16,4);
1530   end;
1531   ValidateGrid;
1532   WindowState:=wsNormal;
1533 end;
1534 
1535 procedure TFormClient.Button2Click(Sender: TObject);
1536 begin
1537 end;
1538 
1539 
1540 procedure TFormClient.FormClose(Sender: TObject; var CloseAction: TCloseAction);
1541 begin
1542   Client.Free;
1543   EvJob.Free;
1544 end;
1545 
1546 procedure TFormClient.FormDestroy(Sender: TObject);
1547 begin
1548 end;
1549 
1550 procedure TFormClient.GridToData(Amount: integer);
1551 Var
1552   c, r, x : integer;
1553 begin
1554   ValidateGrid;
1555   with DataGrid do
1556   begin
1557     c:=1;r:=1;
1558     for x := 0 to Amount- 1 do
1559     begin
1560       Buffer[x]:=StrToIntDef(Cells[c,r],0);
1561       inc(c);
1562       if c=ColCount then
1563       begin
1564         c:=1;
1565         inc(r);
1566       end;
1567     end;
1568   end;
1569 end;
1570 
1571 procedure TFormClient.lbSZLDblClick(Sender: TObject);
1572 begin
1573   if (lbSZL.Items.Count>0) and (lbSZL.ItemIndex>=0) then
1574   begin
1575     EdID.Text:=lbSZL.Items[lbSZL.ItemIndex];
1576     ReadSZL(false);
1577   end;
1578 end;
1579 
1580 procedure TFormClient.ListBlocks;
1581 
1582   procedure UpdateCount;
1583   begin
1584     with BlocksList do
1585     begin
1586       txtOB.Caption :=IntToStr(OBCount);
1587       txtFB.Caption :=IntToStr(FBCount);
1588       txtFC.Caption :=IntToStr(FCCount);
1589       txtSFB.Caption:=IntToStr(SFBCount);
1590       txtSFC.Caption:=IntToStr(SFCCount);
1591       txtDB.Caption :=IntToStr(DBCount);
1592       txtSDB.Caption:=IntToStr(SDBCount);
1593     end;
1594   end;
1595 
1596 begin
1597   LastOP:='Blocks List';
1598   FillChar(BlocksList,SizeOf(BlocksList),#0);
1599   UpdateCount;
1600   LastError:=Client.ListBlocks(@BlocksList);
1601   if LastError=0 then
1602   begin
1603     Elapse;
1604     if LastError=0 then
1605       UpdateCount;
1606   end
1607   else
1608     Elapse;
1609 end;
1610 
1611 procedure TFormClient.ListBlocksOfType(Async: boolean);
1612 Var
1613   List : TS7BlocksOfType;
1614   Count: integer;
1615   BlockType : integer;
1616   c: Integer;
1617 begin
1618   if Async then
1619     LastOp:='Async List Blocks of type'
1620   else
1621     LastOp:='List Blocks of type';
1622 
1623   BlockType:=BlockOf[CbBot.ItemIndex];
1624   ListBot.Clear;
1625 
1626   Count:=SizeOf(List) div 2;
1627 
1628   if Async then
1629     LastError:=Client.AsListBlocksOfType(BlockType,@List,Count)
1630   else
1631     LastError:=Client.ListBlocksOfType(BlockType,@List,Count);
1632 
1633   if LastError=0 then
1634   begin
1635     if Async then
1636       WaitCompletion;
1637     if LastError=0 then
1638     begin
1639       ListBot.Items.BeginUpdate;
1640       try
1641         for c := 0 to Count - 1 do
1642           ListBot.Items.Add(IntToStr(List[c]));
1643       finally
1644         ListBot.Items.EndUpdate;
1645       end;
1646     end;
1647   end;
1648   Elapse;
1649 end;
1650 
1651 procedure TFormClient.ListBotDblClick(Sender: TObject);
1652 begin
1653   if (ListBot.Items.Count>0) and (ListBot.ItemIndex>=0) then
1654   begin
1655     EdBlkNum.Text:=ListBot.Items[ListBot.ItemIndex];
1656     CbBlock.ItemIndex:=CbBot.ItemIndex;
1657     GetBlockInfo;
1658   end;
1659 end;
1660 
LoadFromFilenull1661 function TFormClient.LoadFromFile(const FileName: string; P: pointer;
1662   var Size: integer) : boolean;
1663 Var
1664   F : file of byte;
1665   FSize : integer;
1666   Read : integer;
1667 
1668   procedure Error;
1669   begin
1670     MessageDlg('An error occurred loading '+FileName,mtError,[mbOk],0);
1671   end;
1672 
1673 begin
1674   AssignFile(F,FileName);
1675   {$I-}
1676   Reset(F);
1677   {$I+}
1678   Result:=IoResult=0;
1679   if not Result then
1680   begin
1681     Error;
1682     exit;
1683   end;
1684   {$I-}
1685   FSize:=FileSize(F);
1686   BlockRead(F,P^,FSize,Read);
1687   CloseFile(F);
1688   {$I+}
1689   Result:=(IoResult=0) and (Read=FSize);
1690   if not Result then
1691     Error
1692   else
1693     Size:=FSize;
1694 end;
1695 
1696 procedure TFormClient.MultiRead;
1697 
1698   procedure GetValues(CbArea : TComboBox; EdDB,EDStart,EDSize : TEdit; var PlcArea,DBNum,Start,Size : integer);
1699   begin
1700     DBNum:=StrToIntDef(EdDB.Text,0);
1701     EdDB.Text:=IntToStr(DBNum);
1702     Start:=StrToIntDef(EDStart.Text,0);
1703     EDStart.Text:=IntToStr(Start);
1704     Size:=StrToIntDef(EdSize.Text,0);
1705     EdSize.Text:=IntToStr(Size);
1706     PlcArea:=AreaOf[CbArea.ItemIndex];
1707   end;
1708 
HexStringnull1709   function HexString(ptr : pbyte; size : integer) : string;
1710   var
1711     c: Integer;
1712     P : PS7Buffer;
1713   begin
1714     Result:='';
1715     P:=PS7Buffer(Ptr);
1716     for c := 0 to Size - 1 do
1717       Result:=Result+'$'+IntToHex(P^[c],2)+' ';
1718   end;
1719 
1720 var
1721   c: Integer;
1722 begin
1723   LastOP:='Read MultiVars';
1724 
1725   ClearMultiReadWrite;
1726   // Items
1727   GetValues(ComboArea_1,EdDBNum_1,EdStart_1,EdAmount_1,DataItems[0].Area,DataItems[0].DBNumber,DataItems[0].Start,DataItems[0].Amount);
1728   GetValues(ComboArea_2,EdDBNum_2,EdStart_2,EdAmount_2,DataItems[1].Area,DataItems[1].DBNumber,DataItems[1].Start,DataItems[1].Amount);
1729   GetValues(ComboArea_3,EdDBNum_3,EdStart_3,EdAmount_3,DataItems[2].Area,DataItems[2].DBNumber,DataItems[2].Start,DataItems[2].Amount);
1730   GetValues(ComboArea_4,EdDBNum_4,EdStart_4,EdAmount_4,DataItems[3].Area,DataItems[3].DBNumber,DataItems[3].Start,DataItems[3].Amount);
1731   GetValues(ComboArea_5,EdDBNum_5,EdStart_5,EdAmount_5,DataItems[4].Area,DataItems[4].DBNumber,DataItems[4].Start,DataItems[4].Amount);
1732 
1733   if (DataItems[0].Amount=0) or
1734      (DataItems[1].Amount=0) or
1735      (DataItems[2].Amount=0) or
1736      (DataItems[3].Amount=0) or
1737      (DataItems[4].Amount=0) then
1738   begin
1739     MessageDlg('Size 0 not allowed',mtError,[mbOk],0);
1740     exit;
1741   end;
1742 
1743   // Note: for this demo we assume Wordlen=byte unless Area is Timer or counter.
1744   //       In real application see the documentation
1745   for c := 0 to 4 do
1746     if DataItems[c].Area=S7AreaCT then DataItems[c].WordLen:=S7WLCounter else
1747       if DataItems[c].Area=S7AreaTM then DataItems[c].WordLen:=S7WLTimer else
1748         DataItems[c].WordLen:=S7WLByte;
1749 
1750   // Calcs the size needed
1751   for c := 0 to 4 do
1752     GetMem(DataItems[c].pdata,WordSize(DataItems[c].Amount,DataItems[c].WordLen));
1753 
1754   LastError:=Client.ReadMultiVars(@DataItems,5);
1755 
1756   if LastError=0 then
1757   begin
1758     Elapse;
1759     if LastError=0 then
1760     begin
1761       if DataItems[0].Result=0 then
1762       begin
1763         EdData_1.Text:=HexString(DataItems[0].pdata,WordSize(DataItems[0].Amount,DataItems[0].WordLen));
1764         EdResult_1.Text:='OK';
1765       end
1766       else
1767         EdResult_1.Text:=CliError(DataItems[0].Result);
1768 
1769       if DataItems[1].Result=0 then
1770       begin
1771         EdData_2.Text:=HexString(DataItems[1].pdata,WordSize(DataItems[1].Amount,DataItems[1].WordLen));
1772         EdResult_2.Text:='OK';
1773       end
1774       else
1775         EdResult_2.Text:=CliError(DataItems[1].Result);
1776 
1777       if DataItems[2].Result=0 then
1778       begin
1779         EdData_3.Text:=HexString(DataItems[2].pdata,WordSize(DataItems[2].Amount,DataItems[2].WordLen));
1780         EdResult_3.Text:='OK';
1781       end
1782       else
1783         EdResult_3.Text:=CliError(DataItems[2].Result);
1784 
1785       if DataItems[3].Result=0 then
1786       begin
1787         EdData_4.Text:=HexString(DataItems[3].pdata,WordSize(DataItems[3].Amount,DataItems[3].WordLen));
1788         EdResult_4.Text:='OK';
1789       end
1790       else
1791         EdResult_4.Text:=CliError(DataItems[3].Result);
1792 
1793       if DataItems[4].Result=0 then
1794       begin
1795         EdData_5.Text:=HexString(DataItems[4].pdata,WordSize(DataItems[4].Amount,DataItems[4].WordLen));
1796         EdResult_5.Text:='OK';
1797       end
1798       else
1799         EdResult_5.Text:=CliError(DataItems[4].Result);
1800     end;
1801   end
1802   else
1803     Elapse;
1804 
1805   for c := 0 to 4 do
1806     FreeMem(DataItems[c].pdata,WordSize(DataItems[c].Amount,DataItems[c].WordLen));
1807 end;
1808 
1809 procedure TFormClient.MultiReadBtnClick(Sender: TObject);
1810 begin
1811   MultiRead;
1812 end;
1813 
1814 procedure TFormClient.MultiVarReadBtnClick(Sender: TObject);
1815 begin
1816 end;
1817 
1818 procedure TFormClient.MultiVarWriteBtnClick(Sender: TObject);
1819 begin
1820 end;
1821 
1822 procedure TFormClient.MultiWrite;
1823 
1824   procedure GetValues(CbArea : TComboBox; EdDB,EDStart,EDSize : TEdit; var PlcArea,DBNum,Start,Size : integer);
1825   begin
1826     DBNum:=StrToIntDef(EdDB.Text,0);
1827     EdDB.Text:=IntToStr(DBNum);
1828     Start:=StrToIntDef(EDStart.Text,0);
1829     EDStart.Text:=IntToStr(Start);
1830     Size:=StrToIntDef(EdSize.Text,0);
1831     EdSize.Text:=IntToStr(Size);
1832     PlcArea:=AreaOf[CbArea.ItemIndex];
1833   end;
1834 
1835   procedure EditToBuffer(ChEd: TEdit; p: Pbyte);
1836   var
1837     c: Integer;
1838     pb : PS7Buffer;
1839     B : byte;
1840   begin
1841     B:=StrToIntDef(ChEd.Text,0);
1842     ChEd.Text:='$'+IntToHex(B,2);
1843 
1844     pb:=PS7Buffer(p);
1845     for c := 0 to 15 do
1846       pb^[c]:=B;
1847   end;
1848 
1849 var
1850   c: Integer;
1851 begin
1852   LastOP:='Write MultiVars';
1853 
1854   fillchar(DataItems,SizeOf(TS7DataItems),#0);
1855   // Items
1856   GetValues(ComboArea_1,EdDBNum_1,EdStart_1,EdAmount_1,DataItems[0].Area,DataItems[0].DBNumber,DataItems[0].Start,DataItems[0].Amount);
1857   GetValues(ComboArea_2,EdDBNum_2,EdStart_2,EdAmount_2,DataItems[1].Area,DataItems[1].DBNumber,DataItems[1].Start,DataItems[1].Amount);
1858   GetValues(ComboArea_3,EdDBNum_3,EdStart_3,EdAmount_3,DataItems[2].Area,DataItems[2].DBNumber,DataItems[2].Start,DataItems[2].Amount);
1859   GetValues(ComboArea_4,EdDBNum_4,EdStart_4,EdAmount_4,DataItems[3].Area,DataItems[3].DBNumber,DataItems[3].Start,DataItems[3].Amount);
1860   GetValues(ComboArea_5,EdDBNum_5,EdStart_5,EdAmount_5,DataItems[4].Area,DataItems[4].DBNumber,DataItems[4].Start,DataItems[4].Amount);
1861 
1862   if (DataItems[0].Amount=0) or
1863      (DataItems[1].Amount=0) or
1864      (DataItems[2].Amount=0) or
1865      (DataItems[3].Amount=0) or
1866      (DataItems[4].Amount=0) then
1867   begin
1868     MessageDlg('Size 0 not allowed',mtError,[mbOk],0);
1869     exit;
1870   end;
1871 
1872   // Note: for this demo we assume Wordlen=byte unless Area is Timer or counter.
1873   //       In real application see the documentation
1874   for c := 0 to 4 do
1875     if DataItems[c].Area=S7AreaCT then DataItems[c].WordLen:=S7WLCounter else
1876       if DataItems[c].Area=S7AreaTM then DataItems[c].WordLen:=S7WLTimer else
1877         DataItems[c].WordLen:=S7WLByte;
1878 
1879   // for simplicity we allocate 1k per item
1880   for c := 0 to 4 do
1881   begin
1882     GetMem(DataItems[c].pdata,1024);
1883     fillchar(DataItems[c].pdata^,1024,#0);
1884   end;
1885 
1886   EditToBuffer(ChEd_1,DataItems[0].pdata);
1887   EditToBuffer(ChEd_2,DataItems[1].pdata);
1888   EditToBuffer(ChEd_3,DataItems[2].pdata);
1889   EditToBuffer(ChEd_4,DataItems[3].pdata);
1890   EditToBuffer(ChEd_5,DataItems[4].pdata);
1891 
1892   LastError:=Client.WriteMultiVars(@DataItems,5);
1893 
1894 
1895   if LastError=0 then
1896   begin
1897     Elapse;
1898     if LastError=0 then
1899     begin
1900       if DataItems[0].Result=0 then
1901         EdResult_1.Text:='OK'
1902       else
1903         EdResult_1.Text:=CliError(DataItems[0].Result);
1904 
1905       if DataItems[1].Result=0 then
1906         EdResult_2.Text:='OK'
1907       else
1908         EdResult_2.Text:=CliError(DataItems[1].Result);
1909 
1910       if DataItems[2].Result=0 then
1911         EdResult_3.Text:='OK'
1912       else
1913         EdResult_3.Text:=CliError(DataItems[2].Result);
1914 
1915       if DataItems[3].Result=0 then
1916         EdResult_4.Text:='OK'
1917       else
1918         EdResult_4.Text:=CliError(DataItems[3].Result);
1919 
1920       if DataItems[4].Result=0 then
1921         EdResult_5.Text:='OK'
1922       else
1923         EdResult_5.Text:=CliError(DataItems[4].Result);
1924     end;
1925   end
1926   else
1927     Elapse;
1928 
1929   for c := 0 to 4 do
1930     FreeMem(DataItems[c].pdata,1024);
1931 
1932 end;
1933 
1934 procedure TFormClient.MultiWriteBtnClick(Sender: TObject);
1935 begin
1936   MultiWrite;
1937 end;
1938 
1939 procedure TFormClient.PageControlChange(Sender: TObject);
1940 begin
1941   TimClock.Enabled :=PageControl.ActivePage=TabClock;
1942   TimStatus.Enabled:=PageControl.ActivePage=TabControl;
1943   TimSecurity.Enabled:=Pagecontrol.ActivePage=TabSecurity;
1944 
1945   if Pagecontrol.ActivePage=TabSecurity then
1946     GetProtection;
1947 
1948   if PageControl.ActivePage=TabZSL then
1949     ReadSZLList(false);
1950 end;
1951 
1952 procedure TFormClient.Read(Async: boolean);
1953 Var
1954   Area   : integer;
1955   DBNum  : integer;
1956   Start  : integer;
1957   Amount : integer;
1958   WLen   : integer;
1959 begin
1960   if ASync then
1961     LastOP:='Async Read Data'
1962   else
1963     LastOP:='Read Data';
1964 
1965   Area  :=AreaOf[CbArea.ItemIndex];
1966   DBNum :=StrToIntDef(EdDbNum.Text,0);   EdDbNum.Text:=IntToStr(DBNum);
1967   Start :=StrToIntDef(EdStart.Text,0);  EdStart.Text:=IntToStr(Start);
1968   Amount:=StrToIntDef(EdAmount.Text,0); EdAmount.Text:=IntToStr(Amount);
1969   WLen  :=WLenOf[cbWLen.ItemIndex];
1970 
1971   if Async then
1972     LastError:=Client.AsReadArea(Area,DBNum,Start,Amount,WLen,@Buffer)
1973   else
1974     LastError:=Client.ReadArea(Area,DBNum,Start,Amount,WLen,@Buffer);
1975 
1976   if LastError=0 then
1977   begin
1978     if Async then
1979       WaitCompletion;
1980     Elapse;
1981 
1982     if LastError=0 then
1983       DataToGrid(WordSize(Amount,WLen));
1984   end
1985   else
1986     Elapse;
1987 end;
1988 
1989 procedure TFormClient.ReadSZL(Async: boolean);
1990 Var
1991   ID, Index : integer;
1992   SZL : TS7SZL;
1993   Size : integer;
1994 begin
1995   if ASync then
1996     LastOP:='Async Read SZL'
1997   else
1998     LastOP:='Read SZL';
1999 
2000   MemoSZL.Lines.Clear;
2001   lblSZLdump.Caption:='SZL Dump : 0 bytes';
2002   ID:=StrToIntDef(EdID.Text,0);EdID.Text:='$'+IntToHex(ID,4);
2003   Index:=StrToIntDef(EdIndex.Text,0);EdIndex.Text:='$'+IntToHex(Index,4);
2004   Size:=SizeOf(SZL);
2005   if ASync then
2006     LastError:=Client.AsReadSZL(ID,Index,@SZL, Size)
2007   else
2008     LastError:=Client.ReadSZL(ID,Index,@SZL, Size);
2009 
2010   if LastError=0 then
2011   begin
2012     if ASync then
2013       WaitCompletion;
2014     Elapse;
2015     if (LastError=0) then
2016     begin
2017       DumpData(@SZL,MemoSZL,Size);
2018       lblSZLdump.Caption:='SZL Dump : '+inttostr(Size)+' bytes';
2019     end;
2020   end
2021   else
2022     Elapse;
2023 end;
2024 
2025 procedure TFormClient.RGModeClick(Sender: TObject);
2026 begin
2027   AsMode:=RGMode.ItemIndex; // 0 : amPolling
2028                             // 1 : amEvent
2029                             // 2 : amCallBack
2030   if AsMode =2 then
2031     Client.SetAsCallback(@ClientCompletion,Self)
2032   else
2033     Client.SetAsCallback(nil, nil);
2034 
2035 end;
2036 
2037 procedure TFormClient.SaveToFile(const FileName: string; P: pointer;
2038   Size: integer);
2039 Var
2040   F : File of byte;
2041 begin
2042   AssignFile(F, FileName);
2043   {$I-}
2044   Rewrite(F);
2045   BlockWrite(F,P^,Size);
2046   CloseFile(F);
2047   {$I+}
2048   if IoResult<>0 then
2049     MessageDlg('An error occurred saving '+FileName,mtError,[mbok],0);
2050 end;
2051 
2052 procedure TFormClient.SetFConnected(const Value: boolean);
2053 begin
2054   FConnected := Value;
2055 
2056   if FConnected then
2057   begin
2058     BtnConnect.Enabled:=false;
2059     BtnDisconnect.Enabled:=true;
2060     PageControl.Enabled:=true;
2061     PCC.Enabled:=false;
2062     EdIp.Enabled:=false;
2063     EdRack.Enabled:=false;
2064     EdSlot.Enabled:=false;
2065     if PCC.ActivePageIndex=0 then
2066       GetSysInfo;
2067   end
2068   else begin
2069     ClearPages;
2070     BtnConnect.Enabled:=true;
2071     BtnDisconnect.Enabled:=false;
2072     PageControl.Enabled:=false;
2073     PageControl.ActivePageIndex:=0;
2074     PCC.Enabled:=true;
2075     EdIp.Enabled:=true;
2076     edRack.Enabled:=true;
2077     edSlot.Enabled:=true;
2078   end;
2079 end;
2080 
2081 procedure TFormClient.SetFLastError(const Value: integer);
2082 begin
2083   FLastError := Value;
2084   if FLastError=0 then
2085     StatusBar.Panels[2].Text:='OK'
2086   else
2087     StatusBar.Panels[2].Text:=CliError(FLastError);
2088 end;
2089 
2090 procedure TFormClient.SetFLastOP(const Value: string);
2091 begin
2092   FLastOP := Value;
2093   StatusBar.Panels[0].Text:=FLastOP;
2094 end;
2095 
2096 procedure TFormClient.SetPassword;
2097 begin
2098   LastOp:='Set Session password';
2099   LastError:=Client.SetSessionPassword(AnsiString(EdPassword.Text));
2100   Elapse;
2101 end;
2102 
2103 procedure TFormClient.TimClockTimer(Sender: TObject);
2104 Var
2105   DT : TDateTime;
2106 Begin
2107   if ChkGetDateTime.Checked then
2108   begin
2109     LastOp:='Read PLC Date and Time';
2110     LastError:=Client.GetPlcDateTime(DT);
2111     if LastError=0 then
2112     begin
2113       edAGDate.Text:=DateToStr(DT);
2114       edAGTime.Text:=TimeToStr(DT);
2115     end;
2116     Elapse;
2117   end;
2118   edPGDate.Text:=DateToStr(Now);
2119   edPGTime.Text:=TimeToStr(Now);
2120 end;
2121 
2122 procedure TFormClient.TimSecurityTimer(Sender: TObject);
2123 begin
2124   if ChkSecurity.Checked then
2125     GetProtection;
2126 end;
2127 
2128 procedure TFormClient.TimStatusTimer(Sender: TObject);
2129 begin
2130   if ChkStatusRefresh.Checked then
2131     GetStatus;
2132 end;
2133 
2134 procedure TFormClient.txtOBDblClick(Sender: TObject);
2135 Var
2136   ST : TStaticText;
2137 begin
2138   ST:=TStaticText(Sender);
2139   if StrToIntDef(Trim(ST.Caption),0)=0 then
2140     exit;
2141 
2142   if ST=txtOB then
2143     CbBot.ItemIndex:=0;
2144   if ST=txtFB then
2145     CbBot.ItemIndex:=1;
2146   if ST=txtFC then
2147     CbBot.ItemIndex:=2;
2148   if ST=txtDB then
2149     CbBot.ItemIndex:=3;
2150   if ST=txtSFB then
2151     CbBot.ItemIndex:=4;
2152   if ST=txtSFC then
2153     CbBot.ItemIndex:=5;
2154   if ST=txtSDB then
2155     CbBot.ItemIndex:=6;
2156 
2157   ListBlocksOfType(false);
2158 end;
2159 
2160 procedure TFormClient.Upload(Full, Async: boolean);
2161 Var
2162   BlockType, BlockNumber : integer;
2163   BlockSize : integer;
2164 begin
2165   ClearBlkBuffer;
2166   if Async then
2167     LastOp :='Async Block Upload'
2168   else
2169     LastOp :='Block Upload';
2170 
2171   MemoUpload.Lines.Clear;
2172   MemoBlkInfo.Lines.Clear;
2173 
2174   BlockType:=BlockOf[cbBlkType.ItemIndex];
2175   BlockNumber:=StrToIntDef(EdNum.Text,0);EdNum.Text:=IntToStr(BlockNumber);
2176   BlockSize:=SizeOf(Buffer);
2177 
2178   if Full then
2179   begin
2180     if Async then
2181       LastError:=Client.AsFullUpload(BlockType,BlockNumber,@Buffer,BlockSize)
2182     else
2183       LastError:=Client.FullUpload(BlockType,BlockNumber,@Buffer,BlockSize);
2184   end
2185   else begin
2186     if Async then
2187       LastError:=Client.AsUpload(BlockType,BlockNumber,@Buffer,BlockSize)
2188     else
2189       LastError:=Client.Upload(BlockType,BlockNumber,@Buffer,BlockSize);
2190   end;
2191 
2192   if LastError=0 then
2193   begin
2194     if Async then
2195       WaitCompletion;
2196     if LastError=0 then
2197     begin
2198       DumpData(@Buffer,MemoUpload,BlockSize);
2199       if Full then
2200       begin
2201         Client.GetPgBlockInfo(@Buffer,@BlockInfo,BlockSize);
2202         FillBlockInfo(MemoBlkInfo,@BlockInfo);
2203         FillBlkBuffer(@Buffer,BlockSize);
2204       end
2205       else
2206         MemoBlkInfo.Lines.Add('INFO NOT AVAILABLE');
2207     end;
2208   end;
2209   Elapse;
2210   if LastError=0 then
2211     lblUpld.Caption:='Block Dump : '+IntToStr(BlockSize)+' byte'
2212   else
2213     lblUpld.Caption:='Block Dump : 0 byte';
2214 end;
2215 
2216 procedure TFormClient.ValidateGrid;
2217 Var
2218   r,c : integer;
2219 
ValidateHexCellnull2220   function ValidateHexCell(S : string) : string;
2221   Var
2222     V : integer;
2223   begin
2224     if S='' then
2225       S:='0';
2226 
2227     V:=StrToIntDef(S,0);
2228     if V<0 then V:=0;
2229     if V>255 then V:=255;
2230 
2231     Result:='$'+IntToHex(V,2);
2232   end;
2233 
2234 begin
2235   With DataGrid do
2236   for r:=1 to RowCount - 1 do
2237     for c := 1 to ColCount - 1 do
2238        Cells[c,r]:=ValidateHexCell(Cells[c,r])
2239 end;
2240 
whennull2241 // Call this function when is expect data and size
2242 procedure TFormClient.WaitCompletion(Const Timeout : integer = 1500);
2243 Var
2244   Result : integer;
2245 begin
2246 
2247   Application.ProcessMessages;
2248   case AsMode of
2249     amPolling,
2250     amCallBack:
2251 
2252       repeat
2253         Application.ProcessMessages;
2254       until Client.CheckAsCompletion(Result);
2255 
2256     amEvent : Result:=Client.WaitAsCompletion(Timeout);
2257     (*
2258     amCallBack : begin
2259       // in our callback we setted evJob
2260         if evJob.WaitFor(Timeout)=wrSignaled then
2261         Result:=AsOpResult
2262       else
2263         Result:=errCliJobTimeout;
2264       end;
2265       *)
2266   end;
2267 
2268   LastError:=Result;
2269 end;
2270 
2271 // Call this function when don't expect data and size
WordSizenull2272 function TFormClient.WordSize(Amount, WordLength: integer): integer;
2273 begin
2274   case WordLength of
2275     S7WLBit     : Result := Amount * 1;  // S7 sends 1 byte per bit
2276     S7WLByte    : Result := Amount * 1;
2277     S7WLWord    : Result := Amount * 2;
2278     S7WLDword   : Result := Amount * 4;
2279     S7WLReal    : Result := Amount * 4;
2280     S7WLCounter : Result := Amount * 2;
2281     S7WLTimer   : Result := Amount * 2;
2282   else
2283     Result:=0;
2284   end;
2285 end;
2286 
2287 procedure TFormClient.Write(Async: boolean);
2288 Var
2289   Area   : integer;
2290   DBNum  : integer;
2291   Start  : integer;
2292   Amount : integer;
2293   WLen   : integer;
2294 begin
2295   if ASync then
2296     LastOP:='Async Write Data'
2297   else
2298     LastOP:='Write Data';
2299 
2300   Area  :=AreaOf[CbArea.ItemIndex];
2301   DBNum :=StrToIntDef(EdDbNum.Text,0);
2302   Start :=StrToIntDef(EdStart.Text,0);
2303   Amount:=StrToIntDef(EdAmount.Text,0);
2304   WLen  :=WLenOf[cbWLen.ItemIndex];
2305 
2306   GridToData(Amount*SizeByte[cbWLen.ItemIndex]);
2307 
2308   if Async then
2309     LastError:=Client.AsWriteArea(Area,DBNum,Start,Amount,WLen,@Buffer)
2310   else
2311     LastError:=Client.WriteArea(Area,DBNum,Start,Amount,WLen,@Buffer);
2312 
2313   if LastError=0 then
2314   begin
2315     if Async then
2316       WaitCompletion;
2317     Elapse;
2318   end
2319   else
2320     Elapse;
2321 end;
2322 
2323 end.
2324