'SetVPCFloppy.vbs
'This script sets/clears the floppy drive settings for Virtual PC
'11-13-11 Alan dot Kaplan at VA dot Gov

Option Explicit
Dim wshshell: Set WshShell = CreateObject("WScript.Shell")
Dim message, retval 
dim bNewAssign: bNewAssign = True

Const statustext         = &H0004
Const returnfsancestors  = &H0008
Const editbox            = &H0010
Const validate           = &H0020
Const browseincludefiles = &H4000

Dim objDrive, colFloppyDrives
Dim objVM
dim objVMs, iFlopCount
Dim aVPCs, i

On Error Resume Next
Dim objVPCApp: Set objVPCApp = CreateObject("VirtualPC.Application")
If Err <> 0 Then 
	If Err.Number = 70 Then
		message = "Do not run this in an elevated prompt"
	Else
		message = "Failed to instantiate Virtual PC object with " & Err.Description
	End If 
	MsgBox message, vbCritical + vbOKOnly,"Error"
	WScript.Quit
End If 
On Error GoTo 0

message = "This allows you to connect and disconnect a floppy drive or image to a Virtual PC.  Note that you will still need to " & _
"change the BIOS to set boot from floppy.  You can set the drive to a physical drive, or a VFD image. " & _
"Run this with the ordinary rights of the user who owns the VPC.  Do you want to continue?"
retval = MsgBox(message,vbYesNo+ vbQuestion,"Set Floppy Drive")
If retval <> vbYes Then WScript.Quit

aVPCs = Array()
i=0

Set objVMs = objVPCApp.VirtualMachines
For Each objVM In objVMs
	ReDim Preserve aVPCs(i + 1)
	avpcs(i) = objVM.name
	i = i + 1
Next 

message = "Change Floppy assignment on which VPC? " & VbCrLf & VbCrLf  
For i = 0 To UBound(aVPCs) -1
 	message = message &  i +1 & ")  " &  aVPCs(i) & VbCrLf 
Next
message = message & VbCrLf &  "0)  Exit Script"

retval = InputBox(message, "Select VM")
If cint(retval) = 0 Then WScript.Quit

Dim strVMName:strVMName = aVPCs(retval -1)
Dim strCurrentDrives: strCurrentDrives=CurrentDrives()

FloppyInit strVMName

If len(strCurrentDrives)> 0 Then  PromptClear 

if bNewAssign then PromptAssign

' ========== Functions and Subs ===============
Sub PromptAssign()
	message = "You may:" & VbCrLf & _
	"1) Attach a VFD floppy image to VM " & strVMName & VbCrLf & _
	"2) Attach a physical floppy drive to VM " & strVMName & VbCrLf & _
	"0) Quit"
	
	retval = InputBox(message,"Physical Drive or Image File",0)
	Select Case retval 
		Case 1 AttachImage
		Case 2 AttachDrive
		Case Else WScript.Quit
	End Select
End Sub 

Sub PromptClear()
	message = "You have the following drive or image attached: " & strCurrentDrives & ". You may" & VbCrLf & _
	"1) Clear floppy settings and quit" & VbCrLf & _
	"2) Clear floppy settings and continue" & vbcrlf &  VbCrLf & _
	"0) Quit"
	
	retval = InputBox(message,"Manage Current Floppy Assignments",0)
	If retval = 0 Then WScript.Quit
	If retval = 1 Then bNewAssign = False
	ClearDrives
End Sub

Sub AttachImage()
	dim fso
	set fso = CreateObject("Scripting.FileSystemObject")

	Dim strImagePath
	strImagePath = ExcelOpenDialog("Choose a VFD file", "VFD Files (*.vfd),*.vfd","" ) 

 	If Right(ucase(strImagePath),3) <> "VFD" Then 
 		MsgBox strImagePath & " is not a VFD file." ,vbCritical + vbOKOnly,"Error"
 		WScript.Quit
 	End If 	
 	
	If Not fso.FileExists(strImagePath) Then 
		MsgBox "Could not find " & strImagePath,vbCritical + vbOKOnly,"Error"
		WScript.Quit
	End If 
	
	'Assign an imagename
	For Each objDrive in colFloppyDrives
	    retVal = objDrive.AttachImage(StrImagePath)
	Next
	
	If Err <> 0 Then
		MsgBox "Failed with error: " & Err.Description,vbCritical + vbOKOnly,"Error"
	Else
		message =  "Assigned " & strImagePath  & " To " & strVMName & ". Don't forget to " & _
		"change the BIOS settings to enable floppy and change boot order if necessary.  Press the DEL key " & _
		"on VM boot to enter BIOS setup."
		MsgBox,message, vbOKOnly,"Success"
	End If 
End Sub 

Sub AttachDrive()
	On Error Resume Next
	Dim StrImageDrive 
	StrImageDrive = InputBox ("Attach physical floppy to what drive letter?","Physical Drive","A:")
	StrImageDrive = Left(StrImageDrive,1)

	For Each objDrive in colFloppyDrives
	    retVal = objDrive.AttachHostDrive(StrImageDrive)
	Next
	If Err <> 0 Then
		MsgBox "Failed.  This works only when you have a physical drive attached",vbCritical + vbOKOnly,"Error"
	Else

		message =  "Assigned " & StrImageDrive  & " To " & strVMName & ". Don't forget to " & _
		"change the BIOS settings to enable floppy and change boot order if necessary.  Press the DEL key " & _
		"on VM boot to enter BIOS setup."
		MsgBox message,vbOKOnly,"Success"
	End If 
End Sub 


Sub ClearDrives()
	On Error Resume Next
	For Each objDrive in colFloppyDrives
		objDrive.ReleaseHostDrive()
		objDrive.ReleaseImage()	
	Next
	Err.Clear
	wshshell.Popup "Current assignments have been cleared.",10,"Cleared Settings"
	On Error GoTo 0
End Sub 

Function FloppyInit(VMName)
	Dim objimage	
	Set objVM = objVPCAPP.FindVirtualMachine(VMName)
	Set colFloppyDrives = objVM.FloppyDrives
	iFlopCount = colFloppyDrives.count
	If iFlopCount > 0 Then 
		For Each objImage In colFloppyDrives
			if objImage.Attachment = 1 then strCurrentDrives = objIMage.imageFile
		Next  
	End If
End Function 

Function CurrentDrives()
	On Error Resume Next
	For Each objDrive in colFloppyDrives
		CurrentDrives = CurrentDrives & objDrive.HostDriveLetter
	Next
	On Error GoTo 0 
	Err.Clear
End Function 

Function ExcelOpenDialog( sPrompt, sFilter, strDefaultFile ) 
	'Based on code by Michael Hardt 
   	'http://www.softimage.com/community/xsi/discuss/archives/xsi.archive.0111/msg00066.htm
	Dim oXL, sFile
	On Error Resume Next 
	Set oXL = CreateObject("Excel.Application") 
	If Err =  0 Then 

   	sFile = oXL.GetOpenFilename ( sFilter, , sPrompt) 	   	
	'Cancel or no file name? 
	   	If sFile <> False Then 
	      	ExcelOpenDialog = sFile 
	   	Else 
	     	 Wscript.quit
	   	End If 
	 Else
	 	Err.Clear
		ExcelOpenDialog = InputBox("Enter path to FLP file","File Path")
	 End If 
	On Error GoTo 0
End Function