Tag: vbs

使用VBS批量修改文件夹名

批量修改文件名的软件有不少，但是能批量修改文件夹名称的可不多。如果各位有好的软件，请留言告知Pop，谢谢。

下面是利用VBS的脚本进行批量修改文件夹名，经过Pop的测试，效果还很不错的。

使用方法：
把下面的代码复制保存为 *.vbs 的格式，如1.vbs，然后双击这个文件就可以开始批量修改文件夹名了。

Dim NewLine
NewLine = vbcrlf
TabStop = ""

function isFolderExi Continue reading "使用VBS批量修改文件夹名"

电驴（emule）下载完后自动关机的vbs脚本

将第一行引号内的路径改成你自己的emule临时文件目录，然后保存为 *.vbs 的文件，如emule.vbs

dir="E:\Temp"
Set fso=CreateObject("Scripting.FileSystemObject")
cmd="shutdown -s -f -t 60"
Set ws=WScript.CreateObject("WScript.Shell")
Wscript.Echo "emule自动关机脚本已运行……"
count=0
do until count<-1
chksize = fso.GetFolder(dir).Size
If chksize=0 Then
ws.run cmd,0
End If
WScript.Sleep 120000
loop

此脚本的作用是每两分钟检测一次temp文件夹，若emule下载完成，则temp为空，脚本执行关机命令倒计时60秒关机。

原文地址：
http://www.paozhuan.cn/95

批处理/VBS延时执行某程序

问题：
怎样在开机以后5分钟自动运行某程序？

1、批处理
将下面的内容保存为 .bat 后缀文件，如QQ.bat，然后复制到启动项里

代码内容如下：

@echo off
ping 127.0.0.1 -n 300>null
start D:\tools\Tencent\QQ\Bin\QQ.exe
del null

2、VBS
将下面的内容保存为 .vbs 后缀文件，如QQ.vbs，然后复制到启动项里

代码内容如下：

wscript.sleep 300000
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.run """D:\tools\Tencent\QQ\Bin\QQ.exe"""

ADSL宽带自动拨号VBS版

实现效果：开机自动实现adsl的拨号过程

将下面的代码保存为 *.vbs后缀的文件，如adsl.vbs；然后添加到启动项目即可

代码如下：

dim wsh
set wsh=WScript.CreateObject("WScript.Shell")
wsh.run "Rasdial 宽带连接名称 帐号 密码 ",false,1

说明：
代码中的“宽带连接名称”修改为你的网络连接名称（一般为宽带连接或者adsl等）
账号、密码分别修改为你的ADSL账号和密码

还有另外一段代码：

CreateObject("WScript.Shell").Run "rasdial 宽带连接 宽带帐号 宽带密码",0

vbs实现定时自动关机及源码

pop：其实实现自动关机的核心就是shutdown的命令，at 21:00 shutdown -s 就是在21:00自动关机，会有30秒的提示；要是没有提示直接关机就是：at 21:00 shutdown -s -t 0 （注意：要开启“计划任务”的服务。）

将下面的代码保存为 *.vbs 后缀的文件，如shutdown.vbs

在输入时间或者秒数之后自动关机，代码如下：

Dim mytime,myout1,myout2
mytime=null
mytime=InputBox("请输入定时时间(格式23:10:00)"&vblf&"如果想倒计时关机，请输入倒计时时间"&vblf&"(单位/分钟)"&vblf&"输入“pop”可以马上关机"&vblf&"退出点“取消”","定时关机","23:10:00")
Set wshshell=wscript.createobject("wscript.shell")
If IsNumeric(mytime)=False Then
If IsDate(mytime)=True Then
wshshell.run "at "&mytime&" shutdown -s -t 0" '定时关机在任务列表中
myout1=MsgBox("定时成功！电脑将在"&mytime&"关机！放弃关机请点“取消”！",vbokcancel,"定时关机")
If myout1=vbcancel Then
wshshell.run "at /delete /y"
MsgBox "关机已取消！",64,"定时关机"
End If
Else
If mytime="pop" Then
wshshell.run "shutdown -s -t 0"
End If
MsgBox "输入错误！请重新输入！",64,"定时关机"
End If
Else
If mytime>600 or mytime<=0 Then
MsgBox "输入错误！倒计时不能多于10小时(600分钟)！",64,"定时关机"
wscript.quit
End If
wshshell.run "shutdown -s -t "&mytime*60
myout2=MsgBox("设置成功！电脑将在"&mytime&"分钟后关机！放弃关机请点“取消”！",vbokcancel,"定时关机")
If myout2=vbcancel Then
wshshell.run "shutdown -a"
MsgBox "关机已取消！",64,"定时关机"
End If
End If

