Drive control and cd shutdown

[user1453]

Hi, this probably sounds like a stupid piddling question but I have been banging my head against this for hours

I have a copy to cd program which allows you to drag and drop files to a cd/dvd, then when you try to eject it it finialises the disk

Here's the problem, I would like to make a program wich waits 10 minutes, sends an eject the cd command and then 5 minutes later shuts down the pc, (win xp pro)

Any ideas on how to do this guys

Anyone know how to do this?

[gunsmokingman]

try this vbs script

WScript.Sleep 600
   strComputer = "."
   On Error Resume Next
	Const Hidden = 0, Normal = 1, Min = 2
	Const LogOff = 0,  Shutdown = 1, Reboot = 2,PowerOff = 8
	Dim WMISrv, StrOS, ObjOS 
	Dim Act : Set Act = CreateObject("Wscript.Shell")
	Set oWMP = CreateObject("WMPlayer.OCX.7" )
	Set colCDROMs = oWMP.cdromCollection
	 colCDROMs.Item(i).eject 
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Cscript.exe"),Hidden,True 
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Wscript.exe"),Hidden,True
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Wmiprvse.exe"),Hidden,True
	WScript.Sleep 300
   Set WMISrv = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}\\" & strComputer & "\root\cimv2")
   Set ObjOS = WMISrv.ExecQuery("Select * from Win32_OperatingSystem")
	  For Each StrOS in ObjOS
	   StrOS.Win32Shutdown(Shutdown)
	  Next

[user1453]

I assume I should save this as a vbs file?

[gunsmokingman]

Yes I forgot to add that to the post, saves as CdEject_ShutDownXp.Vbs or whatever name you want to give it.

[user1453]

and use this code if I just wanted it to eject the cd?

WScript.Sleep 600
   strComputer = "."
   On Error Resume Next
	Const Hidden = 0, Normal = 1, Min = 2
	Const LogOff = 0,  Shutdown = 1, Reboot = 2,PowerOff = 8
	Dim WMISrv, StrOS, ObjOS 
	Dim Act : Set Act = CreateObject("Wscript.Shell")
	Set oWMP = CreateObject("WMPlayer.OCX.7" )
	Set colCDROMs = oWMP.cdromCollection
	 colCDROMs.Item(i).eject 
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Cscript.exe"),Hidden,True 
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Wscript.exe"),Hidden,True
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Wmiprvse.exe"),Hidden,True
		  Next

[gunsmokingman]

You will get a error with that code you have a next but know For each.

Here is the eject the Cd code

WScript.Sleep 600
   strComputer = "."
   On Error Resume Next
	Const Hidden = 0, Normal = 1, Min = 2
	Const LogOff = 0,  Shutdown = 1, Reboot = 2,PowerOff = 8 '''' FOR SHUT DOWN CODE
	Dim WMISrv, StrOS, ObjOS '''' FOR SHUT DOWN CODE
	Dim Act : Set Act = CreateObject("Wscript.Shell")
	Set oWMP = CreateObject("WMPlayer.OCX.7" )
	Set colCDROMs = oWMP.cdromCollection
	 colCDROMs.Item(i).eject 
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Cscript.exe"),Hidden,True 
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Wscript.exe"),Hidden,True
	  Act.Run("%comspec% /c TASKKILL /F /T /IM Wmiprvse.exe"),Hidden,True
	WScript.Sleep 300

Here is the shut down code, you will need the lines I have pointed out in the above code for this one to work alone.

Set WMISrv = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}\\" & strComputer & "\root\cimv2")
   Set ObjOS = WMISrv.ExecQuery("Select * from Win32_OperatingSystem")
	  For Each StrOS in ObjOS
	   StrOS.Win32Shutdown(Shutdown)
	  Next

Edited February 21, 2006 by gunsmokingman

[user1453]

The cd eject portion of the script works perfectly, but the taskkill commands all fail.

I get an error message taskkill.com is not a valid win32 application

ditto for the shutdown commad

the next at the end of the file also causes an error, however I sorted this by removing it.

[gunsmokingman]

try and change the TASKKILL to TASKKILL.exe

I ran the script and do not recieve any errors on my computer.

This is where the next is needed.

