📄 frmmain.frm
字号:
Caption = "Counter Reset (Manual)"
Height = 615
Left = 3000
TabIndex = 31
Top = 4440
Width = 1455
End
Begin VB.TextBox CMTHDDNo
Height = 375
Left = 4920
TabIndex = 30
Top = 4680
Width = 1335
End
Begin VB.TextBox FailNo
Height = 375
Left = 4920
TabIndex = 29
Top = 4200
Width = 1335
End
Begin VB.TextBox HDDINNo
Height = 375
Left = 4920
TabIndex = 28
Top = 3720
Width = 1335
End
Begin VB.CommandButton Command3
Caption = "Fail & Untested"
Height = 375
Left = 6480
TabIndex = 27
Top = 4200
Width = 1815
End
Begin VB.CommandButton Command2
Caption = "CMT"
Height = 375
Left = 6480
TabIndex = 26
Top = 4680
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "HDD In"
Height = 375
Left = 6480
TabIndex = 25
Top = 3720
Width = 1815
End
Begin VB.Frame Frame5
Height = 3375
Left = 360
TabIndex = 16
Top = 240
Width = 9255
Begin VB.TextBox drvsta
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 24
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 1335
Left = 480
TabIndex = 37
Top = 1680
Width = 3855
End
Begin VB.TextBox TxtSN
BeginProperty Font
Name = "Times New Roman"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 480
TabIndex = 1
Top = 600
Width = 2295
End
Begin VB.ComboBox CboOpn
Enabled = 0 'False
BeginProperty Font
Name = "Times New Roman"
Size = 9.75
Charset = 177
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
ItemData = "FrmMain.frx":0000
Left = 5520
List = "FrmMain.frx":0002
Sorted = -1 'True
TabIndex = 2
Top = 600
Width = 2055
End
Begin VB.Label Label11
Alignment = 2 'Center
BackColor = &H8000000A&
Caption = "Drive Status "
BeginProperty Font
Name = "Times New Roman"
Size = 20.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 2880
TabIndex = 24
Top = 960
Width = 2655
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "Serial Number :"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 720
TabIndex = 18
Top = 240
Width = 1935
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "Operation :"
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5400
TabIndex = 17
Top = 240
Width = 2055
End
End
Begin VB.Label Label12
Caption = "counter Auto reset at 7:00AM and 7:00 PM Everyday"
Height = 615
Left = 2760
TabIndex = 32
Top = 3720
Width = 1815
End
Begin VB.Label LblMsg
Alignment = 2 'Center
BeginProperty Font
Name = "Times New Roman"
Size = 12
Charset = 177
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 1575
Left = 1320
TabIndex = 19
Top = 3120
Width = 7215
End
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public counterin As Long
Public counterfail As Long
Public countercmt As Long
Public noscancnt As Long
Public InSerial As String
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdProQual_Click()
Dim sn, OpnNum, str As String
Dim RetVal1 As Qualify
Dim RetVal2 As Qualify
If (TxtSN.Text = "") Then
drvsta.Text = ""
CboOpn.Text = ""
Exit Sub
End If
sn = UCase(FrmMain.TxtSN.Text)
Set RetVal1 = CheckProcQual(sn, "SRA")
Set RetVal2 = CheckProcQual(sn, "SRB")
CboOpn.Text = RetVal2.Operation
If RetVal2.Operation = "CMT" Then
drvsta.Text = "PASS"
countercmt = countercmt + 1
CMTHDDNo.Text = countercmt
ElseIf Not RetVal1.Result = "PASS" Then
drvsta.Text = "FAIL"
counterfail = counterfail + 1
FailNo.Text = counterfail
Else: drvsta.Text = "Untested"
End If
If RetVal2.Operation = "CIT2" Then
Flipper.Text = "Drive Flipper."
Else
Flipper.Text = "Drive No Flipper."
End If
End Sub
Private Sub Command1_Click()
CmdProQual_Click
End Sub
Private Sub Command4_Click()
FailNo.Text = 0
CMTHDDNo.Text = 0
HDDINNo.Text = 0
counterin = 0
counterfail = 0
countercmt = 0
'noscancnt = 0
End Sub
Private Sub Form_Load()
Dim ret As VbMsgBoxResult
Dim retstr As String
retstr = Read_IniGPSvr(App.Path & "\LSorter.ini", "GPSRV")
If Len(retstr) = 0 Then
MsgBox "Error Reading LSorter.ini file ....." & Chr(13) & Chr(10) & "(Please check configuration in the " & App.Path & "\LSorter.ini file)"
End
End If
Call Read_GPSvr(retstr)
FrmMain.LblAppVer = CStr(App.Major) + "." + CStr(App.Minor) + "." + CStr(App.Revision)
Set objServer = New FisApiServer
'Need this for running in VB env (Prevent Core Dump)
objServer.Debug = True
If objServer.testConnectionToFisAgent <> 0 Then
Set MyErr = objServer.Errors
ret = MsgBox(MyErr.Description, vbCritical, "FISAPI Agent Error")
End
End If
FrmMain.LblGpSrv_Ver = objServer.getPutVersion
FrmMain.LblJava_Ver = objServer.apiJavaVersion
FrmMain.LblActX_Ver = objServer.apiServerVersion
' PLCComm.CommPort = 1
'PLCComm.RThreshold = 1
'PLCComm.InputLen = 0
' PLCComm.Settings = "9600,E,8,1"
' PLCComm.PortOpen = True
ScannerPort.CommPort = 1
ScannerPort.RThreshold = 1
ScannerPort.InputLen = 0
ScannerPort.Settings = "9600,E,8,1"
ScannerPort.PortOpen = True
counterin = 0
counterfail = 0
countercmt = 0
noscancnt = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Dim RetVal As Integer
'objServer = Nothing
'Set myFisBroker = New FisBroker'
'RetVal = objServer.CloseSocket
End Sub
Private Sub Label16_Click()
End Sub
Private Sub lbltime_Click()
If lbltime.Caption = "7:00:00 PM" Then
counterin = 0
counterfail = 0
countercmt = 0
noscancnt = 0
End If
If lbltime.Caption = "7:00:00" Then
counterin = 0
counterfail = 0
countercmt = 0
noscancnt = 0
End If
End Sub
Private Sub ScannerPort_OnComm()
InSerial = InSerial & ScannerPort.Input
' If InStr(1, InSerial, vbNewLine) Then
InSerial = Left(InSerial, 8)
If Len(InSerial) > 6 Then
TxtSN.Text = InSerial
counterin = counterin + 1
HDDINNo.Text = counterin
CmdProQual_Click
InSerial = ""
End If
InSerial = ""
'TxtSN.Text = InSerial
'InSerial = ""
End Sub
Private Sub Timer1_Timer()
lbldate.Caption = Date
lbltime.Caption = Time
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -