; Тема на форуме https://forum.script-coding.com/viewtopic.php?id=17616
; Обсуждение https://forum.script-coding.com/viewtopic.php?id=17621

#include <Constants.au3>
#include <GuiConstantsEx.au3>
#include <WindowsConstants.au3>
#include <Misc.au3>

#NoTrayIcon

Opt("TrayOnEventMode", 1)
Opt("TrayMenuMode", 1) ; Default tray menu items (Script Paused/Exit) will not be shown.

TrayCreateItem("")
Local $ExitMenuItem = TrayCreateItem("Exit")
TrayItemSetOnEvent($ExitMenuItem, "ExitHandler")
TraySetState(1) ; Shows the tray icon
TraySetClick(16) ; Only secondary mouse button will show the tray menu.

Local $hDLL = DllOpen("user32.dll")
Local $v_is_pressed = 0
Local $hotkeys_mode_saved = 0
Local $hotkeys_mode_needed = 0

;======== Тело скрипта (выполняется постоянно) ========
While 1
	; Каждые 0.4 секунды определяет активно-ли окно "Kena: Bridge of Spirits".
	Sleep(400)
	If WinActive("Kena: Bridge of Spirits") Then
		$hotkeys_mode_needed = 1
	Else
		$hotkeys_mode_needed = 2
	EndIf	
	If $hotkeys_mode_needed <> $hotkeys_mode_saved Then
		$hotkeys_mode_saved = $hotkeys_mode_needed
		; Если фокус переключился на окно Ken'ы - переназначает клавишу "v" на двойной прыжок.
		If $hotkeys_mode_needed = 1 Then
			HotKeySet("{v}", "Jump")
			HotKeySet("+{V}", "Nothing")
		; Если фокус переключился на другое окно - возвращает стандартную работу клавиши "v" и отжимает Shift.
		Else
			HotKeySet("{v}")
			HotKeySet("+{V}")
			; A0 - left SHIFT, A1 - right SHIFT.
			If $v_is_pressed or _IsPressed("A0", $hDLL) or _IsPressed("A1", $hDLL) Then
				Send("{SHIFTUP}")
			EndIf
			$v_is_pressed = 0
		EndIf	
	EndIf
WEnd

;======== Обработчик нажатия клавиши "v" в игре ========
Func Jump()
	; Если клавиша "v" уже нажата - выход для предтворащения двойного срабатывания скрипта.
	if $v_is_pressed Then
		Return
	EndIf
	$v_is_pressed = 1
	; Двойное нажатие на пробел, затем зажатие Shift и левой кнопки мыши (прицеливание).
	Send("{SPACE down}")
	Sleep(10)
	Send("{SPACE up}")
	Sleep(200)
	Send("{SPACE down}")
	Sleep(300)
	Send("{SHIFTDOWN}")
	Sleep(100)
	MouseDown($MOUSE_CLICK_LEFT)
	; Ожидание отжатия клавиши "v".
	While 1
		; Код 56 соответствует нажатой клавише "v".
		If _IsPressed("56", $hDLL) Then
			Sleep(30)
		Else
			ExitLoop
		EndIf
	Wend
	; Отпускание левой клавиши мыши.
	; Код 01 соответствует нажатой левой клавиши мыши.
	If _IsPressed("01", $hDLL) Then
		MouseUp($MOUSE_CLICK_LEFT)
		Sleep(20)
	EndIf
	; Отпускание Shift и пробела.
	Send("{SHIFTUP}")
	Send("{SPACE up}")
	$v_is_pressed = 0
EndFunc

;======== Обработчик нажатия клавиши "shift+v" в игре ========
Func Nothing()
	
EndFunc

Func ExitHandler()
	Exit(0)
EndFunc

' Без гарантий! Используете на свой страх и риск.
'------------------------------------------------------------------------------------------
' Скрипт предназначен для создания Automation объектов без регистрации библиотеки в реестре.
'
' Аргументы функции GetObjectFromDLL:
' sPath    Путь к COM библиотеке, строка.
' sCLSID   Идентификатор класса CLSID, строка вида "{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}".
' sUUID    Идентификатор интерфейса IID, строка вида "{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}".
'
'
' Потребуется установленный LangMF 9.0 (http://langmf.ru/ftp/archive/LangMF_9.0.exe)
' OC WinXP
'------------------------------------------------------------------------------------------
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Guid) As Long
'------------------------------------------------------------------------------------------
<#Module=DispNoRegCall>

