form1.frm

通过RS-232读取产品串口信息,自动保存串口信息,并进行比较,若与合格的串口信息比较就判断合格,否则为不合格,能自动以产品名为文件夹,产品条码系列号为文件名保存信息,测试产品时非常有用.

   End
   Begin VB.Label Label9 
      BackColor       =   &H00FFC0C0&
      Caption         =   "脚本信息:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   11
      Top             =   7440
      Width           =   1455
   End
   Begin VB.Label Label7 
      BackColor       =   &H00FFC0C0&
      Caption         =   "测试结果:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   1560
      Width           =   975
   End
   Begin VB.Label Label3 
      BackColor       =   &H00FFC0C0&
      Caption         =   "串口："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3480
      TabIndex        =   7
      Top             =   2400
      Width           =   735
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFC0C0&
      Caption         =   "波特率:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1080
      TabIndex        =   5
      Top             =   2400
      Width           =   855
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFC0C0&
      Caption         =   "串口信息:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   2760
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Combo1_Click()
    Select Case Combo1.Text
           Case "2400": MSComm1.Settings = "2400,n,8,1"
           Case "4800": MSComm1.Settings = "4800,n,8,1"
           Case "9600": MSComm1.Settings = "9600,n,8,1"
           Case "19200": MSComm1.Settings = "19200,n,8,1"
           Case "115200": MSComm1.Settings = "115200,n,8,1"
    End Select
End Sub
Private Sub Combo2_Click()
        Select Case Combo2.Text
               Case "COM1": MSComm1.CommPort = 1
               Case "COM2": MSComm1.CommPort = 2
               Case "COM3": MSComm1.CommPort = 3
               Case "COM4": MSComm1.CommPort = 4
        End Select
End Sub
Private Sub Command1_Click()
     MSComm1.PortOpen = True
     Command1.Enabled = False
     Command2.Enabled = True
     Combo1.Enabled = False
     Combo2.Enabled = False
End Sub
Private Sub Command2_Click()
     MSComm1.PortOpen = False
     Command1.Enabled = True
     Command2.Enabled = False
     Combo1.Enabled = True
     Combo2.Enabled = True
