Ağdaki Kullanıcı Bilgilerinin Listelenmesi

[Bogachank]

Sayın Üstatlar Merhaba,

Ekteki excel dosyasında Formumuzdaki çeşitli uzmanlarımızın hazırlamış olduğu ve internet üzerinden elde ettiğim bazı kodlar bulunmaktadır. Bu kodlar ağdaki kullanıcıların domainden (user name - user full name - computer name)' ini çekmektedir. Aynı zamanda ilgili makinanın Ip adresini ve Mac adresini çeken iki ayrı kodda bulunmaktadır.

Sizden ricam bu bilgileri ağdaki tüm makinaları listeleyecek şekilde tek bir makro olarak çalıştırıp istenilen sayfasında ki şekli ile listelemek. (Eğer yanında diğer bilgiler de gelirse sorun olmaz)

Haluk Beyin geçmişte yaptığı bazı çalışmalar mevcut, kendisine ulaşamadığım için konu açmak zorunda kaldım.

http://www.excel.web.tr/f134/yerel-aodaki-bilgisayarlar-t41354.html



Yardımınızı rica ederim.

Saygılarımla.

 

[Bogachank]

Sevgili Üstatlarım,

bir yorum yokmu ?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki linkte örnek var ama ben çalıştıramadım.

Nette "netapi32" olarak arama yapın. Network ile ilgili bilgileri araştırırken bu dll dosyası ile çözümlerle karşılaştım. Bu dll dosyası ile ilgili örnekleri inceleyin.

http://www.andreavb.com/tip060006.html

Alttaki linktede yine aynı dll dosyası ile ilgili farklı örnekler bulunmaktadır.

http://www.andreavb.com/API_NETAPI32.html

 

[Bogachank]

Korhan bey merhaba,

öncelikle cevabınız için teşekkür ederim ama bende sizin gibi malesef çalıştıramadım. tavsiyenizle aramalar yapıyorum, umarım bir sonuç bulabilirim.

yardımınız için çok teşekkürler

 

[Bogachank]

Üstatlar,

konuyla ilgili yardımcı olabilirmisiniz. hala çözüme ulaşamadım.

iyi günler.

 

[Bogachank]

Sevgili Üstadlarım,

http://www.vbforums.com/showthread.php?t=532483 adresinde bulduğum bir VB scripti excele uyarlamak istiyorum ama malesef başaramadım, konuyla ilgili yardımlarınızı rica ederim.

İyi Çalışmalar.

kod aşağıdaki gibidir;

<start vbscript>

'==========================================================================
 ' Computer Information Detection Script
 ' 
 ' Description:
 ' Detect is a computer is Online or Offline
 ' If computer is online, extract IP Number, OS version + SP + Build info
 ' and current logged on user.
 '
 ' populate File_name.xls from A2 down with computer names to scan
 ' 
 ' Created by: Marcel Duran.
 ' on: 04-27-2011
 '
 ' version 1.5: added MAC Address
 ' version 1.4: added screensaver detection
 ' version 1.3: second published version
 '==========================================================================

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
intRow = 2

Set Fso = CreateObject("Scripting.FileSystemObject")
Set objWorkbook = objExcel.Workbooks.Open("b:File_Name.xls")
Set InputFile = objWorkbook
Do Until objExcel.Cells(intRow,1).Value = ""
strComputer = objExcel.Cells(intRow, 1).Value 


objExcel.Cells(1, 1).Value = "Machine Name" 
objExcel.Cells(1, 2).Value = "Username" 
objExcel.Cells(1, 3).Value = "Full Name" 
objExcel.Cells(1, 4).Value = "Computer Locked" 
objExcel.Cells(1, 5).Value = "IP Address" 
objExcel.Cells(1, 6).Value = "Status"   
objExcel.Cells(1, 7).Value = "Microsoft OS"   
objExcel.Cells(1, 8).Value = "SP"   
objExcel.Cells(1, 9).Value = "Build"  
objExcel.Cells(1, 10).Value = "MAC Address"  


