06/11/2023, 10:54
program Başka Bilgisayarda Çalışmasın
14/11/2023, 18:12
atoykan
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
23/11/2023, 16:48
ankaram
(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
Çok teşekkür ederim kardeşim.Bu kodu modülemi veya nereye yazmalıyım.
23/11/2023, 22:17
atoykan
Sayın @ankaram BEY
Kodu bir modüle ekleyin uygulamanızın yapısına göre açılırken form yüklenirken vs vs nerede denetim yapmak istiyorsanız orada TestGetInfo prosedürünü çağırarak kullanın.
Kodu bir modüle ekleyin uygulamanızın yapısına göre açılırken form yüklenirken vs vs nerede denetim yapmak istiyorsanız orada TestGetInfo prosedürünü çağırarak kullanın.
08/12/2023, 15:32
ankaram
Teşekkürler