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
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!"
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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?