1

Тема: VBScript: помещение текстовых данных в буфер обмена через Win32 API

Автор примера - Poltergeyst.
Здесь достаточно известный API-метод помещения текстовых данных в буфер обмена, адаптированный к VBScript. Работает под Win98 и WinXP. Потребуется библиотека dynwrap.dll.

'Нет гарантий!Используете на свой страх и риск.
'--------------------------------------------------------------
'Language:    VBScript
'Используется библиотека dynwrap.dll
'-------------------------------------------------------------------------------
'ОС Win98 4.10.2222
'-------------------------------------------------------------------------------
'Резервирование памяти
const GMEM_FIXED=0

'Форматы буфера обмена
const CF_TEXT   =1
'-------------------------------------------------------------------------------

setDataToCLP()

function setDataToCLP()
text=inputBox("Укажите строку для помещения в буфер обмена:", _
"Буфер обмена.")

    if text="" then WScript.Quit(1)
    text=Cstr(text)
'-------------------------------------------------------------------------------
'[Выделение памяти]
set dllWrap=CreateObject("DynamicWrapper")
if not IsObject(dllWrap) then erroHnd("Невозможно создать объект DynamicWrapper")

'Регистрация вызова API
dllWrap.Register _
    "KERNEL32.DLL", _
    "GlobalAlloc", _
    "i=uu", _
    "f=s", _
    "r=l"
hGl=dllWrap.GlobalAlloc(GMEM_FIXED,Cint(len(text)+1))
    set dllWrap=Nothing
if hGl=0 then erroHnd("Невозможно выделить память")
'-------------------------------------------------------------------------------
'[Блокировка памяти]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
    "KERNEL32.DLL", _
    "GlobalLock", _
    "i=l", _
    "f=s", _
    "r=l"
'Вызов API
hGl=dllWrap.GlobalLock(hGl)
    set dllWrap=Nothing
if hGl=0 then erroHnd("Невозможно резервировать память")
'-------------------------------------------------------------------------------
'[Копирование строки в память]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
    "KERNEL32.DLL", _
    "lstrcpy", _
    "i=hs", _
    "f=s", _
    "r=h"
'Вызов API
hGl=dllWrap.lstrcpy(hGl,CStr(text))
    set dllWrap=Nothing
if hGl=0 then erroHnd("Невозможно скопировать данные в память")
'-------------------------------------------------------------------------------
''[Разблокировка памяти]
'set dllWrap=CreateObject("DynamicWrapper")
''Регистрация вызова API
'dllWrap.Register _
'    "KERNEL32.DLL", _
'    "GlobalUnlock", _
'    "i=h", _
'    "f=s", _
'    "r=l"
''Вызов API
'res=dllWrap.GlobalUnlock(hGl)
'    set dllWrap=Nothing
'if res<>0 then erroHnd("Невозможно разблокировать память")
'-------------------------------------------------------------------------------
'[Открытие буфера обмена]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
    "USER32.DLL", _
    "OpenClipboard", _
    "i=h", _
    "f=s", _
    "r=l"
'Вызов API
res=dllWrap.OpenClipboard(0)
    set dllWrap=Nothing
if res=0 then erroHnd("Невозможно открыть буфер обмена")
'-------------------------------------------------------------------------------
'[Очистка буфера обмена]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
    "USER32.DLL", _
    "EmptyClipboard", _
    "f=s", _
    "r=l"
'Вызов API
res=dllWrap.EmptyClipboard()
    set dllWrap=Nothing
if res=0 then erroHnd("Невозможно очистить буфер обмена")
'-------------------------------------------------------------------------------
'[Установка содержимого буфера]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
    "USER32.DLL", _
    "SetClipboardData", _
    "i=uh", _
    "f=s", _
    "r=l"
'Вызов API
res=dllWrap.SetClipboardData(CF_TEXT,hGl)
    set dllWrap=Nothing
if res=0 then erroHnd("Невозможно поместить данные в буфер")
'-------------------------------------------------------------------------------
'[Закрытие буфера(освобождение)]
set dllWrap=CreateObject("DynamicWrapper")
'Регистрация вызова API
dllWrap.Register _
    "USER32.DLL", _
    "CloseClipboard", _
    "f=s", _
    "r=l"
'Вызов API
res=dllWrap.CloseClipboard()
    set dllWrap=Nothing
if res=0 then erroHnd("Невозмоно закрыть буфер")
'-------------------------------------------------------------------------------
    MsgBox "Данные помещены в буфер",vbInformation,"Буфер обмена"
end Function

function erroHnd(text)
    MsgBox text,vbExclamation,"Произошла ошибка"
    WScript.Quit(-1)
end Function
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.