mainbas.bas

来自「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」· BAS 代码 · 共 1,098 行 · 第 1/3 页

            bbH = bbH \ 2 '向右移 1 bit
            bbL = bbL \ 2 '向右移 1 bit
            If (tta = 1) Then bbH = bbH Or 128
            If (ttb = 1) Then bbL = bbL Or 128
 
            bbH = bbH Xor ddL
 
            If ((bbL And 1) <> 0) Then
               tta = 1
            Else
               tta = 0
            End If
 
            If ((bbH And 1) <> 0) Then
               ttb = 1
            Else
               ttb = 0
            End If
 
            bbH = bbH \ 2 '向右移 1 bit
            bbL = bbL \ 2 '向右移 1 bit
            If (tta = 1) Then bbH = bbH Or 128
            If (ttb = 1) Then bbL = bbL Or 128
 
            bbL = bbL Xor ddH
            ddL = bbL
            ddH = bbH
 
        Next i
 
        CrcB = Array(ddL, ddH)
 
End Function
 

Public Function CmbAryB(ByVal vAry1 As Variant, vAry2 As Variant) As Variant
'Last verify:98/2/4
'目的:
'     将数组1加上数组2后传回
'传入:
'     vAry1:Byte or Integer数组1
'     vAry2:来源数组或单一数值
'传回:
'     汇编后之Byte数组
'注:数组以Ubound()计算长度，且由0起算
'
'
Dim i As Integer
Dim bRetAry() As Byte
Dim iCnt As Integer
Dim iTotCnt As Integer
Dim bIsAry1, bIsAry2 As Boolean
 
  bIsAry1 = True
  If IsArray(vAry1) Then     '汇编数组
    iTotCnt = UBound(vAry1)
  Else    '汇编单一数值
    iTotCnt = 0
    bIsAry1 = False
  End If
 
  bIsAry2 = True
  If IsArray(vAry2) Then     '汇编数组
    iTotCnt = iTotCnt + UBound(vAry2) + 1
  Else    '汇编单一数值
    iTotCnt = iTotCnt + 1
    bIsAry2 = False
  End If
  
  ReDim bRetAry(0 To iTotCnt)
  
  iCnt = 0
  If bIsAry1 Then
    For i = 0 To UBound(vAry1)
      bRetAry(iCnt) = vAry1(i)
      iCnt = iCnt + 1
    Next
  Else
    bRetAry(iCnt) = vAry1
    iCnt = iCnt + 1
  End If
  
  If bIsAry2 Then
    For i = 0 To UBound(vAry2)
      bRetAry(iCnt) = vAry2(i)
      iCnt = iCnt + 1
    Next
  Else
    bRetAry(iCnt) = vAry2
    iCnt = iCnt + 1
  End If
  
  CmbAryB = bRetAry()
  
End Function
 

Public Function LRC(ByVal cString As String, ByVal iLen As Integer) As String
'永宏PLC
Dim tt, i As Integer

tt = 0
For i = 1 To iLen
    tt = (tt + Asc(Mid(cString, i, 1)) Mod 256)
Next i
tt = tt Mod 256
LRC = IIf(tt > 15, Hex(tt), "0" + Hex(tt))
End Function
 

Public Function bolOpenCommPort() As Boolean
  
  On Error GoTo porterr
  bolOpenCommPort = True
  FrmFuncTest.ReadCom.commport = commport 'U1 Crane PLC
  
  FrmFuncTest.ReadCom.Settings = portsetting
  
  
  FrmFuncTest.ReadCom.InputLen = 0
  If FrmFuncTest.ReadCom.PortOpen = False Then
    FrmFuncTest.ReadCom.PortOpen = True
  End If
  Exit Function
    
porterr:
        MsgBox (Error$)
        bolOpenCommPort = False
        
End Function
 

Sub Main()
Dim cTime

frmSplash.Show
SetWindowPos frmSplash.hwnd, HWND_TOPMOST, (800 - frmSplash.ScaleWidth) / 2, (600 - frmSplash.ScaleHeight) / 2, frmSplash.ScaleWidth, frmSplash.ScaleHeight, SWP_SHOWWINDOW
cTime = Timer
Do Until Timer > cTime + 0.5
   DoEvents
Loop
Unload frmSplash
'程序不能同时重复运行
If App.PrevInstance Then
   MsgBox "This program is running now!"
   End
End If

