win32apibas.bas

来自「电梯检测系统是对电梯性能进行检测的系统。是一个用来学习的程序。」· BAS 代码 · 共 193 行

Attribute VB_Name = "Win32ApiBas"
Option Explicit
'窗口
Public Const HWND_TOPMOST = -1
Public Const HWND_TOP = 0

Public Const SWP_NOSIZE = &H1
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_NOMOVE = &H2
'网络
Public Const WN_SUCCESS = 0
Public Const WN_NET_ERROR = 59&
Public Const WN_BAD_PASSWORD = 86&
Public Const WN_BAD_NETNAME = 67&
Public Const WN_ALREADY_CONNECTED = 85&
Public Const WN_NOT_SUPPORTED = 50&
Public Const WN_NOT_CONNECTED = 2250&


'函数
Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseCapture Lib "user32" () As Long

Global Const HELP_QUIT = 2
Global Const HELP_INDEX = 3
Global Const HELP_HELPONHELP = 4
Global Const HELP_PARTIALKEY = &H105

Global Const CB_ERR = -1
Global Const CB_FINDSTRING = &H14C
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpbuffer As String, nSize As Long) As Long

'文件关联

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const HKEY_PERFORMANCE_DATA = &H80000004
Global Const HKEY_CURRENT_CONFIG = &H80000005
Global Const HKEY_DYN_DATA = &H80000006

Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7

Public Const MAX_PATH = 260

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


'------------------------ Error Message ------------------
Global Const NoError = 0
Global Const FunctionError = 1
Global Const PortError = 2
Global Const BaudRateError = 3
Global Const DataError = 4
Global Const StopError = 5
Global Const ParityError = 6
Global Const CheckSumError = 7
Global Const ComPortNotOpen = 8
Global Const SendThreadCreateError = 9
Global Const SendCmdError = 10
Global Const ReadComStatusError = 11
Global Const ResultStrCheckError = 12
Global Const CmdError = 13
Global Const TimeOut = 15
Global Const ModuleIdError = 17
Global Const AdChannelError = 18
Global Const UnderInputRange = 19
Global Const ExceedInputRange = 20
Global Const InvalidateCounterNo = 21
Global Const InvalidateCounterValue = 22

'----------------------  UART.DLL -----------------------------------------------
Declare Function Open_Com Lib "uart.dll" (ByVal port As Byte, ByVal BaudRate As Long, _
             ByVal cData As Byte, ByVal cParity As Byte, ByVal cStop As Byte) As Integer

Declare Function Close_Com Lib "uart.dll" (ByVal port As Byte) As Boolean

Declare Function Send_Cmd Lib "uart.dll" (ByVal port As Byte, ByVal Cmd As String, _
             ByVal TimeOut As Integer, ByVal wChkSum As Integer) As Integer

Declare Function Read_Com_Status Lib "uart.dll" (ByVal port As Byte, ByVal Buf As String, _
                                                 status As Integer) As Integer

Declare Function Send_Str Lib "uart.dll" (ByVal port As Byte, ByVal Buf As String, _
        ByVal TimeOut As Integer, ByVal LenT As Integer, ByVal LenR As Integer) As Integer

Declare Function Send_Receive_Cmd Lib "uart.dll" (ByVal port As Byte, ByVal szCmd As String, _
        ByVal szResult As String, ByVal TimeOut As Integer, ByVal CheckSum As Integer, wT As Integer) As Integer


'---------------------------------Open A *.EXE file----------------------
Declare Function WaitForSingleObject Lib "kernel32" _
   (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject As Long) As Long
   
Declare Function OpenProcess Lib "kernel32" _
   (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long


Global Const INFINITE = -1&
Global Const SYNCHRONIZE = &H100000

Function SetExtOperation(ByVal ext As String) As String
    Dim hKey As Long, typeData As Long, lenData As Long
    Dim S As String, ret As Long, Name As String, Idx As Long
    Dim nSubKey As Long, maxSubKeyLen As Long, maxClassLen As Long
    Dim nValue As Long, maxValueNameLen As Long, maxValueLen As Long
    Dim sd As Long, WriteTime As FILETIME
    
    ret = RegOpenKey(HKEY_CLASSES_ROOT, ext, hKey)
    If ret <> 0 Then
        MsgBox LoadResString(1111), vbExclamation
        Exit Function
    End If
    ret = RegQueryValueEx(hKey, "", 0, typeData, ByVal vbNullString, lenData)
    If ret = 0 Then
        S = String(lenData, Chr(0))
        RegQueryValueEx hKey, "", 0, typeData, ByVal S, lenData
        S = left(S, InStr(S, Chr(0)) - 1)
        
        ret = RegOpenKey(HKEY_CLASSES_ROOT, S & "\shell", hKey)
        If ret <> 0 Then
            MsgBox LoadResString(1111), vbExclamation
            Exit Function
        End If
        ret = RegQueryInfoKey(hKey, vbNullString, 0, ByVal 0, _
                    nSubKey, maxSubKeyLen, maxClassLen, nValue, _
                    maxValueNameLen, maxValueLen, sd, WriteTime)
        Name = String(maxSubKeyLen + 1, Chr(0))
    
        For Idx = 0 To nSubKey - 1
            ret = RegEnumKey(hKey, Idx, Name, Len(Name))
            If ret = 0 Then
                SetExtOperation = left(Name, InStr(Name, Chr(0)) - 1)
                RegCloseKey hKey
                Exit Function
            End If
        Next
    End If
    MsgBox LoadResString(1111), vbExclamation
    RegCloseKey hKey
End Function





Sub HelpFunction(lhWnd As Long, HelpCmd As Integer, HelpKey As String)
   
Dim lRtn As Long 'declare the needed variables
   
If HelpCmd = HELP_PARTIALKEY Then
   lRtn = WinHelp(lhWnd, App.HelpFile, HelpCmd, HelpKey)
Else
   lRtn = WinHelp(lhWnd, App.HelpFile, HelpCmd, 0&)
End If
   
End Sub