com.frm

又一个小的串口设置监测程序

         End
         Begin VB.OptionButton Option1 
            Caption         =   "奇校验"
            Height          =   375
            Index           =   1
            Left            =   1560
            TabIndex        =   9
            Top             =   2640
            Width           =   1335
         End
         Begin VB.OptionButton Option1 
            Caption         =   "无校验"
            Height          =   375
            Index           =   0
            Left            =   1560
            TabIndex        =   8
            Top             =   2280
            Width           =   1095
         End
         Begin VB.Label Label1 
            Caption         =   "校验方式："
            Height          =   375
            Index           =   4
            Left            =   240
            TabIndex        =   11
            Top             =   2400
            Width           =   1215
         End
         Begin VB.Label Label1 
            Caption         =   "数据位："
            Height          =   375
            Index           =   3
            Left            =   240
            TabIndex        =   7
            Top             =   1440
            Width           =   975
         End
         Begin VB.Label Label1 
            Caption         =   "停止位："
            Height          =   375
            Index           =   2
            Left            =   240
            TabIndex        =   6
            Top             =   1920
            Width           =   975
         End
         Begin VB.Label Label1 
            Caption         =   "波特率："
            Height          =   375
            Index           =   1
            Left            =   240
            TabIndex        =   5
            Top             =   960
            Width           =   975
         End
         Begin VB.Label Label1 
            Caption         =   "端口号："
            Height          =   375
            Index           =   0
            Left            =   240
            TabIndex        =   4
            Top             =   480
            Width           =   975
         End
      End
      Begin VB.Label Label4 
         Caption         =   "数据长度："
         Height          =   375
         Left            =   -71880
         TabIndex        =   43
         Top             =   3480
         Width           =   1335
      End
      Begin VB.Label Label2 
         Caption         =   "已设置内容:"
         Height          =   255
         Left            =   -74400
         TabIndex        =   30
         Top             =   840
         Width           =   1575
      End
   End
   Begin VB.CommandButton cmdCreateIcon 
      Caption         =   "关闭窗口"
      Height          =   495
      Left            =   5280
      TabIndex        =   1
      Top             =   4560
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "保存设置"
      Height          =   495
      Left            =   2160
      TabIndex        =   0
      Top             =   4560
      Width           =   1335
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   5040
      Top             =   1080
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
      RThreshold      =   1
      SThreshold      =   1
   End
End
Attribute VB_Name = "SetForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim i As Integer
Dim HadAdd As Boolean
Dim nid As NOTIFYICONDATA

Dim BiaoShi As String     '分段标识
Dim KaiShi As String      '开始表示
Dim JianCe As Boolean     '监测状态
Dim myLen As Long         '字符串长度
Dim iStr() As String
Dim Buf
Dim JShStr As String
Dim FSStr As String
Dim myPath As String


Private Sub cmdCreateIcon_Click()
If Not HadAdd Then     '如果没有产生过图标，则添加图标到右下角
    With nid
        '以下填写nid变量的所有成员
        .cbSize = Len(nid) '填写自定义数据类型的长度
        .hWnd = SetForm.hWnd '填写窗体的句柄
        .uID = 9999 '图标的Id，可随意
        '允许显示图标、提示并产生消息
        .uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
        .hIcon = SetForm.Icon.Handle '图标句柄
        .szTip = "SDCommPort——单击设置"          '提示信息
        .uCallbackMessage = 2 '图标的消息号
    End With
    Shell_NotifyIconA NIM_ADD, nid '添加图标
    IconMsg = nid.uCallbackMessage
    '用全局变量记录消息号，
    '读取setform正常的消息处理程序
    '的地址保存在全程变量OldWinProc中
    OldWinProc = GetWindowLong(SetForm.hWnd, GWL_WNDPROC)
    '用自定义过程MyProc的地址
    '代替正常消息处理程序的地址
    SetWindowLong SetForm.hWnd, GWL_WNDPROC, AddressOf MyProc
    SetForm.Hide '隐藏窗体
    HadAdd = True '置"已经添加图标"标志
Else
    SetForm.Hide '如果已经有小图标了，则直接隐藏窗体
End If
End Sub


Private Sub Command1_Click()
'保存设置到ini文件
Dim x
Dim S As String

For i = 0 To 3
    If T1(i) = "" Or T2(i) = "" Or Text1 = "" Or List1.ListCount <= 0 Then
        MsgBox ("数据不完整,请检查后重新输入并保存!")
        myReState
        Exit Sub
    End If
Next i
x = myWriteINI(myPath, "接收端口", "端口号", T1(0))
x = myWriteINI(myPath, "接收端口", "波特率", T1(1))
x = myWriteINI(myPath, "接收端口", "数据位", T1(2))
x = myWriteINI(myPath, "接收端口", "停止位", T1(3))
For i = 0 To 2
    If Option1(i).Value = True Then x = myWriteINI(myPath, "接收端口", "校验方式", CStr(i))
Next i
    
x = myWriteINI(myPath, "发送端口", "端口号", T2(0))
x = myWriteINI(myPath, "发送端口", "波特率", T2(1))
x = myWriteINI(myPath, "发送端口", "数据位", T2(2))
x = myWriteINI(myPath, "发送端口", "停止位", T2(3))
For i = 0 To 2
    If Option1(i).Value = True Then x = myWriteINI(myPath, "接收端口", "校验方式", CStr(i))
Next i
    
