1 unit frmPartner;
2
3 {$MODE Delphi}
4
5 interface
6
7 uses
8 {$IFNDEF FPC}
9 Windows,
10 {$ELSE}
11 LCLIntf, LCLType, LMessages,
12 {$ENDIF}
13 Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
14 Dialogs, ComCtrls, Grids, SyncObjs,
15 StdCtrls, ExtCtrls,
16 Snap7;
17
18 Const
19 _Active = true; // <- the underscore to avoid conflicts with the Form property "Active"
20 _Passive = false;
21
22 type
23
24 TS7Buffer = packed array[0..$FFFF] of byte;
25
26 TPartnerForm = class;
27
28 TRecvThread = class(TThread)
29 private
30 FPartnerForm : TPartnerForm;
31 public
32 constructor Create(PartnerForm : TPartnerForm);
33 procedure Execute; override;
34 end;
35
36 TPartnerForm = class(TForm)
37 PageControl: TPageControl;
38 TabBSend: TTabSheet;
39 TabBRecv: TTabSheet;
40 SB: TStatusBar;
41 DataGrid: TStringGrid;
42 GR_Remote: TGroupBox;
43 Label5: TLabel;
44 Label6: TLabel;
45 Label7: TLabel;
46 EdRemoteIP: TEdit;
47 EdRemTsapHI: TEdit;
48 EdRemTsapLO: TEdit;
49 StartBtn: TButton;
50 StopBtn: TButton;
51 Label1: TLabel;
52 Ed_R_ID: TEdit;
53 Label4: TLabel;
54 EdAmount: TEdit;
55 BsendBtn: TButton;
56 AsBsendBtn: TButton;
57 lbldump: TLabel;
58 RxMemo: TMemo;
59 EdR_ID_In: TEdit;
60 Label8: TLabel;
61 GR_local: TGroupBox;
62 Label2: TLabel;
63 Label3: TLabel;
64 Label9: TLabel;
65 EdLocalIP: TEdit;
66 EdLocTsapHI: TEdit;
67 EdLocTsapLO: TEdit;
68 DataLed: TStaticText;
69 TLed: TTimer;
70 TBsend: TTimer;
71 ChkSend: TCheckBox;
72 TStat: TTimer;
73 TabStat: TTabSheet;
74 EdSent: TEdit;
75 Label10: TLabel;
76 Label11: TLabel;
77 EdRecv: TEdit;
78 RGMode: TRadioGroup;
79 TBRecv: TTimer;
80 EdTimeout: TEdit;
81 Label13: TLabel;
82 BRecvBtn: TButton;
83 BRecvLbl: TLabel;
84 ARGMode: TRadioGroup;
85 procedure DataGridDrawCell(Sender: TObject; ACol, ARow: Integer;
86 Rect: TRect; State: TGridDrawState);
87 procedure DataGridExit(Sender: TObject);
88 procedure DataGridKeyPress(Sender: TObject; var Key: Char);
89 procedure FormCreate(Sender: TObject);
90 procedure TLedTimer(Sender: TObject);
91 procedure StartBtnClick(Sender: TObject);
92 procedure StopBtnClick(Sender: TObject);
93 procedure TStatTimer(Sender: TObject);
94 procedure FormDestroy(Sender: TObject);
95 procedure ChkSendClick(Sender: TObject);
96 procedure TBsendTimer(Sender: TObject);
97 procedure FormClose(Sender: TObject; var Action: TCloseAction);
98 procedure BsendBtnClick(Sender: TObject);
99 procedure AsBsendBtnClick(Sender: TObject);
100 procedure RGModeClick(Sender: TObject);
101 procedure TBRecvTimer(Sender: TObject);
102 procedure ARGModeClick(Sender: TObject);
103 procedure BRecvBtnClick(Sender: TObject);
104 private
105 { Private declarations }
106 TxBuffer : TS7Buffer;
107 FActive : boolean;
108 FRunning: boolean;
109 RecvThread : TRecvThread;
110 Cnt : byte;
111 AsSendMode : integer;
112 AsRecvMode : integer;
113 FLastSendError: integer;
114 FLastRecvError: integer;
115 FLastStartError: integer;
116 procedure ValidateGrid;
117 procedure DataToGrid(Amount : integer);
118 procedure GridToData(Amount : integer);
119 procedure SetFRunning(const Value: boolean);
120 procedure PartnerStart;
121 procedure PartnerStop;
122 procedure DumpData(P : PS7Buffer; Memo : TMemo; Count : integer);
123 procedure BSend(Async : boolean; Const Cyclic : boolean = false);
124 procedure SetFLastSendError(const Value: integer);
125 procedure SetFLastRecvError(const Value: integer);
126 procedure SetFLastStartError(const Value: integer);
127 procedure WaitBSendCompletion;
128 procedure BRecv(WithPolling : boolean);
ErrorTextnull129 function ErrorText(ErrNo : integer) : String;
130 public
131 { Public declarations }
132 Partner : TS7Partner;
133 RxBuffer : TS7Buffer;
134 RxSize : integer;
135 RxR_ID : cardinal;
136 RxError : integer;
137 RxEvent : TEvent;
138 TxEvent : TEvent;
139 procedure DataIncoming;
140 procedure CreatePartner(Mode : boolean);
141 property Running : boolean read FRunning write SetFRunning;
142 property LastStartError : integer read FLastStartError write SetFLastStartError;
143 property LastSendError : integer read FLastSendError write SetFLastSendError;
144 property LastRecvError : integer read FLastRecvError write SetFLastRecvError;
145 end;
146
147 implementation
148 {$R *.lfm}
149
150 Const
151 amPolling = 0;
152 amWait = 1;
153 amCallBack = 2;
154
155 Var
156 CS : TCriticalSection;
157
158 procedure OnRecv(usrPtr : pointer; opResult : integer; R_ID : dword;
159 pdata : pointer; size : integer);
160 {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
161 Var
162 PF : TPartnerForm;
163 begin
164 CS.Enter;
165 try
166 PF:=TPartnerForm(usrPtr);
167 if Assigned(PF) then
168 begin
169 if opResult=0 then
170 begin
171 move(pdata^,PF.RxBuffer[0],Size);
172 PF.RxSize:=Size;
173 PF.RxR_ID:=R_ID;
174 end;
175 PF.RxError:=opResult;
176 PF.RxEvent.SetEvent;
177 end;
178 finally
179 CS.Leave;
180 end;
181 end;
182
183 procedure OnSend(usrPtr : pointer; opResult : integer); stdcall;
184 var
185 PF : TPartnerForm;
186 begin
187 CS.Enter;
188 try
189 PF:=TPartnerForm(usrPtr);
190 if Assigned(PF) then
191 PF.TxEvent.SetEvent;
192 finally
193 CS.Leave;
194 end;
195 end;
196
197
198 procedure TPartnerForm.ARGModeClick(Sender: TObject);
199 begin
200 AsRecvMode:=ARGMode.ItemIndex; // 0 : amPolling
201 // 1 : amEvent
202 // 2 : amCallBack
203 case AsRecvMode of
204 amPolling,
205 amWait : begin
206 Partner.SetRecvCallback(nil,Self); // <-- We don't want callback
207 BRecvBtn.Enabled:=true;
208 end;
209 amCallback: begin
210 Partner.SetRecvCallback(@OnRecv,Self);
211 BRecvBtn.Enabled:=false; // <-- the recv is full async
212 end;
213 end;
214 BRecvLbl.Enabled :=BRecvBtn.Enabled;
215 EdTimeout.Enabled:=BRecvBtn.Enabled;
216 end;
217
218 procedure TPartnerForm.AsBsendBtnClick(Sender: TObject);
219 begin
220 BSend(true,false);
221 end;
222
223 procedure TPartnerForm.BRecv(WithPolling: boolean);
224 Var
225 Timeout : cardinal;
226 Result : integer;
227 Elapsed : cardinal;
228 Done : boolean;
229 begin
230 Timeout:=StrToIntDef(edTimeout.Text,0);
231 edTimeout.Text:=IntToStr(Timeout);
232
233 if WithPolling then
234 begin
235 Elapsed:=GetTickCount;
236 repeat
237 Application.ProcessMessages;
238 Done:=Partner.CheckAsBRecvCompletion(Result,RxR_ID,@RxBuffer,RxSize);
239 until Done or (GetTickCount-Elapsed>Timeout);
240 if not Done then
241 Result:=errParRecvTimeout;
242 end
243 else // Wait idle
244 Result:=Partner.BRecv(Timeout,RxR_ID,@RxBuffer,RxSize);
245
246 LastRecvError:=Result;
247 if Result=0 then
248 begin
249 DumpData(@RxBuffer,RxMemo,RxSize);
250 lbldump.Caption:='Data Dump : '+IntToStr(RxSize)+' bytes';
251 EdR_ID_In.Text:='$'+IntToHex(RxR_ID,8);
252 end;
253 end;
254
255 procedure TPartnerForm.BRecvBtnClick(Sender: TObject);
256 begin
257 BRecv(ARGMode.ItemIndex=0);
258 end;
259
260 procedure TPartnerForm.BSend(Async: boolean; Const Cyclic : boolean = false);
261 Var
262 Amount : integer;
263 R_ID : cardinal;
264 c: Integer;
265 SendTime,RecvTime : cardinal;
266 begin
267 // Amount
268 Amount:=StrToIntDef(EdAmount.Text,0);
269 if Amount>65536 then
270 Amount:=65536;
271 EdAmount.Text:=IntToStr(Amount);
272 // R_ID
273 R_ID:=StrToIntDef(Ed_R_ID.Text,0);
274 Ed_R_ID.Text:='$'+IntToHex(R_ID,8);
275
276
277 if Cyclic then
278 begin
279 TBSend.Enabled:=false;
280 inc(Cnt);
281 for c := 0 to Amount - 1 do
282 TxBuffer[c]:=Cnt;
283 DataToGrid(Amount);
284 end
285 else
286 GridToData(Amount);
287
288 if Async then
289 FLastSendError:=Partner.AsBSend(R_ID,@TxBuffer,Amount)
290 else
291 LastSendError:=Partner.BSend(R_ID,@TxBuffer,Amount);
292
293 if FLastSendError=0 then
294 begin
295 if ASync then
296 WaitBSendCompletion;
297 end;
298 SB.Panels[1].Text:=IntToStr(Partner.SendTime)+' ms';
299
300 if Cyclic then
301 TBSend.Enabled:=true;
302 end;
303
304 procedure TPartnerForm.BsendBtnClick(Sender: TObject);
305 begin
306 BSend(false,false);
307 end;
308
309 procedure TPartnerForm.ChkSendClick(Sender: TObject);
310 begin
311 if ChkSend.Checked then
312 begin
313 BSendBtn.Enabled:=false;
314 Ed_R_ID.Enabled:=false;
315 EdAmount.Enabled:=false;
316 AsBSendBtn.Enabled:=false;
317 TBSend.Enabled:=true;
318 end
319 else begin
320 TBSend.Enabled:=false;
321 BSendBtn.Enabled:=true;
322 AsBSendBtn.Enabled:=true;
323 Ed_R_ID.Enabled:=true;
324 EdAmount.Enabled:=true;
325 end;
326 end;
327
328 procedure TPartnerForm.CreatePartner(Mode: boolean);
329 begin
330 Partner:=TS7Partner.Create(Mode);
331
332 FActive:=Mode;
333
334 if FActive then
335 begin
336 Caption:='Active Partner';
337 GR_Local.Caption:='Local Partner (Active)';
338 GR_Remote.Caption:='Remote Partner (Passive)';
339 EdLocalIP.Text:='';
340 EdLocalIP.Color:=clBtnFace;
341 EdLocalIP.Enabled:=false;
342 end
343 else begin
344 Caption:='Passive Partner';
345 GR_Local.Caption:='Local Partner (Passive)';
346 GR_Remote.Caption:='Remote Partner (Active)';
347 end;
348
349 Partner.SetRecvCallback(@OnRecv,Self);
350 BRecvBtn.Enabled:=false; // <-- the recv is full async
351 BRecvLbl.Enabled:=false;
352 EdTimeout.Enabled:=false;
353 ARgMode.ItemIndex:=2;
354
355 Running:=false;
356 end;
357
358 procedure TPartnerForm.DataGridDrawCell(Sender: TObject; ACol, ARow: Integer;
359 Rect: TRect; State: TGridDrawState);
360 Var
361 aRect : TRect;
362 aText : string;
363 Style : TTextStyle;
364 begin
365 with Sender as TStringGrid do
366 begin
367 ARect:=Rect;
368 AText:=Cells[ACol,ARow];
369 if (ACol=0) or (ARow=0) then
370 Canvas.Brush.Color:=clbtnface
371 else
372 Canvas.Brush.Color:=clWhite;
373
374 Canvas.FillRect(Rect);
375 Style.Alignment:=taCenter;
376 Style.Clipping:=true;
377 Style.ExpandTabs:=false;
378 Style.Layout:=tlCenter;
379 Style.ShowPrefix:=false;
380 Style.Wordbreak:=false;
381 Style.SystemFont:=false;
382 Style.RightToLeft:=false;
383
384 Canvas.TextRect(ARect, 0,0, AText,Style);
385
386 if gdfocused in State then
387 begin
388 Canvas.Brush.Color:=clRed;
389 Canvas.FrameRect(ARect);
390 end;
391 end;
392 end;
393
394 procedure TPartnerForm.DataGridExit(Sender: TObject);
395 begin
396 ValidateGrid;
397 end;
398
399 procedure TPartnerForm.DataGridKeyPress(Sender: TObject; var Key: Char);
400 begin
401 if Key=#13 then
402 ValidateGrid;
403 end;
404
405 procedure TPartnerForm.DataIncoming;
406 begin
407 if RxError=0 then
408 begin
409 DataLed.Color:=clLime;
410 DumpData(@RxBuffer,RxMemo,RxSize);
411 lbldump.Caption:='Data Dump : '+IntToStr(RxSize)+' bytes';
412 EdR_ID_In.Text:='$'+IntToHex(RxR_ID,8);
413 TLed.Enabled:=true;
414 end;
415 LastRecvError:=RxError;
416 end;
417
418 procedure TPartnerForm.DataToGrid(Amount: integer);
419 Var
420 x, c, r : integer;
421 begin
422 with DataGrid do
423 begin
424 c:=1;r:=1;
425 for x := 0 to Amount - 1 do
426 begin
427 Cells[c,r]:='$'+IntToHex(TxBuffer[x],2);
428 inc(c);
429 if c=ColCount then
430 begin
431 c:=1;
432 inc(r);
433 end;
434 end;
435 Row:=1;
436 Col:=1;
437 if PageControl.ActivePage=TabBSend then
438 SetFocus;
439 end;
440 end;
441
442 procedure TPartnerForm.DumpData(P: PS7Buffer; Memo: TMemo; Count: integer);
443 Var
444 SHex, SChr : string;
445 Ch : AnsiChar;
446 c, cnt : integer;
447 begin
448 Memo.Lines.Clear;
449 Memo.Lines.BeginUpdate;
450 SHex:='';SChr:='';cnt:=0;
451 try
452 for c := 0 to Count - 1 do
453 begin
454 SHex:=SHex+IntToHex(P^[c],2)+' ';
455 Ch:=AnsiChar(P^[c]);
456 if not (Ch in ['a'..'z','A'..'Z','0'..'9','_','$','-',#32]) then
457 Ch:='.';
458 SChr:=SChr+String(Ch);
459 inc(cnt);
460 if cnt=16 then
461 begin
462 Memo.Lines.Add(SHex+' '+SChr);
463 SHex:='';SChr:='';
464 cnt:=0;
465 end;
466 end;
467 // Dump remainder
468 if cnt>0 then
469 begin
470 while Length(SHex)<48 do
471 SHex:=SHex+' ';
472 Memo.Lines.Add(SHex+' '+SChr);
473 end;
474 finally
475 Memo.Lines.EndUpdate;
476 end;
477 end;
478
ErrorTextnull479 function TPartnerForm.ErrorText(ErrNo: integer) : string;
480 begin
481 Result:=String(ParErrorText(ErrNo));
482 end;
483
484 procedure TPartnerForm.FormClose(Sender: TObject; var Action: TCloseAction);
485 begin
486 Action:=caFree;
487 end;
488
489 procedure TPartnerForm.FormCreate(Sender: TObject);
490 Var
491 c : integer;
492 begin
493 RxEvent:=TEvent.Create(nil,false,false,'');
494 TxEvent:=TEvent.Create(nil,false,false,'');
495 RecvThread := TRecvThread.Create(Self);
496 RecvThread.Start;
497
498 // Init Grid
499 with DataGrid do
500 begin
501 DefaultColWidth:=32;
502 ColWidths[0]:=48;
503 DefaultRowHeight:=18;
504 ColCount:=17;
505 RowCount:=4097;
506 for c := 1 to ColCount - 1 do
507 Cells[c,0]:=inttohex(c-1,2);
508
509 for c := 1 to RowCount - 1 do
510 Cells[0,c]:=inttohex((c-1)*16,4);
511 end;
512 ValidateGrid;
513 end;
514
515 procedure TPartnerForm.FormDestroy(Sender: TObject);
516 begin
517 Partner.Free;
518 RecvThread.Terminate;
519 RxEvent.SetEvent;
520 TxEvent.SetEvent;
521 RecvThread.Free;
522
523 RxEvent.Free;;
524 TxEvent.Free;
525 end;
526
527 procedure TPartnerForm.GridToData(Amount: integer);
528 Var
529 x, c, r : integer;
530 begin
531 ValidateGrid;
532 with DataGrid do
533 begin
534 c:=1;r:=1;
535 for x := 0 to Amount- 1 do
536 begin
537 TxBuffer[x]:=StrToIntDef(Cells[c,r],0);
538 inc(c);
539 if c=ColCount then
540 begin
541 c:=1;
542 inc(r);
543 end;
544 end;
545 end;
546 end;
547
548 procedure TPartnerForm.PartnerStart;
549 Var
550 LocalAddress : AnsiString;
551 RemoteAddress: AnsiString;
552 LocalTsapHI : integer;
553 LocalTsapLO : integer;
554 RemoteTsapHI : integer;
555 RemoteTsapLO : integer;
556 LocalTsap : integer;
557 RemoteTsap : integer;
558
559 function GetChar(ED : TEdit) : integer;
560 Var
561 B : byte;
562 begin
563 B:=StrToIntDef('$'+Ed.Text,0);
564 Ed.Text:=IntToHex(B,2);
565 Result:=B;
566 end;
567
568 begin
569 LocalAddress :=EdLocalIP.Text;
570 RemoteAddress:=EdRemoteIP.Text;
571 LocalTsapHI :=GetChar(EdLocTsapHI);
572 LocalTsapLO :=GetChar(EdLocTsapLO);
573 RemoteTsapHI :=GetChar(EdRemTsapHI);
574 RemoteTsapLO :=GetChar(EdRemTsapLO);
575
576 LocalTsap :=LocalTsapHI shl 8 + LocalTsapLO;
577 RemoteTsap :=RemoteTsapHI shl 8 + RemoteTsapLO;
578
579 LastStartError:=Partner.StartTo(LocalAddress,
580 RemoteAddress,
581 LocalTsap,
582 RemoteTsap);
583 Running:=FLastStartError=0;
584 end;
585
586 procedure TPartnerForm.PartnerStop;
587 begin
588 Partner.Stop;
589 Running:=false;
590 SB.Panels[2].Text:='';
591 end;
592
593 procedure TPartnerForm.RGModeClick(Sender: TObject);
594 begin
595 AsSendMode:=RGMode.ItemIndex; // 0 : amPolling
596 // 1 : amEvent
597 // 2 : amCallBack
598
599 case AsSendMode of
600 amPolling,
601 amWait : Partner.SetSendCallback(nil,Self);
602 amCallback: Partner.SetSendCallback(@OnSend,Self);
603 end;
604 end;
605
606 procedure TPartnerForm.SetFLastRecvError(const Value: integer);
607 begin
608 FLastRecvError := Value;
609 if FLastRecvError=0 then
610 SB.Panels[2].Text:='Last BRecv OK'
611 else
612 SB.Panels[2].Text:=ErrorText(FLastRecvError);
613 end;
614
615 procedure TPartnerForm.SetFLastSendError(const Value: integer);
616 begin
617
618 FLastSendError := Value;
619 if FLastSendError=0 then
620 SB.Panels[2].Text:='Last BSend OK'
621 else
622 SB.Panels[2].Text:=ErrorText(FLastSendError);
623 end;
624
625 procedure TPartnerForm.SetFLastStartError(const Value: integer);
626 begin
627 FLastStartError := Value;
628 if FLastStartError=0 then
629 SB.Panels[2].Text:='Last Start OK'
630 else
631 SB.Panels[2].Text:=ErrorText(FLastRecvError);
632 end;
633
634 procedure TPartnerForm.SetFRunning(const Value: boolean);
635 begin
636 FRunning := Value;
637
638 if FRunning then
639 begin
640 EdLocalIP.Enabled:=false;
641 EdLocTsapHI.Enabled:=false;
642 EdLocTsapLO.Enabled:=false;
643 EdRemoteIP.Enabled:=false;
644 EdRemTsapHI.Enabled:=false;
645 EdRemTsapLO.Enabled:=false;
646 StartBtn.Enabled:=false;
647 StopBtn.Enabled:=true;
648 BSendBtn.Enabled:=true;
649 AsBSendBtn.Enabled:=true;
650 Ed_R_ID.Enabled:=true;
651 EdAmount.Enabled:=true;
652 end
653 else begin
654 EdLocalIP.Enabled:=not FActive;
655 EdLocTsapHI.Enabled:=true;
656 EdLocTsapLO.Enabled:=true;
657 EdRemoteIP.Enabled:=true;
658 EdRemTsapHI.Enabled:=true;
659 EdRemTsapLO.Enabled:=true;
660 StartBtn.Enabled:=true;
661 StopBtn.Enabled:=false;
662 if FActive then
663 EdLocalIP.Text:='';
664
665 ChkSend.Checked:=false;
666 BSendBtn.Enabled:=false;
667 AsBSendBtn.Enabled:=false;
668 Ed_R_ID.Enabled:=false;
669 EdAmount.Enabled:=false;
670 TBSend.Enabled:=false;
671 end;
672 end;
673
674 procedure TPartnerForm.StartBtnClick(Sender: TObject);
675 begin
676 if not FRunning then
677 PartnerStart;
678 end;
679
680 procedure TPartnerForm.StopBtnClick(Sender: TObject);
681 begin
682 if FRunning then
683 PartnerStop;
684 end;
685
686 procedure TPartnerForm.TBRecvTimer(Sender: TObject);
687 begin
688 //
689 // if Partner.AsBRecvCompletion()
690
691 end;
692
693 procedure TPartnerForm.TBsendTimer(Sender: TObject);
694 begin
695 if not (csDestroying in ComponentState) and Partner.Linked then
696 BSend(false,true);
697 end;
698
699 procedure TPartnerForm.TLedTimer(Sender: TObject);
700 begin
701 DataLed.Color:=clBtnFace;
702 end;
703
704 procedure TPartnerForm.TStatTimer(Sender: TObject);
705 Var
706 Status : integer;
707 BytesSent : cardinal;
708 BytesRecv : cardinal;
709 ErrSend : cardinal;
710 ErrRecv : cardinal;
711 begin
712 Status:=Partner.Status;
713
714 case Status of
715 par_stopped : SB.Panels[0].Text:='Stopped';
716 par_connecting : SB.Panels[0].Text:='Connecting';
717 par_waiting : SB.Panels[0].Text:='Waiting';
718 par_linked : SB.Panels[0].Text:='Connected';
719 par_sending : SB.Panels[0].Text:='Sending';
720 par_receiving : SB.Panels[0].Text:='Receiving';
721 par_binderror : SB.Panels[0].Text:='Bind Error';
722 end;
723
724 BytesSent:=Partner.BytesSent;
725 BytesRecv:=Partner.BytesRecv;
726 ErrSend :=Partner.SendErrors;
727 ErrRecv :=Partner.RecvErrors;
728
729 EdSent.Text:=IntToStr(BytesSent);
730 EdRecv.Text:=IntToStr(BytesRecv);
731 end;
732
733 procedure TPartnerForm.ValidateGrid;
734 Var
735 r,c : integer;
736
737 function ValidateHexCell(S : string) : string;
738 Var
739 V : integer;
740 begin
741 if S='' then
742 S:='0';
743
744 V:=StrToIntDef(S,0);
745 if V<0 then V:=0;
746 if V>255 then V:=255;
747
748 Result:='$'+IntToHex(V,2);
749 end;
750
751 begin
752 With DataGrid do
753 for r:=1 to RowCount - 1 do
754 for c := 1 to ColCount - 1 do
755 Cells[c,r]:=ValidateHexCell(Cells[c,r])
756 end;
757
758 procedure TPartnerForm.WaitBSendCompletion;
759 Var
760 Result : integer;
761 begin
762 Application.ProcessMessages;
763 if AsSendMode=amPolling then
764 begin
765 repeat
766 Application.ProcessMessages;
767 until Partner.CheckAsBSendCompletion(Result);
768 end
769 else
770 Result:=Partner.WaitAsBSendCompletion(3000);
771 LastSendError:=Result;
772 end;
773
774 { TRecvThread }
775
776 constructor TRecvThread.Create(PartnerForm: TPartnerForm);
777 begin
778 inherited Create(true);
779 FreeOnTerminate:=false;
780 FPartnerForm:=PartnerForm;
781 end;
782
783 procedure TRecvThread.Execute;
784 begin
785 while not Terminated do
786 begin
787 FPartnerForm.RxEvent.WaitFor(infinite);
788 if not Terminated then
789 Synchronize(FPartnerForm.DataIncoming);
790 end;
791 end;
792
793
794 initialization
795
796 CS:=TCriticalSection.Create;
797
798 finalization
799
800 CS.Free;;
801
802 end.
803