新增功能模块...

Signed-off-by: 502647092 <jtb1@163.com>
2025-11-24 21:26:26 +00:00 · 2015-10-27 10:36:53 +08:00
parent 8492ab368b
commit db463fa993
4 changed files with 953 additions and 979 deletions
--- a/System.bas
+++ b/System.bas
@@ -0,0 +1,237 @@
+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