VBFunctionBas/System.bas

Attribute VB_Name = "System"
'#######################################<23>û<EFBFBD><C3BB>ؼ<EFBFBD>˵<EFBFBD><CBB5>#########################################

'<27><><EFBFBD><EFBFBD>:ϵͳ<CFB5>ؼ<EFBFBD>

'<27><><EFBFBD><EFBFBD>:<3A><>ȡϵͳ<CFB5><CDB3>Ϣ

'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:2014<31><34>12<31><32>8<EFBFBD><38>

'<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:<3A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>

'<27><>λ:<3A>Ϻ<EFBFBD><CFBA>ж<EFBFBD><D0B6><EFBFBD>ˮ<EFBFBD>繤<EFBFBD>̰<EFBFBD>װ<EFBFBD><D7B0><EFBFBD>޹<EFBFBD>˾

''====================================<3D>û<EFBFBD><C3BB>ؼ<EFBFBD>ʹ<EFBFBD><CAB9>˵<EFBFBD><CBB5>=======================================

Option Explicit
''================================API<50><49><EFBFBD>ô<EFBFBD><C3B4><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD>=========================================
'<27><><EFBFBD>á<EFBFBD><C3A1>򿪡<EFBFBD><F2BFAAA1><EFBFBD><EFBFBD><EFBFBD>
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long    'API<50><49><EFBFBD>ô<EFBFBD><C3B4><EFBFBD>
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long                        'API<50><49><EFBFBD>ô<EFBFBD><C3B4><EFBFBD>
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type                              'API<50><49><EFBFBD>ô<EFBFBD><C3B4><EFBFBD>
Private Const MAX_PATH As Long = 260
''================================<3D><><EFBFBD>ý<EFBFBD><C3BD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ȩ<EFBFBD><C8A8>=========================================
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF    'ȫȨ<C8AB>򿪽<EFBFBD><F2BFAABD><EFBFBD>

''================================ɾ<><C9BE><EFBFBD>ļ<EFBFBD>=========================================
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
    hWnd   As Long
    wFunc   As Long
    pFrom   As String
    pTo   As String
    fFlags   As Integer
    fAborted   As Boolean
    hNameMaps   As Long
    sProgress   As String
End Type
Private Const FO_DELETE = &H3
Private Const FOF_ALLOWUNDO = &H40           '   <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>վ
Private Const FOF_CONFIRMMOUSE = &H2           '   ɾ<><C9BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>վ
Private Const FOF_NOCONFIRMATION = &H10           '   û<><C3BB><EFBFBD><EFBFBD>ʾ

''#####################################################ģ<><C4A3><EFBFBD><EFBFBD><EFBFBD><EFBFBD>#####################################################
'#############################################<23>ؼ<EFBFBD><D8BC><EFBFBD><EFBFBD><EFBFBD>ģ<EFBFBD><C4A3>#################################################
'**********************************************************************************************************
'***<2A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>DeleteFolder
'***<2A><> <20><> <20><>ɾ<EFBFBD><C9BE>һ<EFBFBD><D2BB><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC>С<EFBFBD><D0A1>ù<EFBFBD><C3B9>̿<EFBFBD><CCBF><EFBFBD>ɾ<EFBFBD><C9BE><EFBFBD>ǿյ<C7BF><D5B5>ļ<EFBFBD><C4BC><EFBFBD>
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>(<28>ļ<EFBFBD><C4BC>л<EFBFBD><D0BB>ļ<EFBFBD><C4BC><EFBFBD><EFBFBD><EFBFBD> As String)
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>NULL
'***˵  <20><><EFBFBD><EFBFBD>NULL
'**********************************************************************************************************
Public Sub DeleteFolder(sObject As String)
    Dim SHFileOp     As SHFILEOPSTRUCT
 
    With SHFileOp
        .wFunc = FO_DELETE
        .pFrom = sObject
        .fFlags = FOF_CONFIRMMOUSE Or FOF_NOCONFIRMATION
    End With
    SHFileOperation SHFileOp
