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
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>