VB串口通讯软件2

科技论坛
100 阅读41分钟

VB串口通讯软件2

Private Sub AC_ch_Click() Factor_Seting.Visible = True tx_REQ = 3 End Sub

Private Sub compt_Click() Comptform.Visible = True End Sub

Private Sub Form_Load() Call Close_OpenPort(1) Call MakeToolbarFlat(Toolbar1) sys_set.Visible = True For i = 0 To 8 tx_b(i) = Array(&H68, &H3, &H3, &H68, &H20, &H93, &H83, &H85, &H0, &H30 + Second(Time) Mod 10, &H0, &H30 + Second(Time) Mod 10, &H0, &H41 + Second(Time) Mod 10, &H0, &H61 + Second(Time) Mod 10, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1) Next

tx_REQ = 3: num_rxright = 0: num_sent = 0

End Sub

Private Sub Form_Unload(Cancel As Integer) Unload controlform Unload Comptform Unload Factor_Seting Unload Me End Sub

Private Sub MSComm1_OnComm() Dim temp As Variant

MSComm1.InputLen = 1

While MSComm1.InBufferCount <> 0
    temp = MSComm1.Input

    If rx_ptr < 150 Then
        If rx_ptr = 3 Then rx_data.Caption = rx_data.Caption + vbCr
        rx_b(rx_ptr) = temp(0):    rx_data.Caption = rx_data.Caption + hexbyt(Int(temp(0))) + " "
        rx_ptr = rx_ptr + 1
        
        rx_CRC = rx_CRC Xor (temp(0) And &HFF)
        If rx_CRC < 0 Then rx_CRC = 65536 + rx_CRC
        For j = 0 To 7
            If (rx_CRC And 1) = 1 Then
                rx_CRC = Int(rx_CRC \ 2)
                rx_CRC = rx_CRC Xor &HA001
                If rx_CRC < 0 Then rx_CRC = 65536 + rx_CRC
            Else
                rx_CRC = Int(rx_CRC \ 2)
            End If
        Next
    End If
Wend

End Sub

Private Sub op_Click() controlform.Visible = True End Sub

Private Sub RAM_VScroll1_Change() RAM_addr1th.Text = strhex(RAM_VScroll1.Value) End Sub

Private Sub SN_VScroll_Change() SN_Text.Text = Str(SN_VScroll.Value) '站号调整与显示 End Sub

Private Sub sys_set_Click() s_set.Visible = True End Sub

Private Sub T_05s00_Timer() mn_form.Caption = " X200测试 " + Format(Date, " yyyy-mm-dd ") + Format(Time, "hh:mm:ss ") '标题刷新

If rx_CRC = 0 Then
    Call Process
    num_rxright = (num_rxright + 1) Mod 10000       '显示接收正确次数
    StatusBar1.Panels(2) = Str(num_rxright)
End If

Call Send(tx_REQ)               '发送默认命令
If tx_REQ <> 3 Then tx_REQ = 3

num_sent = (num_sent + 1) Mod 10000
StatusBar1.Panels(1) = Str(num_sent)                '显示召唤次数
rx_ptr = 0

End Sub

Sub Close_OpenPort(port As Byte) On Error Resume Next ' 改变错误处理的方式。 Err.Clear If MSComm1.PortOpen = True Then MSComm1.PortOpen = False

MSComm1.CommPort = port
MSComm1.Settings = "9600,n,8,1"
MSComm1.InputLen = 0
MSComm1.PortOpen = True

If Err.Number <> 0 Then msg = "Error # " & Str(Err.Number) & " was generated by " _ & Err.Source & Chr(13) & Err.Description MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext End If End Sub

Public Sub Process() If (T_pos < 410) Then disp_area.Caption = "" For i = 0 To 63 D_int(i) = b_i(rx_b(4 + i * 2), rx_b(3 + i * 2)) If D_int(i) >= 0 Then disp_area.Caption = disp_area.Caption + Format(D_int(i), " 00000 ") Else disp_area.Caption = disp_area.Caption + "-" + Format(-D_int(i), "00000 ") End If If (i Mod 8) = 7 Then disp_area.Caption = disp_area.Caption + vbCr + " " Next sindraw (0) End If

If T_pos = &H80 Then
    'For i = 0 To 7
        'Factor_Seting.AC_data(i).Caption = Format(b_i(rx_b(4 + i * 2), rx_b(3 + i * 2)) / 100, "0.00")
        Factor_Seting.AC_data(1).Caption = Format(b_i(rx_b(8), rx_b(7)) / 100, "0.00")
        Factor_Seting.AC_data(0).Caption = Format(b_i(rx_b(16), rx_b(15)) / 100, "0.00")
        Factor_Seting.AC_data(3).Caption = Format(b_i(rx_b(24), rx_b(23)) / 100, "0.00")
        Factor_Seting.AC_data(2).Caption = Format(b_i(rx_b(32), rx_b(31)) / 1000 * 38, "0.00")
        Factor_Seting.AC_data(5).Caption = Format(b_i(rx_b(40), rx_b(39)) / 1000 * 38, "0.00")
        Factor_Seting.AC_data(4).Caption = Format(b_i(rx_b(102), rx_b(101)) / 1000, "0.00")
        Factor_Seting.AC_data(7).Caption = Format(b_i(rx_b(104), rx_b(103)) / 1000, "0.00")
        'Factor_Seting.AC_data(7).Caption = Format(b_i(rx_b(6 + i * 2), rx_b(5 + i * 2)) / 100, "0.00")
    'Next
End If

If T_pos = &H178 Then
    For i = 0 To 7
        If rx_b(3 + i) < 128 Then Factor_Seting.VScroll1(i).Value = -rx_b(3 + i) Else Factor_Seting.VScroll1(i).Value = 256 - rx_b(3 + i)
    Next
End If

End Sub

Public Sub sindraw(ByVal ch As Integer) disp_pic.Cls xsc = (disp_pic.Width - 200) / 32: ysc = (disp_pic.Height - 200) / 1280: xax = disp_pic.Height / 2

