Hardisk Serial numarasını Bulmak

[baydeniro]

Merhaba arkadaşlar. Sayın leventm'den alınan bir kod ile Computer Name ve User Name çok kolayca bulunabiliyor. Kod Aşağıda :

msgbox environ("computername")

Bunun gibi kısa ve kolay bir yolla Harddisk Serial Numarasını bulmak mümkün mü ?

 

[Haluk]

Bu öyle çok kolay bir şey değildir.

Bilgisayardaki işletim sistemi ve diskin tipi önemlidir.

Her makinada çalışacağını garanti edemem ama ekteki dosya, yaptığım bir çok denemede başarılı sonuçlar verdi.

 

[hamitcan]

Kodlar, MrExcel sitesinden alıntıdır.
http://www.mrexcel.com/board2/viewtopic.php?t=287718&view=next

Sub Test()
    MsgBox ShowDriveInfo("C:\")
End Sub

Function ShowDriveInfo(drvpath)
   Dim fso, d
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(drvpath)))
   ShowDriveInfo = d.SerialNumber
End Function

 

[Haluk]

Sayın hamitcan;

Önerdiğiniz alternatifte sabit diskin fiziksel seri numarası değil, birim seri numarası geriye dönmektedir. Yani, her formatlamadan sonra otomatik olarak değişen, dolayısiyle de fazla güvenilemeyecek bir değerdir.

 

[baydeniro]

Sayın Hamitcan ve Haluk yardımlarınız için çok teşekkürler. Bu bilgiyi A1 hücresine yazdırmak için kodu nasıl değiştirmek gerekir ?

 

[hamitcan]

Sayın hamitcan;

Önerdiğiniz alternatifte sabit diskin fiziksel seri numarası değil, birim seri numarası geriye dönmektedir. Yani, her formatlamadan sonra otomatik olarak değişen, dolayısiyle de fazla güvenilemeyecek bir değerdir.

Sayın Haluk; açıkcası konuya sizin kadar vakıf değilim. Verdiğiniz ayrıntı için teşekkürler.

 

[hsayar]

Bu öyle çok kolay bir şey değildir.

Bilgisayardaki işletim sistemi ve diskin tipi önemlidir.

Her makinada çalışacağını garanti edemem ama ekteki dosya, yaptığım bir çok denemede başarılı sonuçlar verdi.

hocam teşekkür ederim kodlara göz attım da max ide dirvers = 4 yazan bir satır vardı
satalarda işe yaramıyor mu?

 

[Haluk]

Sayın hsayar;

Bahsettiğiniz konu disk sayısı, önemli olan disklerin SMART (Self-Monitoring Analysis and Reporting Technology) desteklemesi.

 

[baydeniro]

Sayın Hamitcan ve Haluk yardımlarınız için çok teşekkürler. Bu bilgiyi A1 hücresine yazdırmak için kodu nasıl değiştirmek gerekir ?

 

[hamitcan]

Sayın serdarokan, Sayın Haluk'un verdiği koda bir ekleme yaptım, bilginize...

Private Sub DriveSerialNo(MyDrive As String)
    Set ds = CreateObject("Scripting.FileSystemObject")
    Set d = ds.GetDrive(MyDrive)
     Label5.Caption = d.SerialNumber: [a1] = d.SerialNumber
    Label7.Caption = Hex(d.SerialNumber): [a2] = Hex(d.SerialNumber)
End Sub

 

[baydeniro]

Teşekkürler

Hamitcan ilginize teşekkürler. Şu tarz bir kod satırı nasıl yazılır. Bu konuda yardımcı olur musunuz !!!

If [A1] <> [A2] Then Unload File

 

[hsayar]

serdar bey anald&#305;&#287;&#305;m kadar&#305;yla dosya ba&#351;ka bir hardiske kopyalansa bile &#231;al&#305;&#351;mas&#305;n&#305; istemiyorsunuz. e&#287;er do&#287;ru anlm&#305;&#351; isem bu konuda yo&#287;unla&#351;&#305;nca &#231;&#246;z&#252;m bulunabilir., ancak dosyan&#305;z&#305;n yede&#287;inden bu kodu kald&#305;rmassan&#305;z sonra &#231;ok &#252;z&#252;l&#252;rs&#252;n&#252;z.

 

[hamitcan]

Ne yapmak istedi&#287;inizi daha a&#231;&#305;k yazar m&#305;s&#305;n&#305;z?

 

[baydeniro]

Peki şöyle sorayım : Dosyayı kaydetmeden kapat kodu nasıl yazılır ? Biraz amatörce olarak aşağıdaki kodu forumdan derledim. Ama Save - No - Cancel sorusunu soruyor.

ElseIf [A1] <> [A2] Then ActiveWorkbook.Close

 

[hamitcan]

Aşağıdaki şekilde dener misiniz?

Sub auto_close()
 ActiveWorkbook.Close False
End Sub

 

[baydeniro]

Sayın hamitcan çok çok teşekkürler.