Tạo key cho file excel có viết code vba

Liên hệ QC
Mình dùng Olly debug. Rất nhiều tool làm được việc này.
 
Mình không tải được do mạng chậm, chương trình có icon hình như con sao biển đấy.
To phihndhsp: đây là dịch ngược từ mã máy sang assembly chứ không phải dịch xuôi.
Nhờ Bạn Hau151978 Crack lại dùm ....Mình mới viết lại code theo kiểu A keo B nếu ok thì B lại keo C nếu C ok thì Keo A......không biết có được không nũa .... cũng không dám tin vào khả năng mì tôm cua nữa --=0--=0--=0
Xin cảm ơn
Link Sau
http://www.mediafire.com/download/mdsfo92wl9fcbwe/LicenseExcel3.rar
 
Lần chỉnh sửa cuối:
Khoảng 1 tuần tới mình bận rồi, nghịch cái này phải có thời gian rỗi, để chủ nhật mày mò xem sao.
 
Trong khi chờ đợi Bạn Hau151978 xử lý File Bài #45 thì xin mời các Bạn nếu ai có khả năng Hack được Bài #45 thì xin mời tham gia một tí cho thên phần xôi động...

Trong gần một tuần mình chờ bạn hau151978 thì mình cũng tiến hành vọc một số Tools trình dịch ngược code thấy như sau

1/ Một số trình dịch có khả năng dịch ngược được code trong File thư viên *.dll và .exe nhưng để đọc và hiểu hết nó là cả một vấn đề khó....

2/ Hầu hết các hacker thường sử dụng OllyDbg để Debug code coi Pass trong File *.exe kết nối với Access và chặn từng dòng code trong File *.dll và *.exe ....chứ không sửa và viết thêm code vào được.....

3/ Mình có thử một file .exe viết bằng VB6 kết nối với Access.. Qua Vọc OllyDbg thì thấy được Pass kết nối của nó với File Access sau đó mình mở file Access lên nhập pass đó vào thì ok .... sau đó mình lại tiếp tục thử file khác thấy pass nhưng mở lên không được ...phải chăng Pass đã được mã hóa hay gì gì đó....sự khác biệt này là một vấn đề khó.....

4/ File hôm trước mình viết úp lên bạn hậu Patch được mình nghỉ là do mình dùng If và Elseif các điều kiện chung trong một sub .... nên Bạn hau Patch bằng cách chặn nó lại giống như mình Debug code trong VBA....

Vì vậy code Bài #45 mình đã thay đổi cách khác sử dụng If (...) Then và chia ra làm 3 sub khác nhau vì vậy khả năng chặn là khó....Nếu vẫn Hack được thì mình đã nghĩ còn một cách cuối cùng sử dụng Sub 1 nạp tham số gọi sub 2 chạy ..Sub 2 nhận tham số của sub1 chạy ...nếu chặn một trong 2 sub thì Tèo téo teo luôn....

5/ Vấn đề viết Code vào File thư viện *.dll là bảo mật tốt nhất hiên nay nhưng để tốt hơn mình phải có kỷ thuật và thuật toán cao cấp hơn đan xen trong đó thì cho dù bạn có dùng Tools gì chăng nữa thì khả năng Hack được khoảng vài %....và không phải ai cũng hack được

Rất mong các Bạn có kiến thức uyên thâm chỉ thêm...
trên đây mới chỉ là cảm nhận bước đầu của Mình sau khi nghiên cứu và Vọc một số Tools trình dich ngược

Xin cảm ơn các Bạn tham gia
 
Lần chỉnh sửa cuối:
link bị chết rồi bạn gửi cho mình xin file vào địa chỉ mail muaxuantinhyeusp29@gmail.com nhé.Mình có 1 file có mã TE854349043H6R key.Cám ơn bạn trước.
 
nhờ các cao thủ tìm hộ
17F7-67CD-DAEA-8439
 
