Спасибо.]]>
Перем MSScript;
//_____________________________________________________________________________
Процедура ДобавитьИконкуВТрей() Экспорт
Если MSScript <> 0 Тогда Возврат; КонецЕсли;
Code = "
|Public Const IMAGE_ICON = 1
|Public Const NIIF_NONE = &H0
|Public Const NIIF_WARNING = &H2
|Public Const NIIF_ERROR = &H3
|Public Const NIIF_INFO = &H1
|Public Const NIIF_GUID = &H4
|Public Const NIF_TIP = 4
|Public Const NIF_MESSAGE = 1
|Public Const NIF_STATE = &H8
|Public Const NIF_INFO = &H10
|Public Const NIM_ADD = 0
|Public Const NIM_DELETE = 2
|Public Const NIM_MODIFY = 1
|Public Const NIF_ICON = 2
|Public Const VK_ESCAPE = &H1B
|Public Const WM_MOUSEMOVE = &H200
|Public Const WM_LBUTTONDOWN = &H201
|Public Const WM_LBUTTONUP = &H202
|Public Const WM_LBUTTONDBLCLK = &H203
|Public Const WM_RBUTTONDOWN = &H204
|Public Const WM_RBUTTONUP = &H205
|Public Const WM_RBUTTONDBLCLK = &H206
|Public Const WM_SHELLNOTIFY = &H405
|
|Public DX
|Set DX = CreateObject(""DynamicWrapperX"")
|DX.Register ""SHELL32"", ""Shell_NotifyIcon"", ""i=ll"", ""r=l""
|DX.Register ""KERNEL32"",""LoadLibraryA"",""i=s"",""r=l""
|DX.Register ""USER32"",""LoadImageA"",""i=llllll"",""r=l""
|DX.Register ""KERNEL32"",""FreeLibrary"",""i=l""
|DX.Register ""KERNEL32"",""RtlMoveMemory"",""i=lll"",""r=l""
|DX.Register ""KERNEL32"",""HeapAlloc"",""i=lll"",""r=l""
|DX.Register ""KERNEL32"",""GetProcessHeap"",""r=l""
|DX.Register ""KERNEL32"",""HeapFree"",""i=lll"",""r=l""
|
|Public TrayIcon
|Private TrayIconInitialized
|
|Class NOTIFYICONDATA
| Private hHeap,init
| 'Создание класса
| Private Sub Class_Initialize
| hHeap = DX.GetProcessHeap()
| init = DX.HeapAlloc(hHeap,0,488)
| End Sub
| 'Уничтожение класса
| Private Sub Class_Terminate
| DX.HeapFree hHeap,0,init
| End Sub
| 'Базовый адрес
| Public Property Get dwAddress
| dwAddress = init
| End Property
| 'Конвкптация значения
| Private Function ConvertData(dwData)
| hW = Fix(dwData/65536)
| lW = dwData mod 65536
| ConvertData = ChrW(lW) & ChrW(hW)
| End Function
| 'Размер базы
| Public Property Get cbSize
| cbSize = 488
| End Property
| Public Property Let cbSize(Value)
| iOfs = 0: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Дескриптор родителя
| Public Property Let hWnd(Value)
| iOfs = 4: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Идентификатор
| Public Property Let uID(Value)
| iOfs = 8: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Флаги отображения
| Public Property Let uFlags(Value)
| iOfs = 12: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Флаги событий
| Public Property Let uCallbackMessage(Value)
| iOfs = 16: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Хэндл иконки
| Public Property Let hIcon(Value)
| iOfs = 20: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Всплывающая подсказка
| Public Property Let szTip(Value)
| iOfs = 24: iSize = 128
| sData = Left(Value,iSize - 1) & vbNullchar
| For i = 1 To iSize
| DX.RtlMovememory init + iOfs - 1 + i, DX.StrPtr(Mid(sData,i,1), ""s""), 1
| Next
| End Property
| 'Текст информац.сообщения
| Public Property Let szInfo(Value)
| iOfs = 160: iSize = 256
| sData = Left(Value,iSize - 1) & vbNullchar
| For i = 1 To iSize
| DX.RtlMovememory init + iOfs - 1 + i, DX.StrPtr(Mid(sData,i,1), ""s""), 1
| Next
| End Property
| 'Иконка информац.сообщения
| Public Property Let dwInfoFlags(Value)
| iOfs = 484: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Заголовок информац.сообщения
| Public Property Let szInfoTitle(Value)
| iOfs = 420: iSize = 64
| sData = Left(Value,iSize - 1) & vbNullchar
| For i = 1 To iSize
| DX.RtlMovememory init + iOfs - 1 + i, DX.StrPtr(Mid(sData,i,1), ""s""), 1
| Next
| End Property
| 'Время показа информац.сообщения
| Public Property Let uTimeout(Value)
| iOfs = 416: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Статус
| Public Property Let dwState(Value)
| iOfs = 152: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
| 'Маска статуса
| Public Property Let dwStateMask(Value)
| iOfs = 156: iSize = 4
| sData = ConvertData(Value)
| DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
| End Property
|End Class
|
|Class NotifyIcon
| Private SysTray
| Private SysTrayActivated
| 'Создание класса
| Private Sub Class_Initialize
| Set SysTray = New NOTIFYICONDATA
| End Sub
| 'Уничтожение класса
| Private Sub Class_Terminate
| Delete
| Set SysTray = Nothing
| End Sub
| 'Помещаем иконку в трей
| Public Function Init(hWnd,ToolTip,hIcon)
| If SysTrayActivated Then
| Exit Function
| End If
| With SysTray
| .cbSize = .cbSize
| .hWnd = hWnd
| .uID = vbNull
| .uFlags = NIF_ICON Or NIF_TIP
| .uCallbackMessage = WM_MOUSEMOVE
| .hIcon = hIcon
| .szTip = ToolTip
| .dwState = 0
| .dwStateMask = 0
| DX.Shell_NotifyIcon NIM_ADD,.dwAddress
| End With
| SysTrayActivated = True
| Init = SysTray.dwAddress
| End Function
| 'Удаляем иконеу из трея
| Public Sub Delete()
| If Not SysTrayActivated Then
| Exit Sub
| End If
| DX.Shell_NotifyIcon NIM_DELETE,SysTray.dwAddress
| Set SysTray = Nothing
| SysTrayActivated = False
| End Sub
| 'Показать уведомление
| Public Sub Modify(TextMessage, Title, IconFlag, Timeout)
| If Not SysTrayActivated Then
| Exit Sub
| End If
| With SysTray
| .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
| .szInfo = TextMessage
| .szInfoTitle = Title
| .dwInfoFlags = IconFlag
| .uTimeout = Timeout
| DX.Shell_NotifyIcon NIM_MODIFY,.dwAddress
| End With
| End Sub
|End Class
|
|Public Function TrayIconInit(hWnd,ToolTip,hIcon)
| If TrayIconInitialized Then
| Exit Function
| End If
| If Len(Trim(ToolTip)) = 0 Then
| ToolTip = ""1С:Предприятие 7.7""
| End If
| If CLng(hIcon) = 0 Then
| hLib = DX.LoadLibraryA(""" + КаталогПрограммы() + "1crcrus.dll"")
| hIcon = DX.LoadImageA(hLib,128,IMAGE_ICON,16,16,0)
| DX.FreeLibrary hLib
| End If
| Set TrayIcon = New NotifyIcon
| TrayIconInitialized = True
| TrayIconInit = TrayIcon.Init(hWnd,ToolTip,hIcon)
|End Function
|
|Public Sub TrayIconModify(TextMessage,Title,Icon, Timeout)
| Dim IconFlag
| If Not TrayIconInitialized Then
| Exit Sub
| End If
| If Timeout = 0 Then
| Timeout = 50
| End If
| Select Case Icon
| Case 1
| IconFlag = NIIF_INFO
| If Len(Trim(Title)) = 0 Then
| Title = ""Информация""
| End If
| Case 2
| IconFlag = NIIF_WARNING
| If Len(Trim(Title)) = 0 Then
| Title = ""Внимание""
| End If
| Case 3
| IconFlag = NIIF_ERROR
| If Len(Trim(Title)) = 0 Then
| Title = ""Ошибка""
| End If
| Case 4
| IconFlag = NIIF_GUID
| If Len(Trim(Title)) = 0 Then
| Title = ""1С:Предприятие 7.7""
| End If
| Case Else
| IconFlag = NIIF_NONE
| Title = vbNullString
| End Select
| TrayIcon.Modify TextMessage, Title, IconFlag, Timeout
|End Sub
|
|Public Sub TrayIconDelete()
| If Not TrayIconInitialized Then
| Exit Sub
| End If
| TrayIcon.Delete
| Set TrayIcon = Nothing
| TrayIconInitialized = False
|End Sub
|
|";
MSScript = CreateObject("MSScriptControl.ScriptControl");
MSScript.Language="vbscript";
MSScript.AddCode(Code);
MSScript.Modules("Global").CodeObject.TrayIconInit(Дескриптор1С,"",0);
КонецПроцедуры //ДобавитьИконкуВТрей
//_____________________________________________________________________________
Процедура УдалитьИконкуИзТрея() Экспорт
Если MSScript = 0 Тогда Возврат; КонецЕсли;
MSScript.Modules("Global").CodeObject.TrayIconDelete();
MSScript = 0;
КонецПроцедуры //УдалитьИконкуИзТрея
//_____________________________________________________________________________
Процедура ПоказатьУведомление(Текст,Иконка = 1,Заголовок = "",Таймаут = 50) Экспорт
Если MSScript = 0 Тогда ДобавитьИконкуВТрей(); КонецЕсли;
MSScript.Modules("Global").CodeObject.TrayIconModify(Текст, Заголовок, Иконка, Таймаут);
КонецПроцедуры //ПоказатьУведомление
MSScript = 0;Юзайте на здоровье.
На Вашем форуме я новичок, поэтому скриншот приаттачить не удалось
Разобраться в Вашем коде мне сложновато, т.к. VBS знаю слабо. Подскажите, как его запустить, чтобы увидеть эти самые кракозябры. Почитаю пока про Shell_NotifyIcon, чтобы разобраться, как она работает.
]]>Public Const IMAGE_ICON = 1
Public Const NIIF_NONE = &H0
Public Const NIIF_WARNING = &H2
Public Const NIIF_ERROR = &H3
Public Const NIIF_INFO = &H1
Public Const NIIF_GUID = &H4
Public Const NIF_TIP = 4
Public Const NIF_MESSAGE = 1
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
Public Const NIM_ADD = 0
Public Const NIM_DELETE = 2
Public Const NIM_MODIFY = 1
Public Const NIF_ICON = 2
Public Const VK_ESCAPE = &H1B
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_SHELLNOTIFY = &H405
Public Const NID_SIZE = 488
Public DX
Public TrayIcon
Set DX = CreateObject("DynamicWrapperX")
DX.Register "SHELL32", "Shell_NotifyIcon", "i=ll", "r=l"
DX.Register "KERNEL32","LoadLibraryA","i=s","r=l"
DX.Register "USER32","LoadImageA","i=llllll","r=l"
DX.Register "KERNEL32","FreeLibrary","i=l"
DX.Register "KERNEL32","RtlMoveMemory","i=lll","r=l"
DX.Register "KERNEL32","HeapAlloc","i=lll","r=l"
DX.Register "KERNEL32","GetProcessHeap","r=l"
DX.Register "KERNEL32","HeapFree","i=lll","r=l"
Class NOTIFYICONDATA
Private hHeap,init
Private Sub Class_Initialize
hHeap = DX.GetProcessHeap()
init = DX.HeapAlloc(hHeap,0,NID_SIZE)
End Sub
Private Sub Class_Terminate
DX.HeapFree hHeap,0,init
End Sub
Public Property Get BaseAddr
BaseAddr = init
End Property
Public Property Get Size
Size = NID_SIZE
End Property
Private Function ConvertData(dwData)
hW = Fix(dwData/65536)
lW = dwData mod 65536
ConvertData = ChrW(lW) & ChrW(hW)
End Function
Public Sub SetData(strName,varData)
Dim iOfs, iSize, sData
Select Case strName
Case "cbSize"
iOfs = 0: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "hWnd"
iOfs = 4: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "uID"
iOfs = 8: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "uFlags"
iOfs = 12: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "uCallbackMessage"
iOfs = 16: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "hIcon"
iOfs = 20: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "szTip"
sData = Left(varData,127) & vbNullchar
iOfs = 24: iSize = 128
For i = 1 To iSize
DX.RtlMovememory init + iOfs - 1 + i, DX.StrPtr(Mid(sData,i,1)), 1
Next
Case "dwState"
iOfs = 152: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "dwStateMask"
iOfs = 156: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "szInfo"
sData = Left(varData,255) & vbNullchar
iOfs = 160: iSize = 256
For i = 1 To iSize
DX.RtlMovememory init + iOfs - 1 + i, DX.StrPtr(Mid(sData,i,1)), 1
Next
Case "uTimeout"
iOfs = 416: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
Case "szInfoTitle"
sData = Left(varData,63) & vbNullchar
iOfs = 420: iSize = 64
For i = 1 To iSize
DX.RtlMovememory init + iOfs - 1 + i, DX.StrPtr(Mid(sData,i,1)), 1
Next
Case "dwInfoFlags"
iOfs = 484: iSize = 4
sData = ConvertData(varData)
DX.RtlMovememory init + iOfs, DX.StrPtr(sData), iSize
End Select
End Sub
End Class
Class NotifyIcon
Private SysTray
Private SysTrayActivated
Private Sub Class_Initialize
Set SysTray = New NOTIFYICONDATA
End Sub
Private Sub Class_Terminate
Delete
Set SysTray = Nothing
End Sub
Public Function Init(hWnd,ToolTip,hIcon)
If SysTrayActivated Then
Exit Function
End If
With SysTray
.SetData "cbSize", .Size
.SetData "hWnd", hWnd
.SetData "uID", vbNull
.SetData "uFlags", NIF_ICON Or NIF_TIP
.SetData "uCallbackMessage", WM_MOUSEMOVE
.SetData "hIcon", hIcon
.SetData "szTip", ToolTip
.SetData "dwState", 0
.SetData "dwStateMask", 0
End With
DX.Shell_NotifyIcon NIM_ADD,SysTray.BaseAddr
SysTrayActivated = True
Init = SysTray.baseAddr
End Function
Public Sub Delete()
If Not SysTrayActivated Then
Exit Sub
End If
DX.Shell_NotifyIcon NIM_DELETE,SysTray.BaseAddr
Set SysTray = Nothing
SysTrayActivated = False
End Sub
Public Sub Modify(Text, Title, Icon, Timeout)
If Not SysTrayActivated Then
Exit Sub
End If
With SysTray
.SetData "uFlags", NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
.SetData "szInfo", Text
.SetData "szInfoTitle", Title
.SetData "dwInfoFlags", Icon
.SetData "uTimeout", Timeout
End With
DX.Shell_NotifyIcon NIM_MODIFY,SysTray.BaseAddr
End Sub
End ClassПодскажите кто-нибудь, как заставить скрипт работать на русском?
]]>