Donanım Bilgisi (vbscript)

[TRWE_2012]

Kod: Tümünü seç

Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2") ' More user-friendly WMI connection
Set objNetwork = CreateObject("Wscript.Network")
Set wshShell = CreateObject("WScript.Shell")
strComputerName = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Set oShell = WScript.CreateObject("WScript.Shell")
proc_arch = oShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
Set oEnv = oShell.Environment("SYSTEM")

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colMB = objWMIService.ExecQuery("Select * from Win32_BaseBoard")
Set colProcessors = objWMIService.ExecQuery("Select * from Win32_Processor")
Set colDrives = objWMIService.ExecQuery("Select * from Win32_DiskDrive")

' Total RAM calculation
Set obj = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")
TotalRam = 0
ramDetails = ""
i = 1

For Each obj2 In obj
    memTmp1 = obj2.capacity / 1024 / 1024
    TotalRam = TotalRam + memTmp1
    ramSpeed = obj2.Speed
    ramType = ""

    If ramSpeed >= 1600 And ramSpeed < 2133 Then
        ramType = "DDR3"
    ElseIf ramSpeed >= 2133 And ramSpeed < 2933 Then
        ramType = "DDR4"
    ElseIf ramSpeed >= 2933 Then
        ramType = "DDR5"
    Else
        ramType = "Unknown"
    End If

    ramDetails = ramDetails & "Slot " & i & ": " & Int(memTmp1 / 1024) & " GB, Hız: " & obj2.Speed & " MHz, Tür: " & ramType & vbCrLf
    i = i + 1
Next

' Processor architecture
Set colItems = objWMIService.ExecQuery("Select Architecture from Win32_Processor")
For Each objItem in colItems
    If objItem.Architecture = 0 Then
       strArchitecture = "x86"
    ElseIf objItem.Architecture = 9 Then
       strArchitecture = "x64"
    End If
Next

' Graphics Card information
On Error Resume Next
Set colItemsx = objWMIService.ExecQuery("SELECT * FROM Win32_VideoController")
Dim tStr
tStr = ""

' Get display card information
For Each objItem in colItemsx
    tStr = tStr & "Model    : " & objItem.Description & vbCrLf
    
    ' Get memory size
    Dim memSize
    memSize = objItem.AdapterRAM / 1024 / 1024 ' in MB

    ' Check the memory size
    If InStr(LCase(objItem.Description), "intel") > 0 Then
        ' If internal graphics, we can dynamically take the memory from system RAM
        If memSize < 128 Then
            memSize = 128 ' Default memory for integrated graphics is 128 MB
        End If
    Else
        ' For external graphics, check the AdapterRAM value
        If memSize < 1024 Then
            ' If memory is less than 1 GB, probably an incorrect value is returned
            memSize = 4096 ' Default memory for external graphics is 4096 MB (4 GB)
        End If
    End If
Next
On Error GoTo 0

' Operating system information
Set dtmInstallDate = CreateObject("WbemScripting.SWbemDateTime")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
    fthx = getmydat(objOperatingSystem.InstallDate)
    Exit For
Next

Function getmydat(wmitime)
    dtmInstallDate.Value = wmitime
    getmydat = dtmInstallDate.GetVarDate
End Function

' Get disk information and check types
Dim diskInfo
diskInfo = "Disk Summary: " & vbCrLf

' If colDrives is not empty, proceed with processing
If colDrives.Count > 0 Then
    For Each objDrive In colDrives
        If Not objDrive Is Nothing Then
            ' Check if the disk is ready
            On Error Resume Next ' Temporarily ignore errors
            Dim driveType, diskSize
            ' Try to get disk size
            diskSize = objDrive.Size
            If Err.Number = 0 Then
                ' If size data is available
                If objDrive.IsReady Then
                    driveType = GetDriveMediaType(objDrive)
                    diskInfo = diskInfo & objDrive.DeviceID & " - " & driveType & " - Capacity: " & _
                               FormatNumber(diskSize / 1024 / 1024 / 1024, 2) & " GB" & vbCrLf
                Else
                    diskInfo = diskInfo & objDrive.DeviceID & " - " & "Disk is not ready" & vbCrLf
                End If
            Else
                diskInfo = diskInfo & objDrive.DeviceID & " - " & "Disk size cannot be retrieved" & vbCrLf
            End If
            On Error GoTo 0 ' Reset error handling
        End If
    Next