Cả một ngày hôm này mãi mê cái đề tài này quên cả ăn trưa mới viết xong được cái code bảo

mật File Excel theo ID máy ....Ngửa mặt lên trời hahaha --=0--=0 như chưa bao giờ hahaha

bao giờ .....đã ghê


1/ Mỗi lần mở file lên trên một máy bất kỳ là nó tạo một cái ID mới và một mã đăng ký mới nếu nhập đúng mã thì sử dụng File ... Nếu sai thì Tèo chẳng hạn....

2/ Nếu ai muốn sử dụng file thì nhắn mã qua mình cũng cấp cho mã đăng ký là Ok

3/ trong file mình làm luôn phần giải mã rồi nhờ các Bạn tải về kiểm tra cho ý kiếm
4/ hay nhất ở chỗ chỉ nhắn mã qua là mình cho mã sử dụng ko phải viết lại code .....--=----=----=--

5/Luu y giai ma Cells D4
Xin cảm ơn Các Bạn GPE Kiểm tra dùm cho ý kiến để mình hoàn thiện hơn....Xin cảm ơn...Xin cảm ơn

Link tải File
http://www.mediafire.com/download/gx62x52vj9i4xg6/License_Excel.rar

Link die rồi Bác ơi.
 
Cả một ngày hôm này mãi mê cái đề tài này quên cả ăn trưa mới viết xong được cái code bảo

mật File Excel theo ID máy ....Ngửa mặt lên trời hahaha --=0--=0 như chưa bao giờ hahaha

bao giờ .....đã ghê


1/ Mỗi lần mở file lên trên một máy bất kỳ là nó tạo một cái ID mới và một mã đăng ký mới nếu nhập đúng mã thì sử dụng File ... Nếu sai thì Tèo chẳng hạn....

2/ Nếu ai muốn sử dụng file thì nhắn mã qua mình cũng cấp cho mã đăng ký là Ok

3/ trong file mình làm luôn phần giải mã rồi nhờ các Bạn tải về kiểm tra cho ý kiếm
4/ hay nhất ở chỗ chỉ nhắn mã qua là mình cho mã sử dụng ko phải viết lại code .....--=----=----=--

5/Luu y giai ma Cells D4
Xin cảm ơn Các Bạn GPE Kiểm tra dùm cho ý kiến để mình hoàn thiện hơn....Xin cảm ơn...Xin cảm ơn

Link tải File
http://www.mediafire.com/download/gx62x52vj9i4xg6/License_Excel.rar
Link die rồi bạn. Bạn có thể gởi lại được không. Thanks bạn nhiều
 
Cả một ngày hôm này mãi mê cái đề tài này quên cả ăn trưa mới viết xong được cái code bảo

mật File Excel theo ID máy ....Ngửa mặt lên trời hahaha--=0--=0 như chưa bao giờ hahaha

bao giờ .....đã ghê

1/ Mỗi lần mở file lên trên một máy bất kỳ là nó tạo một cái ID mới và một mã đăng ký mới nếu nhập đúng mã thì sử dụng File ... Nếu sai thì Tèo chẳng hạn....

2/ Nếu ai muốn sử dụng file thì nhắn mã qua mình cũng cấp cho mã đăng ký là Ok

3/ trong file mình làm luôn phần giải mã rồi nhờ các Bạn tải về kiểm tra cho ý kiếm
4/ hay nhất ở chỗ chỉ nhắn mã qua là mình cho mã sử dụng ko phải viết lại code .....--=----=----=--

5/Luu y giai ma Cells D4
Xin cảm ơn Các Bạn GPE Kiểm tra dùm cho ý kiến để mình hoàn thiện hơn....Xin cảm ơn...Xin cảm ơn

Link tải File
http://www.mediafire.com/download/gx62x52vj9i4xg6/License_Excel.rar
anh mạnh ơi cho em xin file này của anh được không. link tải ko tải được. nếu được a cho em vào mail nguyenhaik52912@gmail.com. cám ơn anh nhiều
 
