modwinapi.bas

饲料生产控制系统

Attribute VB_Name = "ModWinApi"
Option Explicit



Public Const VK_PRIOR = &H21            'PageUp
Public Const VK_NEXT = &H22             'PageDown
Public Const VK_F1 = &H70
Public Const VK_F2 = &H71
Public Const VK_F3 = &H72
Public Const VK_F4 = &H73
Public Const VK_F5 = &H74
Public Const VK_F6 = &H75
Public Const VK_F7 = &H76
Public Const VK_F8 = &H77
Public Const VK_F9 = &H78
Public Const VK_F10 = &H79
Public Const VK_F11 = &H7A
Public Const VK_F12 = &H7B

Public Const VK_UP = &H26
Public Const VK_DOWN = &H28
Public Const VK_RETURN = &HD

'ini僼傽僀儖忣曬傪曐懚偡傞僌儘僶乕儖曄悢
Public gPCNAME As String
Public gDBCONSTR As String
Public gCSVDRIVE As String
Public gCSVPATH As String
Public gCSVFILENAME As String
Public gDBINITPATH As String
Public gDBNAME As String
Public gDBFILEHEAD As String
Public gDBDAILYPATH1 As String
Public gDBDAILYPATH2 As String
Public gPortableHDD As String
Public gRESTORE_CON As String
Public gISSHUTDOWN As String

'ini僼傽僀儖偺撉傒彂偒API
Public Declare Function GetPrivateProfileInt Lib "kernel32" _
                         Alias "GetPrivateProfileIntA" _
                         (ByVal lpApplicationName As String, _
                          ByVal lpKeyName As String, _
                          ByVal nDefault As Long, _
                          ByVal lpFileName As String) As Long
                          
Public 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
                          
'VB張棟偲傑傞
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMillseconds As Long)

'Windows偺僔儍僢僩僟僂儞
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400&

Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, ByVal PreviousState As Long, ByVal ReturnLength As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const ANYSIZE_ARRAY = 1
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const EWX_LOGOFF = 0            '慡傾僾儕偺廔椆偲尰儐乕僓乕偺儘僌僆僼
Public Const EWX_SHUTDOWN = 1          '慡僾儘僙僗偺廔椆乮揹尮傪愗傟傞忬懺乯
Public Const EWX_REBOOT = 2            '慡僾儘僙僗偺廔椆偲嵞婲摦
Public Const EWX_FORCE = 4             '墳摎偺側偄僾儘僙僗偺嫮惂廔椆
Public Const EWX_POWEROFF = 8          '慡僾儘僙僗偺廔椆偲揹尮僆僼
'僐儞僺儏乕僞柤傪庢摼偡傞
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal IpBuffer As String, nSize As Long) As Long
'僼傽僀儖僐僺乕
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal IpExistingFileName As String, ByVal IpNewFileName As String, ByVal bFailIfExists As Long) As Long
'僋儕僢僾儃乕僪偵僗僋儕乕儞偺僗僫僢僾僔儑僢僩傪僐僺乕
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Const VK_SNAPSHOT = &H2C
Public Const ALLWINDOW = 0             '夋柺慡懱
Public Const ACTIVEWINDOW = 1          '傾僋僥傿僽僂傿儞僪僂
'僼僅乕儉偺奒憌傪堏摦
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
Public Const HWND_BOTTOM = 1           '攚柺偵堏摦
Public Const HWND_TOP = 0              '慜柺偵堏摦
Public Const HWND_TOPMOST = -1         '嵟慜柺偺巜掕
Public Const HWND_NOTOPMOST = -2       '嵟慜柺偺夝彍

'1ms扨埵偺帪崗庢摼
Declare Function timeGetTime Lib "winmm.dll" () As Long

'幚峴拞傾僾儕働乕僔儑儞偺僼傽僀儖柤傪庢摼
Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long

'LUID峔憿懱
Type LUID
    lowpart As Long
    highpart As Long
End Type

'LUID懏惈峔憿懱
Type LUID_AND_ATTRIBUTES
    pLuid As LUID
    Attributes As Long
End Type

'僙僉儏儕僥傿僩乕僋儞峔憿懱
Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

'64價僢僩惍悢峔憿懱
Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type
'
Public stgLKName As String                              '儕儞僋愭DB
Public stgBKName As String                              '僶僢僋傾僢僾梡DB
Public Sub DBFileCopy(stgInFileName As String, stgOutFileName As String)
    Dim lngERR As Long
    lngERR = CopyFile(stgInFileName, stgOutFileName, False)
    If lngERR = 0 Then
        Beep
        MsgBox "Not Copy DB "
    End If
