program Başka Bilgisayarda Çalışmasın

06/11/2023, 10:54

ankaram

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
14/11/2023, 18:12

atoykan

Arşivimdeki eski bir kodu paylaşayım
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
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.
23/11/2023, 16:48

ankaram

(14/11/2023, 18:12)atoykan yazdı: Arşivimdeki eski bir kodu paylaşayım
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
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.

Ç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.
08/12/2023, 15:32

ankaram

Teşekkürler