dlgwinexit.bas

一个clock的 vb 源码

Attribute VB_Name = "DlgWinExit"
Option Explicit
Private T As Long       ' 倒记时
Private TPos As Long    ' 倒记时位置

Private hFont As Long
Private hIconClock As Long
Private OkClick As Boolean

Public startAfresh As Boolean          ' 全局公共变量
Public strExitNotifyText As String  ' 用户在使用了通知文字

Private strExitText As String


Private Button As clsButton
Private WinExit As New clsDialog

Public Function CreateDlgWinExit(hWndParent As Long)
    Call WinExit.CreateDialog(hWndParent, AddressOf DlgProc)
    
    If OkClick Then
        OkClick = False
        If startAfresh Then
            AddTokenforNT
            Call ExitWindowsEx(EWX_REBOOT, 0)
        Else
            AddTokenforNT
            Call ExitWindowsEx(EWX_SHUTDOWN, 0)
        End If
    End If
    OkClick = False
    Set WinExit = Nothing
    hFont = 0
End Function

Private Function DlgProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case uMsg
        '------------------------------------
        ' Create All Control
        '------------------------------------
         Case WM_INITDIALOG
            
            Dim lpRect As RECT, hDesktop As Long
            hDesktop = GetDesktopWindow
            Call GetWindowRect(hDesktop, lpRect)
            Call MoveWindow(hWnd, (lpRect.Right - 275) / 2, (lpRect.Bottom - 138) / 2, 275, 138, 1)
            
            If startAfresh = True Then
                strExitText = "重新启动计算机"
                TPos = 204
            Else
                strExitText = "关闭计算机"
                TPos = 183
            End If
            
            Call SendMessage(hWnd, WM_SETTEXT, 0, ByVal strExitText)
            
            hFont = CreateFont(12, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET, _
            OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, _
            DEFAULT_PITCH Or FF_DONTCARE, "宋体")
            
            hIconClock = LoadResImage(App.hInstance, 1, IMAGE_ICON, 0, 0, 0)

            Set Button = New clsButton
            Button.CreateButton hWnd, "立即执行(&O)", 1, 95, 85, 70, 19, hFont, WS_GROUP Or BS_DEFPUSHBUTTON
            Button.CreateButton hWnd, "取消(&C)", 2, 175, 85, 70, 19, hFont
         
            T = 30                              ' 初始化定时器变量为30秒
            Call SetTimer(hWnd, 2, 1000, 0&)    ' 开始倒数定时器
        Case WM_COMMAND
            Select Case wParam
                Case Is = 1             ' 按下了确定按钮（在退时会检查这标志）
                    OkClick = True      ' 用于确定是否按下了执行按钮
                    Call SendMessage(hWnd, WM_CLOSE, 0, 0)
                Case Is = 2
                    Call SendMessage(hWnd, WM_CLOSE, 0, 0)
            End Select
        Case WM_TIMER
            '----------------------------------------------------------------------
            Dim lpReRect As RECT
            lpReRect.Top = 24
            lpReRect.Bottom = 36
            lpReRect.Left = 183
            lpReRect.Right = 216
            InvalidateRect hWnd, lpReRect, 1
            '----------------------------------------------------------------------
        Case WM_PAINT
            Dim hDc As Long
            Dim lpPaint As PAINTSTRUCT
  
            hDc = BeginPaint(hWnd, lpPaint)
                Call SetBkMode(hDc, NEWTRANSPARENT)
                Call SelectObject(hDc, hFont)
                
                Call DrawIconEx(hDc, 10, 10, hIconClock, 0, 0, 0, 0, DI_NORMAL)
                
                TextOut hDc, 55, 10, "你设置了：" & strExitText, 10 + LenB(strExitText)
                TextOut hDc, 55, 25, strExitText & "进入倒记时", 10 + LenB(strExitText)
                TextOut hDc, 55, 41, "小闹钟将在 30 秒后执行设定的操作。", 34
                
                If T > 0 Then
                    T = T - 1
                Else
                    OkClick = True
                    SendMessage hWnd, WM_CLOSE, 0, 0
                End If
                Call TextOut(hDc, TPos, 25, CStr(T), Len(CStr(T)))
                
                Call OutInfoText(hDc)
                
                DrawFrame hDc, 10, 258, 76, 76
                DrawButton hDc, 94, 166, 84, 105
                DrawButton hDc, 174, 246, 84, 105
            Call EndPaint(hWnd, lpPaint)
        
        Case WM_CLOSE
            Set Button = Nothing
            Call KillTimer(hWnd, 2)
            Call DestroyIcon(hIconClock)
            Call DeleteObject(hFont)
            Call EndDialog(hWnd, 0)
    End Select
End Function


Private Sub OutInfoText(lnghDc As Long)
    ' 判断是否有统知消息文字(自定义的那个文字)
    If strExitNotifyText <> vbNullString Then
        TextOut lnghDc, 12, 56, strExitNotifyText, LenB(StrConv(strExitNotifyText, vbFromUnicode))
    Else
        If startAfresh Then
            TextOut lnghDc, 12, 56, "如果要解除〖" & strExitText & "〗请按取消按钮。", 28 + LenB(strExitText)
        Else
            TextOut lnghDc, 31, 56, "如果要解除〖" & strExitText & "〗请按取消按钮。", 28 + LenB(strExitText)
        End If
    End If
End Sub

Public Sub AddTokenforNT()

    'Windows NT 下调用ExitWindowEx 涵数需要特权
    Dim hToken As Long
    Dim upLuid As LUID
    Dim hProcess As Long
    
    Dim lpPriv  As TOKEN_PRIVILEGES
    Dim lpNewPriv As TOKEN_PRIVILEGES
    Dim lpBuffer As Long
    
    If GetWindowsInfo Then
        hProcess = GetCurrentProcess()
        OpenProcessToken hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken
        LookupPrivilegeValue vbNullString, "SeShutdownPrivilege", upLuid
 
        lpPriv.PrivilegeCount = 1
        lpPriv.Privileges(0).pLuid = upLuid
        lpPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
        AdjustTokenPrivileges hToken, False, lpPriv, Len(lpNewPriv), lpNewPriv, lpBuffer
    End If
End Sub