• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Mã hóa/Giải mã file

Bộ sưu tập mã nguồn các ứng dụng tiện ích
DungCoi
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 77
Ngày tham gia: T.Tư 26/03/2008 9:24 pm
Been thanked: 2 time

Mã hóa/Giải mã file

Gửi bàigửi bởi DungCoi » T.Hai 20/07/2009 12:04 pm

Tên chương trình: Viết ẩu vài đoạn code nên chưa có tên
Ngôn ngữ lập trình: VB6
Tác giả: DũngCòi
Chức năng: Mã hóa/Giải mã file theo mật khẩu




Viết lâu rồi, hôm nay post lên anh em coi cho vui :)

Đặt vấn đề :
Mã hóa và bảo vệ dữ liệu theo mật khẩu.
Mình thấy rất nhiều phần mềm, trong đó có cậu bạn trong khoa dùng một cách “cổ điển” đó là lưu password, mã hóa nó đi và vứt ở đâu đó trong file. Khi giải mã lại password đó và đối chiếu.

Vấn đề ?
Ok. Ngay cả khi khối dữ liệu được mã hóa theo tham số là mật khẩu đi chăng nữa thì thật ra mật khẩu vẫn phải theo nguyên tắc mã hóa nào đó. Mấy bác Reserver chẳng bao lâu cũng sẽ tìm ra nếu muốn.

Giải pháp ?
Tối qua mình mới viết 1 App nhỏ giải quyết vấn đề này.
Cấu trúc tập tin sau khi mã hóa :

“eNcOdE” + strMD5 + Data

Các dữ liệu trên sẽ được mình mã hóa bằng thư viện CryptAPI theo nguyên tắc sau :
Hẳng số tĩnh là (Mình quên mất tên) nhưng đây là key cá nhân : “darklight”
Các key công khai như sau :
Chuỗi “eNcOdE” : Key = “dark”
strMD5 : Key = “light” & Độ dài data
Data : Key = Password

Theo nguyên tắc mã hóa này. Chúng ta sẽ không hề lưu thông tin về Password ở đây, thay vào đó chúng ta kiểm tra strMD5 xem có tương đươg với dữ liệu ban đầu hay không.

Như các bạn đã biết, chúng ta có thể sử dụng mả SHA thay thế MD5. Các mã này gần như không thể bị phá vỡ (Mặt dù thực tế là đã có người làm được, nhưng nếu chỉ mới dừng lại ở việc tạo chuỗi sinh ra mã muốn có thì vẫn rất khó có thể phục hồi lại Data chỉ dựa vào mã MD5 này).

Yeah. Chúng ta dễ dàng hiểu, chính vì vậy mà việc tìm lại password lỡ có "quên" là bất khả thi
Ok. Mình nghĩ đây là một rất cách hay để Encrypt./.

Nói thêm. Kéo thả file vào ô TextBox.
Chương trình tự nhận ra tập tin kéo vào là có bị mã hóa hay không rồi tự quyết định cần mã hóa hay giải mã

:P
Đợi anh em cho ý kiến

Demo.png
Giao diện thô sơ giản dị
Tập tin đính kèm
SourceEncrypt.zip
(11.77 KiB) Đã tải 1618 lần


~vb

Hình đại diện của người dùng
xuanquy_th
Guru
Guru
Bài viết: 798
Ngày tham gia: T.Ba 05/08/2008 9:15 pm
Đến từ: Thanh Hoá
Has thanked: 1 time
Been thanked: 10 time
Liên hệ:

Re: Mã hóa/Giải mã file

Gửi bàigửi bởi xuanquy_th » T.Tư 22/07/2009 3:53 pm

Tôi thấy cái vụ Mã hóa File mày cũng hay đấy. Tôi cũng muốn thử nhưng không hiểu bản chất.

Tôi muốn hỏi hai bạn là việc mã hóa File và mã hóa Text có j khác nhau không?
Nếu khác thì khác ở chổ nào. Có thể chỉ dẩn tôi một số điều cơ bản về việc mã hóa File không?
Khi Chúa Trời đóng cánh cửa này lại, Ngài sẽ mở một cánh cửa khác cho ta.
Nhưng ta thường nhìn quá lâu vào cánh cửa đã đóng nên không thấy được có một cánh cửa khác đang mở ra cho ta!!!

