监视剪贴版，文本有变化就自动追加字符

窄口牛 · 发表于 2025-4-16 21:56:37

本帖最后由窄口牛于 2025-4-18 06:43 编辑

剪贴版追加字符串.rar (1.36 KB, 下载次数: 22)

2025-4-17 20:36 上传

点击文件名下载附件
检测频度可以自己酌情修改，不需要了可以结束wscript进程以终止。

On Error Resume Next
set fso=createobject("scripting.filesystemobject")
set fw=fso.createtextfile("结束.bat",2)
fw.writeline("@echo off")
fw.writeline("Setlocal enabledelayedexpansion")
fw.writeline("reg query HKU\S-1-5-20>nul || (")
fw.writeline("echo;CreateObject^(""Shell.Application""^).ShellExecute ""%~f0"", """", """", ""runas"", 1 > ""%temp%\getadmin.vbs"" && cscript //b ""%temp%\getadmin.vbs"" && exit /b & del ""%temp%\getadmin.vbs"" /f /q>nul 2>nul)")
fw.writeline("pushd ""%CD%"" && CD /D ""%~dp0""")
fw.writeline("taskkill /im wscript.exe /f")
fw.writeline("taskkill /im iexplore.exe /f")
fw.writeline("for /f ""tokens=2 delims= "" %%i in ('whoami /user ^|find ""S-1-5""') do set sid=%%i")
fw.writeline("reg add ""HKEY_USERS\%sid%\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3"" /v ""1407"" /t REG_DWORD /d 1 /f")
fw.writeline("reg add ""HKEY_USERS\%sid%\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3"" /v ""CurrentLevel"" /t REG_DWORD /d 70912 /f")
fw.writeline("Del %0")
fw.Close()
set fw = Nothing
set fso = Nothing
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name='explorer.exe'")
strUser = ""
strDomain = ""
For Each objProcess in colProcesses
objProcess.GetOwner strUser, strDomain
If strUser <> "" Then Exit For
Next
If strUser = "" Then
MsgBox "无法获取当前用户", vbCritical
WScript.Quit
End If
Set colAccounts = objWMIService.ExecQuery("SELECT * FROM Win32_UserAccount WHERE Name='" & strUser & "' AND Domain='" & strDomain & "'")
strSID = ""
For Each objAccount in colAccounts
strSID = objAccount.SID
Exit For
Next
If strSID = "" Then
MsgBox "无法获取用户SID", vbCritical
WScript.Quit
End If
Set WshShell = CreateObject("WScript.Shell")
regPath = "HKEY_USERS" & strSID & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3"
WshShell.RegWrite regPath & "1407", 0, "REG_DWORD"
WshShell.RegWrite regPath & "CurrentLevel", 0, "REG_DWORD"
Set WshShell = CreateObject("WScript.Shell")
Do
WScript.Sleep 1000
Set objHTML = CreateObject("htmlfile")
objHTML.parentWindow.clipboardData.SetData "Text", ""
objHTML.parentWindow.clipboardData.GetData "Text"
CurrentText = objHTML.parentWindow.clipboardData.GetData("Text")
On Error Goto 0
If IsEmpty(CurrentText) Or Not IsString(CurrentText) Then
LastText = ""
Exit Do
End If
If Right(CurrentText, 4) <> ".mp4" Then
NewText = CurrentText & ".mp4"
objHTML.parentWindow.clipboardData.SetData "Text", NewText
WshShell.Run "clip.exe", 0, True
LastText = NewText
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate("about:blank")
Set clipboard = IE.document.parentWindow.clipboardData
clipboard.SetData "Text", NewText
'WScript.Echo "已追加：" & NewText
End If
Loop
Function IsString(var)
On Error Resume Next
IsString = (VarType(var) = 8) And (Len(var) > 0)
End Function

复制代码

it323 · 发表于 2025-4-16 22:11:00

感谢分享！

yc2428 · 发表于 2025-4-16 22:50:14

谢谢分享

我是李刚 · 发表于 2025-4-16 23:42:24

这个有什么实际作用吗？

俪尚皇 · 发表于 2025-4-16 23:42:53

学习到了

Juliany · 发表于 2025-4-16 23:47:19

我是李刚发表于 2025-4-16 23:42
这个有什么实际作用吗？

不知道你有没有剪过报纸, 把报纸上感兴趣的内容剪下来, 贴在一张纸上. 这个软件大概就是干了这些事

yyz2191958 · 发表于 2025-4-17 06:50:22

下来看看谢谢

小灰兔 · 发表于 2025-4-17 07:08:07

谢谢分享

HXQhxq · 发表于 2025-4-17 08:04:46

感谢分享

wang1126 · 发表于 2025-4-17 08:17:08

谢谢楼主分享

sjcjack · 发表于 2025-4-17 09:16:23

感觉剪贴板可以用一些第三方工具

cutebe · 发表于 2025-4-17 09:24:18

感谢分享！

nttwqz · 发表于 2025-4-17 09:29:10

Juliany 发表于 2025-4-16 23:47
不知道你有没有剪过报纸, 把报纸上感兴趣的内容剪下来, 贴在一张纸上. 这个软件大概就是干了这些事

发送到 OneNote

nanan84563 · 发表于 2025-4-17 09:42:16

好工具

guong · 发表于 2025-4-17 11:10:45

来看看谢谢分享！

窄口牛 · 发表于 2025-4-17 11:32:21

已修正错误。

wn168cn@163.com · 发表于 2025-4-17 15:43:40

支持原创

promrhxq · 发表于 2025-4-17 17:26:40

感谢分享好东东学习了

窄口牛 · 发表于 2025-4-17 20:40:07

再次完善修复，clip方式会增加空格和回车符，改用ie方式，建立了一个结束的批处理，用于关闭它，调用ie前修改允许ie修改剪贴版，之后结束的批处理会恢复修改剪贴版的提示。

fegr · 发表于 2025-4-18 16:23:42

感谢分享

窄口牛 · 发表于 2025-4-19 09:36:38

不知道什么原因，第一次运行会失败？

classMain · 发表于 2025-4-19 18:06:51

谢谢楼主分享

		自动登录	找回密码
密码			注册

监视剪贴版，文本有变化就自动追加字符

点评