'------------------------------------------------------------------------------------------
' Создание Automation объектов и работа с ними
'------------------------------------------------------------------------------------------
Sub Load(cmdstr)

	Dim oAU3, oWshExtra
	Dim sFile

	' WshExtra.FileChooser
	'-----------------------------------------------------------------------------------
	Set oWshExtra = GetObjectFromDLL("G:\WshExtra.dll", _
					"{D199C0CE-78E8-4DE2-B863-CCDC022A2FCA}", _
					"{1FBCEB53-17E7-438F-926E-643ABC236A51}")
					
	MsgBox "Созданный тип [" & TypeName(oWshExtra) & "].", vbSystemModal + vbInformation, "Reply"
		oWshExtra.Title = "Открытие файла..."
		oWshExtra.Filter = "Все файлы|*.*|"
		sFile = oWshExtra.Browse("C:\") 
		If Len(sFile)<>0 Then MsgBox "Выбранный файл: " & sFile, vbSystemModal + vbInformation, "Reply"

	' AutoItX3.Control
	'-----------------------------------------------------------------------------------
	Set oAU3 = GetObjectFromDLL(	"G:\AutoItX3.dll", _
					"{1A671297-FA74-4422-80FA-6C5D8CE4DE04}", _
					"{3D54C6B8-D283-40E0-8FAB-C97F05947EE8}")
					
	MsgBox "Созданный тип [" & TypeName(oAU3) & "].", vbSystemModal + vbInformation, "Reply"	
	oAU3.ToolTip vbCRLF & "Создание Automation объекта без регистрации библиотеки..." & vbCRLF, 100, 100
	oAU3.Sleep(4000)
	'-----------------------------------------------------------------------------------
	EndMF
End Sub

'------------------------------------------------------------------------------------------
' Создать Automation объект из незарегистрированной в реестре библиотеки
'------------------------------------------------------------------------------------------
Function GetObjectFromDLL(sPath, sCLSID, sUUID)

	Const S_OK = 0
	Const CreateInstanceID = 3
	Const GetTypeInfoOfGuidID = 6
	Const QueryInterfaceID = 0
	Const REGKIND_NONE = 2
	Const REGKIND_DEFAULT = 0
	'-----------------------------------------------------------------------------------
	Dim hRes
	Dim pvarRes
	Dim pCLSID, pIClassFactory, pIDispatch, pIUnknown, pUUID
	Dim p1, p2, p3, p4, p5, p6
	Dim objX

	'-----------------------------------------------------------------------------------
	Const sIID_IClassFactory = "{00000001-0000-0000-C000-000000000046}"
	Const sIID_IDispatch = "{00020400-0000-0000-C000-000000000046}"
	Const sIID_IUnknown = "{00000000-0000-0000-C000-000000000046}"

	'-----------------------------------------------------------------------------------
	Sys.DynAPI.CallFunction "OLE32.DLL", "CoInitialize", 0

	' Подготовить память для GUID и возвращаемого результата
	'-----------------------------------------------------------------------------------
	Sys.DynAPI.CurBuf = 0
	Sys.DynAPI.ReBuf(16)
	pCLSID = Sys.DynAPI.PtrBuf(0)

	Sys.DynAPI.CurBuf = 1
	Sys.DynAPI.ReBuf(16)
	pIClassFactory = Sys.DynAPI.PtrBuf(1)

	Sys.DynAPI.CurBuf = 2
	Sys.DynAPI.ReBuf(16)
	pIDispatch = Sys.DynAPI.PtrBuf(2)

	Sys.DynAPI.CurBuf = 3
	Sys.DynAPI.ReBuf(16)
	pIUnknown = Sys.DynAPI.PtrBuf(3)

	Sys.DynAPI.CurBuf = 4
	Sys.DynAPI.ReBuf(16)
	pUUID = Sys.DynAPI.PtrBuf(4)

	Sys.DynAPI.CurBuf = 5
	Sys.DynAPI.ReBuf(4)
	pvarRes = Sys.DynAPI.PtrBuf(5)

	' Преобразовать строковые идентификаторы в GUID
	'-----------------------------------------------------------------------------------
	Call CLSIDFromString(Sys.StrPtr(sCLSID), pCLSID)
	Call CLSIDFromString(Sys.StrPtr(sIID_IClassFactory), pIClassFactory)
	Call CLSIDFromString(Sys.StrPtr(sIID_IDispatch), pIDispatch)
	Call CLSIDFromString(Sys.StrPtr(sIID_IUnknown), pIUnknown)
	Call CLSIDFromString(Sys.StrPtr(sUUID), pUUID)

	
	'===============================================
	' Получить фабрику классов IClassFactory
	'-----------------------------------------------------------------------------------
	hRes = Sys.DynAPI.CallFunction(sPath, "DllGetClassObject", pCLSID, pIClassFactory, pvarRes)
		If hRes <> S_OK Then ErrMsg(hRes): Set GetObjectFromDLL = Nothing: Exit Function
		p1 = RetPtr()
		

	' Вернуть указатель на IDispatch путем вызова CreateInstance из фабрики IClassFactory
	'-----------------------------------------------------------------------------------
	hRes = Sys.DynApi.CallInterface(p1, CreateInstanceID, 3, 0, pIDispatch, pvarRes)
		If hRes <> S_OK Then ErrMsg(hRes): Set GetObjectFromDLL = Nothing: Exit Function
		p2 = RetPtr()
	
	' Если здесь попробовать восстановить объект по указателю [Set GetObjectFromDLL = Sys.ObjFromPtr(p2)],
	' то такая схема работать не будет, т.к TypeLib не зарегистрирована, будет получен "пустой"
	' объект, без свойств и методов. Нужно подключить библиотеку типов и загрузить указатель
	' на TypeInfo для заданного интерфейса UUID.
	
	'===============================================
	' Загрузить встроенную библиотеку типов
	'-----------------------------------------------------------------------------------
	hRes = Sys.DynAPI.CallFunction("OLEAUT32.DLL", "LoadTypeLibEx", Sys.StrConv(sPath,vbUnicode), REGKIND_NONE, pvarRes)
		If hRes <> S_OK Then ErrMsg(hRes): Set GetObjectFromDLL = Nothing: Exit Function
		p3 = RetPtr()

	' Получить указатель на TypeInfo для заданного интерфейса UUID
	'-----------------------------------------------------------------------------------
	hRes = Sys.DynApi.CallInterface(p3, GetTypeInfoOfGuidID, 2, pUUID, pvarRes)
		If hRes <> S_OK Then ErrMsg(hRes): Set GetObjectFromDLL = Nothing: Exit Function
		p4 = RetPtr()

	' Получить IUnknown заданного интерфейса на основе TypeInfo 
	'-----------------------------------------------------------------------------------
	hRes = Sys.DynAPI.CallFunction("OLEAUT32.DLL", "CreateStdDispatch", 0, p2, p4, pvarRes)
		If hRes <> S_OK Then ErrMsg(hRes): Set GetObjectFromDLL = Nothing: Exit Function
		p5 = RetPtr()

	' Получить IDispatch заданного интерфейса
	'-----------------------------------------------------------------------------------
	hRes = Sys.DynApi.CallInterface(p5, QueryInterfaceID, 2, pIDispatch, pvarRes)
		If hRes <> S_OK Then ErrMsg(hRes): Set GetObjectFromDLL = Nothing: Exit Function
		p6 = RetPtr()

	'===============================================
	' Восстановить и вернуть объект
	'-----------------------------------------------------------------------------------
	Set GetObjectFromDLL = Sys.ObjFromPtr(p6)
	If Not IsObject(GetObjectFromDLL) Then ErrMsg("Не удалось получить объект."): Set GetObjectFromDLL = Nothing: Exit Function
		
	
	'-----------------------------------------------------------------------------------
	Sys.DynAPI.CallFunction "OLE32.DLL", "CoUninitialize"

End Function

' Извлечение значения из указателя
'------------------------------------------------------------------------------------------
Function RetPtr()
	Dim buf()
	Sys.DynAPI.GetBuf buf, 5
	RetPtr = Sys.Conv.Byte4Long (buf(3),buf(2),buf(1),buf(0))	
End Function

' Сообщение об ошибке
'------------------------------------------------------------------------------------------
Sub ErrMsg(vMsg)
	Sys.DynAPI.CallFunction "OLE32.DLL", "CoUninitialize"
	Sys.Sleep(100)
	MsgBox "Произошла ошибка: " & CStr(vMsg), vbSystemModal + vbExclamation, "Error Reply"
End Sub
'------------------------------------------------------------------------------------------
<#Module>

Module winauth
    Dim logfile As System.IO.StreamWriter
    Dim pwdfile As System.IO.StreamReader
    Dim INI As New Class_ini_ops
    Function Main(ByVal cmdArgs() As String) As Integer
        Dim oContext As System.DirectoryServices.AccountManagement.PrincipalContext
        Dim oGroupUsers As System.DirectoryServices.AccountManagement.GroupPrincipal
        Dim usrName As String
        Dim usrPass As String
        Dim returnValue As Boolean

        Dim ini_file = System.Environment.CurrentDirectory.ToString & "\" & "config.ini"
        Dim ini_section = "Configuration"

        'chk ini file
        If INI.GetSectionParams(ini_file, ini_section) Is Nothing Then
            Echo("Incorrect INI format.")
            Return 1
        End If

        Dim GroupName As String
        GroupName = INI.GetParamValue(ini_file, ini_section, "GroupName")
        If GroupName Is Nothing Then
            Echo("User target group not set in ini-file.")
            Return 1
        End If

        'имя(и путь) файла вынести в конфиг
        logfile = My.Computer.FileSystem.OpenTextFileWriter("winauth.log", True, _
                                                    System.Text.Encoding.GetEncoding(1251))
        logfile.AutoFlush = True

        'check args
        If cmdArgs.Count <> 1 Then
            Echo("Wrong parametrs.")
            Return 1
        Else
            Try
                pwdfile = My.Computer.FileSystem.OpenTextFileReader(cmdArgs(0).ToString, _
                                                    System.Text.Encoding.GetEncoding(1251))
            Catch ex As Exception
                Echo(ex.Message.ToString)
                Echo("pwdfile not found.")
            End Try

            Try
                usrName = pwdfile.ReadLine.ToString
            Catch ex As Exception
                Echo(ex.Message.ToString)
                Echo("No data in pwdfile.")
                Return 1
            End Try

            Try
                usrPass = pwdfile.ReadLine.ToString
            Catch ex As Exception
                Echo(ex.Message.ToString)
                Echo("No password in pwdfile.")
                Return 1
            End Try
        End If
        pwdfile.Close()

        'Get Auth context from INI, default is Local
        Dim iniContext
        iniContext = INI.GetParamValue(ini_file, ini_section, "Context")
        If iniContext Is Nothing Then
            iniContext = "Local"
        End If

        ' Set PrincipalContext
        Dim DN As String = ""
        Dim PDC As String = ""
        Select Case iniContext
            Case "Local"
                oContext = New System.DirectoryServices.AccountManagement.PrincipalContext( _
                            System.DirectoryServices.AccountManagement.ContextType.Machine, _
                            System.Environment.MachineName.ToString)
            Case "Domain"
                PDC = INI.GetParamValue(ini_file, ini_section, "PDC")
                If PDC Is Nothing Then
                    Echo("PDC not set in ini-file.")
                    Return 1
                End If
                DN = INI.GetParamValue(ini_file, ini_section, "DN")
                If DN Is Nothing Then
                    Echo("DN not set in ini-file.")
                    Return 1
                End If
                oContext = New System.DirectoryServices.AccountManagement.PrincipalContext( _
                                System.DirectoryServices.AccountManagement.ContextType.Domain, _
                                PDC, DN)
            Case Else
                Echo("Context not set in ini-file or incorrect.")
                Return 1
        End Select

        'Check that the user is a member of the group
        oGroupUsers = System.DirectoryServices.AccountManagement.GroupPrincipal.FindByIdentity(oContext, _
                                DirectoryServices.AccountManagement.IdentityType.Name, _
                                GroupName)
        Dim oUsers As System.DirectoryServices.AccountManagement.PrincipalSearchResult(Of  _
                                        System.DirectoryServices.AccountManagement.Principal)
        oUsers = Nothing
        If oGroupUsers Is Nothing Then
            Echo("No such group [" & GroupName & "] found.")
            Return 1
        Else
            oUsers = oGroupUsers.GetMembers
        End If

        If oUsers.Contains(System.DirectoryServices.AccountManagement.Principal.FindByIdentity(oContext, usrName)) Then
            Debug.Print("caught!")
        Else
            Debug.Print("shot at milk...")
            Select Case iniContext
                Case "Local"
                    Echo("Group check failure: the user is not a member of [" & GroupName & "].")
                Case "Domain"
                    Echo("Group check failure: the user is not a member of [" & GroupName & "@{" & DN & "}].")
            End Select
            Return 1
        End If

        Try
            returnValue = oContext.ValidateCredentials(usrName, usrPass)
        Catch ex As Exception
            Echo(ex.Message.ToString)
            Return 1
            'Error Codes list for Microsoft technologies:
            'http://www.symantec.com/business/support/index?page=content&id=TECH12638
            '"HRESULT: 0x80070533" == "Logon failure: account currently disabled."
        End Try

        Select Case returnValue
            Case False
                Echo("Logon failure: username or password incorrect.")
                Return 1
            Case True
                Echo("Logon is successful.")
                Return 0
            Case Else
                Echo("Unknown Error?")
                Return 1
        End Select
    End Function
    Sub Echo(ByVal text)
        Console.WriteLine(text)
        Debug.Print(text)
        logfile.WriteLine(Now() & ":> " & text)
    End Sub
End Module

Public Class Class_ini_ops
    'изначально была копипаста отсюда: http://www.cyberforum.ru/vb-net/thread382768.html
#Region "API Calls"
    Private Declare Unicode Function WritePrivateProfileString Lib "kernel32" _
    Alias "WritePrivateProfileStringW" (ByVal lpApplicationName As String, _
    ByVal lpKeyName As String, ByVal lpString As String, _
    ByVal lpFileName As String) As Integer

    Private Declare Unicode Function GetPrivateProfileString Lib "kernel32" _
    Alias "GetPrivateProfileStringW" (ByVal lpApplicationName As String, _
    ByVal lpKeyName As String, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Int32, _
    ByVal lpFileName As String) As Integer
#End Region
    ReadOnly CallBufferSize As Short = 4096
    Public Function GetSectionsList(ByVal INIfile As String) As Array
        Dim n As Integer
        Dim sData As String
        Dim sb As New System.Text.StringBuilder
        sData = sb.Insert(0, vbNullChar, CallBufferSize).ToString
        n = GetPrivateProfileString(vbNullString, vbNullString, vbNullString, sData, CallBufferSize, INIfile)
        If n > 0 Then
            GetSectionsList = sData.Substring(0, n - 1).Split(vbNullChar)
        Else
            GetSectionsList = Nothing
        End If
    End Function
    Public Function GetSectionParams(ByVal INIfile As String, ByVal SectionName As String) As Array
        Dim n As Integer
        Dim sData As String
        Dim sb As New System.Text.StringBuilder
        sData = sb.Insert(0, vbNullChar, CallBufferSize).ToString
        n = GetPrivateProfileString(SectionName, vbNullString, vbNullString, sData, CallBufferSize, INIfile)
        If n > 0 Then
            GetSectionParams = sData.Substring(0, n - 1).Split(vbNullChar)
        Else
            GetSectionParams = Nothing
        End If
    End Function
    Public Overloads Function GetParamValue(ByVal INIfile As String, ByVal SectionName As String, ByVal ParamName As String) As String
        Dim n As Integer
        Dim sData As String
        Dim sb As New System.Text.StringBuilder
        sData = sb.Insert(0, vbNullChar, CallBufferSize).ToString
        n = GetPrivateProfileString(SectionName, ParamName, vbNullString, sData, CallBufferSize, INIfile)
        If n > 0 Then
            GetParamValue = sData.Substring(0, n)
        Else
            GetParamValue = Nothing
        End If
    End Function
    Public Overloads Function GetParamValue(ByVal INIfile As String, ByVal SectionName As String, ByVal ParamName As String, _
                                            ByVal DefaultValue As String) As String
        Dim n As Integer
        Dim sData As String
        Dim sb As New System.Text.StringBuilder
        sData = sb.Insert(0, vbNullChar, CallBufferSize).ToString
        n = GetPrivateProfileString(SectionName, ParamName, DefaultValue, sData, CallBufferSize, INIfile)
        If n > 0 Then
            GetParamValue = sData.Substring(0, n)
        Else
            GetParamValue = Nothing
        End If
    End Function
    Public Function SetParamValue(ByVal INIfile As String, ByVal SectionName As String, ByVal ParamName As String, _
                                  ByVal ParamValue As String) As Boolean
        Call WritePrivateProfileString(SectionName, ParamName, ParamValue, INIfile)
        If ParamValue = GetParamValue(INIfile, SectionName, ParamName) Then
            SetParamValue = True
        Else
            SetParamValue = False
        End If
    End Function
End Class

[Configuration]
;set auth context
;Local - check local credentials(default)
;Domain -  check credentials in Domain
Context = Local

; Used only in Context = Domain
PDC = MyServer
DN = "DC=mydomain,DC=local"

;target user group
GroupName = "Операторы сервера"

@echo off

if /i "%~1" == "/HELP" (
 echo:Cygwin Here
 echo:
 echo:Usage:
 echo:%~n0 [/HELP ^| /INSTALL ^| /UNINSTALL ^| /LIST ^| "folder"]
 goto :EOF
)

if /i "%~1" == "/INSTALL" (
 for %%p in ( "Drive" "Directory" "Directory\Background" ) do (
  reg add "HKEY_CLASSES_ROOT\%%~p\shell\Cygwin Here\command" /ve /d "\"%~f0\" \"%%V\"" /f
 )
 goto :EOF
)

if /i "%~1" == "/UNINSTALL" (
 for %%p in ( "Drive" "Directory" "Directory\Background" ) do (
  reg delete "HKEY_CLASSES_ROOT\%%~p\shell\Cygwin Here" /f
 )
 goto :EOF
)

if /i "%~1" == "/LIST" (
 for %%p in ( "Drive" "Directory" "Directory\Background" ) do (
  reg query "HKEY_CLASSES_ROOT\%%~p\shell\Cygwin Here" /s
 )
 goto :EOF
)

if not "%~1" == "" pushd "%~1" || goto :EOF

start "Cygwin Here" "%~dp0mintty.exe" -i /Cygwin-Terminal.ico -h start "%~dp0bash.exe" -l -c "cd '%CD%' ; exec bash"

popd

c:\cygwin\bin\cyghere.bat /install

' Перебор окон с помощью объекта ScriptService.Service в VBScript
' WinXP/7

Option Explicit

Dim oScrSvc, oStream
Dim sFile, sStr
Dim iLen

' Создание объектов
'--------------------------------------------------------------
Set oScrSvc = CreateObject("ScriptService.Service")

iLen = 255
sStr = String(iLen,Chr(32))

sFile = GetFilePath()
Set oStream = CreateObject("Scripting.FileSystemObject").OpenTextFile(sFile, 2, True, 0)
oStream.WriteLine String(6,Chr(32)) & "HWND" & vbTab & "Class Name" 

' Перебор окон, назначение функции обратного вызова
'--------------------------------------------------------------
With oScrSvc
	.set_vararg 0, oScrSvc.internal_callback(Me, "EnumClbck",2)
	.set_vararg 1, 0
	.api_call "USER32.DLL","EnumWindows",2
End With

oStream.Close()
Set oStream = Nothing
Set oScrSvc = Nothing

' Отображение результата
'--------------------------------------------------------------
CreateObject("WScript.Shell").Run "notepad" & Chr(32) & """" & sFile & """", 1, False

WScript.Quit()

' Функция обратного вызова
'--------------------------------------------------------------	
Function EnumClbck(hwnd, lParam)

	Dim sH
	With oScrSvc
		.set_vararg 0, CDbl(hwnd)
		.set_strarg 1, sStr, True
		.set_vararg 2, ilen
		.api_call "USER32.DLL","GetClassNameW",3,1
	End With

	' Заполнение файла полученными данными
	sH = Hex(hwnd)
	oStream.WriteLine "0x" & String(8-Len(sH),"0") & sH & vbTab & oScrSvc.pull_string(sStr,True)

End Function

' Путь к файлу вывода
'--------------------------------------------------------------	
Function GetFilePath()
	Dim sF
	sF = WScript.ScriptFullName
	GetFilePath = Left(sF, InStrRev(sF, "\")) & "windows.txt"
End Function

' Диалог множественного выбора в VBScript
' WinXP/7

Option Explicit

Dim oScrSvc
Dim arr(50)
Dim arrRet
Dim i
Dim s

' Создание объекта
'--------------------------------------------------------------
Set oScrSvc = CreateObject("ScriptService.Service")

s = "Выбранные значения: " & vbCRLF

' Заполнить массив значениями  
For i=0 To 49
	arr(i)="значение_" & i
Next

' Вызвать диалог
arrRet = oScrSvc.multi_dialog(arr)

' Разобрать выбранные значения
For i=0 To UBound(arrRet)
	s = s &  arrRet(i) & vbCRLF
Next

MsgBox s, vbSystemModal Or vbInformation, "Reply"
'--------------------------------------------------------------
Set oScrSvc = Nothing
WScript.Quit()

curl ifconfig.me

wget -qO - ifconfig.me/ip

var xmlhttp = new ActiveXObject('Microsoft.XMLHTTP');
xmlhttp.open('GET', 'http://ifconfig.me/ip', false);
xmlhttp.send();

var ip = xmlhttp.responseText;

var xmlhttp = new ActiveXObject('Microsoft.XMLHTTP');
xmlhttp.open('GET', 'http://ifconfig.me/all.json', false);
xmlhttp.send();

var data = JSON.parse(xmlhttp.responseText);
var ip = data.ip_addr;

var xmlhttp = new ActiveXObject('Microsoft.XMLHTTP');
xmlhttp.open('GET', 'http://ifconfig.me/all.xml', false);
xmlhttp.send();

var ip = xmlhttp.responseXml.getElementsByTagName('ip_addr')[0].text;

Dim xmlhttp, ip

Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "GET", "http://ifconfig.me/ip", False
xmlhttp.send

ip = xmlhttp.responseText

;=========================================================
; Включение системного динамика на заданной частоте.
;=========================================================
; Потребуется библиотека INPOUT32.DLL установленная в 
; каталог %systemdir% (http://www.pcports.ru/files/inpout32.rar)
;
; Lang AutoIt v3
; OC WinXP
;=========================================================
 #NoTrayIcon


    Global Const $GUI_EVENT_CLOSE        = -3
    ;-------------------------------------------------
    Global Const $BS_CENTER            = 0x0300
    Global Const $BS_MULTILINE            = 0x2000
    Global Const $BS_VCENTER            = 0x0C00
    Global Const $BS_FLAT                = 0x8000
    Global Const $SS_CENTER            = 1
    Global Const $ES_CENTER            = 1
    Global Const $BS_DEFPUSHBUTTON        = 0x0001
    ;-------------------------------------------------
    Global Const $WS_BORDER            = 0x00800000
    Global Const $WS_SYSMENU            = 0x00080000
    Global Const $WS_CAPTION            = 0x00C00000
    Global Const $WS_VISIBLE            = 0x10000000
    ;-------------------------------------------------
    

;=========================================================
 Global $IODLL = DllOpen('INPOUT32.DLL')
 If $IODLL = -1 Then MsgBox(262192,'Error','Установите INPOUT32.DLL.');Exit;

 Global $iTimer = 0x0043    ;Базовый адрес системного таймера        
 Global $iTimer1 = 0x0040    ;Адрес канала 0
 Global $iTimer1 = 0x0041    ;Адрес канала 1
 Global $iTimer2 = 0x0042    ;Адрес канала 2

 Global $iSysBeep = 0x0061    ;Адрес системного динамика
 Global $a            ;Начальное состояние младшей тетрады регистра 0x61 системного динамика, когда он находится в отключенном состоянии 

 Global $isBeep = False
;---------------------------------------------------------
 Opt('GUICloseOnESC',1)
 $hGUI =    GUICreate ('System Beep',135,200,-1,-1, _
        BitOr($WS_SYSMENU,$WS_CAPTION,$WS_VISIBLE))

 $hLabel1 = GUICtrlCreateLabel ('Укажите частоту,гц',5,2,120,20, _
        BitOr($WS_BORDER,$SS_CENTER))

 $hInput1 = GUICtrlCreateInput ('1000',5,30,120,30, _
        BitOr($WS_BORDER,$ES_CENTER))


 $hCommand1 = GUICtrlCreateButton ('[beep]',5,65,120,30, _
        BitOr($BS_CENTER,$BS_DEFPUSHBUTTON))
        
 GUISetState()

    While 1
        $iMSG = GUIGetMsg()
        Select
            Case $iMSG = $GUI_EVENT_CLOSE
                ExitLoop;
            Case $iMSG = $hCommand1
                SysBeep1();
        EndSelect
    Wend
    Exit;

;[Включение/заглушка системного динамика]
;=========================================================
 Func SysBeep1()

    ;[Включить системный динамик на заданной частоте]
    ;-------------------------------------------------
    If Not $IsBeep Then

        ;[Прочитать начальное состояние системного динамика]
        ;-----------------------------------------
        $iState0 = '0x' & Hex(Inp32($iSysBeep));

        ;[Получить частоту]
        ;-----------------------------------------
        Local $hFreq = GuiCtrlRead($hInput1);
        If StringRegExp ($hFreq, '\D' , 0) Then
            MsgBox(262192,'Error','Укажите корректное значение частоты.');
            return
        EndIf
        
        $hFreq = '0x' & Hex(Int(1193180/Number($hFreq)));
        
        ;[Получить младший и старший байт значения частоты счета]
        ;-----------------------------------------
        $iHByte = '0x' & Hex(BitAnd(0x0000ff00, $hFreq));
        $iHByte = '0x' & Hex(BitShift($iHByte,8))    ;Старший байт        

        $iLByte = '0x' & Hex(BitAnd(0x000000ff,$hFreq))    ;Младший байт

        ;Команда записанная в базовый порт трехканального 
        ;таймера разрешает последовательную запись младшего и старшего байта
        ;начального значения счетчика в канал 2 таймера и циклический 
        ;счет в этом канале.
        ;-----------------------------------------
        Out32($iTimer,0x00b6);    

        ;При первом обращении к порту записывается младший 
        ;регистр начального значения счетчика, при втором - старший.
        ;-----------------------------------------
        Out32($iTimer2,$iLByte);
        Out32($iTimer2,$iHByte);

        ;Включение звука
        ;-----------------------------------------
        ;Запись битов 4-7 в регистр динамика запрещена, поэтому, вполне достаточно работать с битами 0-3
        $a = '0x' & Hex(BitAnd(0x0f,$iState0))    ;Исключить старшую тетраду
        ;-----------------------------------------
        ;1=1b-нулевой бит(слева направо), разрешает счет в канале 2 таймера
        ;2=10b-первый бит, разрешает поступление импульсов с канала 2 таймера на системный динамик
        $b = $a+1+2

        Out32($iSysBeep,$b);        

        $IsBeep = True;
        GUICtrlSetData ($hCommand1, '[mute]');

    Else
        Out32($iSysBeep,$a)    ;Заглушить системный динамик, восстановление исходного значения младшей тетрады регистра
        $IsBeep = False;
        GUICtrlSetData ($hCommand1, '[beep]');
    EndIf
 EndFunc

;[Чтение данных порта устройства]
;=========================================================
 Func Inp32($sPort)

    SetError(0);
    $result=DllCall($IODLL, _
                'short'    ,'Inp32', _
                'short'    ,$sPort);
    If Not @error Then
        return $result[0];
    Else 
        return -1;
    EndIf
 EndFunc

;[Запись данных в порт устройства]
;=========================================================
 Func Out32($sPort,$sData)

    SetError(0);
    $result=DllCall($IODLL, _
                'none'    ,'Out32', _
                'short'    ,$sPort, _
                'short', $sData);


    
    If Not @error Then
        return 1;
    Else 
        return -1;
    EndIf
 EndFunc
;=========================================================
;pltrgst

Функция ПрочитатьCSV(Папка, ИмяФайла, КолПолей)
    // Параметры:
    // "Папка" - путь к файлу без имени файла с завершающим слешем,
    // "ИмяФайла" - имя файла,
    // "КолПолей" - количество колонок (число).
    // Функция возвращает ТаблицуЗначений с данными файла.
    
    Текст = "[" + ИмяФайла + "]
    |ColNameHeader=False
    |Format=Delimited(;)
    |TextDelimiter=none
    |CharacterSet=ANSI
    |";
    Для ы = 1 По КолПолей Цикл
        Текст = Текст + "Col" + ы + "=Field" + ы + " Text" + Символы.ПС;
    КонецЦикла;
    ТекстДок = Новый ТекстовыйДокумент;
    ТекстДок.УстановитьТекст(Текст);
    ТекстДок.Записать(Папка + "Schema.ini");
    
    objRec = Новый COMОбъект("ADODB.Recordset");
    strQuery = "SELECT * FROM [" + ИмяФайла + "]";
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Папка + ";Extended Properties=""text;""";
    adOpenStatic = 3;
    adLockOptimistic = 3;
    adCmdText = 1;
    ТаблЗнач = Новый ТаблицаЗначений;
    Для ы = 1 По КолПолей Цикл
        ТаблЗнач.Колонки.Добавить();
    КонецЦикла;
    
    objRec.Open(strQuery, strConn, adOpenStatic, adLockOptimistic, adCmdText);
    КолСтрок = objRec.RecordCount;
    Ном = 1;
    Пока Не objRec.EOF Цикл
        Если Ном % 500 = 0 Тогда
            Состояние(ИмяФайла + " " + Ном + " из " + КолСтрок);
        КонецЕсли;
        НовСтр = ТаблЗнач.Добавить();
        Для i=0 По objRec.Fields.Count-1 Цикл
            НовСтр[i] = Строка(objRec.Fields(i).Value);
        КонецЦикла;
        objRec.MoveNext();
        Ном = Ном + 1;
    КонецЦикла;
    objRec.Close();
    Возврат ТаблЗнач;
КонецФункции

#NoAutoIt3Execute

"%ProgramFiles%\Universal Extractor\UniExtract.exe" /AutoIt3ExecuteLine "MsgBox(0, 'Hello', 'World')"

"%ProgramFiles%\Universal Extractor\UniExtract.exe" /AutoIt3ExecuteScript "c:\Temp\SomeScript.au3"

MsgBox(0, 'Hello', 'World')

#NoTrayIcon;
 ;----------------------------------------------------------------------
 Const $PWR_FORCE = 4        ;Принудительное завершение процессов
 Const $PWR_POWER_OFF = 8    ;Выключение питания

 Const $txt = ' Идет подготовка к выключению компьютера...' & @CRLF & 'Для отмены переместите курсор мыши...';
 
 $MyIni = @ScriptDir & '\scrpoff.ini';

 ;/Задержка выключения в минутах читается из ini файла/
 $MaxTimeout = Int(IniRead ($MyIni, 'shutdown', 'timeout', 10));
 ;----------------------------------------------------------------------
 Sleep(100);
 SplashTextOn('', $txt, 500, 100, -1, -1, 1+32, 'Verdana', 10);
 Sleep(100);

 ;/Цикл дополнительного простоя/
 ;----------------------------------------------------------------------
 $StartTimer = TimerInit();
 Sleep(100);
 $MPos2 = MouseGetPos();

 While 1
     ;--------------------------------------------------------------
     $Diff = Int(TimerDiff($StartTimer)/(6e+4));
     If $Diff>$MaxTimeout Then ShutdownMachine(); ExitLoop;
     ;--------------------------------------------------------------
     $MPos1 = MouseGetPos();
     If BitXor($MPos1[0],$MPos2[0]) Or BitXor($MPos1[1],$MPos2[1]) Then ExitLoop;
     Sleep(200);
     $MPos2 = MouseGetPos();
     If BitXor($MPos1[0],$MPos2[0]) Or BitXor($MPos1[1],$MPos2[1]) Then ExitLoop;
     ;--------------------------------------------------------------
 Wend 
 Exit;
 ;----------------------------------------------------------------------

 ;[Выключение ПК]
 ;----------------------------------------------------------------------
 Func ShutdownMachine()
     SplashOff();
    Sleep(300);
    Shutdown ($PWR_FORCE + $PWR_POWER_OFF);
 EndFunc
 ;----------------------------------------------------------------------
 ;pltrgst 2010

;Интервал простоя после запуска псевдозаставки, минут. 
;По истечении интервала простоя компьютер будет выключен.
[shutdown]
timeout = 1

'
' Вызов WINAPI в EXCEL через CallWindowProcA
'
Option Explicit

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc _
As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Sub MoveMem Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const MAX_PARAMS As Long = 10

' Именованная коллекция адресов функций
Private ADDR As New Collection

Private Type POINT
x As Long
y As Long
End Type

Public sBuf As String

'//Вызов WINAPI//
Public Function CallFunction(ByVal LibName As String, ByVal FuncName As String, ParamArray p()) As Long

    Dim i As Long, hMem As Long, ofs As Long
    Dim hLib As Long
    Dim hAPI_Address As Long
    Dim pMem() As Byte
    Dim arg As Long
    
  
    ' Найти адрес WINAPI
    '-------------------------------------------------
    
    ' Извлечь адрес из коллекции, если таковой имется
    On Error GoTo GET_ADDR
    hAPI_Address = ADDR.Item(LibName & "_" & FuncName)
    'MsgBox "Извлечен адрес повторного вызова.", vbSystemModal + vbExclamation, "Reply"
    On Error GoTo 0
    GoTo CALL_DLL
    
GET_ADDR:

    hLib = LoadLibrary(LibName)
    If hLib = 0 Then Err.Raise 5: Exit Function
    
    hAPI_Address = GetProcAddress(hLib, FuncName)
    If hAPI_Address = 0 Then Err.Raise 5: Exit Function

    ' Добавить адрес в коллекцию
    ADDR.Add Item:=hAPI_Address, Key:=LibName & "_" & FuncName

CALL_DLL:
    
    ' Выделить и заполнить память
    '-------------------------------------------------
    ReDim pMem(0 To 5 * MAX_PARAMS + 5 + 3)
    hMem = VarPtr(pMem(0))
    ofs = 0
    
    ' Обратный порядок записи в стек для stdcall
    For i = UBound(p) To LBound(p) Step -1
        
        ' Команда PUSH
        pMem(ofs) = &H68 'asmPUSH_imm32
        ofs = ofs + 1
        
        ' Аргумент
        If VarType(p(i)) = vbString Then
            arg = CLng(StrPtr(p(i)))
        Else
            arg = CLng(p(i))
        End If
        SetDWord pMem(), ofs, arg
        ofs = ofs + 4
        
    Next
    
    ' Вызов функции
    pMem(ofs) = &HE8 ' asmCALL_rel32
    ofs = ofs + 1
    
    SetDWord pMem(), ofs, CLng(hAPI_Address - hMem - ofs - 4)
    ofs = ofs + 4
    
    ' Возврат с очисткой 0x0010 (16) байт стека
    ' ret 0x0010 - ret imm16 т.е. C2 1000, обратный порядок записи байт
    pMem(ofs) = &HC2
    ofs = ofs + 1
    
    SetWord pMem(), ofs, &H10
    ofs = ofs + 2
    
    CallFunction = CallWindowProc(hMem, 0, 0, 0, 0)
    
End Function

'//Заполнить память двойным словом (Long)//
Private Sub SetDWord(ByRef bMemArr() As Byte, ByVal i As Long, ByVal iData As Long)
    
    Dim k As Integer
    For k = 0 To 3
        bMemArr(i + k) = iData And &HFF
        iData = Int(iData / &H100)  ' Сдвиг вправо на 8 бит равносилен делению на 2^8
    Next
    
End Sub

'//Заполнить память словом (Integer)//
Private Sub SetWord(ByRef bMemArr() As Byte, ByVal i As Long, ByVal iData As Integer)
    
        bMemArr(i) = iData And &HFF
        iData = Int(iData / &H100)
        
        bMemArr(i + 1) = iData And &HFF
        
End Sub

'//Строковый буфер в области VBA//
Public Function GetStrBuf() As String
    GetStrBuf = sBuf
End Function
Public Function SetStrBuf(Lenght As Long) As Long
    sBuf = String(Lenght, Chr(0))
    SetStrBuf = StrPtr(sBuf)
End Function

'//Протестировать вызов WINAPI//
Public Sub Load()

    Dim pid, res As Long
    Dim pt As POINT
    Dim sTempPath As String
    
    sTempPath = String(256, Chr(0))
    '-------------------------
    pid = CallFunction("kernel32.dll", "GetCurrentProcessId")
    MsgBox "Excel PID:" & Chr(32) & pid, vbInformation + vbOKOnly + vbSystemModal
    
    '-------------------------
    res = CallFunction("user32.dll", "MessageBoxA", 0, StrConv("Некоторое сообщение...", vbFromUnicode), StrConv("Заголовок", vbFromUnicode), vbInformation + vbSystemModal)
    
    '-------------------------
    res = CallFunction("user32.dll", "GetCursorPos", VarPtr(pt))
    MsgBox "Положение курсора: " & pt.x & "__" & pt.y, vbInformation + vbSystemModal
    
    '-------------------------
    res = CallFunction("kernel32.dll", "GetTempPathW", Len(sTempPath), StrPtr(sTempPath))
    MsgBox "Temp Path:" & Chr(32) & sTempPath, vbInformation + vbOKOnly + vbSystemModal
    
End Sub

'
' Вызов WINAPI в EXCEL через EnumWindows. WinAPI выступает в роли CALLBACK, которой и передается управление
'
Option Explicit

Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc _
As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function LocalUnlock Lib "kernel32" (ByVal hMem As Long) As Boolean

Private Declare Sub MoveMem Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Const LMEM_FIXED = &H0
Private Const LMEM_MOVEABLE = &H2
Private Const LMEM_NOCOMPACT = &H10
Private Const LMEM_NODISCARD = &H20
Private Const LMEM_ZEROINIT = &H40
Private Const LMEM_MODIFY = &H80
Private Const LMEM_DISCARDABLE = &HF00
Private Const LMEM_VALID_FLAGS = &HF72
Private Const LMEM_INVALID_HANDLE = &H8000

Private Const MAX_PARAMS As Long = 10

' Именованная коллекция адресов функций
Private ADDR As New Collection

Private Type POINT
x As Long
y As Long
End Type

'//Вызов WINAPI//
Public Function CallFunction(ByVal LibName As String, ByVal FuncName As String, ParamArray p()) As Long

    Dim i As Long, hMem As Long
    Dim ofs As Long
    Dim hLib As Long
    Dim hAPI_Address As Long
    Dim pMem() As Byte
    Dim arg As Long
    Dim bRes As Long
    
  
    ' Найти адрес WINAPI
    '-------------------------------------------------
    
    ' Извлечь адрес из коллекции, если таковой имется
    On Error GoTo GET_ADDR
    
    hAPI_Address = ADDR.Item(LibName & "_" & FuncName)
    'MsgBox "Извлечен адрес повторного вызова.", vbSystemModal + vbExclamation, "Reply"
    On Error GoTo 0
    GoTo CALL_DLL
    
GET_ADDR:

    hLib = LoadLibrary(LibName)
    If hLib = 0 Then Err.Raise 5: Exit Function
    
    hAPI_Address = GetProcAddress(hLib, FuncName)
    If hAPI_Address = 0 Then Err.Raise 5: Exit Function
    
    ' Добавить адрес в коллекцию
    ADDR.Add Item:=hAPI_Address, Key:=LibName & "_" & FuncName

CALL_DLL:
    
    ' Выделить и заполнить память
    '-------------------------------------------------
    hMem = LocalAlloc(LMEM_ZEROINIT + LMEM_FIXED, 5 * MAX_PARAMS + 5 + 5 + 5 + 3)
    If hMem = 0 Then Err.Raise 7: Exit Function
    
    hMem = LocalLock(hMem)
    ofs = hMem
    
    ' Обратный порядок записи в стек для stdcall
    For i = UBound(p) To LBound(p) Step -1
        
        MoveMem ByVal ofs, &H68, 1 'asmPUSH_imm32
        ofs = ofs + 1
      
        ' Аргумент
        If VarType(p(i)) = vbString Then
            arg = CLng(StrPtr(p(i)))
        Else
            arg = CLng(p(i))
        End If
        
        MoveMem ByVal ofs, arg, 4
        ofs = ofs + 4
    Next
    
    ' Вызов функции (относительный)
    MoveMem ByVal ofs, &HE8, 1 ' asmCALL_rel32
    ofs = ofs + 1
    
    MoveMem ByVal ofs, CLng(hAPI_Address - ofs - 4), 4
    ofs = ofs + 4
        
    ' Записать результат API(eax) в возврат функции CallFunction
    ' mov [ptr],eax
    CallFunction = CLng(0)
    
    MoveMem ByVal ofs, &HA3, 1
    ofs = ofs + 1
    
    MoveMem ByVal ofs, VarPtr(CallFunction), 4
    ofs = ofs + 4
    
    ' Результат работы EnumWindows = false
    ' mov eax,0
    MoveMem ByVal ofs, &HB8, 1
    ofs = ofs + 1
    ofs = ofs + 4
    
    'Возврат с удалением 8 байт из стека
    'ret 0008
    MoveMem ByVal ofs, &HC2, 1
    ofs = ofs + 1
    
    MoveMem ByVal ofs, &H8, 2
    ofs = ofs + 2
    
    ' Передать управление через EnumWindows CALLBACK
    bRes = EnumWindows(hMem, 0)
    
    LocalUnlock hMem
    LocalFree hMem
   
End Function

'//Строковый буфер в области VBA//
Public Function GetStrBuf() As String
    GetStrBuf = sBuf
End Function
Public Function SetStrBuf(Lenght As Long) As Long
    sBuf = String(Lenght, Chr(0))
    SetStrBuf = StrPtr(sBuf)
End Function

'//Протестировать вызов WINAPI//
Public Sub Load()

    Dim pid, res As Long
    Dim pt As POINT
    Dim sTempPath As String
    
    sTempPath = String(256, Chr(0))
    '-------------------------
    pid = CallFunction("kernel32.dll", "GetCurrentProcessId")
    MsgBox "Excel PID:" & Chr(32) & pid, vbInformation + vbOKOnly + vbSystemModal
    
    '-------------------------
    res = CallFunction("user32.dll", "MessageBoxA", 0, StrConv("Некоторое сообщение...", vbFromUnicode), StrConv("Заголовок", vbFromUnicode), vbInformation + vbSystemModal)
    
    '-------------------------
    res = CallFunction("user32.dll", "GetCursorPos", VarPtr(pt))
    MsgBox "Положение курсора: " & pt.x & "__" & pt.y, vbInformation + vbSystemModal
    
    '-------------------------
    res = CallFunction("kernel32.dll", "GetTempPathW", Len(sTempPath), StrPtr(sTempPath))
    MsgBox "Temp Path:" & Chr(32) & sTempPath, vbInformation + vbOKOnly + vbSystemModal
    
End Sub

 
 '
 ' Вызов WinAPI из VbScript, используя Excel как сервер автоматизации
 ' VBScript
 '
 '
 
 Option Explicit

 Dim objExcel, objWorkBook
 Dim sPath, sTempPath

 Const sWorkBookName = "DLL_CALL.xlsm"

 sPath = WScript.ScriptFullName
 sPath = Left(sPath, InStrRev(sPath, "\")) & sWorkBookName


 ' /Попытаться использовать уже существующий процесс Excel как сервер автоматизации/
 '-------------------------------------------
 On Error Resume Next
 Set objExcel = GetObject(,"Excel.Application")

 If IsObject(objExcel) Then 

	' /Попытаться обнаружить рабочую книгу содержащую VBA-модуль вызова API/
	Set objWorkBook = objExcel.Workbooks.Item(sWorkBookName)
	If Not IsObject(objWorkBook) Then 
		Set objWorkBook = objExcel.Workbooks.Open(sPath)
	End If
 Else
	Set objExcel = CreateObject("Excel.Application")
	objExcel.Application.Visible = False
	Set objWorkBook = objExcel.Workbooks.Open(sPath) 
 End If
 On Error GoTo 0

 ' Протестировать вызов WINAPI
 '-------------------------------------------
 WinAPITest "DLLCALL_CallWindowProc"
 WinAPITest "DLLCALL_EnumWindows"
 WScript.Quit()


 ' Вызов WINAPI через Excel (sModuleName - имя модуля содержащего вызов WinAPI в книге Excel)
 '-------------------------------------------
 Sub WinAPITest(ByVal sModuleName)

	Dim sTitle, hRES, p1 		 
	sTitle = sModuleName
	With objWorkBook.Application

		hRES = .Run(sModuleName & ".CallFunction", "user32.dll", "MessageBoxW", 0, "Процесс Excel не будет остановлен после выполнения этого сценария.", sTitle, vbExclamation + vbSystemModal)
		p1 = .Run(sModuleName & ".SetStrBuf", 255) 
		hRES = .Run(sModuleName & ".CallFunction", "kernel32.dll", "GetTempPathW", 255, p1)
		sTempPath = .Run(sModuleName & ".GetStrBuf") 

	End With
	MsgBox sTempPath, vbSystemModal + vbExclamation, sTitle
 End Sub