Else
    diskInfo = diskInfo & "Disk information not found." & vbCrLf
End If

' Function to determine the disk type (HDD/SSD/NVMe/USB)
Function GetDriveMediaType(DiskDrive)
    On Error Resume Next
    Dim mediaType
    If Not DiskDrive Is Nothing Then
        ' Identify NVMe disks by model name
        If InStr(1, LCase(DiskDrive.Model), "nvme") > 0 Or InStr(1, LCase(DiskDrive.Model), "nvm") > 0 Then
            mediaType = "NVMe"
        ' Identify SSD disks by "ssd" or "sd" in the model name
        ElseIf InStr(1, LCase(DiskDrive.Model), "ssd") > 0 Or InStr(1, LCase(DiskDrive.Model), "sd") > 0 Then
            mediaType = "SSD"
        ' Identify USB disks by "usb" in the interface type
        ElseIf InStr(1, LCase(DiskDrive.InterfaceType), "usb") > 0 Then
            mediaType = "USB"
        ' Default to HDD for other disks
        Else
            mediaType = "HDD"
        End If
    Else
        mediaType = "Unknown"
    End If
    On Error GoTo 0
    GetDriveMediaType = mediaType
End Function

' Get the system collection
Set SystemSet = objWMIService.ExecQuery("SELECT * FROM Win32_OperatingSystem")

' Gather information (only one loop for system, processor, and motherboard)
For Each System in SystemSet
    For Each objProcessor in colProcessors
        For Each bbType In colMB
            MbVendor = bbType.Manufacturer
            MbModel = bbType.Product
            tMessage = "Operating System		: " & System.Caption & vbNewLine & _
                       "OS Version		: " & System.Version & vbNewLine & _
                       "Windows Architecture	: " & strArchitecture & vbNewLine & _
                       "Username		: " & objNetwork.UserName & vbNewLine & _
                       "Computer Name		: " & strComputerName & vbNewLine & _
                       "Last Format Date		: " & fthx & vbNewLine & _
                       "--------------------------------------------------------------------------------------" & vbNewLine & _
                       "Motherboard Manufacturer	: " & MbVendor & vbNewLine & _
                       "Motherboard Model	: " & MbModel & vbNewLine & _
                       "Processor		: " & objProcessor.Manufacturer & vbNewLine & _
                       "Processor Model		: " & objProcessor.Name & vbNewLine & _
                       "CPU Architecture		: " & strArchitecture & vbNewLine & _
                       "Total RAM		: " & Int(TotalRam / 1024) & " GB" & vbNewLine & _
                       "RAM Slots		: " & vbNewLine & ramDetails & vbNewLine & _
                       "Graphics Card(s)		: " & vbNewLine & tStr & _
                       "--------------------------------------------------------------------------------------" & vbNewLine & _
                       diskInfo
            Exit For ' Only run this loop once for each section
        Next
        Exit For
    Next
    Exit For
Next

' Display using WshShell.Popup
Set WshShell = CreateObject("WScript.Shell")
WshShell.Popup tMessage, 0, "Hardware Information | by Abdullah ERTÜRK", 4096
' Tarih formatını ayarlama
Dim currentDate
currentDate = Now
Dim formattedDate
formattedDate = Year(currentDate) & "_" & Right("0" & Month(currentDate), 2) & "_" & Right("0" & Day(currentDate), 2)

' Dosya yolunu belirleme (Masaüstü)
Dim desktopPath
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Sistem Bilgileri_" & formattedDate & ".txt"

' Dosyayı oluşturma ve yazma
Dim fso, outputFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set outputFile = fso.CreateTextFile(desktopPath, True)

' Bilgileri dosyaya yazma
outputFile.WriteLine tMessage
outputFile.Close

' Kullanıcıya bilgi verme
WshShell.Popup "Sistem bilgileri " & desktopPath & " konumuna kaydedildi.", 0, "Bilgi", 64