Hiện nay các cách bảo mật chỉ tương đối mình có cách này mong các bác chỉ giáo.Key kích hoạt theo mã máy cộng với chuỗi mã nguồn thay đổi , mã hóa key đó ,dù có crack được một thời gian sẽ bắt kích hoạt lại, dó chương trình bị lỗi, lỗi này không phải do viết sai code mà do chuỗi đã bị thay đổi (mã nguồn web) ko đáp ứng được khi kích hoạt.. cái này dang update key
 
Có cái mã này nhờ các cao thủ tìm hộ License giúp mình với.

6C7C65656B495B405E563F51555A3B544D5654
 
có cái mã máy này mà tìm dược cái key được mới tài
Code để tạo ra nó là:

Option Explicit

Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647
Private State(4) As Long
Private ByteCounter As Long
Private ByteBuffer(63) As Byte
Private Const S11 = 7
Private Const S12 = 12
Private Const S13 = 17
Private Const S14 = 22
Private Const S21 = 5
Private Const S22 = 9
Private Const S23 = 14
Private Const S24 = 20
Private Const S31 = 4
Private Const S32 = 11
Private Const S33 = 16
Private Const S34 = 23
Private Const S41 = 6
Private Const S42 = 10
Private Const S43 = 15
Private Const S44 = 21

Property Get RegisterA() As String
RegisterA = State(1)
End Property

Property Get RegisterB() As String
RegisterB = State(2)
End Property

Property Get RegisterC() As String
RegisterC = State(3)
End Property

Property Get RegisterD() As String
RegisterD = State(4)
End Property

' Function to digest a text string and output the result as a string
' of hexadecimal characters.

Public Function DigestStrToHexStr(SourceString As String) As String
MD5Init
MD5Update Len(SourceString), StringToArray(SourceString)
MD5Final
DigestStrToHexStr = GetValues
End Function

' Function to quickly digest a file into a hex string

Public Function DigestFileToHexStr(InFile As String) As String
On Error GoTo ErrorHandler

GoSub begin

ErrorHandler:
DigestFileToHexStr = ""
Exit Function

begin:
Dim FileO As Integer
FileO = FreeFile
Call FileLen(InFile)
Open InFile For Binary Access Read As #FileO
MD5Init
Do While Not EOF(FileO)
Get #FileO, , ByteBuffer
If Loc(FileO) < LOF(FileO) Then
ByteCounter = ByteCounter + 64
MD5Transform ByteBuffer
End If
Loop
ByteCounter = ByteCounter + (LOF(FileO) Mod 64)
Close #FileO
MD5Final
DigestFileToHexStr = GetValues
End Function

' A utility function which converts a string into an array of
' bytes

Private Function StringToArray(InString As String) As Byte()
Dim i As Integer, bytBuffer() As Byte
ReDim bytBuffer(Len(InString))
For i = 0 To Len(InString) - 1
bytBuffer(i) = Asc(Mid$(InString, i + 1, 1))
Next i
StringToArray = bytBuffer
End Function

' Concatenate the four state vaules into one string

Public Function GetValues() As String
GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
End Function

' Convert a Long to a Hex string

Private Function LongToString(NUM As Long) As String
Dim A As Byte, B As Byte, C As Byte, d As Byte
A = NUM And &HFF&
If A < 16 Then LongToString = "0" & Hex(A) Else LongToString = Hex(A)
B = (NUM And &HFF00&) \ 256
If B < 16 Then LongToString = LongToString & "0" & Hex(B) Else LongToString = LongToString & Hex(B)
C = (NUM And &HFF0000) \ 65536
If C < 16 Then LongToString = LongToString & "0" & Hex(C) Else LongToString = LongToString & Hex(C)
If NUM < 0 Then d = ((NUM And &H7F000000) \ 16777216) Or &H80& Else d = (NUM And &HFF000000) \ 16777216
If d < 16 Then LongToString = LongToString & "0" & Hex(d) Else LongToString = LongToString & Hex(d)
End Function

