This repository has been archived by the owner on Sep 20, 2023. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 1
/
SERIAL_PORT_VBA6.bas
3217 lines (2187 loc) · 125 KB
/
SERIAL_PORT_VBA6.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Attribute VB_Name = "SERIAL_PORT_VBA"
'
' https://github.com/Serialcomms/Serial-Ports-in-VBA6-legacy-for-2022
'
Option Explicit
' Option Private Module
'
'-------------------------------------------------------------------------
' Change min/max values below to match your com ports and intended usage.
' Data functions should work with most hardware and software port types.
' Signalling functions should be tested individually if required.
' Functions work with port numbers greater than 10 if specified.
Private Const COM_PORT_MIN As Integer = 1 ' = COM1
Private Const COM_PORT_MAX As Integer = 2 ' = COM2
'-------------------------------------------------------------------------
' Optional - can define port settings for your devices here.
' Use constant to start com port instead of settings string.
'
' Public Const BARCODE As String = "Baud=9600 Data=8 Parity=N Stop=1"
' Public Const GPS_SET As String = "Baud=1200 Data=7 Parity=E Stop=1"
'-------------------------------------------------------------------------
Private Const HANDLE_INVALID As Long = -1
Private Const MAXDWORD As Long = &HFFFFFFFF
Private Const VBA_TIMEOUT As Long = 5200 ' VBA "Not Responding" time in MilliSeconds (approximate)
Private Const LONG_NEG_1 As Long = -1
Private Const LONG_0 As Long = 0 ' some predefined constants for minor performance gain.
Private Const LONG_1 As Long = 1
Private Const LONG_2 As Long = 2
Private Const LONG_3 As Long = 3
Private Const LONG_4 As Long = 4
Private Const LONG_5 As Long = 5
Private Const LONG_6 As Long = 6
Private Const LONG_7 As Long = 7
Private Const LONG_8 As Long = 8
Private Const LONG_9 As Long = 9
Private Const LONG_10 As Long = 10
Private Const LONG_14 As Long = 14
Private Const LONG_18 As Long = 18
Private Const LONG_20 As Long = 20
Private Const LONG_21 As Long = 21
Private Const LONG_30 As Long = 30
Private Const LONG_36 As Long = 36
Private Const LONG_40 As Long = 40
Private Const LONG_50 As Long = 50
Private Const LONG_52 As Long = 52
Private Const LONG_54 As Long = 54
Private Const LONG_60 As Long = 60
Private Const LONG_100 As Long = 100
Private Const LONG_333 As Long = 333
Private Const LONG_1000 As Long = 1000
Private Const LONG_3000 As Long = 3000
Private Const LONG_1E6 As Long = 1000000
Private Const LONG_125000 As Long = 125000
Private Const HEX_00 As Byte = &H0 ' some hexadecimal constants for minor readability gain.
Private Const HEX_01 As Byte = &H1
Private Const HEX_02 As Byte = &H2
Private Const HEX_03 As Byte = &H3
Private Const HEX_04 As Byte = &H4
Private Const HEX_08 As Byte = &H8
Private Const HEX_0F As Byte = &HF
Private Const HEX_10 As Byte = &H10
Private Const HEX_20 As Byte = &H20
Private Const HEX_30 As Byte = &H30
Private Const HEX_40 As Byte = &H40
Private Const HEX_7F As Byte = &H7F
Private Const HEX_80 As Byte = &H80
Private Const HEX_C0 As Byte = &HC0
Private Const HEX_100 As Long = &H100
Private Const HEX_102 As Long = &H102
Private Const HEX_103 As Long = &H103
Private Const HEX_200 As Long = &H200
Private Const HEX_400 As Long = &H400
Private Const HEX_800 As Long = &H800
Private Const HEX_1000 As Long = &H1000
Private Const HEX_2000 As Long = &H2000
Private Const HEX_3000 As Long = &H3000
Private Const HEX_4000 As Long = &H4000
Private Const HEX_8000 As Long = &H8000
Private Const HEX_C000 As Long = &HC000
Private Const TEXT_ON As String = "On" ' some text string constants for minor gains.
Private Const TEXT_MS As String = " mS"
Private Const TEXT_US As String = " µS"
Private Const TEXT_TO As String = " To "
Private Const TEXT_OFF As String = "Off"
Private Const TEXT_TRUE As String = "True"
Private Const TEXT_FALSE As String = "False"
Private Const TEXT_DOT As String = "."
Private Const TEXT_DASH As String = "-"
Private Const TEXT_COMMA As String = ","
Private Const TEXT_SPACE As String = " "
Private Const TEXT_EQUALS As String = "="
Private Const TEXT_DOUBLE_SPACE As String = " "
Private Const TEXT_EQUALS_SPACE As String = "= "
Private Const TEXT_SPACE_EQUALS As String = " ="
Private Const TEXT_ERROR As String = "ERROR"
Private Const TEXT_CONFIG As String = "CONFIG"
Private Const TEXT_FAILED As String = "FAILED"
Private Const TEXT_RESULT As String = "RESULT"
Private Const TEXT_SINGLE As String = "SINGLE"
Private Const TEXT_TIMING As String = "TIMING"
Private Const TEXT_CLEARED As String = "CLEARED"
Private Const TEXT_CLOSING As String = "CLOSING"
Private Const TEXT_FAILURE As String = "FAILURE"
Private Const TEXT_LOOPING As String = "LOOPING"
Private Const TEXT_NO_DATA As String = "NO_DATA"
Private Const TEXT_READING As String = "READING"
Private Const TEXT_STARTED As String = "STARTED"
Private Const TEXT_STARTUP As String = "STARTUP"
Private Const TEXT_SUCCESS As String = "SUCCESS"
Private Const TEXT_TIMEOUT As String = "TIMEOUT"
Private Const TEXT_WAITING As String = "WAITING"
Private Const TEXT_WRITING As String = "WRITING"
Private Const TEXT_CLEARING As String = "CLEARING"
Private Const TEXT_DURATION As String = "DURATION"
Private Const TEXT_FINISHED As String = "FINISHED"
Private Const TEXT_RECEIVED As String = "RECEIVED"
Private Const TEXT_SETTINGS As String = "SETTINGS"
Private Const TEXT_STARTING As String = "STARTING"
Private Const TEXT_STOPPING As String = "STOPPING"
Private Const TEXT_COM_PORT As String = "COM Port "
Private Const COM_PORT_RANGE As String = COM_PORT_MIN & " to " & COM_PORT_MAX
Private Type SYSTEMTIME
Year As Integer
Month As Integer
WeekDay As Integer
Day As Integer
Hour As Integer
Minute As Integer
Second As Integer
MilliSeconds As Integer ' used for debug timestamp
End Type
Private Type DEVICE_CONTROL_BLOCK ' DCB - Check latest Microsoft documentation
LENGTH_DCB As Long
BAUD_RATE As Long
BIT_FIELD As Long
RESERVED_0 As Integer
LIMIT_XON As Integer
LIMIT_XOFF As Integer
BYTE_SIZE As Byte
PARITY As Byte
STOP_BITS As Byte
CHAR_XON As Byte
CHAR_XOFF As Byte
CHAR_ERROR As Byte
CHAR_EOF As Byte
CHAR_EVENT As Byte
RESERVED_1 As Integer
End Type
Private Type COM_PORT_STATUS
BIT_FIELD As Long ' 32 bits = waiting for CTS, DRS etc. Top 25 bits not used.
QUEUE_IN As Long
QUEUE_OUT As Long
End Type
Private Type COM_PORT_TIMEOUTS ' Check latest Microsoft documentation before changing
Read_Interval_Timeout As Long
Read_Total_Timeout_Multiplier As Long
Read_Total_Timeout_Constant As Long
Write_Total_Timeout_Multiplier As Long
Write_Total_Timeout_Constant As Long
End Type
Private Type COM_PORT_TIMERS
Char_Loop_Wait As Long ' Arbitrary loop wait time before next read (assuming single characters)
Data_Loop_Wait As Long ' Arbitrary loop wait time before next read (assuming multiple characters)
Line_Loop_Wait As Long ' Arbitrary loop wait time before next read (assuming lines)
Exit_Loop_Wait As Long ' Arbitrary loop wait time before read exit (allow minimum 1 character time)
Read_Timeout As Boolean
Timeslice_Bytes As Long ' Approximate bytes per second for timesliced synchronous read/write
Bytes_Per_Second As Long
Port_Data_Time As Currency ' Currency-scaled time in QPC MicroSeconds of > 0 bytes read
Last_Data_Time As Currency ' Currency-scaled time in QPC MicroSeconds since Port_Data_Time
Read_Wait_Time As Currency ' Currency-scaled time in QPC MicroSeconds of read wait before timeout
Timing_QPC_Now As Currency ' Currency-scaled time in QPC MicroSeconds for timing data start
Timing_QPC_End As Currency ' Currency-scaled time in QPC MicroSeconds for timing data end
Frame_MilliSeconds As Single ' Approximate time in MilliSeconds required to send or receive a character
Frame_MicroSeconds As Single ' Approximate time in MicroSeconds required to send or receive a character
End Type
Private Type COM_PORT_BUFFERS
Read_Result As String
Read_Buffer As String * 4096 ' fixed size buffer for synchronous port read (maximum timeslice bytes)
Write_Result As String
Write_Buffer As String
Receive_Result As String
Receive_Buffer As String
Receive_Length As Long
Transmit_Length As Long
Transmit_Result As String
Transmit_Buffer As String
Read_Buffer_Empty As Boolean
Read_Buffer_Length As Long
Synchronous_Bytes_Read As Long
Synchronous_Bytes_Sent As Long
End Type
Private Type COM_PORT_PROFILE ' Not Microsoft - check/change locally if required
Name As String
Debug As Boolean
Handle As Long
DLL_Error As Long
Settings As String
Port_Errors As Long
Port_Signals As Long
Status As COM_PORT_STATUS
Timers As COM_PORT_TIMERS
Buffers As COM_PORT_BUFFERS
Timeouts As COM_PORT_TIMEOUTS
DCB As DEVICE_CONTROL_BLOCK
End Type
Private Enum PORT_FILE_MODES
GENERIC_RW = &HC0000000
GENERIC_READ = &H80000000
GENERIC_WRITE = &H40000000
OPEN_EXISTING = 3
OPEN_EXCLUSIVE = 0
End Enum
Private Enum PORT_FILE_FLAGS
SYNCHRONOUS_MODE = 0
ATTRIBUTE_NORMAL = &H80
NO_BUFFERING = &H20000000
WRITE_THROUGH = &H80000000
Overlapped_Mode = &H40000000
End Enum
Private Enum PORT_BAUD_RATE
CBR_110 = 110
CBR_300 = 300
CBR_600 = 600
CBR_1200 = 1200
CBR_2400 = 2400
CBR_4800 = 4800
CBR_9600 = 9600
CBR_19200 = 19200 ' add further baud rates if required.
End Enum
Private Enum PORT_DATA_BITS
BITS_5 = 5
BITS_6 = 6
BITS_7 = 7
BITS_8 = 8
End Enum
Private Enum PORT_FRAMING
PARITY_NONE = 0
PARITY_ODD = 1
PARITY_EVEN = 2
PARITY_MARK = 3
PARITY_SPACE = 4
STOP_BITS_ONE = 0
STOP_BITS_1P5 = 1
STOP_BITS_TWO = 2
End Enum
Private Enum PORT_EVENT
RX_CHAR = HEX_01 ' Normal Character Received Event
RX_FLAG = HEX_02 ' Escaped or Interrupt Character - e.g. Control-C Event
TX_EMPTY = HEX_04 ' Transmit Buffer Empty
CTS = HEX_08 ' Clear To Send
DSR = HEX_10 ' Data Set (modem or equivalent comms device) Ready
RLSD = HEX_20 ' Receive Line Signal (Carrier) Detect
RING = HEX_100
BREAK = HEX_40
EVENT_ERROR = HEX_00
LINE_ERROR = HEX_80 ' Line Error (Parity/Frame/Overrun)
RX_80_FULL = HEX_400 ' Receive Buffer 80% full
EVENT_1 = HEX_800
EVENT_2 = HEX_1000
PRINTER_ERROR = HEX_200
End Enum
Private Enum PORT_CONTROL
DTR_CONTROL_ENABLE = 1
DTR_CONTROL_DISABLE = 0
DTR_CONTROL_HANDSHAKE = 2
RTS_CONTROL_TOGGLE = 3
RTS_CONTROL_ENABLE = 1
RTS_CONTROL_DISABLE = 0
RTS_CONTROL_HANDSHAKE = 2
CTS_ON = HEX_10
DSR_ON = HEX_20
RING_ON = HEX_40
RLSD_ON = HEX_80
PURGE_ALL = HEX_0F
PURGE_ABORT_TX = HEX_01
PURGE_ABORT_RX = HEX_02
PURGE_CLEAR_TX = HEX_04
PURGE_CLEAR_RX = HEX_08
End Enum
Private Enum FLOW_CONTROL
DTR_ON = 5
DTR_OFF = 6
RTS_ON = 3
RTS_OFF = 4
XOFF_ON = 1
XOFF_OFF = 2
BREAK_ON = 8
BREAK_OFF = 9
End Enum
Private Enum Port_Errors
OVERFLOW = HEX_01 ' Input buffer overflow, buffer full or data after EOF
OVERRUN = HEX_02 ' Character-buffer overrun. The next character is lost
PARITY = HEX_04 ' Port hardware detected a parity error
FRAME = HEX_08 ' Port hardware detected a framing error
BREAK = HEX_10 ' Port hardware detected a break signal
End Enum
Private Enum SYSTEM_ERRORS
SUCCESS = 0
INVALID_FUNCTION = 1
FILE_NOT_FOUND = 2
PATH_NOT_FOUND = 3
TOO_MANY_OPEN_FILES = 4
ACCESS_DENIED = 5
INVALID_HANDLE = 6
INVALID_DATA = 13
DEVICE_NOT_READY = 15
INVALID_PARAMETER = 87
INSUFFICIENT_BUFFER = 122
OPERATION_ABORTED = 995
IO_INCOMPLETE = 996
IO_PENDING = 997
NO_ACCESS = 998
End Enum
Private COM_PORT(COM_PORT_MIN To COM_PORT_MAX) As COM_PORT_PROFILE
Private Declare Sub Get_System_Time Lib "Kernel32.dll" Alias "GetSystemTime" (ByRef System_Time As SYSTEMTIME)
Private Declare Sub Kernel_Sleep_MilliSeconds Lib "Kernel32.dll" Alias "Sleep" (ByVal Sleep_MilliSeconds As Long)
Private Declare Function QPC Lib "Kernel32.dll" Alias "QueryPerformanceCounter" (ByRef Query_PerfCounter As Currency) As Boolean
Private Declare Function QPF Lib "Kernel32.dll" Alias "QueryPerformanceFrequency" (ByRef Query_Frequency As Currency) As Boolean
' https://docs.microsoft.com/en-us/windows/win32/devio/communications-functions
Private Declare Function Query_Port_DCB Lib "Kernel32.dll" Alias "GetCommState" (ByVal Port_Handle As Long, ByRef Port_DCB As DEVICE_CONTROL_BLOCK) As Boolean
Private Declare Function Apply_Port_DCB Lib "Kernel32.dll" Alias "SetCommState" (ByVal Port_Handle As Long, ByRef Port_DCB As DEVICE_CONTROL_BLOCK) As Boolean
Private Declare Function Build_Port_DCB Lib "Kernel32.dll" Alias "BuildCommDCBA" (ByVal Config_Text As String, ByRef Port_DCB As DEVICE_CONTROL_BLOCK) As Boolean
Private Declare Function Get_Com_Timers Lib "Kernel32.dll" Alias "GetCommTimeouts" (ByVal Port_Handle As Long, ByRef TIMEOUT As COM_PORT_TIMEOUTS) As Boolean
Private Declare Function Set_Com_Timers Lib "Kernel32.dll" Alias "SetCommTimeouts" (ByVal Port_Handle As Long, ByRef TIMEOUT As COM_PORT_TIMEOUTS) As Boolean
Private Declare Function Set_Com_Signal Lib "Kernel32.dll" Alias "EscapeCommFunction" (ByVal Port_Handle As Long, ByVal Signal_Function As Long) As Boolean
Private Declare Function Get_Port_Modem Lib "Kernel32.dll" Alias "GetCommModemStatus" (ByVal Port_Handle As Long, ByRef Modem_Status As Long) As Boolean
Private Declare Function Com_Port_Purge Lib "Kernel32.dll" Alias "PurgeComm" (ByVal Port_Handle As Long, ByVal Port_Purge_Flags As Long) As Boolean
Private Declare Function Com_Port_Close Lib "Kernel32.dll" Alias "CloseHandle" (ByVal Port_Handle As Long) As Boolean
Private Declare Function Com_Port_Clear Lib "Kernel32.dll" Alias "ClearCommError" _
(ByVal Port_Handle As Long, ByRef Port_Error_Mask As Long, ByRef Port_Status As COM_PORT_STATUS) As Boolean
Private Declare Function Com_Port_Create Lib "Kernel32.dll" Alias "CreateFileA" _
(ByVal Port_Name As String, ByVal PORT_ACCESS As Long, ByVal SHARE_MODE As Long, ByVal SECURITY_ATTRIBUTES_NULL As Any, _
ByVal CREATE_DISPOSITION As Long, ByVal FLAGS_AND_ATTRIBUTES As Long, Optional TEMPLATE_FILE_HANDLE_NULL) As Long
Private Declare Function Synchronous_Read Lib "Kernel32.dll" Alias "ReadFile" _
(ByVal Port_Handle As Long, ByVal Buffer_Data As String, ByVal Bytes_Requested As Long, ByRef Bytes_Processed As Long, Optional Overlapped_Null) As Boolean
Private Declare Function Synchronous_Write Lib "Kernel32.dll" Alias "WriteFile" _
(ByVal Port_Handle As Long, ByVal Buffer_Data As String, ByVal Bytes_Requested As Long, ByRef Bytes_Processed As Long, Optional Overlapped_Null) As Boolean
'
Public Function START_COM_PORT(Port_Number As Long, Optional Port_Setttings As String) As Boolean
'-------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "START_COM_PORT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'-------------------------------------------------------------------------
' Port_Settings if supplied should have the same structure as the equivalent command-line Mode arguments for a COM Port:
' [baud=b][parity=p][data=d][stop=s][to={on|off}][xon={on|off}][odsr={on|off}][octs={on|off}][dtr={on|off|hs}][rts={on|off|hs|tg}][idsr={on|off}]
' For example, to configure a baud rate of 1200, no parity, 8 data bits, and 1 stop bit, Port_Settings text is "baud=1200 parity=N data=8 stop=1"
' Alternatively, can assign port settings to a VBA String constant or variable (e.g. SCANNER) and call start_com_port(1,SCANNER) from VBA routine
Dim Temp_Result As Boolean, Port_Handle As Long
Dim Temp_Port_Name As String, Result_Text As String, Detail_Text As String
Const Start_Text_1 As String = " Attempting to Open and Configure COM Port "
Const Start_Text_2 As String = " Opened and Configured COM Port "
Const Start_Text_3 As String = " with Handle "
Const Start_Text_4 As String = " Failed to Configure COM Port "
Const Start_Text_5 As String = " Failed to Open and Configure COM Port "
Const Start_Text_6 As String = " Failed to Open COM Port, Existing Port Handle = "
Const Start_Text_7 As String = " Port Number Invalid, Defined Port Number Range = "
Result_Text = TEXT_FAILURE
Temp_Port_Name = TEXT_COM_PORT & CStr(Port_Number) & TEXT_COMMA
If Port_Valid Then
Port_Handle = COM_PORT(Port_Number).Handle ' existing port handle if port open
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_STARTING, Temp_Port_Name & Start_Text_1 & Port_Number)
If COM_PORT_CLOSED(Port_Number) Then
If OPEN_COM_PORT(Port_Number) Then
If CONFIGURE_COM_PORT(Port_Number, Port_Setttings) Then
PURGE_BUFFERS Port_Number
Temp_Result = True
Result_Text = TEXT_SUCCESS
Port_Handle = COM_PORT(Port_Number).Handle ' new port handle
Detail_Text = Start_Text_2 & Port_Number & Start_Text_3 & Port_Handle
Else
STOP_COM_PORT Port_Number ' close com port if configure failed
Detail_Text = Start_Text_4 & Port_Number
End If
Else: Detail_Text = Start_Text_5 & Port_Number: End If
Else: Detail_Text = Start_Text_6 & Port_Handle: End If
Else: Detail_Text = Start_Text_7 & COM_PORT_RANGE: End If
If Port_Debug Or Not Port_Valid Then Call PRINT_DEBUG_TEXT(Module_Name, Result_Text, Temp_Port_Name & Detail_Text)
START_COM_PORT = Temp_Result
End Function
Private Function OPEN_COM_PORT(Port_Number As Long) As Boolean
'--------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "OPEN_COM_PORT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'--------------------------------------------------------------------------
Dim Temp_Handle As Long
Dim Temp_Result As Boolean
Dim CREATE_FILE_FLAGS As Long
Dim Device_Path As String, Error_Text As String, Result_Text As String, Detail_Text As String, Temp_Name As String
Const DEVICE_PREFIX As String = "\\.\COM"
Const Create_Text_1 As String = "CREATING"
Const Create_Text_2 As String = "PORT_MODE"
Const Create_Text_3 As String = " Attempting to Open COM Port with Device Path "
Const Create_Text_4 As String = " Port Open for Exclusive Access, Handle = "
Const Create_Text_5 As String = " Failed to Open COM Port, "
Const Create_Text_6 As String = " Creating Synchronous (non-overlapped) mode Port "
Device_Path = DEVICE_PREFIX & CStr(Port_Number)
CREATE_FILE_FLAGS = PORT_FILE_FLAGS.SYNCHRONOUS_MODE
Temp_Name = TEXT_COM_PORT & CStr(Port_Number) & TEXT_COMMA
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Create_Text_1, Temp_Name & Create_Text_3 & Device_Path)
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Create_Text_2, Temp_Name & Create_Text_6)
Temp_Handle = Com_Port_Create(Device_Path, GENERIC_RW, OPEN_EXCLUSIVE, LONG_0, OPEN_EXISTING, CREATE_FILE_FLAGS)
COM_PORT(Port_Number).DLL_Error = Err.LastDllError
Select Case Temp_Handle
Case HANDLE_INVALID
Temp_Result = False
Result_Text = TEXT_FAILURE
Error_Text = DLL_ERROR_TEXT(COM_PORT(Port_Number).DLL_Error)
Detail_Text = Create_Text_5 & Error_Text
COM_PORT(Port_Number).Name = vbNullString
COM_PORT(Port_Number).Handle = LONG_0
Case Else
Temp_Result = True
Result_Text = TEXT_SUCCESS
Detail_Text = Create_Text_4 & Temp_Handle
COM_PORT(Port_Number).Name = Temp_Name
COM_PORT(Port_Number).Handle = Temp_Handle
End Select
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Result_Text, Temp_Name & Detail_Text)
OPEN_COM_PORT = Temp_Result
End Function
Private Function CONFIGURE_COM_PORT(Port_Number As Long, Optional Port_Settings As String) As Boolean
'-------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "CONFIGURE_PORT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'-------------------------------------------------------------------------
Dim Temp_Result As Boolean
Dim Clean_Settings As String, Selected_Text As String, Result_Text As String, Detail_Text As String
Const Config_Text_1 As String = " Attempting to Configure Port With Supplied Settings "
Const Config_Text_2 As String = " Attempting to Configure Port With Existing Settings "
Const Config_Text_3 As String = " Configured COM Port with Settings = "
Const Config_Text_4 As String = " Failed to Set Port Values "
Const Config_Text_5 As String = " Failed to Set Port Timers "
Const Config_Text_6 As String = " Failed to Set Port with Supplied Settings, "
Result_Text = TEXT_FAILURE
Clean_Settings = CLEAN_PORT_SETTINGS(Port_Settings)
Selected_Text = IIf(Len(Clean_Settings) > LONG_4, Config_Text_1, Config_Text_2)
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_STARTUP, COM_PORT(Port_Number).Name & Selected_Text)
If SET_PORT_CONFIG(Port_Number, Clean_Settings) Then
If SET_PORT_TIMERS(Port_Number) Then
If SET_PORT_VALUES(Port_Number) Then
Temp_Result = True
Result_Text = TEXT_SUCCESS
Detail_Text = Config_Text_3 & GET_PORT_SETTINGS(Port_Number)
Else: Detail_Text = Config_Text_4: End If
Else: Detail_Text = Config_Text_5: End If
Else: Detail_Text = Config_Text_6 & Port_Settings: End If
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Result_Text, COM_PORT(Port_Number).Name & Detail_Text)
CONFIGURE_COM_PORT = Temp_Result
End Function
Private Function SET_PORT_CONFIG(Port_Number As Long, Optional Port_Settings As String) As Boolean
'-------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "SET_PORT_CONFIG"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'-------------------------------------------------------------------------
' https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-buildcommdcba
Dim Temp_String As String, Result_Text As String, Detail_Text As String
Dim Temp_Result As Boolean, Temp_Build As Boolean, New_Settings As Boolean
Const Set_Text_1 As String = " Attempting to Set Port With Supplied Settings "
Const Set_Text_2 As String = " Attempting to use Existing Port Settings, "
Const Set_Text_3 As String = " Building new Device Control Block (DCB), result = "
Const Set_Text_4 As String = " Supplied Settings applied to Port = "
Const Set_Text_5 As String = " Using Existing Port Settings, "
Const Set_Text_6 As String = " Failed to build DCB, "
Const Set_Text_7 As String = " Failed to apply configuration settings, "
Const Set_Text_8 As String = " Failed to get existing Device Control Block (DCB) Settings "
If GET_PORT_CONFIG(Port_Number) Then ' get existing com port config (baud, parity etc.) into device control block
New_Settings = Len(Port_Settings) > LONG_4
Temp_String = IIf(New_Settings, Set_Text_1 & Port_Settings, Set_Text_2 & GET_PORT_SETTINGS(Port_Number))
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_CONFIG, COM_PORT(Port_Number).Name & Temp_String)
If New_Settings Then
Temp_Build = Build_Port_DCB(Port_Settings, COM_PORT(Port_Number).DCB)
COM_PORT(Port_Number).DLL_Error = Err.LastDllError
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_CONFIG, COM_PORT(Port_Number).Name & Set_Text_3 & Temp_Build)
If Temp_Build Then
Temp_Result = Apply_Port_DCB(COM_PORT(Port_Number).Handle, COM_PORT(Port_Number).DCB)
COM_PORT(Port_Number).DLL_Error = Err.LastDllError
If Temp_Result Then
Result_Text = TEXT_SUCCESS
Detail_Text = Set_Text_4 & GET_PORT_SETTINGS(Port_Number)
Else
Result_Text = TEXT_FAILURE
Detail_Text = Set_Text_7 & DLL_ERROR_TEXT(COM_PORT(Port_Number).DLL_Error)
End If
Else
Temp_Result = False
Result_Text = TEXT_FAILURE
Detail_Text = Set_Text_6 & DLL_ERROR_TEXT(COM_PORT(Port_Number).DLL_Error)
End If
Else
Temp_Result = True
Result_Text = TEXT_SUCCESS
Detail_Text = Set_Text_5 & GET_PORT_SETTINGS_FROM_DCB(Port_Number)
End If
Else
Temp_Result = False
Result_Text = TEXT_FAILURE
Detail_Text = Set_Text_8
End If
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Result_Text, COM_PORT(Port_Number).Name & Detail_Text)
SET_PORT_CONFIG = Temp_Result
End Function
Private Function SET_PORT_VALUES(Port_Number As Long) As Boolean
'-------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "SET_PORT_VALUES"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'-------------------------------------------------------------------------
' optional - can change wait_characters_nnnn to suit local requirements.
'
Const WAIT_CHARACTERS_EXIT As Long = 2 ' characters
Const WAIT_CHARACTERS_CHAR As Long = 5
Const WAIT_CHARACTERS_DATA As Long = 20
Const WAIT_CHARACTERS_LINE As Long = 100
'
' optional - can change read exit wait timers to suit local requirements.
'
Const READ_EXIT_TIMER_FAST As Long = 100000 ' MicroSeconds
Const READ_EXIT_TIMER_SLOW As Long = 500000
Const READ_EXIT_TIMER_ELSE As Long = 125000
'
' ------------------------------------------------------------------------
Dim Temp_Result As Boolean
Dim Frame_MicroSeconds As Single
Dim Timeslice_Bytes As Long, Bytes_Per_Second As Long, Read_Buffer_Length As Long
Const TEXT_READ_BYTES As String = "READ_BYTES"
Const TEXT_READ_BUFFER As String = "READ_BUFFER"
Const Values_Text_1 As String = " Insufficient Read Buffer Size, Buffer Length = "
Const Values_Text_2 As String = " Synchronous Read Buffer Length (Max Timeslice Bytes) = "
Const Values_Text_3 As String = " Setting Timeslice Bytes per Synchronous Read / Write = "
Frame_MicroSeconds = GET_FRAME_TIME(Port_Number)
Bytes_Per_Second = Int(LONG_1 / Frame_MicroSeconds * LONG_1E6)
Read_Buffer_Length = Len(COM_PORT(Port_Number).Buffers.Read_Buffer)
Timeslice_Bytes = IIf(Bytes_Per_Second < Read_Buffer_Length, Bytes_Per_Second, Read_Buffer_Length)
If Read_Buffer_Length > LONG_0 Then
Temp_Result = True
COM_PORT(Port_Number).Timers.Port_Data_Time = LONG_0
COM_PORT(Port_Number).Timers.Last_Data_Time = LONG_0
COM_PORT(Port_Number).Timers.Timeslice_Bytes = Timeslice_Bytes
COM_PORT(Port_Number).Timers.Bytes_Per_Second = Bytes_Per_Second
COM_PORT(Port_Number).Timers.Frame_MicroSeconds = Frame_MicroSeconds
COM_PORT(Port_Number).Timers.Frame_MilliSeconds = Frame_MicroSeconds / LONG_1000
COM_PORT(Port_Number).Buffers.Read_Buffer_Length = Read_Buffer_Length
COM_PORT(Port_Number).Settings = GET_PORT_SETTINGS(Port_Number)
COM_PORT(Port_Number).Timers.Exit_Loop_Wait = Int(LONG_1 + COM_PORT(Port_Number).Timers.Frame_MilliSeconds) * WAIT_CHARACTERS_EXIT
COM_PORT(Port_Number).Timers.Char_Loop_Wait = Int(LONG_1 + COM_PORT(Port_Number).Timers.Frame_MilliSeconds) * WAIT_CHARACTERS_CHAR
COM_PORT(Port_Number).Timers.Data_Loop_Wait = Int(LONG_1 + COM_PORT(Port_Number).Timers.Frame_MilliSeconds) * WAIT_CHARACTERS_DATA
COM_PORT(Port_Number).Timers.Line_Loop_Wait = Int(LONG_1 + COM_PORT(Port_Number).Timers.Frame_MilliSeconds) * WAIT_CHARACTERS_LINE
If COM_PORT(Port_Number).Timers.Exit_Loop_Wait > VBA_TIMEOUT / LONG_5 Then COM_PORT(Port_Number).Timers.Exit_Loop_Wait = LONG_1000
If COM_PORT(Port_Number).Timers.Char_Loop_Wait > VBA_TIMEOUT / LONG_5 Then COM_PORT(Port_Number).Timers.Char_Loop_Wait = LONG_1000
If COM_PORT(Port_Number).Timers.Data_Loop_Wait > VBA_TIMEOUT / LONG_5 Then COM_PORT(Port_Number).Timers.Data_Loop_Wait = LONG_1000
If COM_PORT(Port_Number).Timers.Line_Loop_Wait > VBA_TIMEOUT / LONG_5 Then COM_PORT(Port_Number).Timers.Line_Loop_Wait = LONG_1000
Select Case Bytes_Per_Second
Case Is > LONG_1000: COM_PORT(Port_Number).Timers.Read_Wait_Time = READ_EXIT_TIMER_FAST
Case Is < LONG_100: COM_PORT(Port_Number).Timers.Read_Wait_Time = READ_EXIT_TIMER_SLOW
Case Else: COM_PORT(Port_Number).Timers.Read_Wait_Time = READ_EXIT_TIMER_ELSE
End Select
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_READ_BUFFER, COM_PORT(Port_Number).Name & Values_Text_2 & Read_Buffer_Length)
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_READ_BYTES, COM_PORT(Port_Number).Name & Values_Text_3 & Timeslice_Bytes)
Else ' read buffer size not > 0
Temp_Result = False
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_READ_BUFFER, COM_PORT(Port_Number).Name & Values_Text_1 & Read_Buffer_Length)
End If
SET_PORT_VALUES = Temp_Result
End Function
Public Function SHOW_PORT_VALUES(Port_Number As Long) As Boolean
'--------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "SET_PORT_VALUES"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'--------------------------------------------------------------------------
Const Print_Text_1 As String = "PORT_VALUES"
Const Print_Text_2 As String = "FRAME_TIME"
Const Print_Text_3 As String = "SPEED"
Const Print_Text_4 As String = "BUFFER"
Const Print_Text_5 As String = "TIMING"
Const Print_Text_6 As String = "SETTINGS"
Const Value_Text_01 As String = " Standard Port Settings "
Const Value_Text_02 As String = " MilliSeconds per Read/Write character "
Const Value_Text_03 As String = " MicroSeconds per Read/Write character "
Const Value_Text_04 As String = " Read/Write speed in Bytes per Second "
Const Value_Text_05 As String = " Exit Loop Wait Time MilliSeconds "
Const Value_Text_06 As String = " Char Loop Wait Time MilliSeconds "
Const Value_Text_07 As String = " Data Loop Wait Time MilliSeconds "
Const Value_Text_08 As String = " Line Loop Wait Time MilliSeconds "
Const Value_Text_09 As String = " Synch. Read Timeout MicroSeconds "
Const Value_Text_10 As String = " Read/Write 1-Second Timeslice Bytes "
Const Value_Text_11 As String = " Maximum Synchronous Read Buffer Size "
Dim Temp_Result As Boolean, Port_Name As String
If Port_Valid Then
If Port_Started(Port_Number) Then
Temp_Result = True
Port_Name = COM_PORT(Port_Number).Name
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_6, Port_Name & Value_Text_01, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Settings)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_2, Port_Name & Value_Text_02, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Frame_MilliSeconds)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_2, Port_Name & Value_Text_03, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Frame_MicroSeconds)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_3, Port_Name & Value_Text_04, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Bytes_Per_Second)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_5, Port_Name & Value_Text_05, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Exit_Loop_Wait)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_5, Port_Name & Value_Text_06, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Char_Loop_Wait)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_5, Port_Name & Value_Text_07, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Data_Loop_Wait)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_5, Port_Name & Value_Text_08, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Line_Loop_Wait)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_5, Port_Name & Value_Text_09, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Read_Wait_Time)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_5, Port_Name & Value_Text_10, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Timers.Timeslice_Bytes)
Call PRINT_SHOW_TEXT(Print_Text_1, Print_Text_4, Port_Name & Value_Text_11, TEXT_EQUALS_SPACE & COM_PORT(Port_Number).Buffers.Read_Buffer_Length)
Else
Call PRINT_STOPPED_TEXT(Module_Name, Port_Number)
End If
Else
Call PRINT_INVALID_TEXT(Module_Name, Port_Number)
End If
SHOW_PORT_VALUES = Temp_Result
End Function
Private Function CLOSE_PORT_HANDLE(Port_Number As Long) As Boolean
'----------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "RELEASE_PORT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'----------------------------------------------------------------------
Dim Port_Handle As Long
Dim Temp_Result As Boolean
Dim Result_Text As String, Detail_Text As String
Const Close_Text_1 As String = " Attempting to Close Synchronous Port Handle "
Const Close_Text_2 As String = " Closed Synchronous Port Handle "
Const Close_Text_3 As String = " Error Closing Port, "
Port_Handle = COM_PORT(Port_Number).Handle
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, TEXT_CLOSING, COM_PORT(Port_Number).Name & Close_Text_1 & Port_Handle)
Temp_Result = Com_Port_Close(Port_Handle)
COM_PORT(Port_Number).DLL_Error = Err.LastDllError
If Temp_Result Then
Result_Text = TEXT_SUCCESS
Detail_Text = Close_Text_2 & Port_Handle
Else
Result_Text = TEXT_FAILURE
Detail_Text = Close_Text_3 & DLL_ERROR_TEXT(COM_PORT(Port_Number).DLL_Error)
End If
CLOSE_PORT_HANDLE = Temp_Result
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Result_Text, COM_PORT(Port_Number).Name & Detail_Text)
End Function
Public Function STOP_COM_PORT(Port_Number As Long) As Boolean
'-----------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "STOP_COM_PORT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'-----------------------------------------------------------------------
Dim Temp_Handle As Long
Dim Temp_Result As Boolean
Dim Result_Text As String, Detail_Text As String, Temp_Name As String
Const Stop_Text_1 As String = " Attempting to Stop COM Port "
Const Stop_Text_2 As String = " Stopped COM Port with Handle "
Const Stop_Text_3 As String = " Error Closing Port with Handle "
Const Stop_Text_4 As String = " with Handle "
If Port_Valid Then
If Port_Started(Port_Number) Then
Temp_Name = COM_PORT(Port_Number).Name
Temp_Handle = COM_PORT(Port_Number).Handle
If Port_Debug Then
Detail_Text = Temp_Name & Stop_Text_1 & Port_Number & Stop_Text_4 & Temp_Handle
Call PRINT_DEBUG_TEXT(Module_Name, TEXT_STOPPING, Detail_Text)
End If
PURGE_COM_PORT Port_Number
If CLOSE_PORT_HANDLE(Port_Number) Then
PURGE_BUFFERS Port_Number
COM_PORT(Port_Number).Name = vbNullString
COM_PORT(Port_Number).Handle = LONG_0
Detail_Text = Stop_Text_2 & Temp_Handle
Result_Text = TEXT_SUCCESS
Temp_Result = True
Else
Temp_Result = False
Result_Text = TEXT_FAILURE
Detail_Text = Stop_Text_3 & Temp_Handle
End If
If Port_Debug Then Call PRINT_DEBUG_TEXT(Module_Name, Result_Text, Temp_Name & Detail_Text)
Else
If Port_Debug Then Call PRINT_STOPPED_TEXT(Module_Name, Port_Number)
End If
Else
Call PRINT_INVALID_TEXT(Module_Name, Port_Number)
End If
STOP_COM_PORT = Temp_Result
End Function
Public Function WAIT_COM_PORT(Port_Number As Long, Optional Wait_MilliSeconds As Long = LONG_333) As Boolean
'-----------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "WAIT_COM_PORT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'-----------------------------------------------------------------------
Dim Wait_String As String
Dim WAIT_RESULT As Boolean
Const Wait_String_1 As String = " Waiting for Receive Data, Wait Time = "
Const Wait_String_2 As String = " mS for Receive Data, Result = "
Const Wait_String_3 As String = " Waited "
If Port_Valid Then
If Port_Started(Port_Number) Then
If Port_Debug Then
Wait_String = Wait_String_1 & Wait_MilliSeconds & TEXT_MS
Call PRINT_DEBUG_TEXT(Module_Name, TEXT_STARTED, COM_PORT(Port_Number).Name & Wait_String)
PORT_MICROSECONDS_NOW Port_Number
WAIT_RESULT = SYNCHRONOUS_WAIT_COM_PORT(Port_Number, Wait_MilliSeconds)
PORT_MICROSECONDS_END Port_Number
Wait_String = Wait_String_3 & PORT_MILLISECONDS(Port_Number) & Wait_String_2 & WAIT_RESULT
Call PRINT_DEBUG_TEXT(Module_Name, TEXT_RESULT, COM_PORT(Port_Number).Name & Wait_String)
Else
WAIT_RESULT = SYNCHRONOUS_WAIT_COM_PORT(Port_Number, Wait_MilliSeconds)
End If
Else
If Port_Debug Then Call PRINT_STOPPED_TEXT(Module_Name, Port_Number)
End If
Else
Call PRINT_INVALID_TEXT(Module_Name, Port_Number)
End If
WAIT_COM_PORT = WAIT_RESULT
End Function
Private Function SYNCHRONOUS_WAIT_COM_PORT(Port_Number As Long, Wait_MilliSeconds As Long) As Boolean
'--------------------------------------------------------------------------
Dim Port_Debug As Boolean: Const Module_Name As String = "SYNCHRONOUS_WAIT"
Dim Port_Valid As Boolean: Port_Valid = Port_Number_Valid(Port_Number)
If Port_Valid Then Port_Debug = COM_PORT(Port_Number).Debug
'--------------------------------------------------------------------------
Dim Debug_Text As String, Error_Text As String, Port_Name As String
Dim Data_Waiting As Boolean, Wait_Expired As Boolean, Clear_Result As Boolean
Dim Loop_Iteration As Long, Wait_Remaining As Long, Queue_Length As Long
Dim Loop_Remainder As Long, Loop_Wait_Time As Long, Sleep_Time As Long
Const Loop_Time As Long = LONG_100 ' MilliSeconds
Const Wait_Text_1 As String = " Approximate Wait Time "
Const Wait_Text_2 As String = " mS, Loop Count = "
Const Wait_Text_3 As String = " Loop Countdown "
Const Wait_Text_4 As String = " Wait Time Remaining = "
Const Wait_Text_5 As String = " Receive Data Queue Length = "
Const Wait_Text_6 As String = " Synchronous Wait, Wait Time Remaining = "
Const Wait_Text_7 As String = " Clear Comms Error Failed, "
Const Wait_Text_8 As String = " Clear Comms Error Failed, Input Queue Data not available"
Wait_Remaining = IIf(Wait_MilliSeconds < LONG_1, LONG_1, Wait_MilliSeconds)
Loop_Wait_Time = IIf(Wait_MilliSeconds < Loop_Time, Wait_Remaining, Loop_Time)
Loop_Remainder = IIf(Wait_Remaining Mod Loop_Wait_Time > LONG_0, LONG_1, LONG_0)
Loop_Iteration = Int(Wait_Remaining / Loop_Wait_Time) + Loop_Remainder
If Port_Debug Then
Port_Name = COM_PORT(Port_Number).Name
Debug_Text = Wait_Text_1 & Wait_Remaining & Wait_Text_2 & Loop_Iteration
Call PRINT_DEBUG_TEXT(Module_Name, TEXT_WAITING, Port_Name & Debug_Text)
End If
Do
Clear_Result = Com_Port_Clear(COM_PORT(Port_Number).Handle, COM_PORT(Port_Number).Port_Errors, COM_PORT(Port_Number).Status)
COM_PORT(Port_Number).DLL_Error = Err.LastDllError
If Clear_Result Then
Queue_Length = COM_PORT(Port_Number).Status.QUEUE_IN
Data_Waiting = Queue_Length > LONG_0
If Not Data_Waiting Then
Wait_Expired = Wait_Remaining < LONG_1
If Not Wait_Expired Then
If Port_Debug Then
Debug_Text = Wait_Text_3 & Loop_Iteration & TEXT_COMMA & Wait_Text_4 & Wait_Remaining & TEXT_MS
Call PRINT_DEBUG_TEXT(Module_Name, TEXT_WAITING, Port_Name & Debug_Text)