End Sub
'**********************************************************************************************************
'***<2A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>GetFilePath
'***<2A><> <20><> <20><>API<50><49><EFBFBD>ô򿪴<C3B4><F2BFAAB4><EFBFBD>
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>(PID As Long)
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>String
'***˵  <20><><EFBFBD><EFBFBD>NULL
'**********************************************************************************************************
Public Function GetFilePath(ByVal hWnd As Long, _
                            Optional ByVal DefaultFile As String, _
                            Optional ByVal DefaultFilterStr As String, _
                            Optional ByVal DefaultFilter As String, _
                            Optional ByVal DefaultTitle As String, Optional ByVal DefaultPath As String) As String
    Dim ofn As OPENFILENAME
    Dim rtn As Long
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = hWnd
    ofn.hInstance = App.hInstance
    If DefaultFilter & DefaultFilterStr <> "" Then
        ofn.lpstrFilter = DefaultFilterStr & "(" & DefaultFilter & ")" + Chr$(0) + DefaultFilter + Chr$(0) + _
                          "<22><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD> (*.*)" + Chr$(0) + "*.*" + Chr$(0) + Chr$(0)
    Else
        ofn.lpstrFilter = "<22><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD> (*.*)" + Chr$(0) + "*.*" + Chr$(0) + Chr$(0)
    End If
    ofn.lpstrFile = DefaultFile + Space(255 - Len(DefaultFile))  '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ը<EFBFBD>һ<EFBFBD><D2BB>Ĭ<EFBFBD>ϵ<EFBFBD><CFB5>ļ<EFBFBD><C4BC><EFBFBD>
    ofn.nMaxFile = MAX_PATH
    ofn.lpstrFileTitle = Space(255)
    ofn.nMaxFileTitle = MAX_PATH
    ofn.lpstrInitialDir = DefaultPath
    ofn.lpstrTitle = DefaultTitle
    ofn.Flags = 6148
    rtn = GetOpenFileName(ofn)
    If rtn >= 1 Then GetFilePath = ofn.lpstrFile Else GetFilePath = ""
End Function
'**********************************************************************************************************
'***<2A><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>CheckPid
'***<2A><> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>PID<49>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD><EFBFBD>
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>(PID As Long)
'***<2A><><EFBFBD><EFBFBD>ֵ<EFBFBD><D6B5>Boolean
'***˵  <20><><EFBFBD><EFBFBD>NULL
'**********************************************************************************************************
Public Function CheckPid(ByVal PID As Long) As Boolean
    Dim info As Long
    info = OpenProcess(PROCESS_ALL_ACCESS, &O0, PID)
    If info = 0 Then
        CheckPid = False
    Else
        CloseHandle CheckPid
        CloseHandle PID
        CheckPid = True
    End If
End Function