End Sub
Private Sub Command4_Click()
        Text5.Enabled = False
        Command4.Enabled = False
        Command6.Enabled = True
        If Dir(App.Path & "\" & Text5.Text, vbDirectory) = "" Then
          MkDir App.Path & "\" & Text5.Text
        End If
        If Text5.Text = "" Then
           MsgBox "没有机种名称信息,请输入机种名!"
           Text5.Enabled = True
           Text5.SetFocus
           Command4.Enabled = True
           Command6.Enabled = False
        End If
End Sub
Private Sub Command5_Click()
  If Text5.Text = "" Then
     MsgBox "机种名称没有输入，请输入机种名称信息！"
     Text5.SetFocus
  Else:
     Dim strPath$, strFileName$, strTmp$
               strPath = App.Path & "\" '当前目录
               strTmp = Text4.Text '文件名称
               strFileName = strPath & strTmp & ".Txt" '假设文件类型为TXT文本文件
     If Dir(strFileName) = "" Then
        MsgBox "该机种没有建立脚本文件，请在" & App.Path & "\路径下建立脚本文件!"
     Else:
     Open App.Path & "\" & Text5.Text & ".txt" For Input As #1 '从当前目录当前机种中读取数据
     Do While Not EOF(1)
     Line Input #1, readtext
     Text3.Text = Text3.Text & readtext & vbCrLf
     Loop
     Close #1
     Command5.Enabled = False
     Text3.Enabled = False
    End If
  End If
End Sub
Private Sub Command6_Click()
       Text5.Enabled = True
       Command4.Enabled = True
       Command6.Enabled = False
       Command5.Enabled = True
       Text3.Text = ""
End Sub

Private Sub Command7_Click()
        Text1.Text = Text1.Text & vbCrLf
    If Text4.Text = "" Then
        MsgBox "单板条码没有扫描，请扫描单板条码信息！"
        Text4.SetFocus
    ElseIf Text1.Text = Text3.Text Then
        Text2.Text = "PASS!"
        Text2.BackColor = &HFF00&
    Else: Text2.Text = "Fail!"
        Text2.BackColor = &HFF&
    End If
    Dim strPath$, strFileName$, strTmp$, iSeq%
            strPath = App.Path & "\" & Text5.Text & "\" '当前目录
            strTmp = Text4.Text '文件名称
            strFileName = strPath & strTmp & ".Txt" '假设文件类型为TXT文本文件
            iSeq = 0 '文件序号
      Do While Dir(strFileName) <> ""
         iSeq = iSeq + 1
         strTmp = Text4.Text & "_" & CStr(iSeq)
         strFileName = strPath & strTmp & ".Txt" '假设文件类型为TXT文本文件
      Loop
      Dim iFn%
      iFn = FreeFile
      Open strFileName For Output As iFn
      Print #iFn, Text1.Text '写入文件内容
      Close #iFn
      Text1.Text = ""
End Sub

Private Sub Form_Load()
        Command1.Enabled = True
        Command2.Enabled = False
        Command6.Enabled = False
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text5.Text = ""
        Text6.Text = ""
        On Error GoTo Err       '出错处理
        With MSComm1
            .InputMode = comInputModeText '设置数据接收按字符串方式
            .InputLen = 0             '读取缓冲区的所有内容
            .RThreshold = 1           '每接收到1个字节就触发一次OnComm事件
            .OutBufferCount = 0       '清除发送缓冲区数据
            .InBufferCount = 0        '清除接收缓冲区数据
        End With
        Exit Sub
Err:            MsgBox "打开端口出错！", vbExclamation
    End Sub
Private Sub Command3_Click()
       
        'MSComm1.Output = Text2.Text  '发送文本文件内容到串口
End Sub
Private Sub MSComm1_OnComm()    '接到数据时把字符写到Text1中
        Text1.Text = Text1.Text & MSComm1.Input    ' & 是字符串连接的运算符
        'Open "D:\" & Text4.Text For Output As #1 '自动保存文件在D盘的1.txt中
        'Print #1, Text1.Text
        'Close #1
        Dim strPath$, strFileName$, strTmp$, iSeq%
            strPath = App.Path & "\" & Text5.Text & "\" '当前目录
            strTmp = Text4.Text '文件名称
            strFileName = strPath & strTmp & ".Txt" '假设文件类型为TXT文本文件
            iSeq = 0 '文件序号
      Do While Dir(strFileName) <> ""
         iSeq = iSeq + 1
         strTmp = Text4.Text & "_" & CStr(iSeq)
         strFileName = strPath & strTmp & ".Txt" '假设文件类型为TXT文本文件
      Loop
      Dim iFn%
      iFn = FreeFile
      Open strFileName For Output As iFn
      Print #iFn, Text1.Text '写入文件内容
      Close #iFn
End Sub
'Private Sub cmdSave_Click()
  ''保存为文本文件
  'Dim FileNumber
  'Dim strOuttmpFile As String            '定义输出文件的名称
  'Dim strPrinteTxt As String            '定义输出文件的内容
  'strOuttmpFile = App.Path & Text5.Text & ".txt"
  'strPrinteTxt = Text1.Text & "|" & Text2.Text
'On Error GoTo Err2
  'FileNumber = FreeFile                          '打开文件并追写新数据到文件尾
  'Open strOuttmpFile For Append As #FileNumber
    'Print #FileNumber, strPrinteTxt
  'Close #FileNumber
'End Sub
Private Sub ProgressBar1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
        b = Len(Text3.Text) '确定最大值
        ProgressBar1.Visible = True
        ProgressBar1.Min = 1
        ProgressBar1.Max = b
        ProgressBar1.Value = 1 '初始化
        For c = 0 To b
        d = Len(Text1.Text) 'Mid(Text3.Text, c, 1)
        Print #2, Asc(d) Xor x
        ProgressBar1.Value = c '跟踪进度
        Next c
        ProgressBar1.Value = 0
        ProgressBar1.Visible = False '任务结束
End Sub