disp_pic.Line (xsc, xax)-(disp_pic.Width - xsc, xax), RGB(128, 128, 128) disp_pic.Line (xsc, 100)-(xsc, disp_pic.Height - 100), RGB(128, 128, 128)

If T_pos < &H60 Then For i = 1 To 31 disp_pic.Line (i * xsc, D_int((i - 1) Mod 16) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16) * ysc + xax), RGB(250, ch * 50, 0) disp_pic.Line (i * xsc, D_int((i - 1) Mod 16 + 16) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16 + 16) * ysc + xax), RGB(250, ch * 50, 200)

    disp_pic.Line (i * xsc, D_int((i - 1) Mod 16 + 32) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16 + 32) * ysc + xax), RGB(210, 150, 220)
    disp_pic.Line (i * xsc, D_int((i - 1) Mod 16 + 48) * ysc + xax)-((i + 1) * xsc, D_int(i Mod 16 + 48) * ysc + xax), RGB(150, ch * 50, 100)


Next

Else For i = 1 To 31 disp_pic.Line (i * xsc, xax)-((i + 1) * xsc, xax), RGB(250, ch * 50, 0) disp_pic.Line (i * xsc, 16 * ysc + xax)-((i + 1) * xsc, 16 * ysc + xax), RGB(250, ch * 50, 200)

    disp_pic.Line (i * xsc, 32 * ysc + xax)-((i + 1) * xsc, 32 * ysc + xax), RGB(210, 150, 220)
    disp_pic.Line (i * xsc, 48 * ysc + xax)-((i + 1) * xsc, 48 * ysc + xax), RGB(150, ch * 50, 100)
Next

End If End Sub VERSION 5.00 Begin VB.Form s_set Caption = "sys_set" ClientHeight = 5025 ClientLeft = 60 ClientTop = 450 ClientWidth = 9360 LinkTopic = "Form1" ScaleHeight = 5025 ScaleWidth = 9360 StartUpPosition = 3 '窗口缺省 Begin VB.TextBox Text1 Alignment = 1 'Right Justify BeginProperty Font Name = "宋体" Size = 12 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 3 Left = 7200 TabIndex = 25 Text = "1.0" Top = 2280 Width = 735 End Begin VB.VScrollBar VScroll1 Height = 375 Index = 3 Left = 7920 Max = 255 Min = 1 TabIndex = 24 Top = 2280 Value = 1 Width = 255 End Begin VB.CommandButton Command1 Caption = "确认" BeginProperty Font Name = "宋体" Size = 12 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 735 Left = 7080 TabIndex = 21 Top = 3720 Width = 1095 End Begin VB.VScrollBar VScroll1 Height = 375 Index = 2 Left = 7920 Max = 255 Min = 1 TabIndex = 20 Top = 1680 Value = 10 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 375 Index = 1 Left = 7920 Max = 5 Min = 1 TabIndex = 19 Top = 1080 Value = 1 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 375 Index = 0 Left = 7920 Max = 99 Min = 1 TabIndex = 18 Top = 480 Value = 1 Width = 255 End Begin VB.TextBox Text1 Alignment = 1 'Right Justify BeginProperty Font Name = "宋体" Size = 12 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 2 Left = 7200 TabIndex = 17 Text = "1.0" Top = 1680 Width = 735 End Begin VB.TextBox Text1 Alignment = 1 'Right Justify BeginProperty Font Name = "宋体" Size = 12 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 1 Left = 7200 TabIndex = 16 Text = "1" Top = 1080 Width = 735 End Begin VB.TextBox Text1 Alignment = 1 'Right Justify BeginProperty Font Name = "宋体" Size = 12 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Index = 0 Left = 7200 TabIndex = 15 Text = "1" Top = 480 Width = 735 End Begin VB.ComboBox Combo1 Height = 300 Index = 5 ItemData = "sys_set.frx":0000 Left = 2760 List = "sys_set.frx":0016 TabIndex = 5 Text = "100ms" Top = 4080 Width = 1215 End Begin VB.ComboBox Combo1 Height = 300 Index = 4 ItemData = "sys_set.frx":0043 Left = 2760 List = "sys_set.frx":0059 TabIndex = 4 Text = "100ms" Top = 3240 Width = 1215 End Begin VB.ComboBox Combo1 Height = 300 Index = 3 ItemData = "sys_set.frx":0086 Left = 2760 List = "sys_set.frx":0090 TabIndex = 3 Text = "上升沿" Top = 2520 Width = 1215 End Begin VB.ComboBox Combo1 Height = 300 Index = 2 ItemData = "sys_set.frx":00A2 Left = 2760 List = "sys_set.frx":00B2 TabIndex = 2 Text = "保护模式" Top = 1800 Width = 1215 End Begin VB.ComboBox Combo1 Height = 300 Index = 1 ItemData = "sys_set.frx":00E1 Left = 2760 List = "sys_set.frx":00F1 TabIndex = 1 Text = "Ia" Top = 1080 Width = 1215 End Begin VB.ComboBox Combo1 Height = 300 Index = 0 ItemData = "sys_set.frx":0105 Left = 2760 List = "sys_set.frx":0112 TabIndex = 0 Text = "面板" Top = 480 Width = 1215 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "CT 变比" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 9 Left = 5400 TabIndex = 23 Top = 2400 Width = 1455 End Begin VB.Label Label2 Caption = "CT变比" Height = 15 Left = 5280 TabIndex = 22 Top = 2400 Width = 1215 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "星-三角启动切换时间" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 8 Left = 4440 TabIndex = 14 Top = 1800 Width = 2415 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "散热时间系数" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 7 Left = 5160 TabIndex = 13 Top = 1200 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "通信站号" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 6 Left = 5160 TabIndex = 12 Top = 600 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "启停出口方式" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 5 Left = 720 TabIndex = 11 Top = 4080 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "跳闸出口方式" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 4 Left = 720 TabIndex = 10 Top = 3240 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "接点检测方式" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 720 TabIndex = 9 Top = 2520 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "控制模式" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 720 TabIndex = 8 Top = 1800 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "模拟量输出" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 720 TabIndex = 7 Top = 1080 Width = 1695 End Begin VB.Label Label1 Alignment = 1 'Right Justify Caption = "操作权限" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 720 TabIndex = 6 Top = 510 Width = 1695 End End Attribute VB_Name = "s_set" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim hcd(32) As Byte Private Sub Command1_Click()

