publicmod.bas

一个读取支持modbus协议的设备的数据工具

Attribute VB_Name = "PublicMod"
Option Explicit

Public CurIndex As Integer      '''0:COM 1:Net
Public OpenFlag As Boolean
Public ConnetFlag As Boolean
Public SaveDevFile As String

Public Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Long

Public Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpRetString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpRetString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Long

Public Const LB_FINDSTRING = &H18F
Public Const CB_FINDSTRINGEXACT = &H158
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const SB_END = 7           '''向上或向左移到最前
Public Const WM_HSCROLL1 = &H115   '''上下移动
Public UnloadFlag As Integer

Public Sub Main()
'    If App.PrevInstance Then End
    Load Form1
    Form1.Visible = False
    UnloadFlag = 0
    OpenFlag = False
    ConnetFlag = False
    CurIndex = 0
    SaveDevFile = App.Path + "\Config.ini"
    FrmRegister.Show
End Sub

Public Function Hexn(ByVal number As Long, ByVal n As Integer) As String
Dim str As String

    str = String(n, "0") + Hex(number)
    str = Right(str, n)
    Hexn = str
End Function

Function Strn(Str1 As Integer, n As Integer) As String
Dim Temstr As String

    Temstr = String(n, "0") + CStr(Str1)
    Strn = Right(Temstr, n)
End Function

Function Crc_16(ByVal Str1 As String) As Long
Dim i As Integer
Dim j As Integer
Dim CVal As Long
Dim Temp1 As Integer
Dim Const1 As Long
    CVal = 65535        '&HFFFF
    Const1 = 40961      '&HA001
    For i = 1 To LenB(Str1)
        Temp1 = AscB(MidB(Str1, i, 1))
        CVal = Temp1 Xor CVal
        For j = 0 To 7
            If (CVal Mod 2) = 0 Then
                CVal = CVal \ 2
            Else
                CVal = CVal \ 2
                CVal = CVal Xor Const1
            End If
        Next j
    Next i
    Crc_16 = CVal And &HFFFF&
End Function