For Each StrOS in ObjOS
	   StrOS.Win32Shutdown(Shutdown)
	  Next

[Yzöwl]

I don't really see the need to kill all those processes anyhow, you are after all shutting down.

I have had many instances however where several wscript.exe processes can remain open and can prevent shutdown.

Here is my version of a CD eject script, which closes the wscript process too.

strComputer = "."
Set WshShell = CreateObject("WScript.Shell")
Set oWMP = CreateObject("WMPlayer.OCX.7")
Set colCDROMs = oWMP.cdromCollection
Set objWMIService = GetObject("winmgmts:" _
  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive")
For Each objItem in colItems
  If ObjItem.MediaLoaded Then
    Set CD = colCDROMs.getByDriveSpecifier(objItem.Drive)
    CD.Eject
    Answer = WshShell.Popup("Please remove your CD within 20 seconds.", 20, "CD Removal Message", 0 + 32)
    If Answer = 1 Then
      CD.Eject
      Else
        CD.Eject
    End If
  End If
Next
Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name = " & "'wscript.exe'")
For Each objProcess in colProcess
  objProcess.Terminate()
Next

You may wish to alter that to suit your needs, by adding appropriate sleep /timeouts and shutdown.

Hope it helps!

[gunsmokingman]

I will tell you why I have it taskkill it if you run the CD eject part and the script has completed, look in taskmanager, these process are still running Wmiprvse.exe or wscript.exe and since I use a app to write the vbs scripts in it uses Cscript.exe so the only way to kill those processes is to use taskkill or use taskmanger to kill the process. I suppose those could be left out because I would assume that once the shut down began then those would be killed.

I tried your script and it errors out.

Edited February 23, 2006 by gunsmokingman

[Yzöwl]

GSM, please explain what the error is... I have seen your picture within your app, but that means nothing to me!

The file runs fine on my XP machines, it will only open a cd drawer with loaded media, meaning if you have two or more, only the one with a CD in it will be ejected. If you click on the pop-up it will close the drawer again, otherwise after a 20 second timeout it will auto-shut.

[gunsmokingman]

Then it was my mistake I did not know you needed a CD in the drive.

Slap self 5 times with wet noodles for not reading the code better.

In case you are intrested in the error you get with out a Cd in the drive, now this could also be from how it copies when I paste it, It appears as 1 real long line and I may of made a mistake in how should be.

Error Report

D:\Documents and Settings\Gunsmokingman\Desktop\New VBScript Script File (3).vbs(4, 1) Microsoft VBScript runtime error: Object doesn't support this property or method: 'oWMP.cdromCollectionSet'

Before I separate the code from 1 line

1 Long Line

strComputer = "."Set WshShell = CreateObject("WScript.Shell")Set oWMP = CreateObject("WMPlayer.OCX.7")Set colCDROMs = oWMP.cdromCollectionSet objWMIService = GetObject("winmgmts:" _  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive")For Each objItem in colItems  If ObjItem.MediaLoaded Then	Set CD = colCDROMs.getByDriveSpecifier(objItem.Drive)	CD.Eject	Answer = WshShell.Popup("Please remove your CD within 20 seconds.", 20, "CD Removal Message", 0 + 32)	If Answer = 1 Then	  CD.Eject	  Else		CD.Eject	End If  End IfNext

After I separate the 1 long Line

Is this correct

strComputer = "."
Set WshShell = CreateObject("WScript.Shell")
Set oWMP = CreateObject("WMPlayer.OCX.7")
Set colCDROMs = oWMP.cdromCollectionSet 
objWMIService = GetObject("winmgmts:" _  
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_CDROMDrive")
For Each objItem in colItems  
If ObjItem.MediaLoaded Then	
Set CD = colCDROMs.getByDriveSpecifier(objItem.Drive)	
CD.Eject	
Answer = WshShell.Popup("Please remove your CD within 20 seconds.", 20, "CD Removal Message", 0 + 32)	
If Answer = 1 Then	  
CD.Eject	  
Else	   
 CD.Eject	
 End If 
  End If
  Next

[user1453]

I understand why the taskkill commands are in but I think the reason for my problems is my windows installation, I won't accept the ping command ether

[gunsmokingman]

That is not good as ping should work.

[user1453]

I think it may be time to reinstall windows