这个比较简单，就是实现倒计时关机的VBS脚本代码：

set diaolei=createobject("wscript.shell")
dim shijian,guanji,hua
shijian=time
hua=inputbox("请输入你要用什么单位关机 1 代表分钟 2 代表小时 3 代表天")
if hua=1 then
guanji=inputbox("请输入你要几分钟后关机")
if datediff("m",shijian,time)>=guanji then
diaolei.run "rundll32.exe user.exe,exitwindows"
diaolei.run "shutdown -s -t 0"
elseif hua=2 then
guanji=inputbox("请输入你要几小时后关机")
if datediff("h",shijian,time)>=guanji then
diaolei.run "rundll32.exe user.exe,exitwindows"
diaolei.run "shutdown -s -t 0"
elseif hua=3 then
guanji=inputbox("请输入你要几天后关机")
if datediff("d",shijian,time)>=guanji then
diaolei.run "rundll32.exe user.exe,exitwindows"
diaolei.run "shutdown -s -t 0"
endif

QQ自动发消息的VBS脚本

效果：
可以自动发送消息，利用ctrl+v的粘贴

使用方法：
将需要发送的消息的文件复制一下，然后切换到发送的窗口，运行这个vbs脚本即可开始自动发送消息

将下面的代码保存为 .vbs的后缀，如1.vbs

代码如下：

Set WshShell= WScript.Createobject("WScript.Shell")
for i=1 to 10
WScript.Sleep 1000
WshShell.SendKeys"^v"
WshShell.SendKeys "%s"
next

代码解释：
for i=1 to 10 这里的10就是发送10次
WScript.Sleep 1000 这里的1000就是间隔时间，单位是毫秒，英文：ms，1000毫秒等于1秒

VBS中赋予弹出inputbox默认值的代码

在弹出inputbox时，有默认值，那么是这样：

如：
pop=InputBox("界面上的提示", "标题提示", "inputbox的默认值")

具体例子：
将下面的代码保存为 *.vbs的文件，如1.vbs

代码如下：

dbname=inputbox("请在下面输入数据库名称，数据库必须与本程序在同一目录。名称如pop.mdb", "pop's 网站解压", "web.mdb")

结合ip138获取外网ip（BAT、VBS）代码

批处理代码：

代码1工作原理：获取IP到文本里面

@echo off
<"%~f0" more +5 >tmp.vbs
cscript //NoLogo /e:vbscript tmp.vbs %1>ip.txt
echo >nul && del tmp.vbs
goto:eof
set oDOM = WScript.GetObject("http://www.ip138.com/ip2city.asp")

do until oDOM.readyState = "complete"
WScript.sleep 200
Loop
s=oDOM.documentElement.innerText
set re = New RegExp
re.Pattern="(\d+)\.(\d+)\.(\d+)\.(\d+)"
For Each m in re.Execute(s)
WScript.Echo m
Next

代码2工作原理

下载http://www.ip138.com/ip2city.asp，取“您的IP地址是：" 右13位保存到windows目录下 IP.TXT，利用<读取IP.TXT内容并显示，最后得到%n% 就是外网IP地址值，这对我来说用途太大了。

至于大家说是不是原创，我认为没有所谓的原创，我们天生下来是不会VBS的，但是我们会调用代码为我们工作，只要实用有效就行了。

