module1.bas

自动售药系统

Attribute VB_Name = "Module1"
'com通讯
Public bytInput(30) As Byte
Public CL_PRICE(48) As Integer
Public CL_FOOD(6) As Byte
Public MyArr() As Byte
'应用程序
Public fMainForm As frmMain
Public Constr As String
 'NT下关机需调用的安全机制API函数
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1

Public Type LUID
  lowpart As Long
  highpart As Long
End Type

Public Type LUID_AND_ATTRIBUTES

pLuid As LUID
  Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES

PrivilegeCount As Long
  Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
 
 
 '安全关机需调用的API函数
Global Const EWX_SHUTDOWN = 1 '终止所有进程并关闭计算机
Global Const EWX_FORCE = 4    '强迫进程终止
Global Const EWX_LOGOFF = 3   '关掉在进程安全描述表中运行的所有进程，重起计算机
Global Const EWX_REBOOT = 2   '终止所有运行的进程并关闭计算机
Global Const EWX_LOGIN = 0  '以其它用户名重新登录系统
Public Declare Function ExitWindowsEx Lib "user32" (ByVal fuOptions As Long, ByVal dwReserved As Long) As Integer '关闭系统函数
'购药常数和变量
Public tempid As String
Public startg As Boolean
Public Genie As IAgentCtlCharacterEx


Sub Main()
    frmSplash.Show
    Constr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=data;Data Source=."
    frmSplash.Refresh
    Set fMainForm = New frmMain
    Load fMainForm
    Unload frmSplash
    fMainForm.Show
End Sub

Public Sub AdjustToken()
 Dim hdlProcessHandle As Long
 Dim hdlTokenHandle As Long
 Dim tmpLuid As LUID
 Dim tkp As TOKEN_PRIVILEGES
 Dim tkpNewButIgnored As TOKEN_PRIVILEGES
 Dim lBufferNeeded As Long
  
 hdlProcessHandle = GetCurrentProcess()
 OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle

' Get the LUID for shutdown privilege.
 LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
 tkp.PrivilegeCount = 1 ' One privilege to set
 tkp.Privileges(0).pLuid = tmpLuid
 tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.
 AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
End Sub

Function ValBit(column As Byte, num As Byte) As Boolean
Dim test As Byte

    Select Case num
      Case 0
            test = column And &H1
      Case 1
         test = column And &H2
      Case 2
         test = column And &H4
      Case 3
         test = column And &H8
      Case 4
            test = column And &H10
      Case 5
         test = column And &H20
      Case 6
         test = column And &H40
      Case 7
         test = column And &H80
      Case Else
   End Select
   
    If test = 0 Then
        ValBit = False
    Else
    ValBit = True
    End If
    
End Function