For i = 0 To 2
    If Combo1(i * 2).ListIndex < 0 Then Combo1(i * 2).ListIndex = 0
    If Combo1(i * 2 + 1).ListIndex < 0 Then Combo1(i * 2 + 1).ListIndex = 0
    hcd(i) = (Combo1(i * 2).ListIndex + 1) * 16 + (Combo1(i * 2 + 1).ListIndex + 1)
    hcd(i + 3) = VScroll1(i).Value
    
Next

hcd(7) = VScroll1(3).Value



hcd(10) = &H34: hcd(11) = &HDA
For i = 0 To 4
    hcd(10) = hcd(10) Xor hcd(i * 2): hcd(11) = hcd(11) Xor hcd(i * 2 + 1)
Next

i = 14 * 8 + &H100

tx_b(16) = Array(&H8, &H10, i \ 256, i Mod 256, 0, &H8, &H10, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

hcd(12) = &HFF: hcd(13) = &HFF: hcd(14) = &H12: hcd(15) = &H34
For i = 7 To 7 + 32:        tx_b(16)(i) = hcd(i - 7):    Next
tx_REQ = 16

End Sub

Private Sub VScroll1_Change(Index As Integer) If Index = 2 Then Text1(2).Text = Format(VScroll1(2).Value / 10, "0.0") Else Text1(Index).Text = VScroll1(Index).Value End If

End Sub

第二段程序

VERSION 5.00 Begin VB.Form Comptform BorderStyle = 1 'Fixed Single Caption = "参数设置" ClientHeight = 3810 ClientLeft = 45 ClientTop = 330 ClientWidth = 3120 Icon = "Compt.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3810 ScaleWidth = 3120 StartUpPosition = 3 '窗口缺省 Begin VB.CommandButton Command2 Caption = "下装" Height = 495 Left = 1080 Picture = "Compt.frx":038A Style = 1 'Graphical TabIndex = 9 Top = 3120 Width = 975 End Begin VB.TextBox Text3 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "定值3比例" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 315 Index = 2 Left = 1080 TabIndex = 8 Text = "1" Top = 2020 Width = 975 End Begin VB.TextBox Text3 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "定值2比例" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 315 Index = 1 Left = 1080 TabIndex = 7 Text = "100" Top = 1420 Width = 975 End Begin VB.TextBox Text3 Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "定值1比例" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 315 Index = 0 Left = 1080 TabIndex = 6 Text = "200" Top = 820 Width = 975 End Begin VB.ComboBox Combo3 BeginProperty Font Name = "宋体" Size = 9 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 300 ItemData = "Compt.frx":0714 Left = 1080 List = "Compt.frx":0745 TabIndex = 1 Text = "启动时间长保护" Top = 220 Width = 1935 End Begin VB.ComboBox Combo1 Appearance = 0 'Flat BackColor = &H00FFFFFF& DataField = "类型" DataSource = "Data1" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 300 ItemData = "Compt.frx":0813 Left = 1080 List = "Compt.frx":0832 TabIndex = 0 Text = " 跳闸" Top = 2620 Width = 1575 End Begin VB.Label Label2 Caption = "保护参数" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 0 Left = 120 TabIndex = 5 Top = 260 Width = 855 End Begin VB.Label Label2 Caption = "定 值" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 1 Left = 120 TabIndex = 4 Top = 860 Width = 855 End Begin VB.Label Label2 Caption = "时 限" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 2 Left = 120 TabIndex = 3 Top = 1460 Width = 855 End Begin VB.Label Label2 Caption = "参数1" BeginProperty Font Name = "宋体" Size = 10.5 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Index = 3 Left = 120 TabIndex = 2 Top = 2060 Width = 855 End End Attribute VB_Name = "Comptform" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim hcd(32) As Byte Private Sub Combo1_Click() If Combo1.Text = "调试0mA" Then Label2(1).Caption = "调试0mA" Label2(2).Caption = "调试4mA" Label2(3).Caption = "调试20mA" ElseIf Combo1.Text = "调试4mA" Then Label2(1).Caption = "调试0mA" Label2(2).Caption = "调试4mA" Label2(3).Caption = "调试20mA" ElseIf Combo1.Text = "调试20mA" Then Label2(1).Caption = "调试0mA" Label2(2).Caption = "调试4mA" Label2(3).Caption = "调试20mA" ElseIf Combo1.Text = "0_20mA" Then Label2(1).Caption = "调试0mA" Label2(2).Caption = "调试4mA" Label2(3).Caption = "调试20mA" ElseIf Combo1.Text = "4_20mA" Then Label2(1).Caption = "调试0mA" Label2(2).Caption = "调试4mA" Label2(3).Caption = "调试20mA" Else Label2(1).Caption = "定 值" Label2(2).Caption = "时 限" Label2(3).Caption = "参数1" End If End Sub Private Sub Command2_Click()

 Dim h As Integer
If Combo3.Text = "启动时间长保护" Then
h = 1
ElseIf Combo3.Text = "定时限过负荷保护" Then
h = 2
ElseIf Combo3.Text = "反时限过负荷保护" Then
h = 3
ElseIf Combo3.Text = "堵转保护" Then
h = 4
 ElseIf Combo3.Text = "电流不平衡保护" Then
h = 5
ElseIf Combo3.Text = "接地保护" Then
h = 6
ElseIf Combo3.Text = "过热保护" Then
h = "7"
ElseIf Combo3.Text = "欠电压保护" Then
h = 8
ElseIf Combo3.Text = "过电压保护" Then
h = 9
ElseIf Combo3.Text = "欠电流保护" Then
h = 10
ElseIf Combo3.Text = "断相保护" Then
h = 11
ElseIf Combo3.Text = "电压回路断相保护" Then
h = 12
ElseIf Combo3.Text = "欠压重启动功能" Then
h = 13
ElseIf Combo3.Text = "TE时间保护" Then
h = 14
ElseIf Combo3.Text = "变送值设定" Then
h = 15
End If


If Combo1.ListIndex < 0 Then Combo1.ListIndex = 1

hcd(6) = &HFF: hcd(7) = &HFF: hcd(8) = &H66: hcd(9) = &H66
hcd(12) = &HFF: hcd(13) = &HFF: hcd(14) = &H12: hcd(15) = &H34
If Combo1.ListIndex = 1 Then
    hcd(8) = &HA5
    hcd(9) = &H5A
ElseIf Combo1.ListIndex = 2 Then
    hcd(8) = &H5A
    hcd(9) = &HA5
ElseIf Combo1.ListIndex = 4 Then
    hcd(6) = &H0
    hcd(7) = &H1
ElseIf Combo1.ListIndex = 5 Then
    hcd(6) = &H0
    hcd(7) = &H2
ElseIf Combo1.ListIndex = 6 Then
    hcd(6) = &H0
    hcd(7) = &H3
ElseIf Combo1.ListIndex = 7 Then
    hcd(6) = &H0
    hcd(7) = &H55
ElseIf Combo1.ListIndex = 8 Then
    hcd(6) = &H0
    hcd(7) = &HAA
End If


For i = 0 To 2
    temp = Val(Text3(i).Text)
    hcd(i * 2) = temp \ 256
    hcd(i * 2 + 1) = temp Mod 256                       'para0-2
    
Next

hcd(10) = &H34
hcd(11) = &HDA
For i = 0 To 4
    hcd(10) = hcd(10) Xor hcd(i * 2)
    hcd(11) = hcd(11) Xor hcd(i * 2 + 1)
Next

If h = 15 Then
i = (Val(h) + 1) * 8 + &H100
Else
i = (Val(h) - 1) * 8 + &H100
End If

tx_b(16) = Array(&H8, &H10, i \ 256, i Mod 256, 0, &H8, &H10, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

For i = 7 To 7 + 32
tx_b(16)(i) = hcd(i - 7)
Next
tx_REQ = 16

End Sub

VERSION 5.00 Begin VB.Form controlform BorderStyle = 1 'Fixed Single Caption = "操作电机" ClientHeight = 1995 ClientLeft = 45 ClientTop = 330 ClientWidth = 5430 Icon = "controlform.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 1995 ScaleWidth = 5430 StartUpPosition = 3 '窗口缺省 Begin VB.CommandButton J_ctrl Caption = "校时" Height = 615 Index = 5 Left = 3960 Picture = "controlform.frx":08CA Style = 1 'Graphical TabIndex = 5 Top = 1200 Width = 975 End Begin VB.CommandButton J_ctrl Caption = "清除电度" Height = 615 Index = 4 Left = 2280 Picture = "controlform.frx":0C54 Style = 1 'Graphical TabIndex = 4 Top = 1200 Width = 975 End Begin VB.CommandButton J_ctrl Caption = "复归" Height = 615 Index = 3 Left = 480 Picture = "controlform.frx":1A96 Style = 1 'Graphical TabIndex = 3 Top = 1200 Width = 975 End Begin VB.CommandButton J_ctrl Caption = "停车" Height = 615 Index = 2 Left = 3960 Picture = "controlform.frx":1E20 Style = 1 'Graphical TabIndex = 2 Top = 240 Width = 975 End Begin VB.CommandButton J_ctrl Caption = "启动B" Height = 615 Index = 1 Left = 2280 Picture = "controlform.frx":21AA Style = 1 'Graphical TabIndex = 1 Top = 240 Width = 975 End Begin VB.CommandButton J_ctrl Caption = "启动A" Height = 615 Index = 0 Left = 480 Picture = "controlform.frx":2534 Style = 1 'Graphical TabIndex = 0 Top = 240 Width = 975 End End Attribute VB_Name = "controlform" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub J_ctrl_Click(Index As Integer) If Index < 5 Then '继电器 tx_b(16) = Array(0, 0, &H0, &HD2, &H0, &H1, &H2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) tx_b(16)(7) = (Index + 1) * 17 tx_b(16)(8) = (Index + 1) * 17 ' tx_b(16)(14 + 8) = 40 Else '校时 ts = d_BCD(Second(Time)): tm = d_BCD(Minute(Time)): th = d_BCD(Hour(Time)) dd = d_BCD(Day(Date)): dM = d_BCD(Month(Date)): dY = d_BCD(Year(Date) Mod 100) tx_b(16) = Array(0, 0, &H0, &HD8, &H0, &H4, &H8, dY, dM, dd, th, tm, ts, &H12, &H34, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) End If tx_REQ = 16 '0x10 命令

End Sub

VERSION 5.00 Begin VB.Form Factor_Seting Appearance = 0 'Flat BorderStyle = 3 'Fixed Dialog Caption = "通道校正系数" ClientHeight = 2400 ClientLeft = 1980 ClientTop = 4365 ClientWidth = 11895 BeginProperty Font Name = "System" Size = 12 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False Picture = "Factor_seting.frx":0000 ScaleHeight = 2400 ScaleWidth = 11895 Begin VB.CommandButton Command1 BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 9840 Picture = "Factor_seting.frx":0342 Style = 1 'Graphical TabIndex = 1 Top = 600 Width = 375 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 7 Left = 5880 TabIndex = 42 Text = "0.0" Top = 1200 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 6 Left = 5880 TabIndex = 41 Text = "0.0" Top = 720 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 5 Left = 5880 TabIndex = 40 Text = "0.0" Top = 240 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 4 Left = 1080 TabIndex = 39 Text = "0.0" Top = 240 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 3 Left = 1080 TabIndex = 38 Text = "0.0" Top = 720 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 2 Left = 1080 TabIndex = 37 Text = "0.0" Top = 1200 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 1 Left = 1080 TabIndex = 36 Text = "0.0" Top = 1680 Width = 735 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 7 Left = 5520 TabIndex = 35 Top = 1320 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 6 Left = 5520 TabIndex = 34 Top = 840 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 5 Left = 5520 TabIndex = 33 Top = 360 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 4 Left = 720 TabIndex = 32 Top = 360 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 3 Left = 720 TabIndex = 31 Top = 840 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 255 Index = 2 Left = 720 TabIndex = 30 Top = 1320 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 1 Left = 720 TabIndex = 29 Top = 1800 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 0 Left = 5520 TabIndex = 28 Top = 1800 Width = 255 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 0 Left = 5880 TabIndex = 27 Text = "0.0" Top = 1680 Width = 735 End Begin VB.CommandButton command3 Caption = "计算" Height = 495 Left = 10080 TabIndex = 26 Top = 1560 Width = 855 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 7 Left = 9240 Max = 127 Min = -127 TabIndex = 25 Top = 1200 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 6 Left = 9240 Max = 127 Min = -127 TabIndex = 24 Top = 720 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 5 Left = 9240 Max = 127 Min = -127 TabIndex = 23 Top = 240 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 4 Left = 4440 Max = 127 Min = -127 TabIndex = 22 Top = 240 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 3 Left = 4440 Max = 127 Min = -127 TabIndex = 21 Top = 720 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 2 Left = 4440 Max = 127 Min = -127 TabIndex = 20 Top = 1200 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 1 Left = 4440 Max = 127 Min = -127 TabIndex = 19 Top = 1680 Width = 255 End Begin VB.CommandButton Command2 BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 10560 Picture = "Factor_seting.frx":06CC Style = 1 'Graphical TabIndex = 2 Top = 600 Width = 375 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 0 Left = 9240 Max = 127 Min = -127 TabIndex = 0 Top = 1680 Width = 255 End Begin VB.Label Label9 Caption = "Ua" Height = 255 Left = 360 TabIndex = 58 Top = 360 Width = 405 End Begin VB.Label Label13 Caption = "Ipa" Height = 255 Left = 5160 TabIndex = 57 Top = 360 Width = 405 End Begin VB.Label Label12 Caption = "Ub" Height = 255 Left = 360 TabIndex = 56 Top = 840 Width = 405 End Begin VB.Label Label11 Caption = "Ia" Height = 255 Left = 360 TabIndex = 55 Top = 1800 Width = 405 End Begin VB.Label Label10 Caption = "Ipb" Height = 255 Left = 5160 TabIndex = 54 Top = 840 Width = 405 End Begin VB.Label Label8 Caption = "Uc" Height = 255 Left = 360 TabIndex = 53 Top = 1320 Width = 405 End Begin VB.Label Label7 Caption = "Ic" Height = 255 Left = 5160 TabIndex = 52 Top = 1800 Width = 405 End Begin VB.Label Label4 Caption = "Ipc" Height = 255 Left = 5160 TabIndex = 51 Top = 1320 Width = 405 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 7 Left = 7800 TabIndex = 50 Top = 1200 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 6 Left = 7800 TabIndex = 49 Top = 720 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 5 Left = 7800 TabIndex = 48 Top = 240 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 4 Left = 3000 TabIndex = 47 Top = 240 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 3 Left = 3000 TabIndex = 46 Top = 720 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 2 Left = 3000 TabIndex = 45 Top = 1200 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 1 Left = 3000 TabIndex = 44 Top = 1680 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 0 Left = 7800 TabIndex = 43 Top = 1680 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 7 Left = 8640 TabIndex = 18 Top = 1200 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 6 Left = 8640 TabIndex = 17 Top = 720 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 5 Left = 8640 TabIndex = 16 Top = 240 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 4 Left = 3840 TabIndex = 15 Top = 240 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 3 Left = 3840 TabIndex = 14 Top = 720 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 2 Left = 3840 TabIndex = 13 Top = 1200 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 1 Left = 3840 TabIndex = 12 Top = 1680 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 0 Left = 8640 TabIndex = 11 Top = 1680 Width = 615 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 7 Left = 6720 TabIndex = 10 Top = 1200 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 6 Left = 6720 TabIndex = 9 Top = 720 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 5 Left = 6720 TabIndex = 8 Top = 240 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 4 Left = 1920 TabIndex = 7 Top = 240 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 3 Left = 1920 TabIndex = 6 Top = 720 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 2 Left = 1920 TabIndex = 5 Top = 1200 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 1 Left = 1920 TabIndex = 4 Top = 1680 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 0 Left = 6720 TabIndex = 3 Top = 1680 Width = 855 End End Attribute VB_Name = "Factor_Seting" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit

Private Sub Command1_Click(Index As Integer) Dim i, x As Single tx_b(4) = Array(&HF0, 3, &H4, &HC0, &H0, &H40, 0, 0, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0) tx_REQ = 4 End Sub

Private Sub Command2_Click(Index As Integer) Dim i, sumL, sumH As Integer

tx_b(4) = Array(&H68, 28, 28, &H68, &H40, 0, 4, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
sumL = 0
sumH = 0
For i = 0 To 7

    tx_b(4)(i + 8) = -VScroll1(Index * 8 + i).Value
    If i Mod 2 = 0 Then
        sumL = sumL Xor tx_b(4)(i + 8)
    Else
        sumH = sumH Xor tx_b(4)(i + 8)
    End If
    
Next

tx_b(4)(20) = 0                     'ID

tx_b(4)(21) = &HFF
sumL = sumL Xor tx_b(4)(20)
sumH = sumH Xor tx_b(4)(21)

tx_b(4)(22) = 0

tx_b(4)(23) = &H9A                  'switch
sumL = sumL Xor tx_b(4)(22)
sumH = sumH Xor tx_b(4)(23)
  
tx_b(4)(24) = 255 - Abs(tx_b(4)(8))      'para1 bk
tx_b(4)(25) = 255 - Abs(tx_b(4)(9))

tx_b(4)(26) = sumL Xor tx_b(4)(24)
tx_b(4)(27) = sumH Xor tx_b(4)(25)
 

tx_REQ = 4

End Sub

Private Sub Command3_Click() Dim i As Integer For i = 0 To 7 If Check0(i).Value = 1 Then Label2(i).Caption = Format(((Text0(i).Text - AC_data(i).Caption) / AC_data(i).Caption * 100), "0.0") VScroll1(i).Value = -Label2(i).Caption * 10 + VScroll1(i).Value End If Next i

Command2_Click (0)

End Sub

Private Sub Command4_Click() Factor_Seting.Hide End Sub

Private Sub Form_Load()

Dim i As Integer, KeyName As String

For i = 0 To 7 KeyName = "Text0(" & i & ")" & ".Text" Text0(i).Text = GetSetting(App.Title, Me.Name, KeyName, "0.00") '读取设置

Next i

tx_b(3) = Array(&H68, 4, 4, &H68, &H40, 0, 3, 11, 7, 7)

' End If tx_REQ = 3

End Sub

Private Sub Form_Unload(Cancel As Integer) Dim i As Integer, KeyName As String

For i = 0 To 7 KeyName = "Text0(" & i & ")" & ".Text" Call SaveSetting(App.Title, Me.Name, KeyName, Me.Text0(i).Text) '存储设置 Next i End Sub

Private Sub VScroll1_Change(Index As Integer) Factor_label(Index).Caption = Format(-VScroll1(Index).Value / 10, " 0.0") End Sub

'3号命令－上传系数定值 group10-12 Private Sub VScroll2_Change(Index As Integer) Dim x As Single

x = VScroll2(Index).Value:  x = x / 10:   Text0(Index).Text = Format(x, "#0.0 ")

End Sub

VERSION 5.00 Begin VB.Form Factor_Seting Appearance = 0 'Flat BorderStyle = 1 'Fixed Single Caption = "电力系数校正" ClientHeight = 3270 ClientLeft = 1980 ClientTop = 4365 ClientWidth = 11385 BeginProperty Font Name = "System" Size = 12 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Icon = "Factor_seting_bk.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False Picture = "Factor_seting_bk.frx":038A ScaleHeight = 3270 ScaleWidth = 11385 Begin VB.CommandButton Command3 Caption = "计算" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 9960 Picture = "Factor_seting_bk.frx":06CC Style = 1 'Graphical TabIndex = 74 Top = 1920 Width = 975 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 15 Left = 2160 Max = 256 Min = -127 TabIndex = 65 Top = 5160 Value = 256 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 14 Left = 1920 Max = 256 Min = -127 TabIndex = 1 Top = 5160 Value = 87 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 13 Left = 1680 Max = 256 Min = -127 TabIndex = 64 Top = 5160 Value = 256 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 12 Left = 1440 Max = 127 Min = -127 TabIndex = 63 Top = 5160 Value = 1 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 11 Left = 1200 Max = 127 Min = -127 TabIndex = 62 Top = 5160 Value = 1 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 10 Left = 960 Max = 127 Min = -127 TabIndex = 61 Top = 5160 Value = 1 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 9 Left = 720 Max = 127 Min = -127 TabIndex = 60 Top = 5160 Value = 1 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 8 Left = 480 Max = 127 Min = -127 TabIndex = 59 Top = 5160 Value = 1 Width = 255 End Begin VB.CommandButton Command1 BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 9840 Picture = "Factor_seting_bk.frx":0A56 Style = 1 'Graphical TabIndex = 2 Top = 1200 Width = 375 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 7 Left = 5880 TabIndex = 42 Text = "0.0" Top = 2640 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 6 Left = 960 TabIndex = 41 Text = "0.0" Top = 4080 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 5 Left = 5880 TabIndex = 40 Text = "0.0" Top = 1440 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 4 Left = 5880 TabIndex = 39 Text = "0.0" Top = 2040 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 3 Left = 1080 TabIndex = 38 Text = "0.0" Top = 2040 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 2 Left = 5880 TabIndex = 37 Text = "0.0" Top = 840 Width = 735 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 1 Left = 1080 TabIndex = 36 Text = "0.0" Top = 840 Width = 735 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 7 Left = 5520 TabIndex = 35 Top = 2760 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 6 Left = 600 TabIndex = 34 Top = 4200 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 5 Left = 5520 TabIndex = 33 Top = 1560 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 4 Left = 5520 TabIndex = 32 Top = 2160 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 3 Left = 720 TabIndex = 31 Top = 2160 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 255 Index = 2 Left = 5520 TabIndex = 30 Top = 960 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 1 Left = 720 TabIndex = 29 Top = 960 Width = 255 End Begin VB.CheckBox Check0 Caption = "Check1" Height = 225 Index = 0 Left = 720 TabIndex = 28 Top = 1560 Width = 255 End Begin VB.TextBox Text0 Alignment = 2 'Center Height = 360 Index = 0 Left = 1080 TabIndex = 27 Text = "0.0" Top = 1440 Width = 735 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 7 Left = 9240 Max = 127 Min = -127 TabIndex = 26 Top = 2640 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 6 Left = 4320 Max = 127 Min = -127 TabIndex = 25 Top = 4080 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 5 Left = 9240 Max = 127 Min = -127 TabIndex = 24 Top = 1440 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 4 Left = 9240 Max = 127 Min = -127 TabIndex = 23 Top = 2040 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 3 Left = 4440 Max = 127 Min = -127 TabIndex = 22 Top = 2040 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 2 Left = 9240 Max = 127 Min = -127 TabIndex = 21 Top = 840 Width = 255 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 1 Left = 4440 Max = 127 Min = -127 TabIndex = 20 Top = 840 Width = 255 End Begin VB.CommandButton Command2 BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 10560 Picture = "Factor_seting_bk.frx":0DE0 Style = 1 'Graphical TabIndex = 3 Top = 1200 Width = 375 End Begin VB.VScrollBar VScroll1 Height = 345 Index = 0 Left = 4440 Max = 127 Min = -127 TabIndex = 0 Top = 1440 Width = 255 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "校正系数" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 7 Left = 8640 TabIndex = 73 Top = 360 Width = 975 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "推荐系数" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 6 Left = 7680 TabIndex = 72 Top = 360 Width = 855 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "实测值" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 5 Left = 6720 TabIndex = 71 Top = 360 Width = 735 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "标准值" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 4 Left = 5880 TabIndex = 70 Top = 360 Width = 735 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "校正系数" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 3 Left = 3840 TabIndex = 69 Top = 360 Width = 975 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "推荐系数" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 2 Left = 2880 TabIndex = 68 Top = 360 Width = 855 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "实测值" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 1920 TabIndex = 67 Top = 360 Width = 735 End Begin VB.Label Label1 Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "标准值" BeginProperty Font Name = "宋体" Size = 9 Charset = 134 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 1080 TabIndex = 66 Top = 360 Width = 735 End Begin VB.Label Label9 Caption = "Ib" Height = 255 Left = 360 TabIndex = 58 Top = 1560 Width = 405 End Begin VB.Label Label13 Caption = "Ia" Height = 255 Left = 360 TabIndex = 57 Top = 960 Width = 405 End Begin VB.Label Label12 Caption = "Uab" Height = 255 Left = 5040 TabIndex = 56 Top = 960 Width = 405 End Begin VB.Label Label11 Caption = "U0" Height = 255 Left = 240 TabIndex = 55 Top = 4200 Width = 405 End Begin VB.Label Label10 Caption = "Ic" Height = 255 Left = 360 TabIndex = 54 Top = 2160 Width = 405 End Begin VB.Label Label8 Caption = "Ija" Height = 255 Left = 5040 TabIndex = 53 Top = 2160 Width = 405 End Begin VB.Label Label7 Caption = "Ijc" Height = 255 Left = 5040 TabIndex = 52 Top = 2760 Width = 405 End Begin VB.Label Label4 Caption = "Ubc" Height = 255 Left = 5040 TabIndex = 51 Top = 1560 Width = 405 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 7 Left = 7800 TabIndex = 50 Top = 2640 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 6 Left = 2880 TabIndex = 49 Top = 4080 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 5 Left = 7800 TabIndex = 48 Top = 1440 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 4 Left = 7800 TabIndex = 47 Top = 2040 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 3 Left = 3000 TabIndex = 46 Top = 2040 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 2 Left = 7800 TabIndex = 45 Top = 840 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 1 Left = 3000 TabIndex = 44 Top = 840 Width = 615 End Begin VB.Label Label2 Alignment = 2 'Center BackColor = &H80000005& Caption = "0.0" Height = 330 Index = 0 Left = 3000 TabIndex = 43 Top = 1440 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 7 Left = 8640 TabIndex = 19 Top = 2640 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 6 Left = 3720 TabIndex = 18 Top = 4080 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 5 Left = 8640 TabIndex = 17 Top = 1440 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 4 Left = 8640 TabIndex = 16 Top = 2040 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 3 Left = 3840 TabIndex = 15 Top = 2040 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 2 Left = 8640 TabIndex = 14 Top = 840 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 1 Left = 3840 TabIndex = 13 Top = 840 Width = 615 End Begin VB.Label Factor_label Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 1 'Fixed Single Caption = "0.0 " ForeColor = &H00800000& Height = 330 Index = 0 Left = 3840 TabIndex = 12 Top = 1440 Width = 615 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 7 Left = 6720 TabIndex = 11 Top = 2640 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 6 Left = 1800 TabIndex = 10 Top = 4080 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 5 Left = 6720 TabIndex = 9 Top = 1440 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 4 Left = 6720 TabIndex = 8 Top = 2040 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 3 Left = 1920 TabIndex = 7 Top = 2040 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 2 Left = 6720 TabIndex = 6 Top = 840 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 1 Left = 1920 TabIndex = 5 Top = 840 Width = 855 End Begin VB.Label AC_data Alignment = 1 'Right Justify Appearance = 0 'Flat BackColor = &H00404000& BorderStyle = 1 'Fixed Single Caption = "000.00 " ForeColor = &H0000FFFF& Height = 315 Index = 0 Left = 1920 TabIndex = 4 Top = 1440 Width = 855 End End Attribute VB_Name = "Factor_Seting" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim hcd(32) As Integer Option Explicit

Private Sub Check0_Click(Index As Integer) If Check0(1).Value = 1 Then AAA = "128" ElseIf Check0(0).Value = 1 Then AAA = "128" ElseIf Check0(3).Value = 1 Then AAA = "128" ElseIf Check0(2).Value = 1 Then AAA = "128" ElseIf Check0(5).Value = 1 Then AAA = "128" ElseIf Check0(4).Value = 1 Then AAA = "128" ElseIf Check0(7).Value = 1 Then AAA = "128" Else AAA = BBB End If

End Sub Private Sub Command1_Click(Index As Integer) tx_b(4) = Array(&HF0, 3, &H1, &H78, &H0, &H40, 0, 0, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0) tx_REQ = 4 End Sub Private Sub Command2_Click(Index As Integer) Dim i, sumH, sumL As Integer tx_b(16) = Array(&H8, &H10, &H1, &H78, 0, &H8, &H10, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

For i = 0 To 7
    hcd(i) = -VScroll1(i).Value
Next

hcd(10) = &H34: hcd(11) = &HDA
For i = 0 To 4
    hcd(10) = hcd(10) Xor hcd(i * 2): hcd(11) = hcd(11) Xor hcd(i * 2 + 1)
Next
   
hcd(12) = &HFF: hcd(13) = &HFF: hcd(14) = &H12: hcd(15) = &H34

For i = 7 To 7 + 32:        tx_b(16)(i) = hcd(i - 7):    Next
tx_REQ = 16

End Sub

Private Sub Command3_Click() Dim i As Integer For i = 0 To 7 If Check0(i).Value = 1 And AC_data(i).Caption <> 0 Then Label2(i).Caption = Format(((Text0(i).Text - AC_data(i).Caption) / AC_data(i).Caption * 100), "0.0") ' If Abs(Val(Label2(i).Caption)) < 12 Then VScroll1(i).Value = -Val(Label2(i).Caption) * 10 + VScroll1(i).Value End If Next i End Sub

Private Sub VScroll1_Change(Index As Integer) Factor_label(Index).Caption = Format(-VScroll1(Index).Value / 10, " 0.0") End Sub

VERSION 5.00 Begin VB.Form frmAbout BorderStyle = 3 'Fixed Dialog Caption = "电动机保护器调试软件" ClientHeight = 3555 ClientLeft = 2340 ClientTop = 1935 ClientWidth = 5730 ClipControls = 0 'False Icon = "frmAbout.frx":0000 LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 2453.724 ScaleMode = 0 'User ScaleWidth = 5380.766 ShowInTaskbar = 0 'False Begin VB.PictureBox picIcon AutoSize = -1 'True ClipControls = 0 'False Height = 540 Left = 240 Picture = "frmAbout.frx":08CA ScaleHeight = 337.12 ScaleMode = 0 'User ScaleWidth = 337.12 TabIndex = 1 Top = 240 Width = 540 End Begin VB.CommandButton cmdOK Cancel = -1 'True Caption = "确定" Default = -1 'True Height = 345 Left = 4125 TabIndex = 0 Top = 2625 Width = 1500 End Begin VB.CommandButton cmdSysInfo Caption = "系统信息(&S)..." Height = 345 Left = 4140 TabIndex = 2 Top = 3075 Width = 1485 End Begin VB.Line Line1 BorderColor = &H00808080& BorderStyle = 6 'Inside Solid Index = 1 X1 = 84.515 X2 = 5309.398 Y1 = 1687.583 Y2 = 1687.583 End Begin VB.Label lblDescription Caption = "本软件是西安亚川电力科技有限公司的电动机保护器专用调试软件。" ForeColor = &H00000000& Height = 1170 Left = 1050 TabIndex = 3 Top = 1125 Width = 3885 End Begin VB.Label lblTitle Caption = "西安亚川电力科技有限公司电动机保护调试软件" ForeColor = &H00000000& Height = 480 Left = 1050 TabIndex = 5 Top = 240 Width = 3885 End Begin VB.Line Line1 BorderColor = &H00FFFFFF& BorderWidth = 2 Index = 0 X1 = 98.6 X2 = 5309.398 Y1 = 1697.936 Y2 = 1697.936 End Begin VB.Label lblVersion Caption = "版本 2.00" Height = 225 Left = 1050 TabIndex = 6 Top = 780 Width = 3885 End Begin VB.Label lblDisclaimer Caption = "西安亚川电力科技有限公司 版权所有" ForeColor = &H00000000& Height = 825 Left = 255 TabIndex = 4 Top = 2625 Width = 3630 End End Attribute VB_Name = "frmAbout" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit

' 注册表关键字安全选项... Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' 注册表关键字 ROOT 类型... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' 独立的空的终结字符串 Const REG_DWORD = 4 ' 32位数字

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" Const gREGVALSYSINFOLOC = "MSINFO" Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub

Private Sub cmdOK_Click() Unload Me End Sub

Private Sub Form_Load() Me.Caption = "西安亚川电力科技有限公司 " lblVersion.Caption = "版本 " & App.Major & "." & App.Minor & "." & App.Revision lblTitle.Caption = "电动机保护器调试软件" End Sub

Public Sub StartSysInfo() On Error GoTo SysInfoErr

Dim rc As Long
Dim SysInfoPath As String

' 试图从注册表中获得系统信息程序的路径及名称...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
' 试图仅从注册表中获得系统信息程序的路径...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
    ' 已知32位文件版本的有效位置
    If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
        SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
        
    ' 错误 - 文件不能被找到...
    Else
        GoTo SysInfoErr
    End If
' 错误 - 注册表相应条目不能被找到...
Else
    GoTo SysInfoErr
End If

Call Shell(SysInfoPath, vbNormalFocus)

Exit Sub

SysInfoErr: MsgBox "此时系统信息不可用", vbOKOnly End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' 循环计数器 Dim rc As Long ' 返回代码 Dim hKey As Long ' 打开的注册表关键字句柄 Dim hDepth As Long ' Dim KeyValType As Long ' 注册表关键字数据类型 Dim tmpVal As String ' 注册表关键字值的临时存储器 Dim KeyValSize As Long ' 注册表关键自变量的尺寸 '------------------------------------------------------------ ' 打开 {HKEY_LOCAL_MACHINE...} 下的 RegKey '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表关键字

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 处理错误...

tmpVal = String$(1024, 0)                             ' 分配变量空间
KeyValSize = 1024                                       ' 标记变量尺寸

'------------------------------------------------------------
' 检索注册表关键字的值...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                     KeyValType, tmpVal, KeyValSize)    ' 获得/创建关键字值
                    
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 处理错误

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 外接程序空终结字符串...
    tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null 被找到,从字符串中分离出来
Else                                                    ' WinNT 没有空终结字符串...
    tmpVal = Left(tmpVal, KeyValSize)                   ' Null 没有被找到, 分离字符串
End If
'------------------------------------------------------------
' 决定转换的关键字的值类型...
'------------------------------------------------------------
Select Case KeyValType                                  ' 搜索数据类型...
Case REG_SZ                                             ' 字符串注册关键字数据类型
    KeyVal = tmpVal                                     ' 复制字符串的值
Case REG_DWORD                                          ' 四字节的注册表关键字数据类型
    For i = Len(tmpVal) To 1 Step -1                    ' 将每位进行转换
        KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' 生成值字符。 By Char。
    Next
    KeyVal = Format$("&h" + KeyVal)                     ' 转换四字节的字符为字符串
End Select

GetKeyValue = True                                      ' 返回成功
rc = RegCloseKey(hKey)                                  ' 关闭注册表关键字
Exit Function                                           ' 退出

GetKeyError: ' 错误发生后将其清除... KeyVal = "" ' 设置返回值到空字符串 GetKeyValue = False ' 返回失败 rc = RegCloseKey(hKey) ' 关闭注册表关键字 End Function

avatar
文章
阅读
粉丝