End Sub
'Public Sub ReadMainC(stgMName As String)
'    '儊僀儞僐儞僺儏乕僞傪専抦 */
'    Open "C:\椦寭\HControl.TXT" For Input As #1
'    Input #1, stgMName
'    Close #1
'    Select Case stgMName
'        Case "SEIGO"
'            stgLKName = "\\Seigo\椦寭\hayashikane_be.mdb"
'            stgBKName = "\\Seigo\椦寭\h_be.mdb"
'        Case "KAN1"
'            stgLKName = "\\KAN1\椦寭\hayashikane_be.mdb"
'            stgBKName = "\\KAN1\椦寭\h_be.mdb"
'        Case "KAN2"
'            stgLKName = "\\KAN2\椦寭\hayashikane_be.mdb"
'            stgBKName = "\\KAN2\椦寭\h_be.mdb"
'    End Select
'End Sub

'Windows偺僔儍僢僩僟僂儞
Sub WinExit(ewx As Long)
    Dim token As Long, tkp As TOKEN_PRIVILEGES, result As Long
    '尰嵼偺摿尃傪庢摼偡傞
    result = OpenProcessToken(GetCurrentProcess(), (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), token)
    result = LookupPrivilegeValue(vbNullString, "SeShutdownPrivilege", tkp.Privileges(0).pLuid)
    tkp.PrivilegeCount = 1
    tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    'Windows偺廔椆偑壜擻側摿尃傪庢摼偡傞
    result = AdjustTokenPrivileges(token, False, tkp, 0, 0&, 0&)
    'Windows傪廔椆偡傞
    result = ExitWindowsEx(ewx, 0)
End Sub

'僴乕僪僐僺乕
Sub WinHardCopy()
    '僋儕僢僾儃乕僪偺僋儕傾
    Clipboard.Clear
    '僋儕僢僾儃乕僪偵僗僋儕乕儞偺僗僫僢僾僔儑僢僩傪僐僺乕
    keybd_event VK_SNAPSHOT, ALLWINDOW, 0, 0
    '夋憸揮憲姰椆懸偪
    Do Until Clipboard.GetFormat(vbCFBitmap)
        DoEvents
    Loop

    Dim frmpri As New RHFrmPic
    frmpri.Show 1

'    With Printer
'        .Orientation = 2      '報嶞曽岦乮墶乯
'        .PrintQuality = -4    '僾儕儞僞偺夝憸搙乮崅昳埵乯
'        .PaintPicture Clipboard.GetData, 2000, 1000
'        .EndDoc
'    End With
End Sub

'僼僅乕儉偺奒憌傪堏摦
Sub WinSetPos(frmhwnd As Long, level As Long)
    Dim result As Long
    result = SetWindowPos(frmhwnd, level, 0, 0, 0, 0, &H43)
End Sub

'INI僼傽僀儖偺忣曬傪撉傒崬傒
Public Function ReadStr(ByVal strFileIni As String, ByVal strSectName As String, _
           ByVal strKeyName As String) As String
    Dim lngRtn As Long
    Dim strRtn As String
    Dim strDefault As String
    strRtn = Space$(256)
    lngRtn = GetPrivateProfileString(strSectName, strKeyName, strDefault, strRtn, 255, strFileIni)
    
    If lngRtn > 0 Then
        ReadStr = Left(strRtn, InStr(strRtn, vbNullChar) - 1)
    Else
        ReadStr = strDefault
    End If
    
End Function

'INI僼傽僀儖偺忣曬傪撉傒崬傒
Public Function ReadINIFILE() As Boolean
    
    Dim lngRtn As Long
    Dim strRtn As String
    Dim strFileIni As String
    Dim strDefault As String
    Dim strSectName As String
    Dim strKeyName As String
    
    ReadINIFILE = False
    strRtn = Space$(256)
    strFileIni = App.Path & "\HControl.ini"

On Error GoTo Err
    
    'PC柤
    strSectName = "PCNAME"
    strKeyName = "NAME"
    gPCNAME = ReadStr(strFileIni, strSectName, strKeyName)
    
    'DB CONNECT STRING
    strSectName = "DBCONNECT"
    strKeyName = "CONSTR"
    gDBCONSTR = ReadStr(strFileIni, strSectName, strKeyName)
    
    'CSV_DRIVE
    strSectName = "CSV"
    strKeyName = "DRIVE"
    gCSVDRIVE = ReadStr(strFileIni, strSectName, strKeyName)
    
    'CSV_PATH
    strSectName = "CSV"
    strKeyName = "PATH"
    gCSVPATH = ReadStr(strFileIni, strSectName, strKeyName)
    
    'CSV_FILENAME
    strSectName = "CSV"
    strKeyName = "FILENAME"
    gCSVFILENAME = ReadStr(strFileIni, strSectName, strKeyName)
    
    'DB_OPERATION_INFO
    strSectName = "DBOPERATION"
    strKeyName = "INITPATH"
    gDBINITPATH = ReadStr(strFileIni, strSectName, strKeyName)
    
    'DB_OPERATION_INFO
    strSectName = "DBOPERATION"
    strKeyName = "DBNAME"
    gDBNAME = ReadStr(strFileIni, strSectName, strKeyName)
    
    'DB_OPERATION_INFO
    strSectName = "DBOPERATION"
    strKeyName = "FILEHEAD"
    gDBFILEHEAD = ReadStr(strFileIni, strSectName, strKeyName)