IniPath = App.Path & "\ini\Missys.INI"
'端口及设备
commport = CLng(GetFromINI("comm", "port", IniPath))
portsetting = GetFromINI("comm", "setting", IniPath)
iDeviceID = GetFromINI("device", "deviceID", IniPath)
'以下定义信号地址
KNEAddr = GetFromINI("address", "KNE", IniPath)
KVT = GetFromINI("address", "KVT", IniPath)
KVT2 = GetFromINI("address", "2KVT", IniPath)
KSL_UAddr = GetFromINI("address", "KSL_U", IniPath)
KSL_DAddr = GetFromINI("address", "KSL_D", IniPath)
RPHT1Addr = GetFromINI("address", "RPHT1", IniPath)
RPHT2Addr = GetFromINI("address", "RPHT2", IniPath)
JHCTAddr = GetFromINI("address", "JHCT", IniPath)
JRHAddr = GetFromINI("address", "JRH", IniPath)
JHMAddr = GetFromINI("address", "JHM", IniPath)
JRECAddr = GetFromINI("address", "JRECAddr", IniPath)
DREC_UAddr = GetFromINI("address", "DREC_UAddr", IniPath)
DREC_DAddr = GetFromINI("address", "DREC_DAddr", IniPath)
DRH_UAddr = GetFromINI("address", "DRh_U", IniPath)
DRH_DAddr = GetFromINI("address", "DRh_D", IniPath)
JHCAddr = GetFromINI("address", "JHCAddr", IniPath)
T2Addr = GetFromINI("address", "t2Addr", IniPath)
T2_On = GetFromINI("address", "T2_On", IniPath)
DT_O = GetFromINI("address", "DT_O", IniPath)
DT_S = GetFromINI("address", "DT_s", IniPath)
KL_XAddr = GetFromINI("address", "KL_X", IniPath)
KL_VAddr = GetFromINI("address", "KL_V", IniPath)
KL_HAddr = GetFromINI("address", "KL_H", IniPath)
KL_MAddr = GetFromINI("address", "KL_M", IniPath)
KTSAddr = GetFromINI("address", "KTSAddr", IniPath)
KTCAddr = GetFromINI("address", "KTCAddr", IniPath)
KTC2Addr = GetFromINI("address", "2KTCAddr", IniPath)
DC_1Addr = GetFromINI("address", "DC_1addr", IniPath)
DC_2Addr = GetFromINI("address", "DC_2addr", IniPath)
DC_3Addr = GetFromINI("address", "DC_3addr", IniPath)
DE_U1Addr = GetFromINI("address", "DE_U1addr", IniPath)
DE_U2Addr = GetFromINI("address", "DE_U2addr", IniPath)
DE_D2Addr = GetFromINI("address", "DE_D2addr", IniPath)
DE_D3Addr = GetFromINI("address", "DE_D3addr", IniPath)
KET_OAddr = GetFromINI("address", "KET_OAddr", IniPath)
KET_SAddr = GetFromINI("address", "KET_SAddr", IniPath)
KET_O2Addr = GetFromINI("address", "2KET_OAddr", IniPath)
KET_S2Addr = GetFromINI("address", "2KET_SAddr", IniPath)
KSEAddr = GetFromINI("address", "KSEAddr", IniPath)
KSAddr = GetFromINI("address", "KSAddr", IniPath)
KSKBAddr = GetFromINI("address", "kskbaddr", IniPath)
KSKB2Addr = GetFromINI("address", "2kskbaddr", IniPath)
JBFAddr = GetFromINI("address", "JBFAddr", IniPath)
JABAddr = GetFromINI("address", "jabaddr", IniPath)
JVECAddr = GetFromINI("address", "JVECAddr", IniPath)
IT2 = GetFromINI("address", "it2", IniPath)
RVEC = GetFromINI("address", "RVEC", IniPath)
MGBAddr = GetFromINI("address", "MGBAddr", IniPath)
RLCA = GetFromINI("address", "RLCA", IniPath)
VST_OAddr = GetFromINI("address", "VST_OAddr", IniPath)
VST_SAddr = GetFromINI("address", "VST_SAddr", IniPath)
VST_O2Addr = GetFromINI("address", "2VST_OAddr", IniPath)
VST_S2Addr = GetFromINI("address", "2VST_SAddr", IniPath)
ICS0Addr = GetFromINI("address", "ICS0Addr", IniPath)
ICS1Addr = GetFromINI("address", "ICS1Addr", IniPath)
LC_1 = GetFromINI("address", "LC_1", IniPath)
LC_2 = GetFromINI("address", "LC_2", IniPath)
LC_3 = GetFromINI("address", "LC_3", IniPath)
LE_U1 = GetFromINI("address", "LE_U1", IniPath)
LE_D2 = GetFromINI("address", "LE_D2", IniPath)
LE_U2 = GetFromINI("address", "LE_U2", IniPath)
LE_D3 = GetFromINI("address", "LE_D3", IniPath)
LW_U = GetFromINI("address", "LW_U", IniPath)
LW_D = GetFromINI("address", "LW_D", IniPath)

SAddr = GetFromINI("address", "SAddr", IniPath)
PAddr = GetFromINI("address", "PAddr", IniPath)