'==========================================================================
 ' The following function will resolve a computer name to its ip address
 ' using WMI and the Win32_PingStatus Class
 '==========================================================================

 Dim wmiQuery : wmiQuery = "Select * From Win32_PingStatus Where Address = '" & strComputer & "'"
 
 Dim objWMIService : Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 Dim objPing : Set objPing = objWMIService.ExecQuery(wmiQuery)
 Dim objStatus

 For Each objStatus in objPing
    If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
    objExcel.Cells(intRow, 1).Font.ColorIndex = 3
        objExcel.Cells(intRow, 5).Value = "Computer is Unreachable!"
    objExcel.Cells(intRow, 6).Font.ColorIndex = 3
        objExcel.Cells(intRow, 6).Value = "offline"
    Else
        objExcel.Cells(intRow, 5).Value = objStatus.ProtocolAddress
    objExcel.Cells(intRow, 6).Font.ColorIndex = 4
        objExcel.Cells(intRow, 6).Value = "online"
    End If

On Error Resume Next


'==========================================================================
 ' The following function show the Username that is logged on
 '==========================================================================

strUser="" 'User with ADMIN rights on remote PC
strUserPwd=""
strDomain="" 'If computer is member of Domain, if computer is in workgroup, keep this variable empty ("")

Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
if strDomain="" then
    Set objSWbemServices = objSWbemLocator.ConnectServer(strComputer, "root\cimv2", strUser, strUserPwd)
else
    Set objSWbemServices = objSWbemLocator.ConnectServer(strComputer,  "root\cimv2", strUser, strUserPwd, "MS_409", "ntlmdomain:" + strDomain)
end if

Set colSwbemObjectSet = objSWbemServices.ExecQuery("Select * From Win32_Process where name='explorer.exe'")

on error resume next

For Each Process in colSwbemObjectSet
    If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
        objExcel.Cells(intRow, 2).Value = ""
    else
     lRet = Process.GetOwner(sUser, sDomain)
      If (Err.number = 0) And (lRet = 0) Then
        objExcel.Cells(intRow, 2).Value = "CORP\" & sUser
      else
        objExcel.Cells(intRow, 2).Value = "Error: " & err.number & ":" & err.Description
      End If
  End If
next


'==========================================================================
 ' The following function checks if the screensaver is active
 '==========================================================================

on error resume next

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process")

For Each objProcess in colProcesses
    If Right(objProcess.Name, 4) = ".scr" Then
        objExcel.Cells(intRow, 4).Value = "The screen saver " &  objProcess.Name & " Start time: " & dtmScreensaverStart
        dtmStartTime = objProcess.CreationDate
        dtmScreensaverStart = WMIDateStringToDate(dtmStartTime)
     Else
        objExcel.Cells(intRow, 4).Value = "The screen saver is not running."
    End If
Next

WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" &  Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) & " " &  Mid (dtmBootup, 9, 2) & ":" & Mid(dtmBootup, 11, 2) & ":"  & Mid(dtmBootup,13, 2))



'==========================================================================
 ' The following function show the OS / version and service pack information
 '==========================================================================

on error resume next

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each objOS in colOSes
 If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
    objExcel.Cells(intRow, 4).Value = ""
        objExcel.Cells(intRow, 7).Value = ""
        objExcel.Cells(intRow, 8).Value = ""
        objExcel.Cells(intRow, 9).Value = ""
    else
      objExcel.Cells(intRow, 7).Value = objOS.Caption 'Name
      objExcel.Cells(intRow, 8).Value = objOS.ServicePackMajorVersion & "." & objOS.ServicePackMinorVersion
      objExcel.Cells(intRow, 9).Value = objOS.Version 'Version & build
   End If
Next

'==========================================================================
 ' The following function show the MAC address of the machine name
 '==========================================================================


Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery ("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem in colItems
    If IsNull(objStatus.StatusCode) Or objStatus.Statuscode<>0 Then
        objExcel.Cells(intRow, 10).Value = ""
    Else
        objExcel.Cells(intRow, 10).Value = objItem.MACAddress
    End If
Next


'==========================================================================
 ' The following function will autosize the columns
 '==========================================================================

    objExcel.Range("A1:J1").Select
    objExcel.Selection.Interior.ColorIndex = 19
    objExcel.Selection.Font.ColorIndex = 11
    objExcel.Selection.Font.Bold = True
    objExcel.Cells.EntireColumn.AutoFit 


    Next
    intRow = intRow + 1
    Loop

------
<end of vbscript>