• [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    Nguyen Hoang Diep > 14-02-22, 10:02 PM

    Cho mình xin 1 bản mdb nha bác maidinhdan, mail: hoangdiepmhbtg@gmail.com.
    Cảm ơn bác nhiều!
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    maidinhdan > 16-04-22, 12:32 AM

    Đã gửi 2 mail trên
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    NguyenDungAnh > 16-04-22, 12:42 AM

    bác dân cho e xin bản này học hỏi với ạ
    dunganh9301@gmail.com
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    nguyenhtan > 25-05-22, 05:07 PM

    CHO TUI XIN CODE 
    EMAIL AN220680@GMAIL.COM

    XIN CẢM ƠN
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    nguyenhtan > 06-06-22, 03:36 PM

    Cho mình xin code nha bạn
    an220680@gmail.com
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    ungthienhai > 31-10-22, 08:48 PM

    Chỗ mật khẩu cho khoá kích hoạt, nếu điền chữ và số vào sẽ bị lỗi, bác maidinhdan xem lại chỗ này giúp em nhé.
    Cảm ơn bác.
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    ungthienhai > 31-10-22, 09:42 PM

    Và chỗ giải mã khoá, em giải thế nào cũng không hiện ra mật khẩu được bác maidinhdan.
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    hoangthinh > 30-06-23, 02:56 PM

    (03-05-20, 11:46 PM)maidinhdan Đã viết: Tiếp nối phần 2: [Demo-Phần 2] Tạo khóa bản quyền (Có hạn dùng)

    Thấy dạo này trên diễn đàn ta hăng say tìm tòi việc tạo khóa hôm nay xin giới thiệu Demo Phần 4-Tạo khóa bản quyền cho phần mềm có thời hạn .

    Thế thì tại sao phần 2 tới phần 4, vậy thằng demo phần 3 ở đâu, xin thưa tôi chừa lại vì lỡ đưa thuật toán này vào 01 chương trình khác rồi, nên không chia sẽ được, nay đành chế lấy thằng to bự hơn đỡ bị gạch đó và cũng cho các bạn tùy biến cho dễ.

    Cái mới:
    1. Hàm ngắn gọn, các bạn dể điều chỉnh lại
    2. Có thuật toán thuận nghịch khó mà lần key kích hoạt.... thôi nói chức năng vậy.....tôi sẽ post cả các hàm phía dưới rồi nói sau

    Chức năng:
    - Tạo ra khóa bằng số cố định theo kiểu: xxxxxx-xxxxx-xxxxx-xxxxx-xxxxx (30 ký tự)
    Giải thích:
    + 18 ký tự đầu: đăng ký theo mã ổ cứng ( không bao giờ thay đổi)
    + 06 ký tự tiếp theo đại diện cho Mật khẩu của bạn.
    + 06 ký tự còn lại đại diện cho thời hạn mà người dùng có thể dùng chương trình của bạn ( Thay đổi mỗi lần bạn thay thời gian cũng như Pass của bạn).

    + Với một số đặc điểm chức năng này bạn có thể dùng demo này cho nhiều phần mềm khác nhau bằng cách điền vào ô mật khẩu cho từng cái phần mềm của bạn muốn bảo vệ.

    * Hình minh họa:
    [Hình: DemoHinh_TaoKhoaBanQuyenPhan4.png]

    Code như sau: Tổng cộng 8 hàm
    1. Hàm Tạo ra key kích hoạt: có thuật toán thuận nghịch
    Mã PHP:
    ' --------------------------------------------------------------------------------------------------------
    Thuoc Modules/Class:  modTaoKhoaPhanMem4
    ' Ten ham/thu tuc    :  MaHoaKeyDangky2
    Tao tren may PC    :  HENDANWIN10PRO
    ' Author/ Tac gia    : maidinhdan@gmail.com
    Ngay tao          01/05/2020 3:52:53 PM
    ' Parameters/Tham so :  'KeyDangkyla ma o cung cua banno se cat lay 9 ky tu de ma hoa
                            
    'MatKhau, ThoihanDungChuongTrinh phai co 6 ky tu va chi chap nhan so
    Cu phapPurpose  :
    ' Pham vi ap dung    : Thuat toan ma hoa Thuan Nghich
    --------------------------------------------------------------------------------------------------------
    Function 
    MaHoaKeyDangky(KeyDangky As StringMatKhau As StringThoihanDungChuongTrinh As String) As String
    Dim b1 
    As Stringb2 As Stringb3 As String
    Dim i 
    As ByteAs Byte
        MaHoaKeyDangky 
    ""
        n 9
    ' Nén từ 12 xuống còn 6 ký tự=> 9+6=15
        b1 = Left(KeyDangky, n) & GiaiMaFromHex(Left(MatKhau, 6)) & GiaiMaFromHex(Left(ThoihanDungChuongTrinh, 6))
        n = Len(b1)
        b2 = GiaiMa(Left(b1, n), 1) ' 
    Ma hoa từ 15 thanh 30 ky tu
        
    'Tach tung ky tu de ma hoa bac 2 : chia thành 5 cấp mã hóa.
        For i = 1 To n
            b3 = b3 & MahoaToHex(Mahoa(Mahoa(Mahoa(Mahoa(mID(b2, i, 1), 4), 24), 1), 26))
            If i = 3 Or i = 6 Or i = 9 Or i = 12 Then  ' 
    Dòng này thêm dấu gạch ngang
                b3 
    b3 "-"
            End If
        Next i
        MaHoaKeyDangky 
    b3
    End 
    Function 

    2. Hàm giải mã key kích hoạt: quy trình ngược lại của hàm tạo key
    Mã PHP:
    ' Thuoc Modules/Class:  modTaoKhoaPhanMem4
    Ten ham/thu tuc    :  GiaiMaKeyDangky2
    ' Tao tren may PC    :  HENDANWIN10PRO
    AuthorTac gia    maidinhdan@gmail.com
    ' Ngay tao          : 01/05/2020 3:53:47 PM
    Parameters/Tham so KeyDangkyDaMaHoala key sinh ra tu ham MaHoaKeyDangky
    ' Cu phap/ Purpose  :
    Pham vi ap dung    Thuat toan giai ma Thuan Nghich
    ' --------------------------------------------------------------------------------------------------------
    Function GiaiMaKeyDangky(KeyDangkyDaMaHoa As String) As String
    Dim b1 As String, b2 As String, b3 As String
    Dim i As Byte, n As Byte
        b1 = GiaiMaFromHex(Replace(KeyDangkyDaMaHoa, "-", ""))
        n = Len(b1)
        For i = 1 To n
            b2 = b2 & GiaiMa(GiaiMa(GiaiMa(GiaiMa(mID(b1, i, 1), 26), 1), 24), 4)
        Next i
        b3 = Mahoa(b2, 1)
        b3 = Left(b3, 9) & "-" & MahoaToHex(mID(b3, 10, 3)) & "-" & MahoaToHex(Right(b3, 3))
        GiaiMaKeyDangky = b3
    End Function 

    3. Hàm kiểm tra Key kích hoạt:
    Mã PHP:
    ' --------------------------------------------------------------------------------------------------------
    Thuoc Modules/Class:  modTaoKhoaPhanMem4
    ' Ten ham/thu tuc    :  KiemtraKey
    Tao tren may PC    :  HENDANWIN10PRO
    ' Author/ Tac gia    : maidinhdan@gmail.com
    Ngay tao          03/05/2020 10:01:46 PM
    ' Parameters/Tham so :
    Cu phapPurpose  :
    ' Pham vi ap dung    : Kiem tra khoa con han dung khong
    --------------------------------------------------------------------------------------------------------
    Function 
    KiemtraKey(KeyKichHoatTable As StringPassTest As String) As Boolean
        On Error 
    GoTo Loi
        Dim MatKhau 
    As StringHanDung As StringMaOCung As StringKeyDaGiaiMa As String
        Dim HanTest 
    As DateHanKey As Date

        KeyDaGiaiMa 
    Replace(GiaiMaKeyDangky((KeyKichHoatTable)), "-""")
        MaOCung Left(KeyDaGiaiMa9)
        MatKhau mID(KeyDaGiaiMa106)
        HanDung mID(KeyDaGiaiMa166)
        
        HanDung 
    Right(HanDung4) & "/" Val(Left(HanDung2)) & "/" "28"
        HanKey Format(HanDung"yyyy/mm/dd")
        strHamDung Format(HanKey"dd/mm/yyyy")
        HanTest Format(Date"yyyy/mm/dd")

        'Test Key kich hoat
        If PassTest = MatKhau Then
            If MaOCung = Left(DocHDD, 9) Then
                If HanKey >= HanTest Then
                        KiemtraKey = True
    '
                Debug.Print MaOCungMatKhauHanDung
                End 
    If
            End If
        End If
        Exit Function
    Loi:
            KiemtraKey False
    End 
    Function 

    * Các hàm phụ: 
    Mã PHP:
    Public strHamDung As String 'Khai bao nay de nay de test hien thi cho cac ban xem thoi

    Public Function Mahoa(Data As String, Optional Depth As Integer) As String
    Dim TempChar As String, TempAsc As Integer, NewData As String, vChar As Integer
        
        For vChar = 1 To Len(Data)
            TempChar = mID$(Data, vChar, 1)
            TempAsc = Asc(TempChar)
            If Depth = 0 Then Depth = 40
            If Depth > 254 Then Depth = 254
            
            TempAsc = TempAsc + Depth
            
            If TempAsc > 255 Then TempAsc = TempAsc - 255
            
            TempChar = Chr(TempAsc)
            NewData = NewData & TempChar
        Next vChar
        Mahoa = NewData
    End Function

    Public Function GiaiMa(Data As String, Optional Depth As Integer) As String
    Dim TempChar As String, TempAsc As Integer, NewData As String, vChar As Integer
        For vChar = 1 To Len(Data)
            TempChar = mID$(Data, vChar, 1)
            TempAsc = Asc(TempChar)
            If Depth = 0 Then Depth = 40
            If Depth > 254 Then Depth = 254
            
            TempAsc = TempAsc - Depth
            
            If TempAsc < 0 Then TempAsc = TempAsc + 255
            
            TempChar = Chr(TempAsc)
            NewData = NewData & TempChar
        Next vChar
            GiaiMa = NewData
    End Function

    Function DocHDD()
    Dim Disco As Variant, Discos  As Variant, abc As String
        Set Discos = GetObject("WINMGMTS:").InstancesOf("Win32_PhysicalMedia")
        For Each Disco In Discos
            abc = Disco.SerialNumber
            If Len(Trim(abc)) > 0 Then Exit For
        Next
        DocHDD = Trim(abc)
    End Function

    Public Function MahoaToHex(tString As String) As String
    Dim i As Integer, S As String
    S = ""
    For i = 1 To Len(tString)
      S = S & Right$("00" & Hex(Asc(mID$(tString, i, 1))), 2)
    Next i
    MahoaToHex = S
    End Function
    Function GiaiMaFromHex(strHex As String) As String
        Dim lngCount As Long
        For lngCount = 1 To Len(strHex) Step 2
            GiaiMaFromHex = GiaiMaFromHex & Chr("&h" & mID(strHex, lngCount, 2))
        Next
    End Function 

    * Để tất cả hàm ở đây cho các anh dùng, còn ai lười thì để lại email sẽ nhận được bạn mdb.
    Nói thêm mấy chú bên VB.net hoặc C... khỏi lượm code này cho đỡ tốn thời gian, vì nó không có tác dụng đâu dù có sửa như thế nào đi nửa.


    Thân mến! chúc vui khỏe.
    bác cho e xin code với ạ! email: thinh.hoanghuu92@gmail.com
    e cảm ơn bác nhiều ạ!
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    ngochuong279 > 24-04-24, 06:13 PM

    Cho em xin với ạ:hangochuong09@gmail.com
  • RE: [Demo-Phần 4] Tạo khóa bản quyền (Có hạn dùng)

    ongke0711 > 27-04-24, 11:04 PM

    (24-04-24, 06:13 PM)ngochuong279 Đã viết: Cho em xin với ạ:hangochuong09@gmail.com

    Đã gửi cho bạn rồi nhé.