maidinhdan > 28-07-18, 10:10 PM
(28-07-18, 11:57 AM)niembui Đã viết: Chào các anh/chị
Mình quan tâm " tạo khóa bản quyền cho file access. Anh chị nào có thể nhận dịch vụ tạo dùm mình code này thì làm ơn cho mình hay nha. email buingocniem@gmail.com. Mình có nhu cầu thực, thù lao thỏa thuận. Xin cảm ơn.
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()
   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 
'---------------------------------------------------------------------------------------
' Procedure/ Ten thu tuc : Ma Hoa Key Dang ky
' Author/ Nguoi khoi tao : maidinhdan@gmail.com
' Tao tren may tinh User : DANAspireV5
' Date/ Ngay tao         : 12/31/2016-13:40
' Purpose/Mo ta          :
'---------------------------------------------------------------------------------------
'
Function MaHoaKeyDangky(KeyDangky As String) As String
Dim b1 As String, b2 As String, b3 As String, b4 As String, b5 As String, b6 As String, b7 As String, b8 As String
Dim l As Byte
   b1 = KeyDangky
   b2 = MahoaToHex(b1)
   b3 = Mahoa(b2, 45)
   l = Len(b3) / 2
   k = Left(b3, Len(b3) - Round(l, 0))
   q = mID(b3, Len(b3) - Round(l, 0) + 1)
   b4 = q & k
   b5 = Mahoa(b4, 120)
   b6 = Mahoa(b5, 100)
   b7 = Mahoa(b6, 80)
   b8 = MahoaToHex(b7)
   MaHoaKeyDangky = b8
End Function 
'---------------------------------------------------------------------------------------
' Procedure/ Ten thu tuc : Giai Ma Key Dang ky
' Author/ Nguoi khoi tao : maidinhdan@gmail.com
' Tao tren may tinh User : DANAspireV5
' Date/ Ngay tao         : 12/31/2016-13:40
' Purpose/Mo ta          :
'---------------------------------------------------------------------------------------
'
Function GiaiMaKeyDangky(KeyDangkyDaMaHoa As String) As String
Dim b1 As String, b2 As String, b3 As String, b4 As String, b5 As String, b6 As String, b7 As String, b8 As String
Dim l As Byte
   b1 = KeyDangkyDaMaHoa
   b2 = GiaiMaFromHex(b1)
   b3 = GiaiMa(b2, 80)
   b4 = GiaiMa(b3, 100)
   b5 = GiaiMa(b4, 120)
   
   l = Len(b5) / 2
   k = Left(b5, Len(b5) - Round(l, 0))
   q = mID(b5, Len(b5) - Round(l, 0) + 1)
   b6 = q & k
   b7 = GiaiMa(b6, 45)
   b8 = GiaiMaFromHex(b7)
   GiaiMaKeyDangky = b8
End Function 
Function KiemtraKey(KeyKichHoatTable As String) As Boolean
On Error GoTo Loi
'Nhap code vao
   If GiaiMaKeyDangky(Nz(KeyKichHoatTable)) = DocHDD Then KiemtraKey = True
'
On Error GoTo 0
Exit Function
Loi:
   KiemtraKey = False
End Function 
![[Hình: DangKybanquyen1.png]](https://sites.google.com/site/congthucassecc/home/hinh-linh-tinh/DangKybanquyen1.png)
![[Hình: DangKybanquyen2.png]](https://sites.google.com/site/congthucassecc/home/hinh-linh-tinh/DangKybanquyen2.png)
huuduy.duy > 29-07-18, 01:16 AM
ledangvan > 29-07-18, 10:46 PM
xuankien07 > 30-07-18, 04:22 PM
cpucloi > 30-07-18, 04:32 PM
Xuân Thanh > 30-07-18, 04:39 PM
mrsiro > 30-07-18, 08:06 PM
tui123 > 31-07-18, 05:47 PM
NguyenDungAnh > 31-07-18, 06:23 PM
maidinhdan > 01-08-18, 10:06 PM
Trích dẫn:Đỗ Hữu Duy <huuduy.duy@gmail.com>,
Dangvan Le <Ledangvan06@gmail.com>,
CPUCLoi <cpucloi@gmail.com>,
so siro <sirolichking15@gmail.com>,
Trung Huu <tdanh2002@gmail.com>,
nguyen anh <dunganh9301@gmail.com>