FrymasterVB/Cmdproc-1.frm

1354 lines
39 KiB
Plaintext

VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "Tabctl32.ocx"
Begin VB.Form frmMain
ClientHeight = 11205
ClientLeft = 12270
ClientTop = 915
ClientWidth = 13110
ControlBox = 0 'False
Icon = "Cmdproc-1.frx":0000
LinkTopic = "Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 11205
ScaleWidth = 13110
Begin VB.TextBox txtMonitor
Alignment = 2 'Center
Height = 285
Left = 10200
TabIndex = 80
Text = "wdtCommandProcessor"
Top = 0
Width = 1875
End
Begin VB.CommandButton cmdClearSpoolFiles
Caption = "Clear Spool Files"
Height = 255
Left = 4740
TabIndex = 79
Top = 7200
Width = 1335
End
Begin VB.FileListBox filBuffers
Height = 480
Left = 11280
TabIndex = 77
Top = 8220
Visible = 0 'False
Width = 2055
End
Begin VB.CheckBox chkUseITC
Caption = "Use Inner Task Communications"
Height = 255
Left = 4380
TabIndex = 76
Top = 9240
Value = 1 'Checked
Width = 2715
End
Begin VB.Timer EndTimer
Enabled = 0 'False
Interval = 100
Left = 1320
Top = 540
End
Begin VB.Timer processTimer
Enabled = 0 'False
Interval = 100
Left = 3900
Top = 9120
End
Begin VB.Timer sendTimer
Enabled = 0 'False
Interval = 100
Left = 3480
Top = 9120
End
Begin VB.ListBox lstSend
Height = 645
Left = 60
TabIndex = 72
Top = 10500
Width = 12975
End
Begin VB.ListBox lstRecvd
Height = 645
Left = 60
TabIndex = 71
Top = 9540
Width = 12975
End
Begin VB.CheckBox chkDumper
Caption = "Dumper"
Height = 255
Left = 9120
TabIndex = 70
Top = 4020
Width = 975
End
Begin VB.ListBox lstIncome
Height = 840
Left = 60
TabIndex = 69
Top = 8400
Width = 12975
End
Begin VB.TextBox Text1
Height = 315
Left = 6960
TabIndex = 64
Text = "Text1"
Top = 7020
Visible = 0 'False
Width = 4155
End
Begin VB.PictureBox Picture1
Height = 1455
Left = 11790
ScaleHeight = 1395
ScaleWidth = 1095
TabIndex = 61
Top = 5010
Width = 1155
Begin VB.ComboBox cboMoveQUE
Height = 315
ItemData = "Cmdproc-1.frx":030A
Left = 60
List = "Cmdproc-1.frx":0326
TabIndex = 66
Text = "Empty2"
Top = 750
Width = 1035
End
Begin VB.CommandButton cmdMove2Q1
Caption = "MOVE"
Height = 255
Left = 60
TabIndex = 62
Top = 1080
Width = 945
End
Begin VB.Label Label4
Caption = "Move FROM"
Height = 195
Left = 90
TabIndex = 67
Top = 30
Width = 945
End
Begin VB.Label lblFromTab
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "Gen"
Height = 315
Left = 60
TabIndex = 63
Tag = "0"
Top = 240
Width = 975
WordWrap = -1 'True
End
Begin VB.Label Label6
Caption = "To"
Height = 195
Left = 0
TabIndex = 68
Top = 540
Width = 855
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 7
Left = 12150
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 59
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 7
Left = -150
TabIndex = 60
Top = 0
Width = 795
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 6
Left = 10980
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 57
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 6
Left = -150
TabIndex = 58
Top = 0
Width = 795
End
End
Begin VB.ListBox List1
Height = 840
ItemData = "Cmdproc-1.frx":0357
Left = 10500
List = "Cmdproc-1.frx":0370
TabIndex = 52
Top = 3390
Width = 2535
End
Begin VB.CommandButton cmdBottom
Caption = "Bottom"
Height = 255
Left = 12300
TabIndex = 51
Top = 3120
Width = 735
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 5
Left = 9720
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 48
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 5
Left = 210
TabIndex = 49
Top = 0
Width = 435
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 4
Left = 8520
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 46
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 4
Left = -150
TabIndex = 47
Top = 0
Width = 795
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 3
Left = 7290
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 44
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 3
Left = -150
TabIndex = 45
Top = 0
Width = 795
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 6060
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 42
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 2
Left = -120
TabIndex = 43
Top = 0
Width = 765
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 4890
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 41
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 1
Left = -120
TabIndex = 50
Top = 0
Width = 765
End
End
Begin VB.PictureBox picCount
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 3570
ScaleHeight = 225
ScaleWidth = 675
TabIndex = 39
Top = 4440
Width = 705
Begin VB.Label lblCount
Alignment = 1 'Right Justify
BackColor = &H00FFFFFF&
BackStyle = 0 'Transparent
Caption = "999"
Height = 225
Index = 0
Left = 0
TabIndex = 40
Top = 0
Width = 645
End
End
Begin TabDlg.SSTab SSTab1
Height = 1815
Left = 3150
TabIndex = 26
Top = 4740
Width = 9885
_ExtentX = 17436
_ExtentY = 3201
_Version = 393216
Tabs = 8
TabsPerRow = 8
TabHeight = 520
TabCaption(0) = "Gen"
TabPicture(0) = "Cmdproc-1.frx":03E9
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "lblGroups(0)"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "lstPGroup(0)"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).ControlCount= 2
TabCaption(1) = "Svc"
TabPicture(1) = "Cmdproc-1.frx":0405
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "lblGroups(1)"
Tab(1).Control(1)= "lstPGroup(1)"
Tab(1).ControlCount= 2
TabCaption(2) = "Engr"
TabPicture(2) = "Cmdproc-1.frx":0421
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "lblGroups(2)"
Tab(2).Control(1)= "lstPGroup(2)"
Tab(2).ControlCount= 2
TabCaption(3) = "SP"
TabPicture(3) = "Cmdproc-1.frx":043D
Tab(3).ControlEnabled= 0 'False
Tab(3).Control(0)= "lblGroups(3)"
Tab(3).Control(1)= "lstPGroup(3)"
Tab(3).ControlCount= 2
TabCaption(4) = "IE"
TabPicture(4) = "Cmdproc-1.frx":0459
Tab(4).ControlEnabled= 0 'False
Tab(4).Control(0)= "lblGroups(4)"
Tab(4).Control(1)= "lstPGroup(4)"
Tab(4).ControlCount= 2
TabCaption(5) = "FAB"
TabPicture(5) = "Cmdproc-1.frx":0475
Tab(5).ControlEnabled= 0 'False
Tab(5).Control(0)= "lblGroups(5)"
Tab(5).Control(1)= "lstPGroup(5)"
Tab(5).ControlCount= 2
TabCaption(6) = "Empty1"
TabPicture(6) = "Cmdproc-1.frx":0491
Tab(6).ControlEnabled= 0 'False
Tab(6).Control(0)= "lblGroups(6)"
Tab(6).Control(1)= "lstPGroup(6)"
Tab(6).ControlCount= 2
TabCaption(7) = "Empty2"
TabPicture(7) = "Cmdproc-1.frx":04AD
Tab(7).ControlEnabled= 0 'False
Tab(7).Control(0)= "lblGroups(7)"
Tab(7).Control(1)= "lstPGroup(7)"
Tab(7).ControlCount= 2
Begin VB.ListBox lstPGroup
Height = 1035
Index = 7
ItemData = "Cmdproc-1.frx":04C9
Left = -74940
List = "Cmdproc-1.frx":04CB
MultiSelect = 2 'Extended
TabIndex = 54
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 6
ItemData = "Cmdproc-1.frx":04CD
Left = -74940
List = "Cmdproc-1.frx":04CF
MultiSelect = 2 'Extended
TabIndex = 53
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 5
ItemData = "Cmdproc-1.frx":04D1
Left = -74940
List = "Cmdproc-1.frx":04D3
MultiSelect = 2 'Extended
TabIndex = 32
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 4
ItemData = "Cmdproc-1.frx":04D5
Left = -74940
List = "Cmdproc-1.frx":04D7
MultiSelect = 2 'Extended
TabIndex = 31
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 3
ItemData = "Cmdproc-1.frx":04D9
Left = -74940
List = "Cmdproc-1.frx":04DB
MultiSelect = 2 'Extended
TabIndex = 30
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 2
ItemData = "Cmdproc-1.frx":04DD
Left = -74940
List = "Cmdproc-1.frx":04DF
MultiSelect = 2 'Extended
TabIndex = 29
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 1
ItemData = "Cmdproc-1.frx":04E1
Left = -74940
List = "Cmdproc-1.frx":04E3
MultiSelect = 2 'Extended
TabIndex = 28
Top = 540
Width = 8505
End
Begin VB.ListBox lstPGroup
Height = 1035
Index = 0
ItemData = "Cmdproc-1.frx":04E5
Left = 60
List = "Cmdproc-1.frx":04E7
MultiSelect = 2 'Extended
TabIndex = 27
Top = 540
Width = 8505
End
Begin VB.Label lblGroups
Caption = "Not used"
Height = 195
Index = 7
Left = -74940
TabIndex = 56
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "Not used"
Height = 195
Index = 6
Left = -74940
TabIndex = 55
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "FAB"
Height = 195
Index = 5
Left = -74940
TabIndex = 38
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "IE"
Height = 195
Index = 4
Left = -74940
TabIndex = 37
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "HWFAB/ELECENG/HWQC/HWSERVICE/SPFAB/SPSVPAK/SPTPARK/SPENGPS3"
Height = 195
Index = 3
Left = -74940
TabIndex = 36
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "Engr/NEWPROD"
Height = 195
Index = 2
Left = -74955
TabIndex = 35
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "Recv/Super/Service/CHECKOUT/QCCAGE"
Height = 195
Index = 1
Left = -74940
TabIndex = 34
Top = 330
Width = 4335
End
Begin VB.Label lblGroups
Caption = "Purch/Electr/DOCKC/SUP5SI/ELECENG"
Height = 195
Index = 0
Left = 60
TabIndex = 33
Top = 330
Width = 4335
End
End
Begin VB.CheckBox UseSpooler
Caption = "Use Spooler"
Height = 225
Left = 3510
TabIndex = 23
Top = 3150
Value = 1 'Checked
Width = 1845
End
Begin VB.ListBox lstError
Height = 840
Left = 90
TabIndex = 22
Top = 7500
Width = 12975
End
Begin VB.ListBox lstCounts
Height = 840
Left = 11430
TabIndex = 19
Top = 6600
Width = 1635
End
Begin VB.ComboBox cboPrinterList
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
ItemData = "Cmdproc-1.frx":04E9
Left = 90
List = "Cmdproc-1.frx":04EB
TabIndex = 18
Text = "Printer Names"
Top = 6570
Width = 11265
End
Begin VB.ListBox lstCheckIn
Height = 1815
Left = 90
TabIndex = 17
Top = 4680
Width = 3015
End
Begin VB.CommandButton cmdEnd
Caption = "&Quit"
Height = 360
Left = 12180
TabIndex = 0
Top = 0
Width = 855
End
Begin VB.ListBox lstReply2
BackColor = &H00FFFFFF&
Height = 255
Left = 465
TabIndex = 15
Top = 3645
Width = 9990
End
Begin VB.ListBox lstReply1
Height = 255
Left = 465
TabIndex = 13
Top = 3405
Width = 10005
End
Begin VB.OptionButton CheckACAD
Caption = "Servicing ACAD"
Height = 195
Left = 4050
TabIndex = 11
Top = 4185
Value = -1 'True
Width = 1695
End
Begin VB.OptionButton FileErrInd
Caption = "error processing"
Height = 255
Left = 5400
TabIndex = 7
Top = 3150
Width = 1575
End
Begin VB.Timer Timer2
Interval = 1000
Left = 780
Top = 540
End
Begin VB.CommandButton cmdClearDisplay
Caption = "Clear Display"
Height = 255
Left = 60
TabIndex = 6
Top = 3135
Width = 1575
End
Begin VB.TextBox txtCheckFileFreq
Height = 285
Left = 1575
TabIndex = 3
Text = "1000"
Top = 4275
Width = 735
End
Begin VB.Timer Timer1
Interval = 5000
Left = 240
Top = 540
End
Begin VB.CheckBox ChkLogging
Caption = "Logging Commands to file"
Height = 255
Left = -15
TabIndex = 2
Top = 3930
Value = 1 'Checked
Width = 2175
End
Begin VB.ListBox LstPrint
Enabled = 0 'False
BeginProperty Font
Name = "Fixedsys"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2760
Left = 0
TabIndex = 1
Top = 360
Width = 13050
End
Begin VB.Label lblTog
Alignment = 1 'Right Justify
Caption = "0"
Height = 255
Left = 6120
TabIndex = 78
Top = 7200
Width = 495
End
Begin VB.Label lblPkt
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 90
TabIndex = 20
Top = 6960
Width = 4455
End
Begin VB.Label Label3
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "*CAD*SYYYYMMDDHHMMSS000111222333444555666"
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 90
TabIndex = 21
Top = 7200
Width = 4455
End
Begin VB.Label lblfrmMain
Caption = "Command Processor"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 0
TabIndex = 75
Top = 0
Width = 10155
End
Begin VB.Label lblToApp
Height = 255
Left = 60
TabIndex = 74
Top = 10200
Width = 12915
End
Begin VB.Label lblITC
Caption = "Inner Task Communications"
Height = 255
Left = 60
TabIndex = 73
Top = 9240
Width = 3255
End
Begin VB.Label Label5
Alignment = 2 'Center
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Caption = "All"
ForeColor = &H80000008&
Height = 255
Left = 3240
TabIndex = 65
Top = 4440
Width = 375
End
Begin VB.Label lblReplySt
Caption = "replycmpl.que exists"
Height = 195
Index = 1
Left = 5910
TabIndex = 25
Top = 4155
Width = 1545
End
Begin VB.Label lblReplySt
Caption = "reply.que exists"
Height = 195
Index = 0
Left = 5910
TabIndex = 24
Top = 3945
Width = 1155
End
Begin VB.Label lstReply2Cnt
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0"
ForeColor = &H80000008&
Height = 255
Left = 45
TabIndex = 16
Top = 3645
Width = 375
End
Begin VB.Label lstReply1Cnt
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0"
ForeColor = &H80000008&
Height = 255
Left = 45
TabIndex = 14
Top = 3405
Width = 375
End
Begin VB.Label lblReply
Height = 255
Left = 4080
TabIndex = 12
Top = 3915
Width = 1695
End
Begin VB.Label ErrorCondition
BorderStyle = 1 'Fixed Single
Height = 255
Left = 7020
TabIndex = 10
Top = 3120
Width = 3435
End
Begin VB.Label CADRecs
BorderStyle = 1 'Fixed Single
Height = 255
Left = 2730
TabIndex = 9
Top = 3135
Width = 735
End
Begin VB.Label Label2
BorderStyle = 1 'Fixed Single
Caption = "Cadprint Recs"
Height = 255
Left = 1650
TabIndex = 8
Top = 3135
Width = 1095
End
Begin VB.Label lblScan
Height = 255
Left = 2310
TabIndex = 5
Top = 3930
Width = 1695
End
Begin VB.Label Label1
Caption = "Check file frequency (milliseconds)"
Height = 420
Left = 0
TabIndex = 4
Top = 4185
Width = 1575
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdBottom_Click()
frmMain.LstPrint.ListIndex = frmMain.LstPrint.ListCount - 1
End Sub
Private Sub cmdClearDisplay_Click()
LstPrint.Clear
End Sub
Private Sub cmdClearSpoolFiles_Click()
frmMain.filBuffers.Path = temppath$
frmMain.filBuffers.Refresh
mx = 0
For ix = 0 To frmMain.filBuffers.ListCount - 1
ax$ = frmMain.filBuffers.List(ix)
If InStr(ax$, "CMDBF") <> 0 Then
KillIt (temppath$ + ax$)
End If
Next
TogCount = mx
frmMain.lblTog.Caption = Str(TogCount)
End Sub
Private Sub cmdEnd_Click()
' On Error Resume Next
Unhook
Open MessageFileName$ For Output As #26 'using #26
Print #26, "I Have Been Terminated"
Close #26
Call PrintLog("I Have Been Terminated")
EndTimer.Enabled = True
End Sub
Private Sub cmdMove2Q1_Click()
'
' this routine moves any command to any Queue
'
nn = Val(lblFromTab.Tag)
mm = -1
For ixtab = 0 To SSTab1.Tabs - 1
If cboMoveQUE.List(cboMoveQUE.ListIndex) = SSTab1.TabCaption(ixtab) Then
mm = ixtab
Exit For
End If
Next
If mm = -1 Then Exit Sub
If nn <> mm Then
imx = 0
Do While imx <= lstPGroup(nn).ListCount - 1
If lstPGroup(nn).Selected(imx) Then
lstPGroup(mm).AddItem lstPGroup(nn).List(imx)
lstPGroup(nn).RemoveItem (imx)
Else
imx = imx + 1
End If
Loop
End If
End Sub
Private Sub cmdTestMessage_Click()
frmQueHandler.Show
End Sub
Private Sub EndTimer_Timer()
End
End Sub
Private Sub ErrorCondition_DblClick()
ErrorCondition.Caption = ""
End Sub
Private Sub Form_Load()
'
' +MonitorNib
'
frmMonitorNib.txtID.Text = "wdtCommandProcessor"
frmMonitorNib.Show
frmMonitorNib.Visible = False
'
' -MonitorNib
'
Set rcvListBox = frmMain.lstRecvd
MyWnd = frmMain.hwnd
lstError.AddItem "Start Time:" + Format(Now, "hh:nn:ss yyyy/mm/dd")
Call InitVars
Hook
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'
' +MonitorNib
Unload frmMonitorNib
' -MonitorNib
'
End Sub
Private Sub Form_Resize()
positsize$ = " Top: " + Str(Me.top)
positsize$ = positsize$ + " Left: " + Str(Me.left)
positsize$ = positsize$ + " Width: " + Str(Me.Width)
positsize$ = positsize$ + "Height: " + Str(Me.Height)
lblfrmMain.ToolTipText = positsize$
End Sub
'
' Example Connection Requirements
'
'Private Sub Form_Load()
' Set rcvListBox = lstRecvd
' ToName = "QMGR" ' Application to Connect to
' MyName = "CMDPRC" ' This Application window
' MyWnd = Me.hwnd
' Hook
'
' Me.Show
' Me.Caption = MyName
' lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found" 'Status message
' processTimer.Enabled = True ' Timer to process incoming messages
' sendTimer.Enabled = True ' Timer to send out going responses
'End Sub
'Private Sub Form_Unload(Cancel As Integer)
' Unhook
'End Sub
'
'
'Private Sub processTimer_Timer()
''
'' This timer checks to see if any messages have been received and need to be Processed
''
' processTimer.Interval = 1000 ' set the timer to once a second
' Do While lstRecvd.ListCount > 0
' Msg$ = lstRecvd.List(0)
' lstRecvd.RemoveItem (0)
' '
' ' process the message
' '
' Msg$ = Msg$ + " Back " + Date$ + " " + Time$
' '
' ' send the response
' '
' lstSend.AddItem Msg$
' Loop
'
'End Sub
'
'Private Sub sendTimer_Timer()
''
'' This timer Watches for Connectivity to be able to send messages.
''
' sendTimer.Interval = 1000
' ToWnd = FindWindow(vbNullString, ToName) 'look for App to connect To
' If ToWnd = 0& Then
' lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found"
' lblToApp.BackColor = &HC0C0FF
' SendStatus = "Disconnected"
' Else
' lblToApp.Caption = "Connected to: " + ToName + " Status: Found " + Hex$(ToWnd)
' lblToApp.BackColor = &HC0FFC0
' SendStatus = "Connected"
' End If
' '
' ' if App exists then send the messages in the Send ListBox
' '
' If SendStatus = "Connected" Then
' Do While lstSend.ListCount > 0
' Msg$ = lstSend.List(0)
' lstSend.RemoveItem (0)
' Call SendAMessage(Msg$)
' Loop
' End If
' End Sub
'
Private Sub Label5_DblClick()
For iix = 0 To picCount.Count - 1
If Label5.BackColor = &HFF Then
picCount(iix).BackColor = &H8000000F
picCount(iix).ToolTipText = ""
Else
picCount(iix).BackColor = &HFF
picCount(iix).ToolTipText = "Queue Paused"
End If
Next
If Label5.BackColor = &HFF Then
Label5.BackColor = &H8000000F
Else
Label5.BackColor = &HFF
End If
End Sub
Private Sub lblCount_DblClick(Index As Integer)
'
' pause/unpause print queue
'
'&H8000000F& clear
'&H000000FF& red
'
'picCount(Index).BackColor = &HFF
'picCount(Index).BackColor = &H8000000F
If picCount(Index).BackColor = &HFF Then
picCount(Index).BackColor = &H8000000F
picCount(Index).ToolTipText = ""
Else
picCount(Index).BackColor = &HFF
picCount(Index).ToolTipText = "Queue Paused"
End If
End Sub
Private Sub lblPkt_Click()
lblPkt.Caption = ""
End Sub
Private Sub List1_DblClick()
l$ = List1.List(List1.ListIndex)
Select Case l$
Case "Show Test Message"
frmQueHandler.Show
Case "Show BOM"
frmBOM.Show
Case "Show Assem View"
frmCheckAssembly.Show
Case "Show Spooler"
frmPSSpooler.Show
Case "Show File Watcher"
frmFileWatch.Show
Case "Show Folder Copier"
frmFolderCopy.Show
Case "Show PDF Printer"
frmPDF.Show
Case Else
End Select
End Sub
Private Sub lstCounts_Click()
lstCounts.Clear
ict = lstCheckIn.ListCount
lstCounts.AddItem "ckin=" + Trim$(Str$(ict))
For ixxx = 0 To lstPGroup.Count - 1
ict = lstPGroup(ixxx).ListCount
lstCounts.AddItem "grp" + Trim$(Str$(ixxx)) + "=" + Trim$(Str$(ict))
Next
End Sub
Function MakePGroupPacket$()
ict = lstCheckIn.ListCount
Pkt$ = LPad$(Trim$(Str$(ict)), 3)
For ixxx = 0 To lstPGroup.Count - 1
ict = lstPGroup(ixxx).ListCount
vv$ = LPad$(Trim$(Str$(ict)), 3)
If vv$ = " " Then vv$ = " 0"
Pkt$ = Pkt$ + vv$
Next
MakePGroupPacket$ = LPad$(Format$(Now, "yyyymmddhhmmss"), 14) + Pkt$
End Function
Private Sub lstCounts_GotFocus()
lstCounts.Clear
ict = lstCheckIn.ListCount
lstCounts.AddItem "ckin=" + Trim$(Str$(ict))
For ixxx = 0 To lstPGroup.Count - 1
ict = lstPGroup(ixxx).ListCount
lstCounts.AddItem "grp" + Trim$(Str$(ixxx)) + "=" + Trim$(Str$(ict))
Next
End Sub
Private Sub LstPrint_DblClick()
LstPrint.Clear
End Sub
Public Sub lstReply2Cnt_DblClick()
lstReply2Cnt.BackColor = QBColor(12)
On Error GoTo frOpps
DoEvents
Open "C:\replies.dat" For Output As #17 'using #17
For idre = 0 To lstReply2.ListCount - 1
jff$ = lstReply2.List(idre)
Print #17, jff$
Next
Close #17
If (Not (ExistsNew(Reply$))) And (ExistsNew(ReplyComplete$)) Then
PurgeIt (ReplyComplete$)
End If
Call FlushReplies
lstReply2Cnt.BackColor = QBColor(15)
frOppsOut:
Exit Sub
frOpps:
Close #17
Resume frOppsOut
End Sub
Private Sub processTimer_Timer()
'
' This timer checks to see if any messages have been received and need to be Processed
'
If chkUseITC.value = 1 Then
lblITC.BackColor = &HC0FFC0
processTimer.Interval = 1000 ' set the timer to once a second
Do While lstRecvd.ListCount > 0
Msg$ = lstRecvd.List(0)
lstRecvd.RemoveItem (0)
frmMain.lstIncome.AddItem Msg$
Loop
Else
lblITC.BackColor = &HC0C0FF
End If
End Sub
Private Sub sendTimer_Timer()
'
' This timer Watches for Connectivity to be able to send messages.
'
If chkUseITC.value = 1 Then
lblITC.BackColor = &HC0FFC0
sendTimer.Interval = 1000
ToWnd = FindWindow(vbNullString, ToName) 'look for App to connect To
If ToWnd = 0& Then
lblToApp.Caption = "Connecting to: " + ToName + " Status: Not Found"
lblToApp.BackColor = &HC0C0FF
SendStatus = "Disconnected"
Else
lblToApp.Caption = "Connected to: " + ToName + " Status: Found " + Hex$(ToWnd)
lblToApp.BackColor = &HC0FFC0
SendStatus = "Connected"
End If
'
' if App exists then send the messages in the Send ListBox
'
If SendStatus = "Connected" Then
Do While lstSend.ListCount > 0
Msg$ = lstSend.List(0)
lstSend.RemoveItem (0)
Call SendAMessage(Msg$)
Loop
End If
Else
sendTimer.Interval = 3000
lblToApp.BackColor = &HC0C0FF
lblToApp.Caption = "Inner Task Communications Disabled"
lblITC.BackColor = &HC0C0FF
SendStatus = "Disconnected"
End If
End Sub
'
Private Sub SSTab1_Click(PreviousTab As Integer)
nn = SSTab1.Tab
lblFromTab.Caption = SSTab1.TabCaption(nn)
lblFromTab.Tag = Trim(Str(nn))
End Sub
Private Sub Timer1_Timer()
If Timer1.Tag = "Busy" Then Exit Sub
Timer1.Tag = "Busy"
lblScan.Caption = "Scanning"
DoEvents
Call StartSystem
lblScan.Caption = "Flush Replies"
Call FlushReplies
lblScan.Caption = "idle"
Timer1.Tag = ""
End Sub
Private Sub Timer2_Timer()
FileTimer = FileTimer - 1
If FileTimer <= 0 Then FileTimer = 0
''''''''''''''''''' Call WDTServer
'
' +MonitorNib
'
' (once per second)
txtMonitor.BackColor = frmMonitorNib.BackColor
' -MonitorNib
On Error GoTo Timer2_ERROR
xz% = 0: yz% = 0
xz% = FileLen(ACADIncome$)
yz% = FileLen(ACADWait$)
CADRecs.Caption = Str$((xz% + yz%) \ 79)
lblReply.Caption = "replys=" + Str$(replies) + " | " + Str$(replies2)
If ExistsNew(Reply$) Then
lblReplySt(0).BackColor = QBColor(15)
Else
lblReplySt(0).BackColor = QBColor(14)
End If
If ExistsNew(ReplyComplete$) Then
lblReplySt(1).BackColor = QBColor(15)
Else
lblReplySt(1).BackColor = QBColor(14)
End If
If replies2 >= 2 Then
If (Not (ExistsNew(Reply$))) And (ExistsNew(ReplyComplete$)) Then
'PurgeIt (ReplyComplete$)
End If
If replies2 > 60 Then
Constipation% = 1
End If
Else
Constipation% = 0
End If
For ixxx = 0 To lblCount.Count - 1
lblCount(ixxx).Caption = Trim(Str(lstPGroup(ixxx).ListCount))
Next
lstReply1Cnt.Caption = Str$(lstReply1.ListCount)
lstReply2Cnt.Caption = Str$(lstReply2.ListCount)
DoEvents
Exit Sub
Timer2_ERROR:
Resume Next
End Sub
Private Sub txtCheckFileFreq_Change()
Tl% = Val(txtCheckFileFreq.Text)
If Tl% > 200 Then
Timer1.Interval = Tl%
Else
Timer1.Interval = 500
End If
End Sub
Private Sub txtMonitor_DblClick()
'
' +MonitorNib
frmMonitorNib.Visible = True
' -MonitorNib
End Sub