DungCoi
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 77
Ngày tham gia: T.Tư 26/03/2008 9:24 pm
Been thanked: 2 time

Re: Mã hóa/Giải mã file

Gửi bàigửi bởi DungCoi » T.Tư 22/07/2009 4:17 pm

xuanquy_th đã viết:Tôi thấy cái vụ Mã hóa File mày cũng hay đấy. Tôi cũng muốn thử nhưng không hiểu bản chất.

Tôi muốn hỏi hai bạn là việc mã hóa File và mã hóa Text có j khác nhau không?
Nếu khác thì khác ở chổ nào. Có thể chỉ dẩn tôi một số điều cơ bản về việc mã hóa File không?

Mã file thực chất cũng là mã hóa một đoạn text (string) lớn thôi :)
Còn mã hóa text cơ bản là mã hóa từng byte trong string đó, đối chiếu theo mã Ascii rồi cộng trừ lên một số nhất định rồi trả về lại byte mới đó :)
~vb

Hình đại diện của người dùng
xuanquy_th
Guru
Guru
Bài viết: 798
Ngày tham gia: T.Ba 05/08/2008 9:15 pm
Đến từ: Thanh Hoá
Has thanked: 1 time
Been thanked: 10 time
Liên hệ:

Re: Mã hóa/Giải mã file

Gửi bàigửi bởi xuanquy_th » T.Tư 22/07/2009 4:45 pm

Nếu vậy thì tui áp dụng cái này vào việc mã hóa liệu có ổn khổng?
http://www.caulacbovb.com/forum/viewtop ... f=8&t=4734
Khi Chúa Trời đóng cánh cửa này lại, Ngài sẽ mở một cánh cửa khác cho ta.
Nhưng ta thường nhìn quá lâu vào cánh cửa đã đóng nên không thấy được có một cánh cửa khác đang mở ra cho ta!!!

DungCoi
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 77
Ngày tham gia: T.Tư 26/03/2008 9:24 pm
Been thanked: 2 time

Re: Mã hóa/Giải mã file

Gửi bàigửi bởi DungCoi » T.Tư 22/07/2009 7:48 pm

xuanquy_th đã viết:Nếu vậy thì tui áp dụng cái này vào việc mã hóa liệu có ổn khổng?
http://www.caulacbovb.com/forum/viewtop ... f=8&t=4734

Mã hóa ra ảnh không ổn lắm. Rất chậm + Phiền hà.
Ngay cả cách mã hóa theo từ byte dữ liệu bằng cách Mid từng byte mà xử lý rồi trả về cũng đủ chậm đuối rồi.

Bạn tham khảo trong API Guide có nhóm hàm Crypto giúp làm việc mã hóa dữ liệu khá tốt :)
Sau đây là code mẫu mình lấy từ đó :

