harddisk seri no

[akd]

Merhaba arkadaşlar,
Biliyorsunuz, harddiskin seri numarası her formattan sonra degişiyor, ama bana format atılsa dahi harddiskin degişmeyen bir seri numarası varsa lazım, şifre olayını sabitlemek için lazımdı, yardımcı olacak arkadaşlara şimdiden teşekkürlerimi sunarım...

 

[danersin]

bios seri numarasını kullansanız olmazmı. excel için örnek çalışmalarda @raider'ın bir çalışması var bios seri numarasını okutmakla ilgili.

 

[akd]

Teşekkürler sayın danersin,
Ne demek daha iyi olur,
nereden alabilirim bu kodu yazarmısınız lütfen....
derken aradım aşağıdaki kodu buldum o da boş olarak mesaj veriyor
'Sub InfoBIOS()
Dim MyOBJ As Object
Dim MyBios As Variant
Dim MyMsg As String
On Error Resume Next
Set MyOBJ = GetObject("WinMgmts:").instancesOf _
("Win32_Bios")
If Err.Number <> 0 Then
MsgBox "WMI yüklenmemiş! Programdan çıkılacak...", vbExclamation, _
"Windows Management Instrumentation"
Exit Sub
On Error GoTo 0
End If
For Each MyBios In MyOBJ
MyMsg = String(50, "-") & vbCrLf
MyMsg = MyMsg & "Üretici Firma : " & MyBios.Manufacturer & vbCrLf
MyMsg = MyMsg & "BIOS Seri Numarası : " & MyBios.SerialNumber & vbCrLf
Next
MsgBox MyMsg, vbInformation, "BIOS Bilgileri (Raider ®)"
End Sub

BIOS Seri Numarası : diyor ama boş

 

[Haluk]

ehehee....

Demek sizin BIOS fasonmuş :mrgreen:

İsterseniz benzer şekilde Windows seri numarasını kontrol edin....

http://www.excel.web.tr/viewtopic.php?t=2074

 

[akd]

Merhaba sayın raider,
Bu linkteki kodu çalıştırdım
herşeyi gösteriyorda, malesef bize lazım olan bios un seri numarasını göstermiyor,
ben yapmış olduğum çalışmama bir şifre koyuyorum onuda HHd. seri numarası ile yapıyordum , format atılınca yeniden şifre soruyorlar veya proğramı başka pc lerde çalışmak içinde şifre istiyor olabilirler ,
işte bunu önlemek için , format atıldığında da degişmeyen bir seri numarası varmı onu arıyorum , lütfen yardım edermisiniz.
Saygılar...

 

[Haluk]

Merhaba;

O zaman Windows seri numarasını kullanın.

Herhalde sık sık Windows versiyonunu yükseltmiyorlardır...

 

[veyselemre]

bu kodları internette buldum bir dene

-----------
Private Declare Function GetVolumeInformation Lib _
"kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
lpRootPathName As String, ByVal lpVolumeNameBuffer As _
String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long
Function SeriNoAl(strDrive As String) As Long
Dim SerialNum As Long
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
SeriNoAl = SerialNum
End Function
Private Sub CommandButton1_Click()
Call MsgBox(SeriNoAl("C:\"))
End Sub

 

[cako]

Güzel bir siteden güzel bir çalışma
http://www.api.gen.tr/ExcelApi_0005.asp

 

[birol_mumcu]

merhaba; :hey:
"aşağıdaki kodlar alıntıdır"
Disk Bilgilerini Ã?ğrenmek
Aşağıdaki programcık dilediğiniz sürücünün seri numarasını ve etiketini komut butonuna basıldığında size veriyor. "PathName$ = " satırını değiştirerek istediğiniz sürücüyü seçebilirsiniz...

' Formdan ayrı bir BAS modülüne girecek:
Option Explicit
Declare Function GetVolumeInformation Lib
"kernel32" Alias "GetVolumeInformationA"
(ByVal lpRootPathName As String, ByVal
lpVolumeNameBuffer As String, ByVal
nVolumeNameSize As Long, lpVolumeSerialNumber
As Long, lpMaximumComponentLength As Long,
lpFileSystemFlags As Long, ByVal
lpFileSystemNameBuffer As String, ByVal
nFileSystemNameSize As Long) As Long

'Aşağıdaki kodların hepsi formun General -
Declarations bölümüne girecek
Private Sub cmdVolumeInfo_Click()
Dim r As Long
Dim PathName As String
Dim DrvVolumeName As String
Dim DrvSerialNo As String
PathName$ = "c:\"

rgbGetVolumeInformationRDI PathName$,
DrvVolumeName$, DrvSerialNo$

'Sonuçları Görüntüle
Print: Print " Sürücü İstatistikleri ", ": "; UCase$(PathName$)
Print: Print " Disk Etiketi ", ": "; DrvVolumeName$
Print " Seri Numarası", ": "; DrvSerialNo$
End Sub

Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2,
(Screen.Height - Me.Height) \ 2
End Sub

Function GetHiWord(dw As Long) As Integer
If dw& And &H80000000 Then
GetHiWord% = (dw& \ 65535) - 1
Else: GetHiWord% = dw& \ 65535
End If
End Function

Function GetLoWord(dw As Long) As Integer
If dw& And &H8000& Then
GetLoWord% = &H8000 Or (dw& And &H7FFF&)
Else: GetLoWord% = dw& And &HFFFF&
End If
End Function

Private Sub rgbGetVolumeInformationRDI(PathName$,
DrvVolumeName$, DrvSerialNo$)
Dim r As Long
Dim pos As Integer
Dim HiWord As Long
Dim HiHexStr As String
Dim LoWord As Long
Dim LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
Dim UnusedStr As String
Dim UnusedVal1 As Long
Dim UnusedVal2 As Long

DrvVolumeName$ = Space$(14)
UnusedStr$ = Space$(32)

r& = GetVolumeInformation(PathName$, _
DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, _
UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))

If r& = 0 Then Exit Sub
pos% = InStr(DrvVolumeName$, Chr$(0))
If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(no label)"

HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
HiHexStr$ = Format$(Hex(HiWord&), "0000")
LoHexStr$ = Format$(Hex(LoWord&), "0000")
DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub


kolay gelsin