Тема: VBScript: вывод текста и графич. примитивов на экране через Win32 API
Автор примера - Poltergeyst.
Скрипт симулирует всплывающее окно с текстом в действительном контексте экрана. Работает под Win98 и WinXP. Потребуется библиотека dynwrap.dll.
'Нет гарантий!Используете на свой страх и риск.
'-----------------------------------------------------------------
'Пример симуляции всплывающего окна содержащего текстовые
'данные в действительный контекст экрана.
'-----------------------------------------------------------------
'Language: VBScript
'Используется библиотека dynwrap.dll
'-----------------------------------------------------------------
'ОС Win98 4.10.2222
'-----------------------------------------------------------------
'[Создание основных объектов и объявление переменных]
on Error resume Next
set fso =CreateObject("Scripting.FileSystemObject")
if not IsObject(fso) then comErro("Scripting.FileSystemObject")
set nWork =CreateObject("WScript.Network")
if not IsObject(nWork) then comErro("WScript.Network")
dim hDC
getSystemInformation()
'-----------------------------------------------------------------
'Некоторые данные о вашем компьютере
'-----------------------------------------------------------------
function getSystemInformation()
'-----------------------------------------------------------------
'[Получение дескриптора общего контекста экрана]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
"USER32.DLL", _
"GetWindowDC", _
"i=h", _
"f=s", _
"r=h"
'Вызов API
hDC=dllWrap.GetWindowDC(Null)
set dllWrap=Nothing
'-----------------------------------------------------------------
''[Создание пера]
'
'red =255*1
'green =65280*0
'blue =16711680*0
'
' color=Round(red+green+blue,0)
'
'set dllWrap=CreateObject("DynamicWrapper")
'
''Регистрация вызова API
'dllWrap.Register _
' "GDI32.DLL", _
' "CreatePen", _
' "i=uuu", _
' "f=s", _
' "r=l"
'
''Вызов API
'hPen=dllWrap.CreatePen(0, _
' 5, _
' Cint(color))
'set dllWrap=Nothing
''-----------------------------------------------------------------
''[Выбор заливки в контекст устройства]
'
'set dllWrap=CreateObject("DynamicWrapper")
'
''Регистрация вызова API
'dllWrap.Register _
' "GDI32.DLL", _
' "SelectObject", _
' "i=ll", _
' "f=s", _
' "r=l"
'
''Вызов API
'res=dllWrap.SelectObject(hDC,hPen)
'
'set dllWrap=Nothing
'-----------------------------------------------------------------
'[Вывод прямоугольника]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
"GDI32.DLL", _
"Rectangle", _
"i=luuuu", _
"f=s", _
"r=l"
'Вызов API
res=dllWrap.Rectangle( hDC, _
0, _
5, _
750, _
100)
set dllWrap=Nothing
'-----------------------------------------------------------------
'[Сбор некоторых данных]
'-----------------------------------------------------------------
i=1
for each drive in fso.drives
on Error resume Next
data="Диск: " & drive.Path & " Свободно: "& drive.FreeSpace/1024 & " kB" & _
";Всего: " & drive.TotalSize/1024 & " kB" & _
";Файловая система: " & drive.FileSystem & _
";Номер: " & drive.SerialNumber
setGDIData data,i,len(data)
i=i+1
next
'-----------------------------------------------------------------
data= "Компьютер: " & nWork.ComputerName & _
";Пользователь: " & nWork.UserName
setGDIData data,i,len(data)
'-----------------------------------------------------------------
'[Освобождение контекста устройства]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
"USER32.DLL", _
"ReleaseDC", _
"i=hh", _
"f=s", _
"r=l"
'Вызов API
res=dllWrap.ReleaseDC(0,hDC)
set dllWrap=Nothing
end Function
'-----------------------------------------------------------------
'Симуляция всплывающего окна
'-----------------------------------------------------------------
function setGDIData(data,shiftY,dLen)
'-----------------------------------------------------------------
'[Установка цвета шрифта]
red =255*0
green =65280*0
blue =16711680*1
color=Round(red+green+blue,0)
'Синий
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
"GDI32.DLL", _
"SetTextColor", _
"i=hu", _
"f=s", _
"r=h"
'Вызов API
hBrush=dllWrap.SetTextColor(hDC,color)
set dllWrap=Nothing
'-----------------------------------------------------------------
'[Вывод текста в графическом представлении]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
"GDI32.DLL", _
"TextOut", _
"i=luusu", _
"f=s", _
"r=l"
'Вызов API
res=dllWrap.TextOut(hDC, _
10, _
10+15*shiftY, _
CStr(data), _
CInt(dLen))
set dllWrap=Nothing
End function
'-----------------------------------------------------------------
'Обработчик ошибок COM
'-----------------------------------------------------------------
function comErro(objName)
msgBox "Невозможно создание объекта " & objName & vbCRLF & _
"Установите соответствующую библиотеку" & vbCRLF & _
"и зарегистрируйте её в реестре.", _
vbOKOnly + vbExclamation, _
"Всплывающий комментарий"
WScript.Quit(-1)
end FunctionПредложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.
