-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathOperation 50.vbs
1282 lines (1147 loc) · 54.4 KB
/
Operation 50.vbs
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
Option Explicit
'****** Version History *********
'1.0 10/15/2018 - Initial release to production
'1.1 4/9/2019 - Updated "In MRB" search to ignore Null. MRB location table tracking was updated to record in and out from the cage, null is for when the part is no longer in the cage [shows red in the final inspection, but didn't error in shipping]
'***************************************
Dim ScriptHost : ScriptHost = Mid(WScript.FullName, InStrRev(WScript.FullName, "\") + 1, Len(WScript.FullName))
Dim objShell : Set objShell = CreateObject("WScript.Shell")
Dim oProcEnv : Set oProcEnv = objShell.Environment("Process")
Dim allOPSsource : allOPSsource = "G:\Flow\Operations\Seattle\Quality\Contract Cutting\Operation Documents\Scripts\All Operations.vbs"
Dim sOPsCmd : sOPsCmd = """" & oProcEnv("windir") & "\SysWOW64\" & ScriptHost & """" & " """ & allOPSsource & """" & sArg
Dim dataSource : dataSource = "PRODSQLAPP01.shapetechnologies.com\PRODSQLAPP01"
Dim adminPassword : adminPassword = "FLOW288"
Dim tabletPassword : tabletPassword = "Fl0wSh0p17"
Dim computerPassword : computerPassword = "Snowball18!"
Dim closeWindow : closeWindow = false
Dim errorWindow : errorWindow = false
Dim adminMode : adminMode = false
Dim debugMode : debugMode = false
Dim POChange : POChange = false
Dim boxSize : boxSize = 12
Dim notFoundCount : notFoundCount = 0
Dim prodCount : prodCount = -1
Dim prodArray()
Dim fieldArray(2)
Dim MRBArray : MRBArray = Array("MRB Staging", "Scrap", "Scrap Box 1", "Scrap Box 2", _
"A1", "A2", "A3", "A4", "A5", "A6", _
"B1", "B2", "B3", "B4", "B5", "B6", _
"C1", "C2", "C4", "C5", "C5", "C6", _
"D1", "D2", "D3", "D4", "D5", "D6", _
"E1", "E2", "E3", "E4", "E5", "E6", _
"F1", "F2", "F3", "F4", "F5", "F6", _
"G1", "G2", "G3", "G4", "G5", "G6", _
"H1", "H2", "H3", "H4", "H5", "H6", _
"I1", "I2", "I3", "I4", "I5", "I6", _
"J1", "J2", "J3", "J4", "J5", "J6", _
"K1", "K2", "K3", "K4", "K5", "K6", _
"L1", "L2", "L3", "L4", "L5", "L6")
Dim DispositionArray : DispositionArray = Array("In MRB", "Return to Customer", "Scrap", "Supplier Rework/Remake", "Use As Is", "Void")
Dim StatusArray : StatusArray = Array("Need to be created", "Created", "Closed")
Dim strData, fieldsBad
Dim SendData, RecieveData, wmi, cProcesses, oProcess
Dim machineBox, strSelection, RemoteHost, RemotePort
'************** TO DO *****************
'****** CHANGE THESE SETTINGS *********
'***************************************
Const sckClosed = 0 '// Default. Closed
Const sckOpen = 1 '// Open
Const sckListening = 2 '// Listening
Const sckConnectionPending = 3 '// Connection pending
Const sckResolvingHost = 4 '// Resolving host
Const sckHostResolved = 5 '// Host resolved
Const sckConnecting = 6 '// Connecting
Const sckConnected = 7 '// Connected
Const sckClosing = 8 '// Peer is closing the connection
Const sckError = 9 '// Error
Const adOpenDynamic = 2 '// Uses a dynamic cursor. Additions, changes, and deletions by other users are visible, and all types of movement through the Recordset are allowed, except for bookmarks, if the provider doesn't support them.
Const adOpenForwardOnly = 0 '// Default. Uses a forward-only cursor. Identical to a static cursor, except that you can only scroll forward through records. This improves performance when you need to make only one pass through a Recordset.
Const adOpenKeyset = 1 '// Uses a keyset cursor. Like a dynamic cursor, except that you can't see records that other users add, although records that other users delete are inaccessible from your Recordset. Data changes by other users are still visible.
Const adOpenStatic = 3 '// Uses a static cursor, which is a static copy of a set of records that you can use to find data or generate reports. Additions, changes, or deletions by other users are not visible.
Const adOpenUnspecified = -1 '// Does not specify the type of cursor.
Const adLockBatchOptimistic = 4 '// Indicates optimistic batch updates. Required for batch update mode.
Const adLockOptimistic = 3 '// Indicates optimistic locking, record by record. The provider uses optimistic locking, locking records only when you call the Update method.
Const adLockPessimistic = 2 '// Indicates pessimistic locking, record by record. The provider does what is necessary to ensure successful editing of the records, usually by locking records at the data source immediately after editing.
Const adLockReadOnly = 1 '// Indicates read-only records. You cannot alter the data.
Const adLockUnspecified = -1 '// Does not specify a type of lock. For clones, the clone is created with the same lock type as the original.
Const adStateClosed = 0 '// The object is closed
Const adStateOpen = 1 '// The object is open
Const adStateConnecting = 2 '// The object is connecting
Const adStateExecuting = 4 '// The object is executing a command
Const adStateFetching = 8 '// The rows of the object are being retrieved
'*********************************************************
' Am I running 64-bit version of WScript.exe/Cscript.exe? So, call script again in x86 script host and then exit.
If InStr(LCase(WScript.FullName), LCase(oProcEnv("windir") & "\System32\")) And oProcEnv("PROCESSOR_ARCHITECTURE") = "AMD64" Then
If Not WScript.Arguments.Count = 0 Then
Dim sArg, Arg : sArg = ""
For Each Arg In Wscript.Arguments
sArg = sArg & " " & """" & Arg & """"
Next
End If
Dim sCmd : sCmd = """" & oProcEnv("windir") & "\SysWOW64\" & ScriptHost & """" & " """ & WScript.ScriptFullName & """" & sArg
objShell.Run sCmd
WScript.Quit
End If
If debugMode = False Then On Error Resume Next
objShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1406", 0, "REG_DWORD" 'Changes security settings on ie to allow HTA
objShell.RegWrite "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\TcpTimedWaitDelay", "30", "REG_DWORD" 'Changes TCP timeout settings if needing to restart program w/in 5 minutes
On Error Goto 0
'Checks for existing vbs scripts that are running and terminates them, avoids locking up ports
Set wmi = GetObject("winmgmts:root\cimv2")
Set cProcesses = wmi.ExecQuery("select * from win32_process where Name like '%mshta.exe%'")
For Each oProcess in cProcesses
oProcess.Terminate()
Next
If Not WScript.Arguments.Count = 0 Then
sArg = ""
For Each Arg In Wscript.Arguments
sArg = sArg & " " & """" & Arg & """"
Next
End If
Dim machineString : machineString = sArg
If sArg <> "" Then
Do While AscW(Right(machineString, 1)) = 34 or AscW(Right(machineString, 1)) = 32
machineString = Left(machineString, Len(machineString) - 1)
Loop
Do While AscW(Left(machineString, 1)) = 34 or AscW(Left(machineString, 1)) = 32
machineString = Right(machineString, Len(machineString) - 1)
Loop
Else
machineString = "Manual"
End If
If Left(machineString, 3) = "COM" Then
Dim objComport : Set objComport = CreateObject( "AxSerial.ComPort" )
objComport.Clear()
objComport.LicenseKey = "FD2C1-DC93A-6BFBF"
objComport.Device = machineString
objComport.BaudRate = 112500
objComport.ComTimeout = 1000 ' Timeout after 1000msecs
ElseIf Left(machineString, 4) = "SHIP" or Left(machineString, 2) = "QA" Then
'// CREATE WINSOCK: 0 - QA Scabben
Dim winsock : Set winsock = Wscript.CreateObject("OSWINSCK.Winsock", "winsock_")
'// CREATE WINSOCK: 0 - QA Scanner
If Err.Number <> 0 Then
MsgBox "Winsock Object Error!" & vbCrLf & "Script will exit now."
WScript.Quit
End If
Load_IP
End If
Dim leftX : leftX = 0
Dim topY : topY = 0
If Left(MachineString, 2) = "QA" Then
leftX = 0 '2200
topY = 20
End If
'Calls function to create ie window
Dim windowBox : set windowBox = HTABox("white", 830, 1000, leftX , topY) : with windowBox
.document.title = "Operation 50"
'Function to check for access connection and load info from database
Dim AccessResult : AccessResult = Load_Access
Call checkDatabase
'Connects to the scanner
Call connect2Scanner
'.document.accessText.focus
'.document.accessText.select
do until closeWindow = true 'Run loop until conditions are met
do until .done.value = "cancel" or .done.value = "access" or .done.value = "scanner" or .submitButton.value = "true" _
or .done.value = "allOps" or .done.value = "SQLSubmit" or .done.value = "addETag" or .done.value = "removeETag" _
or .done.value = "eTagChange" or .done.value = "cancelMRB" or .done.value = "okMRB" or .done.value = "Reset"
wsh.sleep 50
On Error Resume Next
If .done.value = true Then
wsh.quit
End If
On Error GoTo 0
If Left(machineString, 3) = "COM" Then ReadResponse(objComport)
loop
if .done.value = "cancel" then 'If the x button is clicked
closeWindow = true 'Variable to end loop
ElseIf .done.value = "access" then
.done.value = false
windowBox.accessText.innerText = "Retrying connection."
windowBox.accessButton.style.backgroundcolor = "orange"
If FieldsCheckEmpty(windowBox.bladeID.innerText) Then
fieldArray(0) = windowBox.bladeID.innerText
fieldArray(1) = windowBox.POID.innerText
fieldArray(2) = windowBox.shipDate.value
fieldArray(3) = windowBox.PalletID.innerText
fieldArray(4) = windowBox.BoxID.innerText
fieldsBad = False
For n = 0 to ubound(fieldArray)
If FieldsCheckEmpty(fieldArray(n)) Then fieldsBad = True
Next
If fieldsBad = False Then LoadSNtoAccess
Else
AccessResult = Load_Access
checkDatabase
End If
ElseIf .done.value = "scanner" then
.done.value = false
connect2Scanner
ElseIf .done.value = "SQLSubmit" then
.done.value = false
windowBox.SubmitSQLButton.disabled = false
LoadSNtoAccess
ElseIf .submitButton.value = "true" Then
.submitButton.value = false
Check_String(windowBox.submitText.value)
.returnToHTA.click()
ElseIf .done.value = "allOps" Then
objShell.Run sOPsCmd
WScript.Quit
ElseIf .done.value = "addETag" Then
.done.value = false
.addMRBButton.disabled = true
SQL_ETag("Add")
.addMRBButton.disabled = false
ElseIf .done.value = "removeETag" Then
.done.value = false
.removeMRBButton.disabled = true
SQL_ETag("Remove")
.removeMRBButton.disabled = false
AccessCheck
ElseIf .done.value = "eTagChange" Then
.done.value = false
SQL_ETag("Change")
ElseIf .done.value = "okMRB" Then
.done.value = false
.addMRBButton.number = false
.addMRBButton.disabled = false
saveMRBChange(.addMRBButton.number)
AccessCheck
ElseIf .done.value = "cancelMRB" Then
.done.value = false
.addMRBButton.disabled = false
AccessCheck
ElseIf .done.value = "Reset" Then
.done.value = false
CleanUpScreen
End If
loop
.close 'Closes the window
end with
ServerClose() 'Function to close open connections and return settings back to original
Wscript.Quit
Function HTABox(sBgColor, h, w, l, t)
Dim IE, nRnd
randomize : nRnd = Int(1000000 * rnd)
sCmd = "mshta.exe ""javascript:{new " _
& "ActiveXObject(""InternetExplorer.Application"")" _
& ".PutProperty('" & nRnd & "',window);" _
& "window.moveTo(" & l & ", " & t & "); " _
& "window.resizeTo(" & w & "," & h & ")}"""
with CreateObject("WScript.Shell")
.Run sCmd, 1, False
do until .AppActivate("javascript:{new ") : WSH.sleep 10 : loop
end with
For Each IE In CreateObject("Shell.Application").windows
If IsObject(IE.GetProperty(nRnd)) Then
set HTABox = IE.GetProperty(nRnd)
IE.Quit
HTABox.document.title = "HTABox"
HTABox.document.write LoadHTML(sBgColor)
Exit Function
End If
Next
MsgBox "HTA window not found."
wsh.quit
End Function
Function connect2Scanner()
Dim secs : secs = 0
If machineString <> "Manual" and machineString <> "" Then
windowBox.scannerText.innerText = "Connect to " & machineString
windowBox.scannerButton.style.backgroundcolor = "orange"
windowBox.scannerButton.disabled = true
windowBox.errorString.innerText = ""
End If
'Stores variable if connected to part marker
If machineString = "Manual" Then
windowBox.scannerText.innerText = "Manual scanner mode"
windowBox.scannerButton.style.backgroundcolor = "limegreen"
windowBox.scannerButton.disabled = true
windowBox.errorString.innerText = ""
windowBox.manualSerialNumber.style.backgroundColor = "DimGrey"
windowBox.SerialNumberText.style.visibility = "hidden"
windowBox.inputFormDiv.style.visibility = "visible"
windowBox.inputForm.disabled = false
windowBox.inputForm.stringInput.disabled = false
windowBox.inputForm.stringInput.focus
ElseIf Left(machineString, 3) = "COM" Then
objComport.Open
If( objComport.LastError <> 0 ) Then
windowBox.scannerText.innerText = "Error: " & machineString
windowBox.errorString.innerText = objComport.LastError & " (" & objComport.GetErrorDescription( objComport.LastError ) & ")"
windowBox.scannerButton.style.backgroundcolor = "red"
windowBox.scannerButton.disabled = false
Else
windowBox.scannerText.innerText = "Connected to " & machineString
windowBox.scannerButton.style.backgroundcolor = "limegreen"
windowBox.scannerButton.disabled = true
End If
Else
' loads port settings into winsock
If winsock.state <> sckClosed Then winsock.Disconnect
If RemoteHost <> "" and RemotePort <> "" Then
winsock.RemoteHost = RemoteHost
winsock.RemotePort = RemotePort
'Connects to the scanner
On Error Resume Next
winsock.Connect
On Error GoTo 0
'// MAIN DELAY - WAITS FOR CONNECTED STATE
'// SOCKET ERROR RAISES WINSOCK ERROR SUB
while winsock.State <> sckError And winsock.state <> sckConnected And winsock.state <> sckClosing And secs < 25
WScript.Sleep 1000 '// 1 sec delay in loop
secs = secs + 1 '// wait 25 secs max
Wend
End If
If winsock.state = sckConnected Then
windowBox.scannerText.innerText = "Connected to " & machineString
windowBox.scannerButton.style.backgroundcolor = "limegreen"
windowBox.scannerButton.disabled = true
Else
windowBox.scannerText.innerText = "Error: " & machineString
windowBox.scannerButton.style.backgroundcolor = "red"
windowBox.scannerButton.disabled = false
End If
End If
End Function
Function checkDatabase()
If AccessResult = false Then
windowBox.accessText.innerText = "SQL Database not loaded"
windowBox.accessButton.style.backgroundcolor = "red"
Else
windowBox.accessText.innerText = "SQL Database connection successful"
windowBox.accessButton.style.backgroundcolor = "limegreen"
windowBox.accessButton.disabled = true
End If
End Function
Function adminSettings()
windowBox.SerialNumberInput.value = ""
duplicatePrefix = ""
windowBox.errorString.innerText = "ADMIN ACCESS GRANTED"
windowBox.duplicateButton.disabled = false
windowBox.adminText.style.visibility = "visible"
windowBox.adminButton.style.visibility = "visible"
windowBox.adminString.style.visibility = "visible"
End Function
Function TrimString(ByVal VarIn)
VarIn = Trim(VarIn)
If Len(VarIn) > 0 Then
Do While AscW(Right(VarIn, 1)) = 10 or AscW(Right(VarIn, 1)) = 13
VarIn = Left(VarIn, Len(VarIn) - 1)
Loop
Do While AscW(Left(VarIn, 1)) = 10 or AscW(Left(VarIn, 1)) = 13
VarIn = Right(VarIn, Len(VarIn) - 1)
Loop
End If
TrimString = Trim(VarIn)
End Function
Function Check_String(stringFromScanner)
Dim inputString, n
windowBox.submitText.value = ""
inputString = TrimString(stringFromScanner)
windowBox.errorDiv.style.background = ""
windowBox.errorString.innerText = ""
windowBox.SubmitSQLButton.disabled = true
If inputString = tabletPassword or inputString = computerPassword Then
Exit Function
ElseIf inputString = "Reset" Then
CleanUpScreen
windowBox.errorString.innerText = "Fields Reset"
Exit Function
ElseIf inputString = "AccessRetry" Then
windowBox.done.value = "access"
Exit Function
ElseIf inputString = "Cancel" Then
windowBox.done.value = "cancel"
Exit Function
ElseIf Left(inputString, 5) = "QA_" Then
machineString = inputString
sArg = """" & inputString & """"
RemoteHost = ""
RemotePort = ""
Load_IP
connect2Scanner
ElseIF Len(inputString) = 10 and Mid(inputString, 9, 1) = "-" and (Left(inputString, 1) = "D" or Left(inputString, 1) = "H") Then
CleanUpScreen
windowBox.bladeID.innerText = inputString
AccessCheck
End If
fieldArray(0) = windowBox.bladeID.innerText
fieldArray(1) = windowBox.inspectorID.innerText
fieldArray(2) = windowBox.CMMID.value
'H0000000-0
For n = 0 to ubound(fieldArray)
If FieldsCheckEmpty(fieldArray(n)) Then Exit Function
Next
windowBox.SubmitSQLButton.disabled = false
End Function
Function FieldsCheckEmpty(VarIN)
FieldsCheckEmpty = False
If VarIN = false Then
FieldsCheckEmpty = True
ElseIf VarIN = "false" Then
FieldsCheckEmpty = True
ElseIf VarIN = "" Then
FieldsCheckEmpty = True
ElseIf AscW(Left(VarIN,1)) = 32 Then
FieldsCheckEmpty = True
ElseIf AscW(Left(VarIN,1)) = 160 Then
FieldsCheckEmpty = True
ElseIf VarIN = "NO OPEN PO'S FOUND" Then
FieldsCheckEmpty = True
End If
End Function
Function LoadSNtoAccess()
'Dim CurrentTime, Operator, strQueryPre, sqlString, rs, Duplicate, SCFound, POID, ShipDate, PalletID, BoxID, strQuery, accept
Dim objCmd : set objCmd = GetNewConnection
Dim bladeID : bladeID = windowBox.bladeID.innerText
Dim accept: If windowBox.CMMID.value = 1 Then
accept = "'N'"
ElseIf windowBox.CMMID.value = 2 Then
accept = "'Y'"
Else
accept = "null"
End If
Dim comment : comment = windowBox.commentNote.value
Dim strQuery : strQuery = "UPDATE [50_Final] SET "
strQuery = strQuery & "[Accepted Y/N] = " & accept & ", "
strQuery = strQuery & "[Comments] = '" & comment & "' "
strQuery = strQuery & "WHERE [Blade S/N] = '" & bladeID & "';"
On Error GoTo 0
If objCmd is Nothing Then
windowBox.errorString.innerText = "Error connecting to database, data not sent"
windowBox.accessText.innerText = "Connection failed, click to retry."
windowBox.accessButton.style.backgroundcolor = "red"
windowBox.accessButton.disabled = false
windowBox.errorDiv.style.background = "red"
Exit Function
ElseIf windowBox.accessButton.style.backgroundcolor <> "limegreen" Then
windowBox.accessText.innerText = "Access connection successful"
windowBox.accessButton.style.backgroundcolor = "limegreen"
windowBox.accessButton.disabled = true
windowBox.errorDiv.style.background = ""
End If
Dim rs : Set rs = objCmd.Execute(strQuery)
Set rs = Nothing
objCmd.Close
Set objCmd = Nothing
windowBox.errorDiv.style.background = "limegreen"
windowBox.errorString.innerText = bladeID & " updated " & accept & "."
CleanUpScreen
End Function
Function CleanUpScreen()
Dim oOption : Set oOption = windowBox.Document.CreateElement("OPTION")
windowBox.bladeID.innerText = ""
windowBox.PartNumber.innerHTML = ""
windowBox.inspectorID.innerText = ""
windowBox.prodID.innerHTML = ""
windowBox.inspectDate.innerHTML = ""
windowBox.CMMID.value = 0
windowBox.commentNote.value = ""
windowBox.MRBLoc.innerHTML = ""
windowBox.AEButton.style.backgroundcolor = ""
windowBox.InitialButton.style.backgroundcolor = ""
windowBox.PartMarkButton.style.backgroundcolor = ""
windowBox.FixtureButton.style.backgroundcolor = ""
windowBox.CMMButton.style.backgroundcolor = ""
windowBox.HasTagButton.style.backgroundcolor = ""
windowBox.MRBLocButton.style.backgroundColor = ""
windowBox.SubmitSQLButton.disabled = true
windowBox.ETagID.innerHTML = ""
oOption.text = "TBD"
oOption.Value = 0
windowBox.ETagID.add(oOption)
Set oOption = Nothing
End Function
Function GetNewConnection()
Dim objCmd : Set objCmd = CreateObject("ADODB.Connection")
Dim sConnection : sConnection = "Data Source=" & dataSource & ";Initial Catalog=CMM_Repository;Integrated Security=SSPI;"
Dim sProvider : sProvider = "SQLOLEDB.1;"
objCmd.ConnectionString = sConnection 'Contains the information used to establish a connection to a data store.
'objCmd.ConnectionTimeout 'Indicates how long to wait while establishing a connection before terminating the attempt and generating an error.
'objCmd.CommandTimeout 'Indicates how long to wait while executing a command before terminating the attempt and generating an error.
'objCmd.State 'Indicates whether a connection is currently open, closed, or connecting.
objCmd.Provider = sProvider 'Indicates the name of the provider used by the connection.
'objCmd.Version 'Indicates the ADO version number.
objCmd.CursorLocation = adOpenStatic 'Sets or returns a value determining who provides cursor functionality.
If debugMode = False Then On Error Resume Next
objCmd.Open
On Error GoTo 0
If objCmd.State = adStateOpen Then
Set GetNewConnection = objCmd
Else
Set GetNewConnection = Nothing
End If
End Function
Function AccessCheck()
Dim objCmd : set objCmd = GetNewConnection
Dim SlugSN : SlugSN = false
Dim sqlString, rs, a
Dim ETagIDS, ETag, oOption
If objCmd is Nothing Then Exit Function
sqlString = "SELECT COUNT([Blade S/N]) FROM [50_Final] WHERE [Blade S/N]='" & windowBox.bladeID.innerText & "';"
Set rs = objCmd.Execute(sqlString)
If rs(0).value = 0 Then
windowBox.errorDiv.style.background = "red"
windowBox.errorString.innerText = "Final Inspection is missing"
Exit Function
End If
Set rs = Nothing
sqlString = "SELECT TOP 1 [Blade S/N], [Blade Inspected Date], [Accepted Y/N], [Final Insp Inspector Last Name], [Comments], [ProdID] FROM [50_Final] WHERE [Blade S/N]='" & windowBox.bladeID.innerText & "';"
Set rs = objCmd.Execute(sqlString)
DO WHILE NOT rs.EOF
windowBox.bladeID.innerHTML = rs.Fields(0)
windowBox.inspectDate.innerHTML = rs.Fields(1)
If UCase(rs.Fields(2)) = "Y" Then
windowBox.CMMID.value = 2
ElseIf UCase(rs.Fields(2)) = "N" Then
windowBox.CMMID.value = 1
Else
windowBox.CMMID.value = 0
End IF
If rs.Fields(3) <> "" Then
windowBox.inspectorID.innerHTML = rs.Fields(3)
Else
windowBox.inspectorID.innerHTML = ""
End If
If rs.Fields(4) <> "" Then
windowBox.commentNote.value = rs.Fields(4)
End If
If rs.Fields(5) <> "" Then
windowBox.prodID.innerHTML = rs.Fields(5)
End If
rs.MoveNext
Loop
Set rs = Nothing
sqlString = "SELECT TOP 1 [FIC Blade Part Number], [Slug Serial Number] FROM [00_AE_SN_Control] WHERE [Blade Serial Number]='" & windowBox.bladeID.innerText & "';"
Set rs = objCmd.Execute(sqlString)
windowBox.AEButton.style.backgroundcolor = "red"
DO WHILE NOT rs.EOF
windowBox.PartNumber.innerHTML = rs.Fields(0)
SlugSN = rs.Fields(1)
windowBox.AEButton.style.backgroundcolor = "limegreen"
rs.MoveNext
Loop
Set rs = Nothing
If SlugSN = false Then
windowBox.AEButton.style.backgroundcolor = "red"
windowBox.InitialButton.style.backgroundcolor = "red"
Else
sqlString = "SELECT COUNT(*) FROM [00_Initial] WHERE [Slug S/N]='" & SlugSN & "';"
set rs = objCmd.Execute(sqlString)
If rs(0).value = 0 Then
windowBox.InitialButton.style.backgroundcolor = "red"
Else
windowBox.InitialButton.style.backgroundcolor = "limegreen"
End If
End If
Set rs = Nothing
sqlString = "SELECT COUNT(*) FROM [10_Part_Marking] WHERE [Blade Serial Number]='" & windowBox.bladeID.innerText & "';"
Set rs = objCmd.Execute(sqlString)
If rs(0).value <> 0 Then
windowBox.PartMarkButton.style.backgroundColor = "limegreen"
Else
windowBox.PartMarkButton.style.backgroundColor = "Red"
End If
Set rs = Nothing
sqlString = "SELECT COUNT(*) FROM [20_LPT5] WHERE [Blade SN Dash 1]='" & windowBox.bladeID.innerText & "' or [Blade SN Dash 2]='" & windowBox.bladeID.innerText & "';"
Set rs = objCmd.Execute(sqlString)
windowBox.FixtureButton.style.backgroundColor = "red"
If rs(0).value <> 0 Then
windowBox.FixtureButton.style.backgroundColor = "limegreen"
End If
Set rs = Nothing
sqlString = "SELECT COUNT(*) FROM [40_CMM_LPT5] WHERE [Serial Number]='" & windowBox.bladeID.innerText & "';"
Set rs = objCmd.Execute(sqlString)
If rs(0).value <> 0 Then
windowBox.CMMButton.style.backgroundColor = "limegreen"
Else
windowBox.CMMButton.style.backgroundColor = "Red"
End If
Set rs = Nothing
Dim rsFound : rsFound = false
sqlString = "SELECT TOP 1 [Serial Number], [Location] FROM [40_MRB] WHERE [Serial Number]='" & windowBox.bladeID.innerText & "' AND [Location] IS NOT NULL;"
Set rs = objCmd.Execute(sqlString)
windowBox.MRBLocButton.style.backgroundColor = "limegreen"
DO WHILE NOT rs.EOF
windowBox.MRBLocButton.style.backgroundColor = "red"
windowBox.MRBLoc.innerHTML = rs.Fields(1)
rs.MoveNext
Loop
Set rs = Nothing
rsFound = false
sqlString = "SELECT TOP 1 [Serial Number], [Tag Numbers], [Dispositions], [Status], [Summary Disposition], [Summary Status] FROM [40_Rejections] WHERE [Serial Number]='" & windowBox.bladeID.innerText & "';"
set rs = objCmd.Execute(sqlString)
windowBox.HasTagButton.style.backgroundColor = "limegreen"
DO WHILE NOT rs.EOF
windowBox.HasTagButton.style.backgroundColor = "red"
windowBox.ETagID.innerHTML = ""
ETagIDS = Split(rs.Fields(1), ";")
a = 0
For Each ETag in ETagIDS
If ETag <> "" Then
Set oOption = windowBox.Document.CreateElement("OPTION")
oOption.text = TrimString(ETag)
oOption.Value = a
windowBox.ETagID.add(oOption)
Set oOption = Nothing
a = a + 1
End If
Next
If rs.Fields(5) = "Closed" and (rs.Fields(4) = "Use As Is" or rs.Fields(4) = "Void" or rs.Fields(4) = "Return to Sender") Then
windowBox.HasTagButton.style.backgroundColor = "limegreen"
End If
rs.MoveNext
Loop
Set rs = Nothing
'SQL_ETag("Change")
objCmd.Close
Set objCmd = Nothing
End Function
Function SQL_ETag(Method)
Dim objCmd : set objCmd = GetNewConnection
Dim SlugSN : SlugSN = false
Dim sqlString, rs, a
Dim ETagNumber, oOption, objOption, objOptions
'msgbox Method
If objCmd is Nothing Then Exit Function
If Method = "Change" Then
'Dim DispositionArray : DispositionArray = Array("In MRB", "Return to Customer", "Scrap", "Supplier Rework/Remake", "Use As Is", "Void")
'Dim StatusArray : StatusArray = Array("Need to be created", "Created", "Closed")
sqlString = "SELECT TOP 1 [Disposition], [Status], [Created By], [Open Date] FROM [40_E-Tags] WHERE [Tag Number]='" & windowBox.ETagID(int(windowBox.ETagID.value)).innerText & "';"
set rs = objCmd.Execute(sqlString)
DO WHILE NOT rs.EOF
For a = 0 to UBound(DispositionArray)
If InStr(1, rs.Fields(0), DispositionArray(a)) <> 0 Then Exit For
Next
If a > UBound(DispositionArray) Then a = 0
windowBox.eTagDispositionSelect.value = a
For a = 0 to UBound(StatusArray)
If StatusArray(a) = rs.Fields(1) Then Exit For
Next
If a > UBound(StatusArray) Then a = 0
windowBox.eTagStatusSelect.value = a
windowBox.originatorID.innerHTML = rs.Fields(2)
windowBox.ETagDate.innerHTML = rs.Fields(3)
rs.MoveNext
Loop
Set rs = Nothing
sqlString = "SELECT [Serial Number] FROM [40_Rejections] WHERE [Tag Numbers] LIKE '%" & windowBox.ETagID(int(windowBox.ETagID.value)).innerText & "%';"
windowBox.SNIDs.innerHTML = ""
set rs = objCmd.Execute(sqlString)
DO WHILE NOT rs.EOF
If windowBox.SNIDs.innerHTML = "" Then
windowBox.SNIDs.innerHTML = rs.Fields(0)
Else
windowBox.SNIDs.innerHTML = windowBox.SNIDs.innerHTML & chr(10) & rs.Fields(0)
End If
rs.MoveNext
Loop
Set rs = Nothing
ElseIf Method = "Add" Then
ETagNumber = inputBox("Enter a Tag Number")
If ETagNumber <> "" Then
windowBox.addMRBButton.disabled = true
windowBox.addMRBButton.number = ETagNumber
If windowBox.ETagID(0).text = "TBD" Then windowBox.ETagID.innerHTML = ""
Set objOptions = windowBox.document.getElementById("ETagID")
a = 0
For Each objOption in objOptions
a = a + 1
Next
Set objOptions = Nothing
Set oOption = windowBox.Document.CreateElement("OPTION")
oOption.text = TrimString(ETagNumber)
oOption.Value = a
windowBox.ETagID.add(oOption)
Set oOption = Nothing
windowBox.ETagID.value = a
sqlString = "SELECT COUNT(*) FROM [40_E-Tags] WHERE [Tag Number]='" & ETagNumber & "';"
set rs = objCmd.Execute(sqlString)
If rs(0).value = 0 Then
windowBox.ETagDate.innerHTML = Now
windowBox.eTagDispositionSelect.value = 0
windowBox.eTagStatusSelect.value = 0
windowBox.statusSummary.innerHTML = "New Tag"
windowBox.originatorID.innerHTML = windowBox.InspectorID.innerHTML
windowBox.SNIDs.innerHTML = windowBox.bladeID.innerHTML
Else
msgbox windowBox.ETagID.value
windowBox.statusSummary.innerHTML = "New SN, Save"
SQL_ETag("Change")
End If
Set rs = Nothing
End If
Else
windowBox.addMRBButton.disabled = true
msgbox "Remove!"
End If
objCmd.Close
Set objCmd = Nothing
End Function
Function saveMRBChange(TagNumber)
Dim objCmd : set objCmd = GetNewConnection
Dim sqlString, rs
sqlString = "SELECT COUNT(*) FROM [40_Rejections] WHERE [Serial Number] = '" & windowBox.bladeID.innerHTML & "';"
set rs = objCmd.Execute(sqlString)
If rs(0).value = 0 Then
sqlString = "INSERT INTO [40_Rejections] ([Serial Number], [Tag Numbers], [Dispositions], [Status], [Summary Disposition], [Summary Status]) " _
& " VALUES ('" & windowBox.bladeID.innerHTML & "', '" & TagNumber & "', 'New Tag', 'New Tag', 'New Tag', 'New Tag');"
Else
Set rs = Nothing
sqlString = "SELECT TOP 1 [Tag Numbers] FROM [40_Rejections] WHERE [Serial Number] = '" & windowBox.bladeID.innerHTML & "';"
Set rs = objCmd.Execute(sqlString)
sqlString = ""
DO WHILE NOT rs.EOF
If InStr(1, rs.Fields(0), TagNumber) <> 0 Then
Exit Do
Else
msgbox rs.Fields(0)
sqlString = "UPDATE [40_Rejections] Set [Tag Numbers] = '" & rs.Fields(0) & chr(10) & TagNumber & ";' "_
& "WHERE [Serial Number] = '" & windowBox.bladeID.innerHTML & "';"
End If
rs.MoveNext
Loop
Set rs = Nothing
msgbox sqlString
If sqlString <> "" Then
Set rs = objCmd.Execute(sqlString)
Set rs = Nothing
End If
End If
msgbox sqlString
sqlString = "SELECT COUNT(*) FROM [40_MRB] WHERE [Serial Number] = '" & windowBox.bladeID.innerHTML & "';"
set rs = objCmd.Execute(sqlString)
If rs(0).value = 0 Then
sqlString = "INSERT INTO [40_MRB] ([Serial Number], [Location]) " _
& " VALUES ('" & windowBox.bladeID.innerHTML & "', '" & windowBox.MRBLocSelect(Int(windowBox.MRBLocSelect.Value)).Text & "');"
Else
sqlString = "UPDATE [40_MRB] Set [Location] = '" & windowBox.MRBLocSelect(Int(windowBox.MRBLocSelect.Value)).Text _
& "' WHERE [Serial Number] = '" & windowBox.bladeID.innerHTML & "';"
End If
Set rs = objCmd.Execute(sqlString)
Set rs = Nothing
objCmd.Close
Set objCmd = Nothing
End Function
Function Load_Access()
Dim objCmd : set objCmd = GetNewConnection
If objCmd is Nothing Then Load_Access = false : Exit Function
objCmd.Close
Set objCmd = Nothing
Load_Access = true
End Function
Function Load_IP()
Dim sqlString, rs
Dim objCmd : set objCmd = GetNewConnection
On Error GoTo 0
If objCmd is Nothing Then Exit Function
sqlString = "Select [IPAddress], [Port] From [00_Machine_IP] WHERE [DeviceType] = 'CognexBTHandheld' AND [MachineName] = '" & machineString & "';"
If machineString <> "Manual" Then
set rs = objCmd.Execute(sqlString)
DO WHILE NOT rs.EOF
RemoteHost = rs.Fields(0)
RemotePort = rs.Fields(1)
rs.MoveNext
Loop
End If
Set rs = Nothing
objCmd.Close
Set objCmd = Nothing
End Function
'// WINSOCK DATA ARRIVES
Function Send_Email(Message)
Exit Function
Dim MyEmail : Set MyEmail=CreateObject("CDO.Message")
Dim bodyPre : bodyPre = "<body><p><span style='font-size:12pt; color:red'>This is an automatically generated email, please reply to sender if you have any issues</span></p><br>" _
& "<p><span>Please close the following work orders:</span></p>"
Dim Signature : Signature = "<footer><div>" _
& "<span> </span><br>" _
& "<span> </span><br>" _
& "<span> </span><br>" _
& "<span style='font-size:7.5pt;font-family:""Franklin Gothic Medium"",sans-serif; color:teal'>Chris Zarlengo</span><span style='color:#1F497D'></span><br>" _
& "<span style='font-size:7.5pt;font-family:""Franklin Gothic Medium"",sans-serif; color:gray'>Manufacturing Engineer</span><span style='color:#1F497D'></span><br>" _
& "<span style='font-size:7.5pt;font-family:""Franklin Gothic Medium"",sans-serif; color:teal'>Flow International Corporation | <a href=""http://www.flowwaterjet.com/"">http://www.FlowWaterjet.com/</a></span><br>" _
& "<span style='font-size:7.5pt;font-family:""Franklin Gothic Medium"",sans-serif; color:gray'>23500 64th Ave. S. | Kent | Washington | 98032 | USA</span><br>" _
& "<span style='font-size:7.5pt;font-family:""Franklin Gothic Medium"",sans-serif; color:gray'>253-246-3741 | <a href=""mailto:CZarlengo@flowcorp.com"">CZarlengo@flowcorp.com</a><br>" _
& "<span> </span><br>" _
& "<span style='font-size:8.0pt;font-family:""Franklin Gothic Medium"",sans-serif; color:gray'>" _
& "This electronic message contains information from and is the property of Flow International Corporation (Flow). " _
& "The contents of this electronic message may be privileged and confidential and are for the use of the intended addressee(s) only. " _
& "If you are not an intended addressee, note that any disclosure, copying, distribution, or use of the contents of this message is prohibited. " _
& "If you have received this message in error, please contact the sender or call Flow immediately at (800) 962-8576.</span>" _
& "</div></footer>"
MyEmail.Subject="Contract cutting work orders need closing"
MyEmail.From="czarlengo@flowcorp.com"
MyEmail.To="czarlengo@flowcorp.com"
MyEmail.BCC="czarlengo@flowcorp.com"
MyEmail.HTMLBody = bodyPre & Message & Signature
MyEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
'SMTP Server
MyEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")="SKENEXC60.flowcorp.com"
'SMTP Port
MyEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
'SMTP Auth (For Windows Auth set this to 2)
MyEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")=2
MyEmail.Configuration.Fields.Update
MyEmail.Send
set MyEmail=nothing
End Function
Sub winsock_OnDataArrival(bytesTotal)
winsock.GetData strData, vbString
WScript.Sleep 1000
Check_String strData
End Sub
'// WINSOCK ERROR
Sub winsock_OnError(Number, Description, SCode, Source, HelpFile, HelpContext, CancelDisplay)
windowBox.scannerText.innerText = "Error: " & machineString
windowBox.scannerButton.style.backgroundcolor = "red"
windowBox.scannerButton.disabled = false
windowBox.errorString.innerText = "Scanner Error: " & Number & vbCrLf & Description
End Sub
Sub ReadResponse(ByVal objComport)
Dim str : str = "notempty"
objComport.Sleep(200)
While (str <> "")
str = objComport.ReadString()
If (str <> "") Then
Call Check_String(str)
End If
WEnd
End Sub
'// EXIT SCRIPT
Sub ServerClose()
If debugMode = False Then On Error Resume Next
WScript.Sleep 1000 '// REQUIRED OR ERRORS
objShell.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1406", 1, "REG_DWORD"
objShell.RegWrite "HKLM\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\TcpTimedWaitDelay", "240", "REG_DWORD"
objComport.Close()
objComport.Clear()
Set objComport = Nothing
If winsock.state <> sckClosed Then winsock.Disconnect
winsock.CloseWinsock
Set winsock = Nothing
windowBox.close
On Error GoTo 0
Wscript.Quit
End Sub
'Function to create all of the JS and HTML code for the window
Function LoadHTML(sBgColor)
Dim a, Status, Disposition
Dim bodyTop : bodyTop = 250
Dim footerTop : footerTop = 25
'HTA String
LoadHTML = "<HTA:Application contextMenu=no border=thin minimizebutton=no maximizebutton=no sysmenu=no />"
'CSS String
LoadHTML = LoadHTML _
& "<head><style>" _
& "body {" _
& "background-color: " & sBgColor & ";" _
& "font:normal 28px Tahoma;" _
& "border-Style:outset" _
& "border-Width:3px" _
& "}" _
& ".HTAButton {" _
& "border-top-left-radius: 50%;" _
& "border-radius: 12px;" _
& "}" _
& ".unselectable {" _
& "-moz-user-select: -moz-none;" _
& "-khtml-user-select: none;" _
& "-webkit-user-select: none;" _
& "-o-user-select: none;" _
& "user-select: none;" _
& "}" _
& ".closeButton {" _
& "background-color: red;" _
& "color: white;" _
& "height: 30px;" _
& "width: 30px;" _
& "font-weight: bold;" _
& "font: 20px;" _
& "}" _
& ".modal {" _
& "background-color: red;" _
& "font-weight: bold;" _
& "font: 20px;" _
& "}" _
& "#SubmitSQLButton {" _
& "font:normal 30px Tahoma;" _
& "}" _
& ".prodCount, #MRBLoc {" _
& "font:normal 20px Tahoma;" _
& "}" _
& "#ETagButton {" _
& "font:normal 30px Tahoma;" _
& "}" _
& "#commentModal {" _
& "font:normal 30px Tahoma;" _
& "background-color = 'grey';" _
& "visibility: hidden;" _
& "}" _
& "#MRBModal {" _
& "font:normal 20px Tahoma;" _
& "background-color = 'grey';"
If adminMode <> true Then
LoadHTML = LoadHTML _
& "visibility: hidden;"
End If
LoadHTML = LoadHTML _
& "}" _
& "#table_wrapper {" _
& "width:100%;" _