中国DOS联盟

可执行文件取自Ghostxp电脑公司版。

http://zhenlove.com.cn/cndos/fileup/files/Manage_CD_EXE.rar




[ Last edited by baomaboy on 2007-5-12 at 11:04 AM ]

Dim WshShell,FSO
On Error Resume Next
Set WshShell = WScript.Createobject("WScript.Shell")
Set FSO = Createobject("Scripting.Filesystemobject")
Set WinVer = WshShell.Environment("Process")
Set Args = WScript.Arguments
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
LnkPathNT = WshShell.SpecialFolders(2)
LnkPath9X = WshShell.SpecialFolders(14)
LnkPathAll = WshShell.SpecialFolders("StartMenu")
OtherFileName1="光驱弹出或关闭(Ctrl+Alt+↓).exe"
OtherFilePath=FSO.GetSpecialFolder(1)
TemFileName="无标题"
TemFilePath=FSO.GetSpecialFolder(2)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="光驱弹出或关闭"
InsAnswer="光驱弹出或关闭"
RegPath1="HKLM\SOFTWARE\LLKJ\SYSSoft\Manage_CD_EXE\"
RegValue1="光驱弹出或关闭"
RegForm1="REG_SZ"
RegPath2="HKLM\SOFTWARE\LLKJ\SYSSoft\Manage_CD_EXE\DelAllAtShutDown"
RegValue2="No"
RegValue3="Yes"
RegValue4="All"
RegForm2="REG_SZ"
If WinVer("OS") = "Windows_NT" Then
LnkPath=LnkPathNT
MyShortcutFolder="快捷功能"
MyShortcutName1="光驱弹出或关闭(Ctrl+Alt+↓).Lnk"
MyShortcutName2="快速关机(Ctrl+Alt+End).Lnk"
MyShortcutHotKey1="Ctrl+Alt+↓"
MyShortcutHotKey2="CTRL+ALT+End"
MyShortcutHotKeybak="CTRL+ALT+Down"
intAnswer = Msgbox("【是】将“"+ InsAnswer +"”加入到快捷键" +Chr(34)+ MyShortcutHotKey1 +Chr

(34)+ "，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”取消系统热键" +Chr(34)+ MyShortcutHotKey1

+Chr(34)+ "。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ Copyright)
If intAnswer = vbYes Then
If (FSO.FileExists(FSO.BuildPath(FilePath,"光驱弹出或关闭(Ctrl+Alt+↓).llkj"))) Then
FSO.GetFile(FSO.BuildPath(FilePath,"光驱弹出或关闭(Ctrl+Alt+↓).llkj")).Copy(FSO.BuildPath

(InsPath,OtherFileName1))
Else
Call alltovbs
End If
If (FSO.FolderExists(FSO.BuildPath(LnkPath ,"\附件\" & MyShortcutFolder))) Then
Else
FSO.CreateFolder(FSO.BuildPath(LnkPath ,"\附件\" & MyShortcutFolder))
End If
Set MyShortcut = WshShell.CreateShortcut(FSO.BuildPath(LnkPath ,"附件\" & MyShortcutFolder & "\"

& MyShortcutName1))
MyShortcut.TargetPath = (FSO.BuildPath(InsPath,OtherFileName1))
MyShortcut.WorkingDirectory = (InsPath)
MyShortcut.Windowstyle = 4
MyShortcut.Description = "光驱弹出或关闭"
MyShortcut.Hotkey = MyShortcutHotKeybak
MyShortcut.Save
WshShell.popup _
"添加执行文件："+Chr(10)+FSO.BuildPath(InsPath,OtherFileName1)+Chr(10)+Chr(10)+ _
"添加快捷方式："+Chr(10)+ FSO.BuildPath(LnkPath ,"附件\" & MyShortcutFolder & "\" &

MyShortcutName1) +Chr(10)+Chr(10)+ _
"添加系统热键:" +Chr(10)+Chr(34) & MyShortcutHotKey1 +Chr(34)+Chr(10)+Chr(10)+ _
Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +Chr(10)+Chr(10)+ _
Chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
End If
If intAnswer = vbNo Then
FSO.DeleteFile FSO.BuildPath(InsPath,OtherFileName1)
FSO.DeleteFile FSO.BuildPath(LnkPath ,"附件\" & MyShortcutFolder & "\" & MyShortcutName1)
WshShell.popup _
"删除执行文件："+Chr(10)+FSO.BuildPath(InsPath,OtherFileName1)+Chr(10)+Chr(10)+Chr(10)+ _
"删除快捷方式："+Chr(10)+ FSO.BuildPath(LnkPath ,"附件\" & MyShortcutFolder & "\" &

MyShortcutName1) +Chr(10)+Chr(10)+ _
"删除系统热键:" +Chr(10)+Chr(34) & MyShortcutHotKey1 +Chr(34)+Chr(10)+Chr(10)+ _
Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +Chr(10)+Chr(10)+ _
Chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64

End If
If intAnswer = vbCancel Then
End If
Else
WshShell.popup _
"程序要求运行于 " + Chr(34)+WinVer("OS")+Chr(34)+" 环境，安装失败。"+Chr(10)+Chr(10)+ _
Chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +Chr(10)+Chr(10)+ _
Chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装失败 - "+ InsTitle +" - "+ Copyright, 0 + 48
End If
Set WshShell = Nothing
Set FSO = Nothing
Set Args = Nothing
WScript.Quit(0)

Sub alltovbs()
'太长了删除掉!
End Sub

可执行文件取自Ghostxp电脑公司版。

论坛上有一句话版的

Originally posted by electronixtar at 2007-3-18 12:38:

论坛上有一句话版的

Set WshShell= WScript.CreateObject("WScript.Shell")
Set oWMP = CreateObject("WMPlayer.OCX.7" )
Set colCDROMs = oWMP.cdromCollection
if colCDROMs.Count >= 1 then
colCDROMs.Item(CStr(0)).Eject
oWMP.close()
End If
WScript.Sleep CLng(WaitTime)
Set colCDROMs = oWMP.cdromCollection
if colCDROMs.Count >= 1 then
colCDROMs.Item(CStr(0)).Eject
oWMP.close()
End If

这个版本在我这里都要光驱开启后使用，一旦光驱在关闭的状态下误运行后就没了任何反映，以后都没发用了，如果不是这个，兄给个链接吧或者关键字

With CreateObject("WMPlayer.OCX.7").cdromCollection:.Item(0).eject:WScript.Sleep 3000:.Item(0).eject:End With

只是WScript.exe不能退出进程

Originally posted by zh159 at 2007-3-18 13:48:
With CreateObject("WMPlayer.OCX.7").cdromCollection:.Item(0).eject:WScript.Sleep 3000:.Item(0).eject:End With

只是WScript.exe不能退出进程

任务管理器 结束进程后也不成

Originally posted by zh159 at 2007-3-18 13:48:
With CreateObject("WMPlayer.OCX.7").cdromCollection:.Item(0).eject:WScript.Sleep 3000:.Item(0).eject:End With

只是WScript.exe不能退出进程

确实如兄所说Wscritp进程卡死了，但结束后也不能用了
刚才只看”进程"没仔细看兄的代码就回了，兄是给的解决办法是吧，

Originally posted by baomaboy at 2007-3-18 13:53:


确实如兄所说Wscritp进程卡死了，但结束后也不能用了
刚才只看”进程"没仔细看兄的代码就回了，兄是给的解决办法是吧，

怎么你们那里都有不能结束进程的问题？改天我研究下汇报

Originally posted by electronixtar at 2007-3-18 14:44:



怎么你们那里都有不能结束进程的问题？改天我研究下汇报

希望兄解决此问题，那样我就可以丢掉那DLL和EXE版，因为只要系统默认情况下可以实现的我总不愿借用第三方程序。

我是直接将SYSTEM32文件夹中的光驱开关小软件取出.建一个快捷方式到桌面.用F3做快捷键

Originally posted by eech at 2007-3-19 07:37:
我是直接将SYSTEM32文件夹中的光驱开关小软件取出.建一个快捷方式到桌面.用F3做快捷键

呵呵 自己动手 丰衣又足食啊