x = myWriteINI(myPath, "拦截数据", "断句标志", Asc(Text1))
x = myWriteINI(myPath, "拦截数据", "开始标志", Asc(Text3))
x = myWriteINI(myPath, "拦截数据", "数据长度", Text4)

S = ""
For i = 0 To List1.ListCount - 2
    S = S & List1.List(i) & ","
Next i
S = S & List1.List(List1.ListCount - 1)
If Len(S) > 0 Then x = myWriteINI(myPath, "拦截数据", "拦截字串", S)

myReState

End Sub

Private Sub Command2_Click()

If HadAdd Then
    '如果曾向右下角添加过小图标
    '则根据事先记录的OldWinProc 恢复原来的消息处理程序，并删除图标
    SetWindowLong SetForm.hWnd, GWL_WNDPROC, OldWinProc
    Call Shell_NotifyIconA(NIM_DELETE, nid)         '删除图标
End If
Unload Me   '卸载窗体

End Sub

Private Sub Command3_Click()
Dim S As String
S = InputBox("请输入需增加的字符!", "增加内容")
If S <> "" Then List1.AddItem S

End Sub

Private Sub Command4_Click()
If List1.ListCount > 0 And List1.ListIndex >= 0 Then List1.RemoveItem (List1.ListIndex)
End Sub

Private Sub Command5_Click()
If Command5.Caption = "开始测试" Then
    JianCe = True
    Command5.Caption = "停止测试"
Else
    JianCe = False
    Command5.Caption = "开始测试"
End If

End Sub

Private Sub Form_Load()
SetForm.Show
DoEvents
HadAdd = False '将"是否添加了图标的标志"置为False
cmdCreateIcon_Click
DoEvents
myPath = App.Path             '程序运行路径
If Right(myPath, 1) <> "\" Then myPath = myPath & "\"
myPath = myPath & "scomport.ini"
myReState
End Sub

Private Sub MSComm1_OnComm()

Dim l As Integer
Dim BufA
Dim f As Integer

BufA = MSComm1.Input
If JianCe Then
    Text2 = Text2 & BufA
Else
    For i = 1 To Len(BufA)
        If Mid(BufA, i, 1) = KaiShi Then   '检查开始标志
            BufA = Right(BufA, Len(BufA) - i + 1)
            Buf = ""
            Exit For
        End If
    Next i
    Buf = Buf & BufA
    If Len(Buf) = myLen Then    '检测字串长度
        iStr = Split(Trim(Buf), " ")
        For i = 0 To UBound(iStr)
            For l = 0 To List1.ListCount - 1
                List1.ListIndex = l
                If Trim(iStr(i)) = Trim(List1.Text) Then Exit Sub       '终止下面程序运行
            Next l
        Next i
        MSComm1.Output = Buf
        Buf = ""
    End If
End If
End Sub

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub

Sub myReState()

On Error Resume Next

T1(0) = Trim(myReadINI(myPath, "接收端口", "端口号", "1"))
T1(1) = Trim(myReadINI(myPath, "接收端口", "波特率", "9600"))
T1(2) = Trim(myReadINI(myPath, "接收端口", "数据位", "8"))
T1(3) = Trim(myReadINI(myPath, "接收端口", "停止位", "1"))
For i = 0 To 2
    If CInt(myReadINI(myPath, "接收端口", "校验方式", "0")) = i Then Option1(i).Value = True
Next i

T2(0) = Trim(myReadINI(myPath, "发送端口", "端口号", "1"))
T2(1) = Trim(myReadINI(myPath, "发送端口", "波特率", "9600"))
T2(2) = Trim(myReadINI(myPath, "发送端口", "数据位", "8"))
T2(3) = Trim(myReadINI(myPath, "发送端口", "停止位", "1"))
For i = 3 To 5
    If CInt(myReadINI(myPath, "发送端口", "校验方式", "0")) = i - 3 Then Option1(i).Value = True
Next i

BiaoShi = Chr(myReadINI(myPath, "拦截数据", "断句标志", " "))
KaiShi = Chr(myReadINI(myPath, "拦截数据", "开始标志", " "))
myLen = myReadINI(myPath, "拦截数据", "数据长度", "64")

Text1 = BiaoShi
Text3 = KaiShi
Text4 = myLen
iStr = Split(Trim(myReadINI(myPath, "拦截数据", "拦截字串", "")), ",")
List1.Clear
For i = 0 To UBound(iStr)
    If Len(Trim(iStr(i))) >= 1 Then List1.AddItem Trim(iStr(i))
Next i
For i = 0 To 2
    If Option1(i).Value = True Then
        Select Case i
            Case 0
                JShStr = "N"
            Case 1
                JShStr = "O"
            Case 2
                JShStr = "E"
        End Select
    End If
Next i
JShStr = T1(1) & "," & JShStr & "," & T1(2) & "," & T1(3)
For i = 3 To 5
    If Option1(i).Value = True Then
        Select Case i
            Case 3
                FSStr = "N"
            Case 4
                FSStr = "O"
            Case 5
                FSStr = "E"
        End Select
    End If
Next i
FSStr = T2(1) & "," & FSStr & "," & T2(2) & "," & T2(3)
MSComm1.Settings = JShStr
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
MSComm1.CommPort = T1(0)
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True


End Sub


Private Sub Text2_Change()
Text5 = Len(Text2)
End Sub

Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3)
End Sub


Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4)
End Sub