Sağol. Teşekkür ederim. Bunu denedim. ama hem masaüstüne çıktı kaydediyor. ki ben bunu istememiştim.
Hemde wifi kartı ve ethernet kartı kayboldu. Ben bu ikisininde görünmesini istemiştim. Biraz uğraştım ama yapamadım.
Bu script işleri biraz zor ya.

Sana istediğin şekilde sadece ag kartı 1 ve 2'yi gösterecek şekilde script hazırladım. Bunu indirip deneyebilirsin. Kendi bilgisayarımda denedim. Normal scriptte ağ kartı 3 ve 4'ü gösteriyordu şimdiki editledigimde göstermiyor.

https://pixeldrain.com/u/7vgUvqMf

Hoşgeldin , özettin kendini....!!!

[Kayserilifatih]

Hoş bulduk teşekkür ederim hoş karşılaman için. Biraz forum'a ara vermek istemiştim bu arada terörle mücadele katında emniyette ifade verdim üç beş gün önce hala onun şokundayım nasıl oluyorsa 2012 yılında hakkında şimdi soruşturma başlatılan biri ankesörlü telefondan beni aramış seni niye arıyorlar terör örgütüyle ve o kişiyle bağlantın var mı, Pyd Ypg terör örgütü ile falan diye sordular detaylı bir şekilde ifade vermiştim. Normalde biraz daha foruma ara verecektim fakat Burak kardeşim özellikle yardım isteyince kıramadım geri döndüm.

[velociraptor]

Hoşgeldin

[Kayserilifatih]

Hoşgeldin

Karşılama mesajı yazan yazmayan tüm ekibe sıcak karşılamaları için ayrıca teşekkür ederim. Giriş yapmasam da her gün foruma ya da kardeş site yazılım adasına girip olanı biteni takip ediyordum. Sadece belli bir süre yaşadığım sorunlar yüzünden forumlardan kopmuş gibi hissettim kendimi fakat hep buradaydım misafir olarak. Tarkan hocam senin sayende bu script işine başladım yoksa pek ilgim yoktu, sitede seninle tanışmasam büyük ihtimalle Windows'u severek kulanıyor olmazdım. O yüzden yazılım çözümleri ile destek olan tüm ekibe sonsuz teşekkürler. Merak ettiğim bir soru var onu sormak istiyorum müsaadenizle. 12 yıldır bilgisayardaki 5400 rpm hard diskimde bekleyen 100 sektör zayıf 2 sektör çıktı yedek 252 sektör oluşmuş fakat bu bekleyen 100 zayıf sektörü bad sektör olarak işaretleyecegim bir araç arıyorum hard diskin kendisi işaretlememiş, umarım bulurum.

[TRWE_2012]

Hoşgeldin

Karşılama mesajı yazan yazmayan tüm ekibe sıcak karşılamaları için ayrıca teşekkür ederim. Giriş yapmasam da her gün foruma ya da kardeş site yazılım adasına girip olanı biteni takip ediyordum. Sadece belli bir süre yaşadığım sorunlar yüzünden forumlardan kopmuş gibi hissettim kendimi fakat hep buradaydım misafir olarak. Tarkan hocam senin sayende bu script işine başladım yoksa pek ilgim yoktu, sitede seninle tanışmasam büyük ihtimalle Windows'u severek kulanıyor olmazdım. O yüzden yazılım çözümleri ile destek olan tüm ekibe sonsuz teşekkürler. Merak ettiğim bir soru var onu sormak istiyorum müsaadenizle. 12 yıldır bilgisayardaki 5400 rpm hard diskimde bekleyen 100 sektör zayıf 2 sektör çıktı yedek 252 sektör oluşmuş fakat bu bekleyen 100 zayıf sektörü bad sektör olarak işaretleyecegim bir araç arıyorum hard diskin kendisi işaretlememiş, umarım bulurum.

Zayıf sektörleri bad sektör olarak işaretlemek için birkaç araç var, belki bunlar işine yarar:

HDD Regenerator: Bu yazılım, hard diskindeki zayıf sektörleri onarmaya çalışırken, aynı zamanda bad sektörleri de işaretlemeni sağlıyor. Kullanımı oldukça kolay, bir şans vermek isteyebilirsin.