' Initialize the class
' This must be called before a digest calculation is started

Public Sub MD5Init()
ByteCounter = 0
State(1) = UnsignedToLong(1732584193#)
State(2) = UnsignedToLong(4023233417#)
State(3) = UnsignedToLong(2562383102#)
State(4) = UnsignedToLong(271733878#)
End Sub

Public Sub MD5Final()
Dim dblBits As Double, Padding(72) As Byte, lngBytesBuffered As Long
Padding(0) = &H80
dblBits = ByteCounter * 8
lngBytesBuffered = ByteCounter Mod 64
If lngBytesBuffered <= 56 Then MD5Update 56 - lngBytesBuffered, Padding Else MD5Update 120 - ByteCounter, Padding
Padding(0) = UnsignedToLong(dblBits) And &HFF&
Padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
Padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
Padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
Padding(4) = 0
Padding(5) = 0
Padding(6) = 0
Padding(7) = 0
MD5Update 8, Padding
End Sub

' Break up input stream into 64 byte chunks

Public Sub MD5Update(InputLen As Long, InputBuffer() As Byte)
Dim II As Integer, i As Integer, J As Integer, K As Integer, lngBufferedBytes As Long, lngBufferRemaining As Long, lngRem As Long

lngBufferedBytes = ByteCounter Mod 64
lngBufferRemaining = 64 - lngBufferedBytes
ByteCounter = ByteCounter + InputLen

If InputLen >= lngBufferRemaining Then
For II = 0 To lngBufferRemaining - 1
ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
Next II
MD5Transform ByteBuffer
lngRem = (InputLen) Mod 64
For i = lngBufferRemaining To InputLen - II - lngRem Step 64
For J = 0 To 63
ByteBuffer(J) = InputBuffer(i + J)
Next J
MD5Transform ByteBuffer
Next i
lngBufferedBytes = 0
Else
i = 0
End If
For K = 0 To InputLen - i - 1
ByteBuffer(lngBufferedBytes + K) = InputBuffer(i + K)
Next K
End Sub

Private Sub MD5Transform(Buffer() As Byte)
Dim x(16) As Long, A As Long, B As Long, C As Long, d As Long

A = State(1)
B = State(2)
C = State(3)
d = State(4)
Decode 64, x, Buffer
FF A, B, C, d, x(0), S11, -680876936
FF d, A, B, C, x(1), S12, -389564586
FF C, d, A, B, x(2), S13, 606105819
FF B, C, d, A, x(3), S14, -1044525330
FF A, B, C, d, x(4), S11, -176418897
FF d, A, B, C, x(5), S12, 1200080426
FF C, d, A, B, x(6), S13, -1473231341
FF B, C, d, A, x(7), S14, -45705983
FF A, B, C, d, x(8), S11, 1770035416
FF d, A, B, C, x(9), S12, -1958414417
FF C, d, A, B, x(10), S13, -42063
FF B, C, d, A, x(11), S14, -1990404162
FF A, B, C, d, x(12), S11, 1804603682
FF d, A, B, C, x(13), S12, -40341101
FF C, d, A, B, x(14), S13, -1502002290
FF B, C, d, A, x(15), S14, 1236535329

GG A, B, C, d, x(1), S21, -165796510
GG d, A, B, C, x(6), S22, -1069501632
GG C, d, A, B, x(11), S23, 643717713
GG B, C, d, A, x(0), S24, -373897302
GG A, B, C, d, x(5), S21, -701558691
GG d, A, B, C, x(10), S22, 38016083
GG C, d, A, B, x(15), S23, -660478335
GG B, C, d, A, x(4), S24, -405537848
GG A, B, C, d, x(9), S21, 568446438
GG d, A, B, C, x(14), S22, -1019803690
GG C, d, A, B, x(3), S23, -187363961
GG B, C, d, A, x(8), S24, 1163531501
GG A, B, C, d, x(13), S21, -1444681467
GG d, A, B, C, x(2), S22, -51403784
GG C, d, A, B, x(7), S23, 1735328473
GG B, C, d, A, x(12), S24, -1926607734

HH A, B, C, d, x(5), S31, -378558
HH d, A, B, C, x(8), S32, -2022574463
HH C, d, A, B, x(11), S33, 1839030562
HH B, C, d, A, x(14), S34, -35309556
HH A, B, C, d, x(1), S31, -1530992060
HH d, A, B, C, x(4), S32, 1272893353
HH C, d, A, B, x(7), S33, -155497632
HH B, C, d, A, x(10), S34, -1094730640
HH A, B, C, d, x(13), S31, 681279174
HH d, A, B, C, x(0), S32, -358537222
HH C, d, A, B, x(3), S33, -722521979
HH B, C, d, A, x(6), S34, 76029189
HH A, B, C, d, x(9), S31, -640364487
HH d, A, B, C, x(12), S32, -421815835
HH C, d, A, B, x(15), S33, 530742520
HH B, C, d, A, x(2), S34, -995338651

II A, B, C, d, x(0), S41, -198630844
II d, A, B, C, x(7), S42, 1126891415
II C, d, A, B, x(14), S43, -1416354905
II B, C, d, A, x(5), S44, -57434055
II A, B, C, d, x(12), S41, 1700485571
II d, A, B, C, x(3), S42, -1894986606
II C, d, A, B, x(10), S43, -1051523
II B, C, d, A, x(1), S44, -2054922799
II A, B, C, d, x(8), S41, 1873313359
II d, A, B, C, x(15), S42, -30611744
II C, d, A, B, x(6), S43, -1560198380
II B, C, d, A, x(13), S44, 1309151649
II A, B, C, d, x(4), S41, -145523070
II d, A, B, C, x(11), S42, -1120210379
II C, d, A, B, x(2), S43, 718787259
II B, C, d, A, x(9), S44, -343485551

State(1) = LongOverflowAdd(State(1), A)
State(2) = LongOverflowAdd(State(2), B)
State(3) = LongOverflowAdd(State(3), C)
State(4) = LongOverflowAdd(State(4), d)
End Sub

Private Sub Decode(Length As Integer, OutputBuffer() As Long, InputBuffer() As Byte) 'was private sub
Dim intDblIndex As Integer, intByteIndex As Integer, dblSum As Double
For intByteIndex = 0 To Length - 1 Step 4
dblSum = InputBuffer(intByteIndex) + InputBuffer(intByteIndex + 1) * 256# + InputBuffer(intByteIndex + 2) * 65536# + InputBuffer(intByteIndex + 3) * 16777216#
OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
intDblIndex = intDblIndex + 1
Next intByteIndex
End Sub

Private Function FF(A As Long, B As Long, C As Long, d As Long, x As Long, s As Long, ac As Long) As Long
A = LongOverflowAdd4(A, (B And C) Or (Not (B) And d), x, ac)
A = LongLeftRotate(A, s)
A = LongOverflowAdd(A, B)
End Function

Private Function GG(A As Long, B As Long, C As Long, d As Long, x As Long, s As Long, ac As Long) As Long
A = LongOverflowAdd4(A, (B And d) Or (C And Not (d)), x, ac)
A = LongLeftRotate(A, s)
A = LongOverflowAdd(A, B)
End Function

Private Function HH(A As Long, B As Long, C As Long, d As Long, x As Long, s As Long, ac As Long) As Long
A = LongOverflowAdd4(A, B Xor C Xor d, x, ac)
A = LongLeftRotate(A, s)
A = LongOverflowAdd(A, B)
End Function

Private Function II(A As Long, B As Long, C As Long, d As Long, x As Long, s As Long, ac As Long) As Long
A = LongOverflowAdd4(A, C Xor (B Or Not (d)), x, ac)
A = LongLeftRotate(A, s)
A = LongOverflowAdd(A, B)
End Function

Function LongLeftRotate(value As Long, Bits As Long) As Long
Dim lngSign As Long, lngI As Long
Bits = Bits Mod 32
If Bits = 0 Then LongLeftRotate = value: Exit Function
For lngI = 1 To Bits
lngSign = value And &HC0000000
value = (value And &H3FFFFFFF) * 2
value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
Next
LongLeftRotate = value
End Function

Private Function LongOverflowAdd(Val1 As Long, Val2 As Long) As Long
Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
LongOverflowAdd = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
End Function

Private Function LongOverflowAdd4(Val1 As Long, Val2 As Long, val3 As Long, val4 As Long) As Long
Dim lngHighWord As Long, lngLowWord As Long, lngOverflow As Long
lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + ((val3 And &HFFFF0000) \ 65536) + ((val4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))
End Function

Private Function UnsignedToLong(value As Double) As Long
If value < 0 Or value >= OFFSET_4 Then Error 6
If value <= MAXINT_4 Then UnsignedToLong = value Else UnsignedToLong = value - OFFSET_4
End Function

Private Function LongToUnsigned(value As Long) As Double
If value < 0 Then LongToUnsigned = value + OFFSET_4 Else LongToUnsigned = value
End Function
 
Lần chỉnh sửa cuối:
Cả một ngày hôm này mãi mê cái đề tài này quên cả ăn trưa mới viết xong được cái code bảo

mật File Excel theo ID máy ....Ngửa mặt lên trời hahaha--=0--=0 như chưa bao giờ hahaha

bao giờ .....đã ghê


1/ Mỗi lần mở file lên trên một máy bất kỳ là nó tạo một cái ID mới và một mã đăng ký mới nếu nhập đúng mã thì sử dụng File ... Nếu sai thì Tèo chẳng hạn....

2/ Nếu ai muốn sử dụng file thì nhắn mã qua mình cũng cấp cho mã đăng ký là Ok

3/ trong file mình làm luôn phần giải mã rồi nhờ các Bạn tải về kiểm tra cho ý kiếm
4/ hay nhất ở chỗ chỉ nhắn mã qua là mình cho mã sử dụng ko phải viết lại code .....--=----=----=--

5/Luu y giai ma Cells D4
Xin cảm ơn Các Bạn GPE Kiểm tra dùm cho ý kiến để mình hoàn thiện hơn....Xin cảm ơn...Xin cảm ơn

Link tải File
http://www.mediafire.com/download/gx62x52vj9i4xg6/License_Excel.rar
Bạn xóa link rồi hả?
 
Bạn giải nén file đó ra trong đó có 3 file. bạn chạy File Install DLL.bat để đăng ký với widows

xong mở file Excel lên xóa hết mấy cái mã cũ đi bấm lay ma HD Vb6 nó cho bạn 2 mã hai bên

[B4] là mã máy [D4] là giải mã bạn bấm check ma HD VB6 kiểm tra nhập bất kỳ mã nào vào [C4]

kiểm tra xem thế nào ... cuối cùng copy [D4] paste vào [C4] kiểm tra lại xem.....

1/ Ý tưởng sẻ dùng nó bảo vệ file Excel theo máy code viết hết vào file *.dll khi mở Excel nó sẻ kiểm

tra mã máy và tạo ra mã sử dụng luôn ..nếu mã sử dụng đúng thì cho chạy ...nếu sai thì chào.....


2/ Hay ở chỗ chạy trên máy mới thì nó tự đổi mã theo máy đó bắt buộc phải có mã mới . Mới sử dụng

được

xin cảm ơn bạn đã tham gia
Bài đã được tự động gộp:

Bạn ơi mình ấn vào giờ ko dùng được excel vba nữa. Giúp mình với HUHU
 
Web KT
Back
Top Bottom