mdlform.bas

一款比较专业

    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

Public Const SMP_SITE As String = "smp.e-freshware.com"

Public Sub MoveForm(hwnd As Long)
    ReleaseCapture
    SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Public Sub AlwaysOnTop(hwnd As Long, SetOnTop As Boolean)
    If SetOnTop Then
        SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPFLAGS
    Else
        SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPFLAGS
    End If
End Sub

Public Function IsTransparent(hwnd As Long) As Boolean
    On Error Resume Next
    Dim Msg As Long
    Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
    If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
        IsTransparent = True
    Else
        IsTransparent = False
    End If
    If Err Then
        IsTransparent = False
    End If
End Function

Public Function MakeTransparent(hwnd As Long, Perc As Integer) As Long
    Dim Msg As Long
    On Error Resume Next
    If Perc < 0 Or Perc > 255 Then
        MakeTransparent = 1
    Else
        Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
        Msg = Msg Or WS_EX_LAYERED
        SetWindowLong hwnd, GWL_EXSTYLE, Msg
        SetLayeredWindowAttributes hwnd, 0, Perc, LWA_ALPHA
        MakeTransparent = 0
    End If
    If Err Then
        MakeTransparent = 2
    End If
End Function

Public Function MakeOpaque(hwnd As Long) As Long
    Dim Msg As Long
    On Error Resume Next
    Msg = GetWindowLong(hwnd, GWL_EXSTYLE)
    Msg = Msg And Not WS_EX_LAYERED
    SetWindowLong hwnd, GWL_EXSTYLE, Msg
    SetLayeredWindowAttributes hwnd, 0, 0, LWA_ALPHA
    MakeOpaque = 0
    If Err Then
        MakeOpaque = 2
    End If
End Function

Public Function CheckValueData(lValue As Long, _
    Optional CheckItemValue As String) As String
    Dim sValueNow As String
    Select Case lValue
        Case Is = 0
            Select Case LCase$(CheckItemValue)
                Case "scanned"
                    sValueNow = "已扫描!"
                Case "infected"
                    sValueNow = "被感染!"
                Case "repaired"
                    sValueNow = "已修复!"
                Case "detected"
                    sValueNow = "已删除!"
            End Select
            CheckValueData = ": 没有文件" & sValueNow
        Case Is = 1
            CheckValueData = ": " & CStr(lValue) & "个文件"
        Case Else
            CheckValueData = ": " & CStr(lValue) & "个文件"
    End Select
End Function

Public Function CheckBoxesValues(lValue As CheckBox) As String
    If lValue.Value = vbChecked Then
        CheckBoxesValues = ": 允许"
    Else
        CheckBoxesValues = ": 禁止"
    End If
End Function

Public Function CheckFileScanValue(lValue As OptionButton, _
    sExtForm As ComboBox) As String
    If lValue.Value = True Then
        CheckFileScanValue = ": 全部文件"
    Else
        CheckFileScanValue = ": 筛选文件 [" & sExtForm & "]"
    End If
End Function

Public Sub FinishAlert()
    If frmMain.chkSound.Value = 1 Then
        BeepAPI 1800, 50
        Sleep 20
        BeepAPI 1800, 100
    End If
End Sub

Public Sub CreateLogFile(sLocation As String, sInputData As String)
    On Error Resume Next
    Dim lFree As Integer
    lFree = FreeFile
    Open sLocation For Output As #lFree
        Print #lFree, sInputData
    Close #lFree
End Sub

Public Function GetSaveName(Optional WindowTitle As String = "报告另存为", _
    Optional FilterStr As String = "文本日志 (*.log)" + vbNullChar + "*.log") _
    As String
    On Error Resume Next
    Dim DlgInfo As OPENFILENAME
    Dim ret As Long
    Dim Filename As String
    With DlgInfo
        .lStructSize = Len(DlgInfo)
        .hwndOwner = Screen.ActiveForm.hwnd
        .lpstrFilter = FilterStr
        .nFilterIndex = 1
        .lpstrFile = Filename & String(255 - Len(Filename), Chr(0))
        .nMaxFile = 256
        .lpstrFileTitle = String(255, Chr(0))
        .nMaxFileTitle = 256
        .lpstrInitialDir = CurDir & vbNullChar
        .lpstrTitle = WindowTitle & vbNullChar
        .flags = OFN_EXPLORER Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or _
            OFN_OVERWRITEPROMPT Or OFN_ENABLEHOOK
        .nMaxCustomFilter = 0
        .nFileOffset = 0
        .nFileExtension = 0
        .lCustData = 0
        .lpfnHook = 0
        .hInstance = 0
    End With
    ret = GetSaveFileName(DlgInfo)
    If Not ret = 0 Then
        GetSaveName = Left(DlgInfo.lpstrFile, InStr(DlgInfo.lpstrFile, vbNullChar) - 1)
    Else
        GetSaveName = ""
    End If
End Function

Public Sub AnimateText(lAnim As Label)
    On Error Resume Next
    With lAnim
        If .Caption = "[-]" Then
            .Caption = "[\]"
        ElseIf .Caption = "[\]" Then
            .Caption = "[|]"
        ElseIf .Caption = "[|]" Then
            .Caption = "[/]"
        ElseIf .Caption = "[/]" Then
            .Caption = "[-]"
        End If
    End With
End Sub

Public Sub LV_AutoSizeColumn(ByVal LV As ListView, _
    Optional ByVal Column As ColumnHeader = Nothing)
    On Error Resume Next
    Dim C As ColumnHeader
    If Column Is Nothing Then
        For Each C In LV.ColumnHeaders
            SendMessage LV.hwnd, LVM_FIRST + 30, C.Index - 1, -1
        Next
    Else
        SendMessage LV.hwnd, LVM_FIRST + 30, Column.Index - 1, -1
    End If
    LV.Refresh
End Sub

Sub ExitNow()
    On Error Resume Next
    App.TaskVisible = False
    With frmMain
        .Hide
        .OnSystray.Visible = False
        ExecuteOptimizer .lvwSystemOptimizer
    End With
    'SaveAppSettings
    With frmInfo
        .Caption = "正在关闭程序"
        .prgInfo.Color = &H4080&
        .Show vbModal
    End With
    MsgBox "感谢您使用简易计算机保护软件！" & vbCrLf & "更多信息请访问SAIL软件工作室" & vbCrLf & "       http://hi.baidu.com/陈峰clg", _
        vbInformation + vbSystemModal, "感谢"
    End
End Sub

Public Function GenerateMainTitle() As String
    GenerateMainTitle = "$螹PL