modfunctions.bas

优盘 锁定监视器

Attribute VB_Name = "modFunctions"

Option Explicit

Public objFind As LV_FINDINFO
Public objItem As LV_ITEM
Public sOrder As Boolean

Public Type POINTAPI
 x As Long
 Y As Long
End Type

Public Type LV_FINDINFO
 Flags As Long
 psz As String
 lParam As Long
 pt As POINTAPI
 vkDirection As Long
End Type

Public Type LV_ITEM
 mask As Long
 iItem As Long
 iSubItem As Long
 State As Long
 stateMask As Long
 pszText As String
 cchTextMax As Long
 iImage As Long
 lParam As Long
 iIndent As Long
End Type

Public Const LVFI_PARAM As Long = &H1
Public Const LVIF_TEXT As Long = &H1
Public Const LVM_FIRST As Long = &H1000
Public Const LVM_FINDITEM As Long = (LVM_FIRST + 13)
Public Const LVM_GETITEMTEXT As Long = (LVM_FIRST + 45)
Public Const LVM_SORTITEMS As Long = (LVM_FIRST + 48)
Private aAppPath As String
Const SW_MAXIMIZE = 3
Const SW_MINIMIZE = 6

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public 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

Public Function CompareDates(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
Dim dDate1 As Date
Dim dDate2 As Date
 dDate1 = ListView_GetItemDate(hwnd, lParam1)
 dDate2 = ListView_GetItemDate(hwnd, lParam2)
 Select Case sOrder
  Case True: 'sort descending
   If dDate1 < dDate2 Then
    CompareDates = 0
   ElseIf dDate1 = dDate2 Then
    CompareDates = 1
   Else: CompareDates = 2
   End If
  Case Else: 'sort ascending
   If dDate1 > dDate2 Then
    CompareDates = 0
   ElseIf dDate1 = dDate2 Then
    CompareDates = 1
   Else: CompareDates = 2
   End If
 End Select
End Function

Public Function CompareValues(ByVal lParam1 As Long, ByVal lParam2 As Long, ByVal hwnd As Long) As Long
Dim val1 As Long
Dim val2 As Long
 val1 = ListView_GetItemValueStr(hwnd, lParam1)
 val2 = ListView_GetItemValueStr(hwnd, lParam2)
 Select Case sOrder
  Case True: 'sort descending
   If val1 < val2 Then
    CompareValues = 0
   ElseIf val1 = val2 Then
    CompareValues = 1
   Else: CompareValues = 2
   End If
  Case Else: 'sort ascending
   If val1 > val2 Then
    CompareValues = 0
   ElseIf val1 = val2 Then
    CompareValues = 1
   Else: CompareValues = 2
   End If
 End Select
End Function

Public Function FARPROC(ByVal pfn As Long) As Long
 FARPROC = pfn
End Function

Public Function ListView_GetItemDate(hwnd As Long, lParam As Long) As Date
Dim hIndex As Long
Dim r As Long
 objFind.Flags = LVFI_PARAM
 objFind.lParam = lParam
 hIndex = SendMessage(hwnd, LVM_FINDITEM, -1, objFind)
 objItem.mask = LVIF_TEXT
 objItem.iSubItem = 1
 objItem.pszText = Space$(32)
 objItem.cchTextMax = Len(objItem.pszText)
 r = SendMessage(hwnd, LVM_GETITEMTEXT, hIndex, objItem)
 If r > 0 Then
  ListView_GetItemDate = CDate(Left$(objItem.pszText, r))
 End If
End Function

Public Function ListView_GetItemValueStr(hwnd As Long, lParam As Long) As Long
Dim hIndex As Long
Dim r As Long
 objFind.Flags = LVFI_PARAM
 objFind.lParam = lParam
 hIndex = SendMessage(hwnd, LVM_FINDITEM, -1, objFind)
 objItem.mask = LVIF_TEXT
 objItem.iSubItem = 2
 objItem.pszText = Space$(32)
 objItem.cchTextMax = Len(objItem.pszText)
 r = SendMessage(hwnd, LVM_GETITEMTEXT, hIndex, objItem)
 If r > 0 Then
  If IsNumeric((Trim$(objItem.pszText))) Then ListView_GetItemValueStr = CLng(Left$(Trim$(objItem.pszText), r))
 End If
End Function

Public Function FileExist(fileName As String) As Boolean
On Error Resume Next
 FileExist = (Dir$(UCase$((fileName))) <> "")
End Function

Public Function readFile(fileName As String) As String()
On Error Resume Next
Dim f As Integer
Dim tmpStr As String
Dim arr() As String
 f = FreeFile()
 Open fileName For Input As f
  tmpStr = Input$(LOF(f), f)
 Close f
 arr = Split(tmpStr, Chr(10) & Chr(13))
 readFile = arr
End Function

Public Function onlyNumbers(str As String) As String
Dim tmpStr As String
Dim strLen As Long
Dim i As Integer
 strLen = Len(str): tmpStr = ""
 For i = 1 To strLen
  Select Case Mid(str, i, 1)
   Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9: tmpStr = tmpStr & Mid(str, i, 1)
   Case Else
  End Select
 Next i
 onlyNumbers = tmpStr
End Function

Public Function updateGLsettings()
 glHours = CInt(GetSetting(App.EXEName, "Time", "Hours", "00"))
 glMinutes = CInt(GetSetting(App.EXEName, "Time", "Minutes", "00"))
 glSeconds = CInt(GetSetting(App.EXEName, "Time", "Seconds", "00"))
 
 gldoWhat = GetSetting(App.EXEName, "doWhat", "doWhat", 2)
 
 If glHours = 0 And glMinutes = 0 And glSeconds = 0 Then
  glSeconds = 1
  SaveSetting App.EXEName, "Time", "Seconds", "01"
 End If
 
 glSecondsUsed = 0
 glMinutesUsed = 0
 glHoursUsed = 0
 
 If CInt(GetSetting(App.EXEName, "usbKeys", "numOfKeys", 0)) = 0 Then
  MsgBox "您至少要选择一个能运行本程序的磁盘。", vbInformation, "提示"
  appActive = False
  frmSystray.tmrSecurity.Enabled = False
  frmSystray.mnuOnOff.Checked = False
 Else
  frmSystray.tmrSecurity.Enabled = True
  appActive = True
  frmSystray.mnuOnOff.Checked = True
 End If

End Function