06/11/2023, 10:54
Slm Access de yaptığım bu veya benzeri program başka bilgisayarda benim izinim olmadan çalışmasını istemiyorum. Kopyalayıp başka bir bilgisayara aktarıp çalışmasın istiyorum. Teşekkürler
Option Compare Database
Option Explicit
Private Declare PtrSafe 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
Private Declare PtrSafe Function GetAdaptersInfo Lib "IPHLPAPI" _
(pAdapterInfo As Any, pBufLen As Long) As Long
Function GetHDDSerialNumber() As String
Dim serialNumber As Long
Dim volumeName As String * 255
Dim fileSystemName As String * 255
If GetVolumeInformation("C:\", volumeName, Len(volumeName), serialNumber, 0, 0, fileSystemName, Len(fileSystemName)) <> 0 Then
GetHDDSerialNumber = Hex(serialNumber)
Else
GetHDDSerialNumber = "N/A"
End If
End Function
Function GetMACAddress() As String
Dim adapterInfo As Any
Dim bufLen As Long
Dim macAddress As String
If GetAdaptersInfo(adapterInfo, bufLen) = 0 Then
macAddress = Right("00" & Hex(AscB(adapterInfo(4))), 2)
For i = 1 To 5
macAddress = macAddress & ":" & Right("00" & Hex(AscB(adapterInfo(i + 4))), 2)
Next i
GetMACAddress = UCase(macAddress)
Else
GetMACAddress = "N/A"
End If
End Function
Sub TestGetInfo()
MsgBox "HDD Serial Number: " & GetHDDSerialNumber() & vbCrLf & _
"MAC Address: " & GetMACAddress()
End Sub
(14/11/2023, 18:12)atoykan yazdı: [ -> ]Arşivimdeki eski bir kodu paylaşayım
Bu kod uygulamanın yüklü olduğu bilgisayarda HDD seri nosunu ve MAC adreslerini tespit eder. Kurgunuzu bu çerçevede değerlendirin. HDD seri nosu ve MAC adresi eşleşmeyen bilgisayarda çalışmasını engelleyin. Ancak bu son derece basit bir yöntemdir ortalama üzeri biraz bilgisi olan veya az çok kodlamaya ilgi duyan birisi aşacaktır. Ayrıca uygulamanızın yüklendiği bilgisayardaki kullanıcı yetkileri açısından bu tip kodlar sorun çıkartabilir unutmamanız gerekn bir diğer detay. Onun dışında lisanslama için daha ciddi çalışmalar yapmak gerekir ancak mevcut uygulamanızdaki kodlama düzeyinize baktığımda biraz daha gelişme gösterdikten sonra bunlara yönelmeniz gerektiği kanaatindeyim.Kod:Option Compare Database
Option Explicit
Private Declare PtrSafe 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
Private Declare PtrSafe Function GetAdaptersInfo Lib "IPHLPAPI" _
(pAdapterInfo As Any, pBufLen As Long) As Long
Function GetHDDSerialNumber() As String
Dim serialNumber As Long
Dim volumeName As String * 255
Dim fileSystemName As String * 255
If GetVolumeInformation("C:\", volumeName, Len(volumeName), serialNumber, 0, 0, fileSystemName, Len(fileSystemName)) <> 0 Then
GetHDDSerialNumber = Hex(serialNumber)
Else
GetHDDSerialNumber = "N/A"
End If
End Function
Function GetMACAddress() As String
Dim adapterInfo As Any
Dim bufLen As Long
Dim macAddress As String
If GetAdaptersInfo(adapterInfo, bufLen) = 0 Then
macAddress = Right("00" & Hex(AscB(adapterInfo(4))), 2)
For i = 1 To 5
macAddress = macAddress & ":" & Right("00" & Hex(AscB(adapterInfo(i + 4))), 2)
Next i
GetMACAddress = UCase(macAddress)
Else
GetMACAddress = "N/A"
End If
End Function
Sub TestGetInfo()
MsgBox "HDD Serial Number: " & GetHDDSerialNumber() & vbCrLf & _
"MAC Address: " & GetMACAddress()
End Sub