Link to home
Start Free TrialLog in
Avatar of MarryJ
MarryJ

asked on

I need to convert a VBS to a Delphi GUI?

Hello,
I do have a little problem, i do have this VBS script, and i need to convert it to a delphi instead. It has to be an exe with a GUI, i have been trying to it with no success :( . I do really need that for my work, can any body help? I have pasted the VBS bellow

Any help is really appreciated.
Thank you
On error resume next
 
Dim objUser, strExcelPath, objExcel, objSheet, k, objGroup, cnt, unReached
 
' Spreadsheet file to be created.
strExcelPath = "c:\UserGroup.xls"
 
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Excel application not found."
    Wscript.Quit
End If
'On Error GoTo 0
 
cnt = 2
unReached = 2
Const ADS_SCOPE_SUBTREE = 2
Set fso = CreateObject("Scripting.FileSystemObject")
 
' Create a new workbook.
objExcel.Workbooks.Add
 
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "User Groups"
 
Set objSheetU = objExcel.ActiveWorkbook.Worksheets(2)
objSheetU.Name = "Unavailable"
objExcel.ActiveWorkbook.SaveAs strExcelPath
 
' Populate spreadsheet cells with user attributes.
objSheet.Cells(1, 1).Value = "Computer Name"
objSheet.Cells(1, 2).Value = "User Name"
objSheet.Cells(1, 3).Value = "Manufacturer"
objSheet.Cells(1, 4).Value = "Model"
objSheet.Cells(1, 5).Value = "Serial No"
objSheet.Cells(1, 6).Value = "Part No"
objSheet.Cells(1, 7).Value = "OS"
objSheet.Cells(1, 8).Value = "Processor"
objSheet.Cells(1, 9).Value = "Ram"
objSheet.Cells(1, 10).Value = "DiskDrive Size"
objSheet.Cells(1, 11).Value = "Graphic Card Model"
objSheet.Cells(1, 12).Value = "Graphic Card Memory"
 
 
objSheetU.Cells(1, 1).Value = "Computer Name"
 
 
 
set list = fso.CreateTextFile("./output.txt")
Set upgrade = fso.CreateTextFile("./upgrade.txt")
 
strDomainDn = InputBox("domain" & vbCrLf & "(i.e. dc=domain,dc=com)")
 
If strDomainDn = "" Then
	WScript.Echo "Exiting!"
	WScript.Quit
End If
 
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
 
Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = _
    "Select Name, Location from 'LDAP://" & strDomainDn & "' " _
        & "Where objectClass='computer'"  
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
 
Do Until objRecordSet.EOF
    
    ' list.write "Computer Name: " & objRecordSet.Fields("Name").Value
    strComputer = objRecordSet.Fields("Name").Value
    
    Set objShell = CreateObject("WScript.Shell")
    strCommand = "%comspec% /c ping -n 3 -w 1000 " & strComputer & ""
    Set objExecObject = objShell.Exec(strCommand)
 
	Do While Not objExecObject.StdOut.AtEndOfStream
        strText = objExecObject.StdOut.ReadAll()
        If Instr(strText, "Reply") > 0 Then
            Set objWMIService = GetObject _
                ("winmgmts:\\" & strComputer & "\root\cimv2")
	 	    Set colItems = objWMIService.ExecQuery _
	                ("Select * From Win32_OperatingSystem")
		      
		    Set colItems2 = objWMIService.ExecQuery("Select * from Win32_BIOS",,48)
	           ' list.write Err.Description
		    Set colItems3 = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
		    Set colItems4 = objWMIService.ExecQuery("SELECT * FROM Win32_Processor", "WQL", _
	                                          wbemFlagReturnImmediately + wbemFlagForwardOnly)
		    Set colItems5 = objWMIService.ExecQuery("Select * from Win32_VideoController ")
 		    Set colItems6 = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
		    Set colItems7 = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
		    Set colItems8 = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
	
 
 
 
 
		    For Each objItem in ColItems
	        	strOS = objItem.Caption
		    Next
			
		    For Each objItem in colItems2
				strSerialno = objItem.SerialNumber
				strManu = objItem.Manufacturer
	    	    Next
			
		    For Each objItem in colItems5
				strGraphicalVideoCard = objItem.Caption
				strGraphicalVideoCardMemory = objItem.AdapterRAM
		    Next
			
		    For Each objItem in colItems6
				strHDsize = objItem.Size
		    Next
			
		    For Each objItem in colItems7
				stOS = objItem.Caption
		    Next
 
			
	
		    For Each objItem in colitems3
		        strUserName = objItem.Username
				strModel = objItem.Model
				strRAM = objItem.TotalPhysicalMemory
				strTimeZone = (objItem.CurrentTimeZone / 60)
				strDayLightSavings = objItem.DaylightInEffect
		    Next
		
		    For Each objItem in colitems4
				strProcessor = objItem.Name
	        Next
			
			If Err.Number > 0 then
			    strErrorSystems =  strComputer & ", " & strErrorSystems 
			Else
			    list.write "-------------------------------------------------------------" & vbcrlf & vbcrlf
			    list.write "Computer Name: " & strComputer & ", " & strUserName & vbcrlf 
			    list.write "-------------------------------------------------------------" & vbcrlf & vbcrlf
'#################### Comuter Name ###################################
objSheet.Cells(cnt, 1).Value = strComputer
'####################################################################
		        list.write "Operating System: " & strOS & vbcrlf
	            list.write "Current User: " & strUserName & vbcrlf
'#################### Current User ###################################
objSheet.Cells(cnt, 2).Value = strUserName
'####################################################################
			    list.write "::::" & vbcrlf
			    list.write "Manufacturer: " & strManu & vbcrlf
'#################### Manufacturer  ###################################
objSheet.Cells(cnt, 3).Value = strManu
'####################################################################
			    list.write "Model: " & strModel & vbcrlf
'#################### Model  ###################################
objSheet.Cells(cnt, 4).Value = strModel
'####################################################################
			    list.write "Service Tag: " & DellTag & vbcrlf
			    list.write "Processor type: " & strProcessor & vbcrlf
'#################### Processor ###################################
objSheet.Cells(cnt, 8).Value = strProcessor
'####################################################################
			    list.write "RAM: " & strRAM & vbcrlf
'#################### Ram  ###################################
memoryX = (strRam/1024)/1024
memoryX = Int(memoryX)
memoryX = memoryX + 2
objSheet.Cells(cnt, 9).Value = memoryX 
'########################################################################################
list.write "GraphicalVideoCard: " & strGraphicalVideoCard & vbcrlf
'##############################  GraphicalVideoCard ######################################
objSheet.Cells(cnt, 11).Value = strGraphicalVideoCard
'##############################  GraphicalVideoCard Memory ######################################
memoryz = (strGraphicalVideoCardMemory/1024)/1024
memoryz = Int(memoryz)
objSheet.Cells(cnt, 12).Value = memoryz 
'##############################  Hard Drive Memory ######################################
memoryT = ((strHDsize/1024)/1024)/1024
memoryT = Int(memoryT)
objSheet.Cells(cnt, 10).Value = memoryT
'#################### Serial Number ###################################
objSheet.Cells(cnt, 5).Value = strSerialno
'#################### O S ###################################
objSheet.Cells(cnt, 7).Value = stOS
'#################### O S ###################################
objSheet.Cells(cnt, 6).Value = strModel
 
 
 
 
			    list.write "Time Zone: " & strTimeZone & vbcrlf
			    list.write "Daylight Savings in effect: " & strDayLightSavings & vbcrlf
			    list.write "-------------------------------------------------------------" & vbcrlf & vbCrLf
			    memory = (strRam/1024)/1024
			    memory = Int(memory)
			    memory = memory + 2
				
								
			End If
			    
		    'flushes error code from the previous loop
		    Err.Clear
	   Else
	     	UnavailableSystems =  strComputer & ", " & UnavailableSystems
		objSheetU.Cells(unReached, 1).Value = strComputer
unReached = unReached + 1
	   End If
    Loop
    objRecordSet.MoveNext
    cnt = cnt +1
 
objExcel.ActiveWorkbook.Save
Loop
 
list.write "The following systems were unavailable: " & UnavailableSystems & vbcrlf
list.write " " & vbcrlf & vbcrlf
list.write "The following systems were on, but returned an error: " & strErrorSystems & vbcrlf
 
' Save the spreadsheet and close the workbook.
 
objExcel.ActiveWorkbook.Close
 
' Quit Excel.
objExcel.Application.Quit
 
WScript.Echo "Done!"

Open in new window

Avatar of aikimark
aikimark
Flag of United States of America image

Here are examples of using WMI with Delphi:
https://www.experts-exchange.com/questions/23201105/Get-All-Lan-card-names-with-ip-address-DELPHI.html
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=628&lngWId=7
http://www.prototypical.co.uk/pdf/are%20you%20wmi%202.pdf
Downloadable example from Embarcadero is knowledgebase item 19255

There are also some WMI wrapper libraries, like:
http://www.online-admin.com/wmiset.html

===========================
For simplicity, I would eliminate the FileSystemObjects when creating the list and update files.  Note that the Update file is never written to an these statements can be deleted.

There are two options for writing the data into Excel.  You can instantiate an Excel object, much like the VBScript code.  You can also use an TExcel control on your Delphi form.

===========================
What is your level of Delphi expertise?
What is your level of VBScrip expertise?

Avatar of MarryJ
MarryJ

ASKER

Thank You,
I will try that , i hope i couldnt build some sort of GUI using your tips as its needed by one of my clients.
I know nothing about VBscripting, i only work with a team in customizing database applications in delphi.
ASKER CERTIFIED SOLUTION
Avatar of aikimark
aikimark
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial