VBS 映射远程电脑磁盘

 
'以下创建ie对象，以及设置ie对象的一些属性
set ie=wscript.createobject("internetexplorer.application","event_")
ie.menubar=0 '取消菜单栏
ie.addressbar=0 '取消地址栏
ie.toolbar=0 '取消工具栏
ie.statusbar=0 '取消状态栏
ie.width=380 'ie对象宽度
ie.height=500 'ie对象高度
ie.resizable=0 '不允许用户改变窗口大小
ie.navigate "about:blank" '打开空白页面
ie.left=fix((ie.document.parentwindow.screen.availwidth-ie.width)/2) '水平居中
ie.top=fix((ie.document.parentwindow.screen.availheight-ie.height)/2) '垂直居中
ie.visible=1 '窗口可见
'以下调用document.write方法，写ie对象内容
with ie.document
.write "<html>"
.write "<title>映射远程电脑磁盘</title> "'ie对象标题
.write "<body scroll=yes>"
.write "<p align=right><input id=help type=button value=帮助>   <input id=about type=button value=关于>"
.write "<h2 align=center>映射远程电脑磁盘</h2><br>"
.write "<fieldset><legend >目标IP</legend><lable><font size=2>远程电脑的IP地址：</font></lable><input id=ip type=text size=15 value=192.168.1.104></fieldset><br>"
.write "<fieldset><legend>用户名和密码</legend><lable><font size=2>用户名：</font></lable><input id=user type=text size=10 value=administrator>   <lable><font size=2>密码：</font></lable><input id=pass type=password size=10 value=111111></fieldset><br>"
.write "<fieldset><legend>盘符</legend><lable><font size=2>远程盘符：</font></lable><input id=disk1 type=text size=2 value=c>   <lable><font size=2>本地盘符：</font></lable><input id=disk2 type=text size=2 value=p></fieldset><br>"
.write "<fieldset><legend>删除网络映射</legend><lable><font size=2>输入单个网络驱动器盘符：</font></lable><input id=disk3 type=text size=2 >  &nbsp<input id=del type=button value=删除><br><lable><font size=2>删除本地所有网络驱动器：</font></lable><input id=dels type=button value=删除></fieldset>"
.write  "<p align=center><input id=confirm type=button value=确定>   &nbsp  &nbsp <input id=cancel type=button value=取消>"
.write "</body>"
.write "</html>"
end with
'以下是设置点击页面按钮时的处理函数
set wnd=ie.document.parentwindow '设置wnd为窗口对象
set id=ie.document.all '设置id为document中全部对象的集合
id.confirm.onclick=getref("confirm") '设置点击"确定"按钮时的处理函数
id.cancel.onclick=getref("cancel") '设置点击"取消"按钮时的处理函数
id.del.onclick=getref("del") '设置点击单个"删除"按钮时的处理函数
id.dels.onclick=getref("dels") '设置点击全部"删除"按钮时的处理函数
id.about.onclick=getref("about")'设置点击"关于"按钮时的处理函数
id.help.onclick=getref("help")'设置点击"帮助"按钮时的处理函数
'由于ie对象支持事件，所以相应的，脚本以无限循环来等待各种事件
do while true
wscript.sleep 100
loop
'ie退出事件处理过程
sub event_onquit
wscript.quit '当ie退出时，脚本也退出
end sub
'"帮助"按钮处理函数
sub help
wnd.alert("错误号5，拒绝访问：很可能你使用的用户不是管理员权限的，先提升权限；"&Chr(10)&"错误号51，Windows无法找到网络路径：网络有问题；"&Chr(10)&"错误号53，找不到网络路径：ip地址错误；目标未开机；目标lanmanserver服务未启动；目标有防火墙（端口过滤）； （net start lanmanserver 开启lanmanserver服务）"&Chr(10)&"错误号67，找不到网络名：你的lanmanworkstation服务未启动或者目标删除了ipc$； "&Chr(10)&"错误号1219，提供的凭据与已存在的凭据集冲突：你已经和对方建立了一个ipc$，请删除再连； "&Chr(10)&"错误号1326，未知的用户名或错误密码：原因很明显了； "&Chr(10)&"错误号1792，试图登录，但是网络登录服务没有启动：目标NetLogon服务未启动； "&Chr(10)&"错误号2242，此用户的密码已经过期：目标有帐号策略，强制定期要求更改密码")
end sub
'"关于"按钮处理函数
sub about
wnd.alert ("此脚本仅供娱乐而已，目前仍存在Bug"&Chr(10)&"如有更好的建议请联系QQ:798776238"&Chr(10)&"作者：sirrah")
end sub
'单个"删除"按钮处理函数
sub del
with id
Dim str
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
'判断删除单个网络映射的盘符输入框是否是空的，如果是空的，给出提示
if (.disk3.value="") Then
    For Each objDrive in colDrives
       if(objDrive.DriveType=3 ) then
            str=str & objDrive.DriveLetter & "、"   
       end if
    Next
