Получить текст из буфера обмена
Код (vb.net):
GetFromClipBoard = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
Скопировать текст в буфер обмена (используется временный файл HTA)
Код (vb.net):
Sub CopyToClipBoard(Data)
Const QT = """"
Dim oShell: set oShell = CreateObject("WScript.Shell")
Dim oFSO: set oFSO = CreateObject("Scripting.FileSystemObject")
Dim cur: cur = oFSO.GetParentFolderName(WScript.ScriptFullName)
Dim BuferServer: BuferServer = oFSO.BuildPath(cur, "SetClipBoard.hta")
if not oFSO.FileExists(BuferServer) then
on error resume next
Dim oTS: set oTS = oFSO.OpenTextFile(BuferServer,2,true)
if Err.Number <> 0 then ' не хватает прав для распаковки ресурса в папку со скриптом - распаковую в папку %temp%
Err.Clear
Dim temp: temp = oShell.ExpandEnvironmentStrings("%temp%")
BuferServer = oFSO.BuildPath(temp, "SetClipBoard.hta")
set oTS = oFSO.OpenTextFile(BuferServer,2,true)
end if
oTS.WriteLine "<html><head><HTA:APPLICATION ID=""objHTA"" WindowState=""minimize"" ShowInTaskbar=""yes""/></head>"
oTS.WriteLine "<script language=""VBScript"">Sub Window_onLoad(): comm = objHTA.CommandLine"
oTS.WriteLine "document.parentwindow.clipboardData.SetData ""text"", mid(comm, instr(2, comm, chr(34)) + 2)"
oTS.WriteLine "window.close(): End Sub </script></html>"
oTS.Close: set oTS = Nothing
on error goto 0
end if
if oFSO.FileExists(BuferServer) then
Dim windir: windir = oShell.ExpandEnvironmentStrings("%windir%") 'Получаем путь к серверу HTA
oShell.Run windir & "\system32\mshta.exe " & QT & BuferServer & QT & " " & QT & Data & QT, 0, false
end if
Set oFSO = Nothing: set oShell = Nothing
End Sub
Упрощенный вариант:
Код (vb.net):
Sub CopyToClipBoard(Data)
Dim oShell: set oShell = CreateObject("WScript.Shell")
Dim mshta: mshta = oShell.ExpandEnvironmentStrings("%windir%") & "\system32\mshta.exe" 'Получаем путь к серверу HTA
oShell.Run mshta & " ""vbscript:document.parentwindow.clipboardData.SetData(""text"",replace(""" & replace(Data," ","$#@!~%") & """,""$#@!~%"",chr(32)))&close()""",0,false
End Sub
