Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:09. Заголовок: Re:
Как же выключить компьютер в Windows XP® ?
Я долго искал способ выключить компьютер в Windows XP… Например: функция ExitWindows() вообще сдохла, а ExitWindowsEx() делает только LOGOFF. И однажды нашёл на одном форуме:
Dim strComputer As String strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate, _ (Shutdown)}!\\" & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery( _ "Select * from Win32_OperatingSystem") For Each ObjOperatingSystem In colOperatingSystems ObjOperatingSystem.Reboot ' Для перезагрузки Next
и…
Dim strComputer As String
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery( _ "Select * from Win32_OperatingSystem")
For Each ObjOperatingSystem In colOperatingSystems
ObjOperatingSystem.ShutDown 'Для выключения
Next
Примечание: Данный код работает и для VBScript… P.S. Пробуйте, у меня работает безотказно.
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:12. Заголовок: Re:
Как ловить нажатия на клавиши вне вашей программы
1. Положите на форму таймер, поставьте интервал в 50 2. Добавьте в модуль:
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Const VK_TAB = &H9 ' Константа для TAB key. ' константы для других кнопок посмотрите в API вьювере ' Поместите в событие Timer: If GetAsyncKeyState(VK_TAB) And KEY_SHIFT = True Then msgboх "Кто то трогает ТАБ", vbinformation End If
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:14. Заголовок: Re:
Проверка файла на "заблоченность"
' пытается получить исключительный доступ к существующему файлу ' если неполучается или файл не существует - выдает FALSE ' использовать можно свободно ' ************************************************************************************ Public Const OPEN_EXISTING = 3 Public Const FILE_ATTRIBUTE_NORMAL = &H80&
Private Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" _ (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long
Public Function IsFreeFile(ByVal sLongFileName As String) As Boolean Dim hfile As Long IsFreeFile = False hfile = CreateFile(sLongFileName, 0, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) If hfile <> -1 Then IsFreeFile = True End If CloseHandle hfile End Function
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:15. Заголовок: Re:
Глюк в ExistDir
При разработке приложений в VB или VBA часто возникает потребность в функциях ExistFile и ExistDir, проверяющих существование файла или папки. В литературе встречаются такие примеры:
Public Function ExistFile(ByVal strFileName As String) As Boolean ExistFile = False On Error GoTo f1 ExistFile = (Dir(strFileName) <> "") f1: On Error GoTo 0 End Function
Public Function ExistDir(ByVal dirName As String) As Boolean ExistDir = False On Error GoTo f1 If Len(dirName) < 2 Then GoTo f1 If Right(dirName, 1) = "\" Then dirName = Left(dirName, Len(dirName) - 1) ExistDir = (Dir(dirName, vbDirectory) <> "") f1: On Error GoTo 0 End Function
Однако, при попытке применить функцию ExistDir к сетевым путям, обнаруживается, что она работает неверно, возвращая, например, False для существующей папки \\MAIN\POST$. Небольшая модификация этой фунции позволяет использовать ее как для обычных, так и сетевых путей:
Public Function ExistDir(ByVal dirName As String) As Boolean ExistDir = False On Error GoTo f1 If Len(dirName) < 2 Then GoTo f1 If Right(dirName, 1) = "\" Then dirName = Left(dirName, Len(dirName) - 1) If Left(dirName, 2) = "\\" Then ExistDir = (Dir(dirName + "\", vbDirectory) <> "") Else ExistDir = (Dir(dirName, vbDirectory) <> "") End If f1: On Error GoTo 0 End Function
Возможно, это наблюдение окажется полезным разработчикам ПО.
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:16. Заголовок: Re:
Простой способ открыть файл, связанный с каким либо приложением Windows
Под Windos NT:
Shell "cmd /X /C start c:\mydoc\example.doc"
Под Windos 9x:
Shell "start c:\mydoc\example.doc"
При способе, предложенном Автором появляется минимизированое окно Command Prompt. Не всем юзерам это нравиться. Как альтернативу можно использовать API функцию ShellExecute. Для этого необходимо испльзовать декларацию:
' Декларация функции для запуска файла. 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
' Декларация константы для максимизирования окна открываемого приложения. ' Для работы с другими константами смотрите MSDN. Public Const SW_SHOWMAXIMIZED = 3
'После этого нижеследующий код будет открывать файл test.xls.
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:18. Заголовок: Re:
Как таскать форму не за заголовок, а за любое место
Не пугайтесь, никакого громоздкого кода на событе MouseMove, с отслеживанием положения мыши. Все, как обычно просто:
Const WM_NCLBUTTONDOWN = &HA1 Const HTCAPTION = 2 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Call ReleaseCapture Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End Sub
Увидел у Вас на странице пример кода для перемещения окна не за заголовок и решил прислать свой вариант. Используется объект Image с именем imgMove. Объект может любой.
Public BarX Public BarY
Private Sub imgMove_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) If Button = 1 Then BarY = Y: BarX = X End Sub
Private Sub imgMove_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single)
If Button = 1 Then frmMain.Top = frmMain.Top + Y - BarY frmMain.Left = frmMain.Left + X - BarX end if
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:19. Заголовок: Re:
Как поместить форму поверх других форм
'Поместите в модуль Public Declare Function SetWindowPos Lib "user32" _ (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _ ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _ ByVal cy As Long, ByVal wFlags As Long) As Long Public Const HWND_NOTOPMOST = -2 Public Const HWND_TOPMOST = -1 Public Const SWP_NOACTIVATE = &H10 Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1
Public Sub SetFormPosition(frmHandl As Long, TopPosition As Boolean) If TopPosition Then SetWindowPos frmHandl, HWND_TOPMOST, 0, 0, 0, 0, _ SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE Else SetWindowPos frmHandl, HWND_NOTOPMOST, 0, 0, 0, 0, _ SWP_NOSIZE Or SWP_NOMOVE End If End Sub 'Поместите на форму в любой процедуре call SetFormPosition(Me.hwnd, True)
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:24. Заголовок: Re:
Сделать программу невидимой в списке задач Windows 9х
Option Explicit Private Declare Function RegisterServiceProcess Lib "kernel32.dll" _ (ByVal dwProcessId As Long, ByVal dwType As Long) As Long Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Sub toVisible() Call RegisterServiceProcess(GetCurrentProcessId, 0) End Sub
Private Sub toInvisible() Call RegisterServiceProcess(GetCurrentProcessId, 1) End Sub
Не зарегистрирован
Зарегистрирован: 01.01.70
Рейтинг:
0
Отправлено: 02.06.06 02:38. Заголовок: Re:
Вывод на экран постоянного показа позиции курсора в ToolTyp'е
В своей программке столкнулся с необходимостью вывода на экран постоянного показа позиции курсора в ToolTyp'е. Я думаю, что этот пример подойдет для твоего раздела хитростей:
1. Создаем форму Form1, размещаем на ней PictureBox с именем Picture1. Вводим код:
Option Explicit Private clsPictureBox1 As Class1
Private Sub Form_Load() Set clsPictureBox1 = New Class1 Set clsPictureBox1.Coordinat = Picture1 End Sub
2. Создаем модуль класса Class1 и размещаем в нем код:
Option Explicit
Private WithEvents pic As PictureBox
Public Property Set Coordinat(OutsidePictureBox As PictureBox) Set pic = OutsidePictureBox End Property
Private Sub pic_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) pic.ToolTipText = "X = " & X & "; Y = " & Y End Sub
Все даты в формате GMT
3 час. Хитов сегодня: 31
Права: смайлы да, картинки да, шрифты да, голосования нет
аватары да, автозамена ссылок вкл, премодерация откл, правка нет