@echo off
echo On Error Resume next >checkip.vbs
echo Url="http://www.ip138.com/ip2city.asp" >>checkip.vbs
echo Set NP = Createobject("Microsoft.XMLHTTP") >>checkip.vbs
echo NP.Open "GET", url, False >>checkip.vbs
echo NP.Send >>checkip.vbs
echo Data=NP.responsebody >>checkip.vbs
echo Set NP = Nothing >>checkip.vbs
echo Data = bytes2BSTR(Data) >>checkip.vbs
echo Here = InstrRev(Data, "您的IP地址是：", -1,0) >>checkip.vbs
echo Data = Mid(Data,Here+9,13) >>checkip.vbs
echo Hers = InstrRev(data, "<",-1,0) >>checkip.vbs
echo Set ICEhack = CreateObject("InternetExplorer.Application") >>checkip.vbs
echo ICEhack.Navigate("about:blank") >>checkip.vbs
echo If Hers ^<^> 0 Then >>checkip.vbs
echo ICEhack.document.parentwindow.clipboardData.SetData "text", Mid(Data,1,Hers-1) >>checkip.vbs
echo Set WshSHell = WScript.CreateObject("WScript.Shell") >>checkip.vbs
echo Set FSO = CreateObject("Scripting.FileSystemObject") >>checkip.vbs
echo Set SCF = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(0),"ip.txt"),2,True) >>checkip.vbs
echo SCF.Write(Data) >>checkip.vbs
echo SCF.Close >>checkip.vbs
echo Else >>checkip.vbs
echo ICEhack.document.parentwindow.clipboardData.SetData "text", Data >>checkip.vbs
echo Set WshSHell = WScript.CreateObject("WScript.Shell") >>checkip.vbs
echo Set FSO = CreateObject("Scripting.FileSystemObject") >>checkip.vbs
echo Set SCF = FSO.OpenTextFile(FSO.BuildPath(FSO.GetSpecialFolder(0),"ip.txt"),2,True) >>checkip.vbs
echo SCF.Write(Data) >>checkip.vbs
echo SCF.Close >>checkip.vbs
echo End If >>checkip.vbs
echo ICEhack.Quit >>checkip.vbs
echo fso.DeleteFile(WScript.ScriptName) >>checkip.vbs
echo Function bytes2BSTR(vIn) >>checkip.vbs
echo strReturn = "" >>checkip.vbs
echo For i = 1 To LenB(vIn) >>checkip.vbs
echo ThisCharCode = AscB(MidB(vIn,i,1)) >>checkip.vbs
echo If ThisCharCode ^< ^&H80 Then >>checkip.vbs
echo strReturn = strReturn ^& Chr(ThisCharCode) >>checkip.vbs
echo Else >>checkip.vbs
echo NextCharCode = AscB(MidB(vIn,i+1,1)) >>checkip.vbs
echo strReturn = strReturn ^& Chr(CLng(ThisCharCode) * ^&H100 + CInt(NextCharCode)) >>checkip.vbs
echo i = i + 1 >>checkip.vbs
echo End If >>checkip.vbs
echo Next >>checkip.vbs
echo bytes2BSTR = strReturn >>checkip.vbs
echo End Function >>checkip.vbs
checkip.vbs
set/p n=

Windows XP正版序列号KEY 更换器vbs版

将下面的代码保存为 *.vbs，如xp.vbs然后运行下就可以了

ON ERROR RESUME NEXT

Dim VOL_PROD_KEY
if Wscript.arguments.count<1 then
VOL_PROD_KEY=InputBox("XP序列号更换器"&vbCr&vbCr&" 本程序将自动替换你当前 Windows 的序列号,通过微软验证完全正版。"&vbCr&vbCr&"序列号(OEM版无效,默认版本为 XP VLK)：","Windows XP 序列号自动更换器","MRX3F-47B9T-2487J-KWKMF-RPWBY")
if VOL_PROD_KEY="" then
Wscript.quit
end if
else
VOL_PROD_KEY = Wscript.arguments.Item(0)
end if

VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") 'remove hyphens if any

for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")

result = Obj.SetProductKey (VOL_PROD_KEY)

if err = 0 then
Wscript.echo "OK，去微软的网站验证试试看吧。祝你好运！"
end if

if err <> 0 then
Wscript.echo "替换失败！输入的 CD-KEY 与当前的版本不匹配。"
Err.Clear
end if

Next