'判断当前电脑是否存在网络映射
    if(str="") then
     wnd.alert("当前没有网络映射！！！")
     exit sub
    end if  
    wnd.alert ("您当前电脑存在的网络驱动器盘符是：" & Left(str,Len(str)-1) & Chr(10)&"请输入相应盘符,并点击删除即可删除该网络驱动器")
    exit sub
end if
'判断当前输入的盘符是否存在
 For Each objDrive in colDrives 
       If (objDrive.DriveType=3 and objDrive.DriveLetter=UCase(.disk3.value)) then
          on error resume next
             Set vbs2=CreateObject("Wscript.Shell")
             vbs2.Run "cmd"
             wscript.sleep 500
             vbs2.SendKeys "net use " & .disk3.value & ": /del" & "{Enter}"
             vbs2.SendKeys "exit"
             vbs2.SendKeys "{Enter}"
    .disk3.value=""
         Exit sub
         End If
 next
wnd.alert ("您当前输入的盘符所对应的网络驱动器不存在，请重新输入！")
.disk3.value=""
end with
end sub
 
'全部"删除"按钮处理函数
sub dels
'判断当前是否存在网络映射
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objDrive in colDrives
if(objDrive.DriveType=3) Then
    '最后验证是否真的需要删除本地所有网络映射
      intMessage=msgbox("点击是，您将删除本地所有网络映射，点击否，您将取消删除本地所有网络映射",vbYesNo,"确认是否全部删除")
      If intMessage=vbYes then
          on error resume next
          Set vbs=CreateObject("Wscript.Shell")
          vbs.Run "cmd"
          wscript.sleep 500
          vbs.SendKeys " net use * /del " & " {enter}" & "Y" & " {enter}" & "exit" & "{Enter}"
   Exit sub
    else
        Exit sub
     End If
end If           
Next
wnd.alert("当前没有网络映射！！！")
end Sub
 
'"确认"按钮处理函数
sub confirm
with id
If(.ip.value="") then
wnd.alert("请输入IP地址")
exit sub
End If
If(.user.value="") then
wnd.alert("请输入登入用户名")
exit sub
End If
If(.pass.value="") then
wnd.alert("请输入登入密码")
exit sub
End If
If(.disk1.value="") then
wnd.alert("请输入远程盘符")
exit sub
End If
If(.disk2.value="") then
wnd.alert("请输入本地盘符")
exit sub
End If
'判断映射到本地的盘符是否存在
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colDrives = objFSO.Drives
For Each objDrive in colDrives
If (objDrive.DriveLetter=UCase(.disk2.value)) then
wnd.alert("对不起，您输入的本地盘符"& .disk2.value &"已存在，请重新输入！！！")
.disk2.value=""
Exit Sub
End If
Next
'映射网络驱动器
on error resume next
Set vbs1=CreateObject("Wscript.Shell")
vbs1.Run "cmd"
wscript.sleep 500
'建立空链接
vbs1.SendKeys "net use \\" & .ip.value & "\ipc$ " & Chr(34) & .pass.value & Chr(34) & " /user:"& Chr(34) & .user.value & Chr(34) & "{enter}"
'映射磁盘
vbs1.SendKeys "net use " & .disk2.value & ": \\"& .ip.value & "\" & .disk1.value & "$ " & Chr(34)& .pass.value & Chr(34) & "  /user:" & Chr(34) & .user.value & Chr(34) & " {enter}"
vbs1.SendKeys "exit"
vbs1.SendKeys "{Enter}"
.disk1.value=""
.disk2.value=""
end with
end sub
'"取消"按钮处理函数
sub cancel
ie.quit
end sub

 

 

posted @ 2011-06-16 00:51  Sirrah  阅读(2005)  评论(0)  编辑  收藏  举报