Victoria: Bu araç, disk yüzeyini taramak için oldukça etkili. Biraz teknik bir yapısı var ama internette bulabileceğin birçok rehberle işini kolaylaştırabilirsin.

MHDD: Komut satırı tabanlı bir araç ama oldukça güçlü. Diskini tarayıp bad sektörleri işaretlemek için kullanabilirsin. Dikkatli olman gerek tabii, ama sonuçları genelde tatmin edici oluyor.

HDD Regenerator >>> 100 üzerinden 95 (daha önce defalarca eski sistemimde kullandım)
Victoria >>> 100 üzerinden 75 (bunu da kullandım)
MHDD >>>> 100 üzerinde 98 (bunu korka korka kullandım, neden korka korka kullandım? eğer tarama/işaretleme yaparken, elektrik giderse, yada aniden BDDOS (ünlü mavi ekran) verirse, diskinine veda etme olasılığın var)

[Kayserilifatih]

Bunların çoğunun indirme linkleri ya yok ya da sorunlu tam olarak güven vermedi bu programlar sadece hdd regeneratörü biliyorum onu indirip deneyeceğim fakat diğerleri hakkında pek fazla internette güvenli sitelerden indirme linki yok. Yapay zekaya sabah sormuştum aynı cevabı vermişti, bende antivirüs yok o yüzden deneme şansım da yok güvenip indirmeye çekiniyorum.

[TRWE_2012]

Bunların çoğunun indirme linkleri ya yok ya da sorunlu tam olarak güven vermedi bu programlar sadece hdd regeneratörü biliyorum onu indirip deneyeceğim fakat diğerleri hakkında pek fazla internette güvenli sitelerden indirme linki yok. Yapay zekaya sabah sormuştum aynı cevabı vermişti, bende antivirüs yok o yüzden deneme şansım da yok güvenip indirmeye çekiniyorum.

Ben bunları gerçekten kullandım...

HDD Regenerator >>> 100 üzerinden 95 (daha önce defalarca eski sistemimde kullandım)
Victoria >>> 100 üzerinden 75 (bunu da kullandım)
MHDD >>>> 100 üzerinde 98 (bunu korka korka kullandım, neden korka korka kullandım? eğer tarama/işaretleme yaparken, elektrik giderse, yada aniden BDDOS (ünlü mavi ekran) verirse, diskinine veda etme olasılığın var)

Hatta bu forum'da Victoria arat mutlaka önüne çıkacaktır forum konusu

[Kayserilifatih]

Hiç bu işlere işim düşmedi yeni deneyecegim fakat yine de teşekkürler.

[TRWE_2012]

Hiç bu işlere işim düşmedi yeni deneyecegim fakat yine de teşekkürler.

Ben bu yazılımlar sayesinde (+ Vopt 9.21 Disk Birleştirme Yazılımı dahil) eski sistemdeki Fijutsu Marka 160 GB SATA-II 5400 RPM diski tam 75000 saat kullanabildim.En sonunda "Uçtan Uca Hatası" verdi. (100'den 99'a indi.) ve kullanılmaz hale geldi.İyi dayandı 16 sene....

[TRWE_2012]

İspat Ekran Görüntüsü :

Arşivden bir görüntü....

[Kayserilifatih]

Attığın resimden hiçbir şey anlamadım, ne ifade ettiğini açıklar mısın. Hdd regenerator yüzey taramasının sonucunda disk sağlığını yüzde 56 buldu sarı işaretle yedekleme önerdi. Dmcrc hatasını 28 olarak buldu, 84 tane D yazan sektör olduğunu söyledi, D harfi gecikme anlamına geliyormuş. 11.195 saat çalışmış hard disk programa göre fakat free kullandım yani ilaç yapmadım bulursam yapacağım yoksa programlar ilaç yapmadan fazla bir şey yapmıyor. Yedek dediğim kısımda 2 yazıyor sanırım o 100 değil 2 yani data 2 yazıyor 100=100>2 data kısmında 2 yazıyor. Diskte su anlık bad sektör çıkmadı. En kısa sürede bu diski değiştireceğim. 318 gb veriyi Ssd diskten buna deneme amaçlı olarak kopyaladım sorunsuz kopyaladı fakat yedekleme anlamında bu seagate diskim bana pek güven vermiyor.