Public Function GetSystemPath() As String
    Dim aa$, jj%
    aa = Environ("ComSpec")
    jj = InStrRev(aa, "\")
    GetSystemPath = Mid(aa, 1, jj - 1)
End Function

Public Function IsX86() As Boolean
'If Environ("PROCESSOR_ARCHITECTURE") = "x86" Then IsX86 = True: Exit Function
    If Dir(Left(Environ("ComSpec"), 1) & ":\Windows\SysWOW64", vbDirectory) = "" Then
        IsX86 = True
    Else
        IsX86 = False
    End If
End Function

Public Function FileCheck(ByVal FileName As String, Optional ByVal Reg As Boolean) As Boolean
    Dim FileData() As Byte
    Dim FileInfo() As String
    Dim SystemPath As String
    SystemPath = GetSystemPath
    If Dir(SystemPath & "\" & FileName) = "" Then
        FileInfo = Split(FileName, ".")
        If UBound(FileInfo) < 1 Then MsgBox "<22>ļ<EFBFBD>" & FileName & "<22><><EFBFBD>ƴ<EFBFBD><C6B4><EFBFBD><EFBFBD><EFBFBD>", vbCritical
        FileData = LoadResData(UCase(FileInfo(0)), UCase(FileInfo(1)))
        Open SystemPath & "\" & FileName For Binary As #1    '<27>Զ<EFBFBD><D4B6><EFBFBD><EFBFBD>Ʒ<EFBFBD>ʽд<CABD><D0B4><EFBFBD><EFBFBD><EFBFBD>ɣ<EFBFBD><C9A3>ؼ<EFBFBD><D8BC><EFBFBD>kjmc.kjlx<6C><78><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ڵ<EFBFBD>Ŀ¼
        Put #1, , FileData
        Close #1
        If Reg Then Shell "regsvr32 \s " & SystemPath & "\" & FileName, vbHide
    End If
End Function

Public Sub MkMulDirs(ByVal Path As String)
    Dim FilePath As String
    Dim Index As Long
    Index = InStr(1, Path, "\")
    Debug.Print Index
    Do While Index > 0
        FilePath = Left(Path, Index)
        If Dir(FilePath, vbDirectory) = "" Then _
           MkDir FilePath
        Index = InStr(Index + 1, Path, "\")
    Loop
    Debug.Print "<22><><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD><C4BC><EFBFBD>: " & Path
End Sub

Public Function FindPath(ByVal AppName As String) As String
    On Error Resume Next
    Dim PathDir As String
    Dim WshShell
    Set WshShell = CreateObject("Wscript.Shell")
    '   ע<><D7A2><EFBFBD><EFBFBD>д<EFBFBD><D0B4>
    '   WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"
    '   ע<><D7A2><EFBFBD><EFBFBD>ɾ<EFBFBD><C9BE>
    '   WshShell.RegDelete "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName
    '   ע<><D7A2><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ȡ
    FindPath = WshShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & AppName & "\Path")
    Set WshShell = Nothing
    '    PathDir = Left(Environ("ComSpec"), 1)
    '    If Dir(PathDir & ":\Program Files\Java\jre6\bin\java.exe") <> "" Then
    '        FindJava = PathDir & ":\Program Files\Java\jre6\bin\java.exe"
    '    ElseIf Dir(PathDir & ":\Program Files (x86)\Java\jre6\bin\java.exe") <> "" Then
    '        FindJava = PathDir & ":\Program Files (x86)\Java\jre6\bin\java.exe"
    '    ElseIf Dir(PathDir & ":\Program Files\Java\jre7\bin\java.exe") <> "" Then
    '        FindJava = PathDir & ":\Program Files\Java\jre7\bin\java.exe"
    '    ElseIf Dir(PathDir & ":\Program Files (x86)\Java\jre7\bin\java.exe") <> "" Then
    '        FindJava = PathDir & ":\Program Files (x86)\Java\jre7\bin\java.exe"
    '    ElseIf Dir(PathDir & ":\Program Files\Java\jre8\bin\java.exe") <> "" Then
    '        FindJava = PathDir & ":\Program Files\Java\jre8\bin\java.exe"
    '    ElseIf Dir(PathDir & ":\Program Files (x86)\Java\jre8\bin\java.exe") <> "" Then
    '        FindJava = PathDir & ":\Program Files (x86)\Java\jre8\bin\java.exe"
    '    Else
    '        FindJava = ""
    '    End If
End Function

Public Function FindJar() As String
    If Dir(App.Path & "/*.jar") <> "" Then
        FindJar = Dir(App.Path & "/*.jar")
    End If
End Function

Public Function GetMaxMem() As String
    Dim strComputer
    Dim strNameSpace
    Dim strClass
    Dim objSWbemObject
    Dim objSWbemServices
    Dim objSWbemObjectSet
    Dim MaxMemN
    MaxMemN = 0
    Set objSWbemServices = GetObject("winmgmts:")
    Set objSWbemObjectSet = objSWbemServices.ExecQuery("select Capacity from Win32_PhysicalMemory where CreationClassName='Win32_PhysicalMemory'")
    For Each objSWbemObject In objSWbemObjectSet
        MaxMemN = objSWbemObject.Capacity + MaxMemN
    Next
    GetMaxMem = Int(MaxMemN / 1024 / 1024)
    GetMaxMem = Trim(Str(GetMaxMem))
    Set objSWbemObject = Nothing
    Set objSWbemServices = Nothing
    Set objSWbemObjectSet = Nothing
End Function