AccessTr.neTMicrosoft AccessAccess Cevaplanmış Soruları

Fonksiyonda "Sıfır" Hatası

1 2
22/03/2016, 14:28

megasoftware

Ms-Dos ortamında VOL değerine baktığım da değer : 0223-6EC9 ancak fonksiyon başa sıfır geldiğinde 2236-6EC9 olarak değeri geri döndürüyor. Acaba nerede hata yapıyorum
Kod:
Option Compare Database
Option Explicit
Private Declare Function GetVolumeSerialNumber 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
Public Function VolumeSerialNumber(ByVal RootPath As String) As String
Dim VolLabel As String
Dim VolSize As Long
Dim Serial As Long
Dim MaxLen As Long
Dim Flags As Long
Dim Name As String
Dim NameSize As Long
Dim Deger As String
If GetVolumeSerialNumber(RootPath, VolLabel, VolSize, Serial, MaxLen, Flags, Name, NameSize) Then
    Deger = Format(Hex(Serial), "#########")
    VolumeSerialNumber = Left(Deger, 4) + "-" + Right(Deger, 4)
    MsgBox VolumeSerialNumber, vbOKOnly, "Class Bilgisayar © 2016"
Else
End If
End Function
22/03/2016, 15:07

atoz112

sayın megasoftware,

harddisk serial number değerini edinmek için,farklı yöntemler mevcut.bunlardan bir diğer alternatif yöntem olarak şu kodları da deneyebilirsiniz.
Kod:
Function HDSerialNumber() As String
    Dim fsObj   As Object
    Dim drv     As Object
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    Set drv = fsObj.Drives("C")
    HDSerialNumber = Left(Hex(drv.SerialNumber), 4) & "-" & Right(Hex(drv.SerialNumber), 4)
End Function
yukarıda yazılı kodları,formun kod sayfasına ekleyiniz.

ayrıca,formun YÜKLENDİĞİNDE olay yordamına da
Kod:
Me.Vol.Caption = HDSerialNumber
kod satırını ekleyiniz ve kullanımı deneyiniz.bilginize...iyi çalışmalar,saygılar.
22/03/2016, 15:22

megasoftware

Hocam kod aynı mantıkla çalışıyor sonuçta aynı çıkıyor. Sanırım hata HEX komutundan kaynaklı sıfır değerini almadan geçiyor. "C:" sürücüm     0223-6EC9 olması gerekirken 2236-6EC9 olarak geliyor. "D:" Sürücüm 86D8-1F36 bu doğru geliyor. Sıfır ile başlamadığı için hiç bir sıkıntı yok.. Sıfırla başlamaya bağlı bir sorun var sanırım Hex komutu sıfırı null kabul 4 basamak alacağı için yola devam edip ikinci kısımdaki ilk değeri alıyor
22/03/2016, 17:52

ozanakkaya

Left right kodunda sayı yerine - öncesi ve - sonrasını almayı dener misin

- öncesi

Left(Deger;InStr(1;deger;"-")-1)

-sonrası

mid(deger;InStr(1;deger;"-")+1)

Ayrıca deger as string yerine deger as byte kodunu da deneyebilirsin.
22/03/2016, 18:08

megasoftware

(22/03/2016, 17:52)ozanakkaya yazdı: Left right kodunda sayı yerine - öncesi ve - sonrasını almayı dener misin

- öncesi

Left(Deger;InStr(1;deger;"-")-1)

-sonrası

mid(deger;InStr(1;deger;"-")+1)

Ayrıca deger as string yerine deger as byte kodunu da deneyebilirsin.

Sayın hocam diğer kodda ve hocamın verdiği kodda da denedim tip uyuşmazlık hatası verdi.

Kod:
Public Function HDSerialNumber() As String
Dim fsObj As Object
Dim drv As Object
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set drv = fsObj.Drives("C")
'HDSerialNumber = Left(Hex(drv.SerialNumber), 4) & "-" & Right(Hex(drv.SerialNumber), 4)
HDSerialNumber = Left(drv.SerialNumber;Instr(1;drv.serialnumber;"-")-1) & "-" & Right(Hex(drv.SerialNumber), 4)
End Function
nerede hata yapıyorum anlayamadım
22/03/2016, 22:34

atoz112

sayın megasoftware,

Kod:
HDSerialNumber = Left(drv.SerialNumber;Instr(1;drv.serialnumber;"-")-1) & "-" & Right(Hex(drv.SerialNumber), 4)

yazdığınız kod satırı incelendiğinde,hata vereceği görülmektedir.

çünkü;kod sayfasında fonksiyon benzeri yazarken,noktalı virgül (;) ile değil sadece virgül (,) ile yazılmalı.noktalı virgül yazımları ancak sorgularda veya form denetimlerindeki Denetim Kaynağı satırlarında geçerlidir.

son olarak;konunuzun 2.mesajında paylaştığım alternatif kod satırlarında 

Kod:
HDSerialNumber = Left(drv.SerialNumber;Instr(1;drv.serialnumber;"-")-1) & "-" & Right(Hex(drv.SerialNumber), 4)

bu şekilde yazdığınızda ise,yine size ilk sonucu değil tire (-) işaretinden sonraki değeri verecektir.sayın ozan bey tarafından bahsi yapılan tire işaretinden önceki değeri almak için yazılan kod satırını bu fonksiyonda değil aksine şu şekilde yazmalısınız.

Kod:
Function HDSerialNumber() As String
   Dim fsObj   As Object
   Dim drv     As Object
   Set fsObj = CreateObject("Scripting.FileSystemObject")
   Set drv = fsObj.Drives("C")
    HDSerialNumber = Left(Hex(drv.SerialNumber), 4) & "-" & Right(Hex(drv.SerialNumber), 4)
End Function

fonksiyon yine bu hali ile kalmalı.sadece,formun YÜKLENDİĞİNDE olay yordamındaki kodları

Kod:
Me.Vol.Caption = HDSerialNumber
Me.Vol.Caption = Left(HDSerialNumber, InStr(1, HDSerialNumber, "-") - 1)

bu şekilde yazmalısınız.böylece,tire işaretinden önceki ilk 4 değeri ekranda gösterebilirsiniz.

bilginize...iyi çalışmalar,saygılar.
1 2