[burak35]

@Kayserilifatih teşekkürler. Tekrar hoşgeldin. Tamda bana lazım olan şekilde scripti editlemişsin. Sağol arşive ekleyeceğim artık.
Yaşadığın olayı bilmiyordum. Şimdi yazdıklarından okudum öğrendim. Geçmiş olsun. Dikkat et. Dünya bu. Kötü insanlar heryerde malesef.
Herif kimbilir kimi aradıda, Senin gibi sıradan sade vatandaş çıktı telefonda işte. Ama gelde anlat insanlara. Umarım sorunu çözmüşsündür.
Umarım emniyet Sana inanmıştır ikna olmuşlardır. Zira zaman kötü. Herkesin dikkatli olması lazım artık.
Buarada hdd regenarator programını bende birçok sitede gördüm. İstersen o programı kullanabilirsin. Ben hiç kullanmadım.
Çünkü hiç işim düşmedi. İnternette birçok program yazılım vardır o tarz. Bolbol araştırma yapıp youtubeda videolarını izlemeni tavsiye ederim.

[Kayserilifatih]

Güle güle kullanmanı dilerim. Şimdilik sorun yok gibi görünüyor fakat ileride sorun olursa da büyük ihtimalle yanlış anlaşılma olduğu anlaşılır sonuçta iddia ettikleri aramada kötü bir şey olsaydı bunu bana mutlaka sorarlardı fakat bu tarz bir olayın neden 2012 yılında olmasına rağmen şimdi bu zamanda ortaya çıktığını anlayamaıyorum. Ifadem alınırken bana sakin, güleryüzlü ve ılımlı davranıldı büyük ihtimalle yanlış anlaşılmadır dedi ifademi alan görevli ki bunun için kötü bir olay yaşayacagıma dair içimde bir his olmasa da hafif bir tedirginlik de yok degil. Bu tedirginliğin zamanla hafifleyecegini ve yok olacağını düşünüyorum. Sorun olursa da mutlaka bir çözüm bulunur. Desteğin için sonsuz teşekkürler.

[burak35]

Umarım sorun sıkıntı yaşamazsın. Script tam istediğim gibi buarada. Teşekkür etmek için bende kendi tweak paketimi paylaşayım.
Kısa bir süre önce elimdeki tüm tweakleri birleştirdim. Hemen hemen Hepsini tek parça haline getirdim. Ve çok iyi oldu. Büyük kolaylık sağladı.
Bir nevi format sonrası gibi bir tweak paketi yaptım denebilir. 2 tıkla kullandığım tüm özelleştirmeleri sisteme ekle kaldır yapabiliyorum.
Göz atıp denemeni hatta kullanmanı tavsiye ederim. Bence çok işine yarayabilir. Hem zamandanda tasarruf ettirebilir.
viewtopic.php?t=226095

[Kayserilifatih]

Windows 11 24H2 de virtualbox programındaki sistemde denedim sorun çıkarmıyor gibi görünüyor fakat gerçek sistemde denemedim. Ben bu çoğu ayarı kendime yaptığım modifiye sistemlerde iso dosyasında kullanıyorum lakin yine de teşekkürler. Bilgisayar kullanımında amatör olan bazı Windows 10 kullanıcılarının belli bir ölçüde işine yarayabilir fakat senin de dedigin gibi bu reg kayıtlarını kullanmadan önce sistem yedeği almaları ya da sistem geri yükleme noktası oluşturmalarını kendi faydalarına olacağı için ben de özelikle tavsiye ediyorum. Karşılık beklemeden içimden geldi yoksa forumda biraz daha misafir olarak kalmayı planlıyordum yardım ricanla geri döndüm. Ne demişler iyilik yap denize at insan bilmezse Allah bilir benim misyonum bu olduğu için hiçbir zaman övünme gereği duymadım çünkü şunu çok iyi biliyorum işportacı bağırır fakat altıncı bağırmaz çünkü kendinden her daim emindir bu yüzden kendini ispatlama gereği duymaz.