Mã: Chọn hết

  1. 'Paste this code in a Class Module, named clsCryptoFilterBox
  2.  
  3. Option Explicit
  4. Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (phProv As Long, pszContainer As String, pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
  5. Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
  6. Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, phKey As Long) As Long
  7. Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
  8. Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  9. Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long, ByVal dwBufLen As Long) As Long
  10. Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
  11. Private Declare Function CryptExportKey Lib "advapi32.dll" (ByVal hKey As Long, ByVal hExpKey As Long, ByVal dwBlobType As Long, ByVal dwFlags As Long, ByVal pbData As String, pdwDataLen As Long) As Long
  12. Private Declare Function CryptGenKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal dwFlags As Long, phKey As Long) As Long
  13. Private Declare Function CryptGetProvParam Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
  14. Private Declare Function CryptGetUserKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwKeySpec As Long, phUserKey As Long) As Long
  15. Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
  16. Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
  17. Private Declare Function CryptSignHash Lib "advapi32.dll" Alias "CryptSignHashA" (ByVal hHash As Long, ByVal dwKeySpec As Long, ByVal sDescription As String, ByVal dwFlags As Long, ByVal pbSignature As String, pdwSigLen As Long) As Long
  18. Private Declare Function CryptVerifySignature Lib "advapi32.dll" Alias "CryptVerifySignatureA" (ByVal hHash As Long, ByVal pbSignature As String, ByVal dwSigLen As Long, ByVal hPubKey As Long, ByVal sDescription As String, ByVal dwFlags As Long) As Long
  19.  
  20. 'API error function
  21. Private Declare Function GetLastError Lib "kernel32" () As Long
  22.  
  23. 'API memory functions
  24. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  25. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  26. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  27. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  28. Private Declare Sub CpyMemValAdrFromRefAdr Lib "kernel32" Alias "RtlMoveMemory" (ByVal hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  29. Private Declare Sub CpyMemRefAdrFromValAdr Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)
  30.  
  31. 'constants for API memory functions
  32. Private Const GMEM_MOVEABLE = &H2
  33. Private Const GMEM_ZEROINIT = &H40
  34. Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  35.  
  36. 'constants for Cryptography API functions
  37. Private Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
  38. Private Const PROV_RSA_FULL = 1
  39. Private Const CRYPT_NEWKEYSET = &H8
  40. Private Const PP_CONTAINER = 6
  41. Private Const AT_KEYEXCHANGE = 1
  42. Private Const AT_SIGNATURE = 2
  43.  
  44. Private Const SIMPLEBLOB = 1
  45.  
  46. Private Const ALG_CLASS_DATA_ENCRYPT = 24576
  47. Private Const ALG_CLASS_HASH = 32768
  48. Private Const ALG_TYPE_ANY = 0
  49. Private Const ALG_TYPE_BLOCK = 1536
  50. Private Const ALG_TYPE_STREAM = 2048
  51. Private Const ALG_SID_RC2 = 2
  52. Private Const ALG_SID_RC4 = 1
  53. Private Const ALG_SID_MD5 = 3
  54.  
  55. Private Const CALG_MD5 = ((ALG_CLASS_HASH Or ALG_TYPE_ANY) Or ALG_SID_MD5)
  56. Private Const CALG_RC2 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_BLOCK) Or ALG_SID_RC2)
  57. Private Const CALG_RC4 = ((ALG_CLASS_DATA_ENCRYPT Or ALG_TYPE_STREAM) Or ALG_SID_RC4)
  58.  
  59. 'constants from WinErr.h
  60. Private Const NTE_NO_KEY As Long = -2146893811  '0x8009000DL
  61. Private Const NTE_BAD_SIGNATURE As Long = -2146893818
  62.  
  63. 'clsCryptoFilterBox constants
  64. Private Const CFB_BUSY = 0
  65. Private Const CFB_READY = 1
  66. Private Const CFB_VALID = 2
  67.  
  68. Private Const ENCRYPT_ALGORITHM = CALG_RC4
  69. Private Const ENCRYPT_BLOCK_SIZE = 1
  70.  
  71. Private Const CRYPT_EXPORTABLE = 1
  72.  
  73. 'private property buffers
  74. Private sInBuffer As String
  75. Private sOutBuffer As String
  76. Private sPassword As String
  77. Private sSignature As String
  78. Private lStatus As Long
  79. Public Property Get InBuffer() As String
  80.     InBuffer = sInBuffer
  81. End Property
  82. Public Property Let InBuffer(vNewValue As String)
  83.     sInBuffer = vNewValue
  84. End Property
  85. Public Property Get OutBuffer() As String
  86.     OutBuffer = sOutBuffer
  87. End Property
  88. Public Property Get Signature() As String
  89.     Signature = sSignature
  90. End Property
  91. Public Property Let Signature(vNewValue As String)
  92.     sSignature = vNewValue
  93. End Property
  94. Public Sub Sign()
  95. 'Create a signature for Inbuffer and place in Signature
  96.  
  97. Dim sContainer As String, sDescription As String, sProvider As String, lHCryptprov As Long
  98. Dim lHHash As Long, lResult As Long, lSignatureLen As Long
  99.  
  100. On Error GoTo ErrSign
  101.  
  102. 'switch Status property
  103. lStatus = CFB_BUSY
  104.  
  105. 'init Signature property
  106. sSignature = ""
  107.  
  108. 'Get handle to the default provider.
  109. sContainer = vbNullChar
  110. sProvider = MS_DEF_PROV & vbNullChar
  111. If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
  112.     MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
  113.     GoTo ReleaseHandles:
  114. End If
  115.  
  116. 'Create a hash object.
  117. If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
  118.     MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
  119.     GoTo ReleaseHandles:
  120. End If
  121.  
  122. If Not CBool(CryptHashData(lHHash, sInBuffer, Len(sInBuffer), 0)) Then
  123.     MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
  124.     GoTo ReleaseHandles:
  125. End If
  126.  
  127. 'Sign hash object.
  128. 'Determine size of signature.
  129. sDescription = vbNullChar
  130. lResult = CryptSignHash(lHHash, AT_SIGNATURE, sDescription, 0, sSignature, lSignatureLen)
  131.  
  132. sSignature = String(lSignatureLen, vbNullChar)
  133.  
  134. 'Sign hash object (with signature key).
  135. If Not CBool(CryptSignHash(lHHash, AT_SIGNATURE, sDescription, 0, sSignature, lSignatureLen)) Then
  136.     MsgBox ("Error " & CStr(GetLastError()) & " during CryptSignHash")
  137.     GoTo ReleaseHandles:
  138. End If
  139.  
  140. ReleaseHandles:
  141. 'Destroy hash object.
  142. If lHHash Then lResult = CryptDestroyHash(lHHash)
  143. 'Release provider handle.
  144. If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)
  145.  
  146. 'switch Status property
  147. lStatus = CFB_READY
  148.  
  149. Exit Sub
  150.  
  151. ErrSign:
  152. MsgBox ("ErrSign " & Error$)
  153. GoTo ReleaseHandles
  154. End Sub
  155.  
  156. Public Sub Validate()
  157. 'Validate InBuffer with Signature and assign Status with result
  158. Dim bValid As Boolean, sContainer As String, sDescription As String, sProvider As String
  159. Dim lDataLen As Long, lDataPoint As Long, lHCryptprov As Long, lHHash As Long
  160. Dim lResult As Long, lSignatureLen As Long, lHCryptKey As Long
  161.  
  162. ReDim aByteData(0) As Byte
  163.  
  164. On Error GoTo ErrValidate
  165.  
  166. 'switch Status property
  167. lStatus = CFB_BUSY
  168.  
  169. 'init internal valid flag
  170. bValid = True
  171.  
  172. 'Get handle to the default provider.
  173. sContainer = vbNullChar
  174. sProvider = MS_DEF_PROV & vbNullChar
  175. If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
  176.     bValid = False
  177.     MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
  178.     GoTo ReleaseHandles:
  179. End If
  180.  
  181. 'Create a hash object.
  182. If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
  183.     bValid = False
  184.     MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
  185.     GoTo ReleaseHandles:
  186. End If
  187.  
  188. 'Add data to hash object.
  189. If Not CBool(CryptHashData(lHHash, sInBuffer, Len(sInBuffer), 0)) Then
  190.     bValid = False
  191.     MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
  192.     GoTo ReleaseHandles:
  193. End If
  194.  
  195. 'Determine size of signature.
  196. 'sDescription = vbNullChar
  197. 'lResult = CryptSignHash(lHHash, AT_SIGNATURE, sDescription, 0, 0, lSignatureLen)
  198.  
  199. 'Get handle to signature key.
  200. If Not CBool(CryptGetUserKey(lHCryptprov, AT_SIGNATURE, lHCryptKey)) Then
  201.     bValid = False
  202.     MsgBox ("Error " & CStr(GetLastError) & " during CryptGetUserKey!")
  203.     GoTo ReleaseHandles:
  204. End If
  205.  
  206. lSignatureLen = Len(sSignature)
  207.  
  208. 'Verify signature.
  209. If Not CBool(CryptVerifySignature(lHHash, sSignature, lSignatureLen, lHCryptKey, sDescription, 0)) Then
  210.  
  211.     If GetLastError = NTE_BAD_SIGNATURE Then
  212.         bValid = False
  213.         GoTo ReleaseHandles:
  214.     Else
  215.         bValid = False
  216.         MsgBox ("Error " & CStr(GetLastError) & " during CryptVerifySignature!")
  217.         GoTo ReleaseHandles:
  218.     End If
  219.  
  220. End If
  221.  
  222. ReleaseHandles:
  223. 'Release signature key.
  224. If lHCryptKey Then lResult = CryptDestroyKey(lHCryptKey)
  225. 'Destroy hash object.
  226. If lHHash Then lResult = CryptDestroyHash(lHHash)
  227. 'Release provider handle.
  228. If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)
  229.  
  230. Select Case bValid
  231.     Case True
  232.         lStatus = CFB_VALID
  233.     Case Else
  234.         lStatus = CFB_READY
  235. End Select
  236.  
  237. Exit Sub
  238.  
  239. ErrValidate:
  240. MsgBox ("ErrValidate " & Error$)
  241. Resume
  242.  
  243. End Sub
  244. Public Sub Encrypt()
  245. 'Encrypt InBuffer into OutBuffer
  246.  
  247. Dim lHExchgKey As Long, lHCryptprov As Long, lHHash As Long, lHkey As Long
  248. Dim lResult As Long, sContainer As String, sProvider As String, sCryptBuffer As String
  249. Dim lCryptLength As Long, lCryptBufLen As Long
  250.  
  251. On Error GoTo ErrEncrypt
  252.  
  253. 'switch Status property
  254. lStatus = CFB_BUSY
  255.  
  256. 'Get handle to the default provider
  257. sContainer = vbNullChar
  258. sProvider = vbNullChar
  259. sProvider = MS_DEF_PROV & vbNullChar
  260. If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
  261.     MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
  262.     GoTo Done
  263. End If
  264.  
  265. 'Create a hash object.
  266. If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
  267.     MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
  268.     GoTo Done
  269. End If
  270.  
  271. 'Hash in the password data.
  272. If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
  273.     MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
  274.     GoTo Done
  275. End If
  276.  
  277. 'Derive a session key from the hash object.
  278. If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
  279.     MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
  280.     GoTo Done
  281. End If
  282.  
  283. 'Destroy the hash object.
  284. CryptDestroyHash (lHHash)
  285. lHHash = 0
  286.  
  287. 'Prepare a string buffer for the CryptEncrypt function
  288. lCryptLength = Len(sInBuffer)
  289. lCryptBufLen = lCryptLength * 2
  290. sCryptBuffer = String(lCryptBufLen, vbNullChar)
  291. LSet sCryptBuffer = sInBuffer
  292.  
  293. 'Encrypt data
  294. If Not CBool(CryptEncrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptLength, lCryptBufLen)) Then
  295.     MsgBox ("bytes required:" & CStr(lCryptLength))
  296.     MsgBox ("Error " & CStr(GetLastError) & " during CryptEncrypt!")
  297.     'GoTo Done
  298. End If
  299.  
  300. sOutBuffer = Mid$(sCryptBuffer, 1, lCryptLength)
  301.  
  302. Done:
  303.  
  304. 'Destroy session key.
  305. If (lHkey) Then lResult = CryptDestroyKey(lHkey)
  306.  
  307. 'Release key exchange key handle.
  308. If lHExchgKey Then CryptDestroyKey (lHExchgKey)
  309.  
  310. 'Destroy hash object.
  311. If lHHash Then CryptDestroyHash (lHHash)
  312.  
  313. 'Release provider handle.
  314. If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)
  315.  
  316. 'switch Status property
  317. lStatus = CFB_READY
  318.  
  319. Exit Sub
  320.  
  321. ErrEncrypt:
  322.  
  323. MsgBox ("ErrEncrypt " & Error$)
  324. Resume
  325.  
  326. End Sub
  327. Public Sub Decrypt()
  328. 'Decrypt InBuffer into OutBuffer
  329. Dim lHExchgKey As Long, lHCryptprov As Long, lHHash As Long, lHkey As Long
  330. Dim lResult As Long, sContainer As String, sProvider As String
  331. Dim sCryptBuffer As String, lCryptBufLen As Long, lCryptPoint As Long
  332. Dim lPasswordPoint As Long, lPasswordCount As Long
  333.  
  334. On Error GoTo ErrDecrypt
  335.  
  336. 'switch Status property
  337. lStatus = CFB_BUSY
  338.  
  339. 'Init sOutBuffer
  340. sOutBuffer = ""
  341.  
  342. 'Get handle to the default provider.
  343. sContainer = vbNullChar
  344. sProvider = vbNullChar
  345. sProvider = MS_DEF_PROV & vbNullChar
  346. If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
  347.     MsgBox ("Error " & CStr(GetLastError) & " during CryptAcquireContext!")
  348.     GoTo Done
  349. End If
  350.  
  351. 'Create a hash object.
  352. If Not CBool(CryptCreateHash(lHCryptprov, CALG_MD5, 0, 0, lHHash)) Then
  353.     MsgBox ("Error " & CStr(GetLastError) & " during CryptCreateHash!")
  354.     GoTo Done
  355. End If
  356.  
  357. 'Hash in the password data.
  358. If Not CBool(CryptHashData(lHHash, sPassword, Len(sPassword), 0)) Then
  359.     MsgBox ("Error " & CStr(GetLastError) & " during CryptHashData!")
  360.     GoTo Done
  361. End If
  362.  
  363. 'Derive a session key from the hash object.
  364. If Not CBool(CryptDeriveKey(lHCryptprov, ENCRYPT_ALGORITHM, lHHash, 0, lHkey)) Then
  365.     MsgBox ("Error " & CStr(GetLastError) & " during CryptDeriveKey!")
  366.     GoTo Done
  367. End If
  368.  
  369. 'Destroy the hash object.
  370. CryptDestroyHash (lHHash)
  371. lHHash = 0
  372.  
  373. 'Prepare sCryptBuffer for CryptDecrypt
  374. lCryptBufLen = Len(sInBuffer) * 2
  375. sCryptBuffer = String(lCryptBufLen, vbNullChar)
  376. LSet sCryptBuffer = sInBuffer
  377.  
  378. 'Decrypt data
  379. If Not CBool(CryptDecrypt(lHkey, 0, 1, 0, sCryptBuffer, lCryptBufLen)) Then
  380.     MsgBox ("bytes required:" & CStr(lCryptBufLen))
  381.     MsgBox ("Error " & CStr(GetLastError) & " during CryptDecrypt!")
  382.     GoTo Done
  383. End If
  384.  
  385. 'Apply decrypted string from sCryptBuffer to private buffer for OutBuffer property
  386. sOutBuffer = Mid$(sCryptBuffer, 1, Len(sInBuffer))
  387.  
  388. Done:
  389.  
  390. 'Destroy session key.
  391. If (lHkey) Then lResult = CryptDestroyKey(lHkey)
  392.  
  393. 'Release key exchange key handle.
  394. If lHExchgKey Then CryptDestroyKey (lHExchgKey)
  395.  
  396. 'Destroy hash object.
  397. If lHHash Then CryptDestroyHash (lHHash)
  398.  
  399. 'Release provider handle.
  400. If lHCryptprov Then lResult = CryptReleaseContext(lHCryptprov, 0)
  401.  
  402. 'switch Status property
  403. lStatus = CFB_READY
  404.  
  405. Exit Sub
  406.  
  407. ErrDecrypt:
  408. MsgBox ("ErrDecrypt " & Error$)
  409. GoTo Done
  410.  
  411. End Sub
  412. Public Property Get Status() As Long
  413.     Status = lStatus
  414. End Property
  415. Private Function InitUser() As Long
  416.     Dim lHCryptprov As Long, lHCryptKey As Long, avProviderData(1000) As Byte
  417.     Dim lProviderDataAddress As Long, lProviderDataLen As Long, lDataSize As Long
  418.     Dim lResult As Long, sContainer As String, sProvider As String
  419.     Dim sUserName As String, lPoint As Long, lMemHandle As Long
  420.     Dim lReturn As Long, sBuffer As String
  421.  
  422.     On Error GoTo ErrInitUser
  423.     'prepare string buffers
  424.  
  425.     sContainer = vbNullChar
  426.     sProvider = MS_DEF_PROV & vbNullChar
  427.  
  428.     'Attempt to acquire a handle to the default key container.
  429.     If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, 0)) Then
  430.  
  431.         'Create default key container.
  432.         If Not CBool(CryptAcquireContext(lHCryptprov, ByVal sContainer, ByVal sProvider, PROV_RSA_FULL, CRYPT_NEWKEYSET)) Then
  433.             MsgBox ("Error creating key container! " & CStr(GetLastError))
  434.             Exit Function
  435.         End If
  436.  
  437.         'Get name of default key container.
  438.         lProviderDataLen = Len(avProviderData(0)) * (UBound(avProviderData) + 1)
  439.         If Not CBool(CryptGetProvParam(lHCryptprov, PP_CONTAINER, avProviderData(0), lProviderDataLen, 0)) Then
  440.             MsgBox ("Error getting user name! " & CStr(GetLastError))
  441.             avProviderData(0) = 0
  442.         End If
  443.  
  444.         'Get sUserName from avProviderData()
  445.         lPoint = LBound(avProviderData)
  446.         While lPoint <= UBound(avProviderData)
  447.             If avProviderData(lPoint) <> 0 Then
  448.                 sUserName = sUserName & Chr$(avProviderData(lPoint))
  449.             Else
  450.                 lPoint = UBound(avProviderData)
  451.             End If
  452.             lPoint = lPoint + 1
  453.         Wend
  454.  
  455.         MsgBox ("Create key container " & sUserName)
  456.  
  457.     End If
  458.  
  459.     'Attempt to get handle to signature key
  460.     If Not CBool(CryptGetUserKey(lHCryptprov, AT_SIGNATURE, lHCryptKey)) Then
  461.         If GetLastError = NTE_NO_KEY Then
  462.             MsgBox ("Create key exchange key pair")
  463.             If Not CBool(CryptGenKey(lHCryptprov, AT_SIGNATURE, 0, lHCryptKey)) Then
  464.                 MsgBox ("Error during CryptGenKey! " & CStr(GetLastError))
  465.                 Exit Function
  466.             Else
  467.                 lResult = CryptDestroyKey(lHCryptprov)
  468.             End If
  469.         Else
  470.             MsgBox ("Error during CryptGetUserKey! " & CStr(GetLastError))
  471.             Exit Function
  472.         End If
  473.     End If
  474.  
  475.     'Attempt to get handle to exchange key
  476.     If Not CBool(CryptGetUserKey(lHCryptprov, AT_KEYEXCHANGE, lHCryptKey)) Then
  477.         If GetLastError = NTE_NO_KEY Then
  478.             MsgBox ("Create key exchange key pair")
  479.             If Not CBool(CryptGenKey(lHCryptprov, AT_KEYEXCHANGE, 0, lHCryptKey)) Then
  480.                 MsgBox ("Error during CryptGenKey! " & CStr(GetLastError))
  481.                 Exit Function
  482.             Else
  483.                 lResult = CryptDestroyKey(lHCryptprov)
  484.             End If
  485.         Else
  486.             MsgBox ("Error during CryptGetUserKey! " & CStr(GetLastError))
  487.             Exit Function
  488.         End If
  489.     End If
  490.  
  491.     'release handle to provider
  492.     lResult = CryptReleaseContext(lHCryptprov, 0)
  493.     InitUser = True
  494.  
  495. Exit Function
  496.  
  497. ErrInitUser:
  498.     MsgBox ("ErrInitUser " & Error$)
  499.     Resume
  500.  
  501. End Function
  502. Private Sub Class_Initialize()
  503.     If InitUser = True Then
  504.         MsgBox ("InitUser OK")
  505.     Else
  506.         MsgBox ("InitUser failed")
  507.     End If
  508. End Sub
  509. Public Property Get Password() As String
  510.     Password = sPassword
  511. End Property
  512. Public Property Let Password(vNewValue As String)
  513.     sPassword = vNewValue
  514. End Property
~vb

modest
Bài viết: 1
Ngày tham gia: CN 27/02/2011 10:22 pm

Re: Mã hóa/Giải mã file

Gửi bàigửi bởi modest » T.Ba 31/12/2013 9:30 pm

minh co file sau muon xem thong tin ve no ma chua biet cach cac ban chi minh voi


Quay về “[VB] Mã nguồn chương trình tiện ích”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.1 khách