'AlarmAddr = GetFromINI("address", "alarm", IniPath)
CountAddr = GetFromINI("address", "CountAddr", IniPath)
'wire test
XLight1 = GetFromINI("wireaddress", "xlight1", IniPath)
iXLight1 = GetFromINI("wireaddress", "ixlight1", IniPath)
XLight2 = GetFromINI("wireaddress", "xlight2", IniPath)
iXLight2 = GetFromINI("wireaddress", "ixlight2", IniPath)
XPOWER1 = GetFromINI("wireaddress", "XPOWER1", IniPath)
iXPOWER1 = GetFromINI("wireaddress", "iXPOWER1", IniPath)
XPOWER2 = GetFromINI("wireaddress", "XPOWER2", IniPath)
iXPOWER2 = GetFromINI("wireaddress", "iXPOWER2", IniPath)

TESTED_BEGIN = GetFromINI("wireaddress", "tested.begin", IniPath)
'计数值
MaxCount = GetFromINI("count", "maxcount", IniPath)
Floor2ndCount = GetFromINI("count", "floor2ndcount", IniPath)

'口令及工号
SysUserGh = GetFromINI("SYSTEM", "SYSUSERGH", IniPath)
UserPass = GetFromINI("SYSTEM", "UserPass", IniPath)
SysPass = GetFromINI("SYSTEM", "Syspass", IniPath)
'Set SetDb = OpenDatabase(App.Path & "\mdb\sysset.mdb", False)

'com 口 interval
CommInterv = Val(GetFromINI("COMM", "TIME", App.Path & "\INI\MISSYS.INI"))

SysPass = GetFromINI("test trip", "1msg", App.Path & "\functest\project1.ini")


T2On = False

FrmMainTest.Show

End Sub

Public Function bolsglcompat()

End Function


Public Function SignalBitRight(ByVal LngVRetAryB As Variant, ByVal SignalBit As Integer, ByVal value As Integer) As Boolean
  'lngvretaryb 时钟读出的数据
  'signalbit  信号的偏移量
  'value  所判断值 1 或0
  Dim i As Integer
  
    
  SignalBit = (SignalBit \ 8) * 8 + 16 + SignalBit Mod 8
  
  
  If SignalBit > 112 Then
    i = LngVRetAryB(20) And 2 ^ (SignalBit - 112 - 1)
    i = i \ 2 ^ (SignalBit - 112 - 1)
  Else
  
  If SignalBit > 104 Then
    i = LngVRetAryB(17) And 2 ^ (SignalBit - 105 - 1)
    i = i \ 2 ^ (SignalBit - 105 - 1)
  Else
  
  If SignalBit > 96 Then
    i = LngVRetAryB(18) And 2 ^ (SignalBit - 96 - 1)
    i = i \ 2 ^ (SignalBit - 96 - 1)
  Else
  
  If SignalBit > 88 Then
    i = LngVRetAryB(15) And 2 ^ (SignalBit - 88 - 1)
    i = i \ 2 ^ (SignalBit - 88 - 1)
  Else
  If SignalBit > 80 Then
    i = LngVRetAryB(16) And 2 ^ (SignalBit - 80 - 1)
    i = i \ 2 ^ (SignalBit - 80 - 1)
  Else
  If SignalBit > 72 Then
    i = LngVRetAryB(13) And 2 ^ (SignalBit - 72 - 1)
    i = i \ 2 ^ (SignalBit - 72 - 1)
  Else
  If SignalBit > 64 Then
    i = LngVRetAryB(14) And 2 ^ (SignalBit - 64 - 1)
      i = i \ 2 ^ (SignalBit - 64 - 1)

  Else
  If SignalBit > 56 Then
    i = LngVRetAryB(11) And 2 ^ (SignalBit - 56 - 1)
    i = i \ 2 ^ (SignalBit - 56 - 1)
  
  Else
    If SignalBit > 48 Then
      i = LngVRetAryB(12) And 2 ^ (SignalBit - 48 - 1)
    i = i \ 2 ^ (SignalBit - 48 - 1)
  
  Else
    If SignalBit > 40 Then
      i = LngVRetAryB(9) And 2 ^ (SignalBit - 40 - 1)
    i = i \ 2 ^ (SignalBit - 40 - 1)
  
  Else
    If SignalBit > 32 Then
    i = LngVRetAryB(10) And 2 ^ (SignalBit - 32 - 1)
    i = i \ 2 ^ (SignalBit - 32 - 1)
  
  Else
    If SignalBit > 24 Then
      i = LngVRetAryB(7) And 2 ^ (SignalBit - 24 - 1)
      i = i \ 2 ^ (SignalBit - 24 - 1)
  Else
   If SignalBit > 16 Then
     i = LngVRetAryB(8) And 2 ^ (SignalBit - 16 - 1)
    i = i \ 2 ^ (SignalBit - 16 - 1)
  End If
  
  End If
  End If
  End If
  End If
  End If
  End If
  End If
  End If
  End If
  End If
End If
End If
   
  If i = value Then
    SignalBitRight = True
  Else
    SignalBitRight = False
  End If
End Function

Public Function subCloseCommPort()
'For i = 0 To 1   'FXP
  FrmFuncTest.ReadCom.InputLen = 0
  FrmFuncTest.ReadCom.PortOpen = False
End Function
Public Sub subExitWithCloseCommPort()
subCloseCommPort
End
End Sub