module1.bas

某机械工程学院的毕业设计以及毕业论文 非常参考价值

Attribute VB_Name = "Module1"
Public commandbz As Integer
Public maxnum As Integer
Public bknum As Integer
Public bkdata(100) As Integer
Public addrdata(500, 10) As String
Public fname As String
Public hnum As Integer
Public fmID(500, 100) As String
Public fmaddr(500, 100) As String
Public fmname(500, 100) As String
Public infor(500, 100) As String

Public lgnum As Integer
Public fmnum As Integer
Public num(100) As Integer
Public filedata(100, 20) As String
Public data(100, 20) As Integer
Public lgsettime(100) As Integer
Public lgopentime(100) As String
Public lgclosetime(100) As String
Public lgbacktime(100) As Integer

Public opentime(500) As String
Public closetime(500) As String
Public addtime(500) As Single
Public choicebz As Integer
Public choicetype As String
Public choicenum As Integer

Public dusttemp(10000, 15) As String
Public dustnum As Integer
Public tempdata(10000, 15) As String
Public tempnum As Integer
Public datan As Integer
Public openfmn As Integer
 

Public WinDir As String
Public Declare Function GetWindowsDirectory Lib "kernel32" _
      Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
      ByVal nSize As Long) As Long
Public Const MAX_PATH = 260


'以下是与CAN板卡有关的参数
'函数初始化
Public Declare Function CAN_Open Lib "k8110.dll" (ByVal iIndex As Long) As Boolean
Public Declare Sub CAN_Close Lib "k8110.dll" (ByVal iIndex As Long)
Public Declare Function CAN_Init Lib "k8110.dll" (ByVal iIndex As Long, ByRef config As Any) As Boolean
Public Declare Function CAN_Trans Lib "k8110.dll" (ByVal iIndex As Long, ByRef obyte As Any, ByVal wtimeout As Long) As Boolean
Public Declare Function CAN_Recv Lib "k8110.dll" (ByVal iIndex As Long, ByRef ibyte As Any, ByVal rtimeout As Long) As Boolean
Public Declare Sub CAN_Reset Lib "k8110.dll" (ByVal iIndex As Long)
Public Declare Sub CAN_ReadReg Lib "k8110.dll" (ByVal iIndex As Long, ByRef oreg As Any)
Public Declare Sub CAN_WriteReg Lib "k8110.dll" (ByVal iIndex As Long, ByRef ireg As Any)

'变量定义
Public mindex As Long                                      'CAN卡号
Public station_no, addr As Byte                            '模块站址
Public cbtr0, cbtr1, mbtr0, mbtr1 As Byte                  '波特率
Public macr, mamr As Byte                                  '验收码、屏蔽码

'参数初始化
Public Sub caninit()
  mindex = 0                  'CAN卡号
  station_no = 1              '模块站址
  addr = 1                    '模块站址
  macr = 0                    '验收码
  mamr = &HFF                 '屏蔽码
  mbtr0 = &H18                '模块波特率1
  mbtr1 = &H1C                '模块波特率2
  cbtr0 = &H18                '板卡波特率1
  cbtr1 = &H1C                '板卡波特率2
End Sub

'复位CAN设备
Public Sub re_CAN()
   Call CAN_Reset(mindex)
End Sub

'连接CAN设备
Public Sub Connect_CAN()
  Dim i As Boolean
  Dim canconfig(11) As Byte

    i = CAN_Open(mindex)
    If (i = 0) Then
      'MsgBox "无法打开设备", vbCritical, "信息提示"
      Exit Sub
    End If
 
    canconfig(0) = cbtr0
    canconfig(1) = cbtr1
    canconfig(2) = 0
    canconfig(3) = 0
    canconfig(4) = 0
    canconfig(5) = 0
    canconfig(6) = &HFF
    canconfig(7) = &HFF
    canconfig(8) = &HFF
    canconfig(9) = &HFF
    canconfig(10) = 0
    If CAN_Init(mindex, canconfig(0)) Then

    Else
      'MsgBox "通讯卡初始化失败", vbCritical, "信息提示"
    End If
  End Sub
  
'断开所有继电器(断开所有电磁阀)
Public Sub open_all()
  Dim canbuff(13) As Byte
  For i = 1 To 7
    canbuff(0) = &H3
    canbuff(1) = i
    canbuff(2) = 0
    canbuff(3) = &HAA
    canbuff(4) = &H3
    canbuff(5) = 255
    If (CAN_Trans(mindex, canbuff(0), 50) <> 1) Then
      'MsgBox " 发送失败 ", vbCritical, "信息提示"
    End If
   
  Next i
End Sub

Public Function GetWinDir() As String
  Dim ChrLen As Long
  WinDir = Space(MAX_PATH)
  ChrLen = GetWindowsDirectory(WinDir, MAX_PATH)
  If ChrLen > MAX_PATH Then
    ChrLen = GetWindowsDirectory(WinDir, ChrLen)
  End If
  GetWinDir = Left(WinDir, ChrLen)
  WinDir = GetWinDir
End Function

Public Sub open_addr()
  Dim fname1 As String
  Dim datastring(5000) As String
  Dim openaddr(500, 10) As String
  Dim l As Long
  Dim a As String, b As String, X As String
  Dim k As Integer
  On Error GoTo hh
  F1% = FreeFile
  b = ""
  maxnum = 0
  Close
  fname1 = App.Path & "\data\idset.txt"
  'fname1 = WinDir & "\" & "\system32\" & "idset.txt"
  Open fname1 For Input As #F1%
  Do While Not EOF(F1%)
    Line Input #F1%, a
    l = Len(a)
    b = ""
    For i = 1 To l
      X = Mid$(a, i, 1)
      b = b + X
    Next i
    datastring(maxnum) = b
    maxnum = maxnum + 1
  Loop
  Close #F1%

  For i = 0 To maxnum - 1
    openaddr(i + 1, 1) = Mid$(datastring(i), 1, 14)
    openaddr(i + 1, 2) = Mid$(datastring(i), 15, 14)
    openaddr(i + 1, 3) = Mid$(datastring(i), 29, 14)
    openaddr(i + 1, 4) = Mid$(datastring(i), 43, 14)
  Next i
 
  For j = 1 To maxnum
    For i = 1 To 4
      addrdata(j, i) = Trim$(openaddr(j, i))
    Next i
  Next j
  k = 2
  bknum = 0: bkdata(1) = addrdata(1, 2)
  For j = 1 To maxnum
    If addrdata(j, 2) <> addrdata(k, 2) Then
      bknum = bknum + 1
      bkdata(bknum + 1) = addrdata(k, 2)
    End If
    k = k + 1
  Next j
hh: Exit Sub
End Sub

Public Function Quote(StrValue As String) As String
  Quote = Chr(34) & StrValue & Chr(34)
End Function