ledangvan > 19-08-15, 10:45 AM
tranthanhan1962 > 19-08-15, 06:18 PM
(19-08-15, 10:45 AM)ledangvan Đã viết: Mình có một ngu ý : Muốn chuyển chữ thành số để làm cái đăng ký sử dụng chương trình
Ví dụ : Đăng ký cho : Công ty ABC -> Sẽ hiện Công ty ABC thay vì bằng chữ nó ra bằng số để mình lấy số đó làm số đăng ký cho cái tên Công ty ABC
Cụ thể hơn : chữ A - ứng với số 1, chữ B - ứng với số 2 ...
Xin mọi người giúp đỡ
Option Compare Database
Option Explicit
Dim sochu, SOLAN As Integer
Dim CHUADOI, DOI, DOIXONG As String
Function SODOICHU(SO As String)
Dim XSO As String
Dim XSOCHU As Integer
sochu = Len(Left(SO, (Len(SO) - 3)))
DOIXONG = ""
For SOLAN = 1 To sochu
CHUADOI = Mid(Left(SO, (Len(SO) - 3)), SOLAN, 1)
Select Case CHUADOI
Case 1
DOI = "A"
Case 2
DOI = "B"
Case 3
DOI = "C"
Case 4
DOI = "D"
Case 5
DOI = "E"
Case 6
DOI = "F"
Case 7
DOI = "G"
Case 8
DOI = "H"
Case 9
DOI = "I"
Case 0
DOI = "0"
End Select
DOIXONG = DOIXONG & DOI
Next SOLAN
SODOICHU = DOIXONG
End Function
Function THANGDOICHU(Thang As Integer)
Select Case Thang
Case 1
DOI = "A"
Case 2
DOI = "B"
Case 3
DOI = "C"
Case 4
DOI = "D"
Case 5
DOI = "E"
Case 6
DOI = "F"
Case 7
DOI = "G"
Case 8
DOI = "H"
Case 9
DOI = "I"
Case 10
DOI = "J"
Case 11
DOI = "K"
Case 12
DOI = "L"
End Select
THANGDOICHU = DOI
End Function
Function NGAYDOICHU(NGAY As Integer)
Select Case NGAY
Case 1
DOI = "A"
Case 2
DOI = "B"
Case 3
DOI = "C"
Case 4
DOI = "D"
Case 5
DOI = "E"
Case 6
DOI = "F"
Case 7
DOI = "G"
Case 8
DOI = "H"
Case 9
DOI = "I"
Case 10
DOI = "J"
Case 11
DOI = "K"
Case 12
DOI = "L"
Case 13
DOI = "M"
Case 14
DOI = "N"
Case 15
DOI = "O"
Case 16
DOI = "P"
Case 17
DOI = "Q"
Case 18
DOI = "R"
Case 19
DOI = "S"
Case 20
DOI = "T"
Case 21
DOI = "U"
Case 22
DOI = "V"
Case 23
DOI = "W"
Case 24
DOI = "X"
Case 25
DOI = "Y"
Case 26
DOI = "Z"
Case 27
DOI = "@"
Case 28
DOI = "#"
Case 29
DOI = "$"
Case 30
DOI = "%"
Case 31
DOI = "&"
End Select
NGAYDOICHU = DOI
End Function
Function NAMDOICHU(NAM As Integer)
Select Case NAM
Case 2012
DOI = "A"
Case 2013
DOI = "B"
Case 2014
DOI = "C"
Case 2015
DOI = "D"
Case 2016
DOI = "E"
Case 2017
DOI = "F"
Case 2018
DOI = "G"
Case 2019
DOI = "H"
Case 2020
DOI = "I"
Case 2021
DOI = "J"
Case 2022
DOI = "K"
Case 2023
DOI = "L"
Case 2024
DOI = "M"
Case 2025
DOI = "N"
Case 2026
DOI = "O"
Case 2027
DOI = "P"
Case 2028
DOI = "Q"
Case 2029
DOI = "R"
Case 2030
DOI = "S"
Case 2031
DOI = "T"
Case 2032
DOI = "U"
Case 2033
DOI = "V"
Case 2034
DOI = "W"
Case 2035
DOI = "X"
Case 2036
DOI = "Y"
Case 2037
DOI = "Z"
Case 2038
DOI = "@"
Case 2039
DOI = "#"
Case 2040
DOI = "$"
Case 2041
DOI = "%"
Case 2042
DOI = "&"
End Select
NAMDOICHU = DOI
End Function
ledangvan > 20-08-15, 10:00 AM
(19-08-15, 06:18 PM)tranthanhan1962 Đã viết:(19-08-15, 10:45 AM)ledangvan Đã viết: Mình có một ngu ý : Muốn chuyển chữ thành số để làm cái đăng ký sử dụng chương trình
Ví dụ : Đăng ký cho : Công ty ABC -> Sẽ hiện Công ty ABC thay vì bằng chữ nó ra bằng số để mình lấy số đó làm số đăng ký cho cái tên Công ty ABC
Cụ thể hơn : chữ A - ứng với số 1, chữ B - ứng với số 2 ...
Xin mọi người giúp đỡ
Lúc trước mình có mấy cái hàm xử lý đổi số ra chữ cho một trung tâm vàng bạc. Bạn có thể lấy rồi xử lý ngược ra hàm đổi chữ thành số.
Mã PHP:Option Compare Database
Option Explicit
Dim sochu, SOLAN As Integer
Dim CHUADOI, DOI, DOIXONG As String
Function SODOICHU(SO As String)
Dim XSO As String
Dim XSOCHU As Integer
sochu = Len(Left(SO, (Len(SO) - 3)))
DOIXONG = ""
For SOLAN = 1 To sochu
CHUADOI = Mid(Left(SO, (Len(SO) - 3)), SOLAN, 1)
Select Case CHUADOI
Case 1
DOI = "A"
Case 2
DOI = "B"
Case 3
DOI = "C"
Case 4
DOI = "D"
Case 5
DOI = "E"
Case 6
DOI = "F"
Case 7
DOI = "G"
Case 8
DOI = "H"
Case 9
DOI = "I"
Case 0
DOI = "0"
End Select
DOIXONG = DOIXONG & DOI
Next SOLAN
SODOICHU = DOIXONG
End Function
Function THANGDOICHU(Thang As Integer)
Select Case Thang
Case 1
DOI = "A"
Case 2
DOI = "B"
Case 3
DOI = "C"
Case 4
DOI = "D"
Case 5
DOI = "E"
Case 6
DOI = "F"
Case 7
DOI = "G"
Case 8
DOI = "H"
Case 9
DOI = "I"
Case 10
DOI = "J"
Case 11
DOI = "K"
Case 12
DOI = "L"
End Select
THANGDOICHU = DOI
End Function
Function NGAYDOICHU(NGAY As Integer)
Select Case NGAY
Case 1
DOI = "A"
Case 2
DOI = "B"
Case 3
DOI = "C"
Case 4
DOI = "D"
Case 5
DOI = "E"
Case 6
DOI = "F"
Case 7
DOI = "G"
Case 8
DOI = "H"
Case 9
DOI = "I"
Case 10
DOI = "J"
Case 11
DOI = "K"
Case 12
DOI = "L"
Case 13
DOI = "M"
Case 14
DOI = "N"
Case 15
DOI = "O"
Case 16
DOI = "P"
Case 17
DOI = "Q"
Case 18
DOI = "R"
Case 19
DOI = "S"
Case 20
DOI = "T"
Case 21
DOI = "U"
Case 22
DOI = "V"
Case 23
DOI = "W"
Case 24
DOI = "X"
Case 25
DOI = "Y"
Case 26
DOI = "Z"
Case 27
DOI = "@"
Case 28
DOI = "#"
Case 29
DOI = "$"
Case 30
DOI = "%"
Case 31
DOI = "&"
End Select
NGAYDOICHU = DOI
End Function
Function NAMDOICHU(NAM As Integer)
Select Case NAM
Case 2012
DOI = "A"
Case 2013
DOI = "B"
Case 2014
DOI = "C"
Case 2015
DOI = "D"
Case 2016
DOI = "E"
Case 2017
DOI = "F"
Case 2018
DOI = "G"
Case 2019
DOI = "H"
Case 2020
DOI = "I"
Case 2021
DOI = "J"
Case 2022
DOI = "K"
Case 2023
DOI = "L"
Case 2024
DOI = "M"
Case 2025
DOI = "N"
Case 2026
DOI = "O"
Case 2027
DOI = "P"
Case 2028
DOI = "Q"
Case 2029
DOI = "R"
Case 2030
DOI = "S"
Case 2031
DOI = "T"
Case 2032
DOI = "U"
Case 2033
DOI = "V"
Case 2034
DOI = "W"
Case 2035
DOI = "X"
Case 2036
DOI = "Y"
Case 2037
DOI = "Z"
Case 2038
DOI = "@"
Case 2039
DOI = "#"
Case 2040
DOI = "$"
Case 2041
DOI = "%"
Case 2042
DOI = "&"
End Select
NAMDOICHU = DOI
End Function
tranthanhan1962 > 20-08-15, 12:40 PM
ledangvan > 20-08-15, 01:01 PM
(20-08-15, 12:40 PM)tranthanhan1962 Đã viết: Trong Function SODOICHU mình dùng For Next và tổ hợp Mid(Left(SO, (Len(SO) - 3)), SOLAN, 1) để cắt CHUADOI thành từng ký tự sau đó dùng select case để dịch số ra chữ rồi ghép lại. Bạn cứ dùng đoạn mã này nhưng đổi ngược từ chữ ra số là xong
paulsteigel > 20-08-15, 11:25 PM
(19-08-15, 10:45 AM)ledangvan Đã viết: Mình có một ngu ý : Muốn chuyển chữ thành số để làm cái đăng ký sử dụng chương trình
Ví dụ : Đăng ký cho : Công ty ABC -> Sẽ hiện Công ty ABC thay vì bằng chữ nó ra bằng số để mình lấy số đó làm số đăng ký cho cái tên Công ty ABC
Cụ thể hơn : chữ A - ứng với số 1, chữ B - ứng với số 2 ...
Xin mọi người giúp đỡ
Option Explicit
Public Function XORDecryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To (Len(DataIn) / 2)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
Next lonDataPtr
XORDecryption = strDataOut
End Function
Public Function XOREncryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim temp As Integer
Dim tempstring As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To Len(DataIn)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
temp = (intXOrValue1 Xor intXOrValue2)
tempstring = Hex(temp)
If Len(tempstring) = 1 Then tempstring = "0" & tempstring
strDataOut = strDataOut + tempstring
Next lonDataPtr
XOREncryption = strDataOut
End Function
ledangvan > 21-08-15, 11:33 AM
(20-08-15, 11:25 PM)paulsteigel Đã viết:(19-08-15, 10:45 AM)ledangvan Đã viết: Mình có một ngu ý : Muốn chuyển chữ thành số để làm cái đăng ký sử dụng chương trình
Ví dụ : Đăng ký cho : Công ty ABC -> Sẽ hiện Công ty ABC thay vì bằng chữ nó ra bằng số để mình lấy số đó làm số đăng ký cho cái tên Công ty ABC
Cụ thể hơn : chữ A - ứng với số 1, chữ B - ứng với số 2 ...
Xin mọi người giúp đỡ
Ledangvan sao phải phức tạp hóa thế làm gì. Mình đề nghị một cách dùng mã hóa theo phương phức nối, ghép chuỗi thông dụng. Bạn có thể dùng đoạn code sau với 2 hàm chính:
+ Hàm giải mã: XORDecryption([Khóa giải mã],[Chuỗi cần giải mã])
+ Hàm mã hóa: XOREncryption([Khóa giải mã],[Chuỗi cần mã hóa])
2 hàm mình gửi theo đây được dùng rất nhiều trong đó cụ thể cách làm là họ trộn ký tự mã khóa sau đó chuyển sang mã ASC và dùng hàm XOR.
Rất đơn giản.
Nếu bạn muốn dùng các chuẩn khác như Base64 hoặc Sha thì có các thư viện khác cũng đầy trên mạng cả.
Riêng với đoạn chương trình sau đây, tùy vào kích thước mã khóa mà có khi phải mất rất nhiều thời gian để giải mã đấy. (26 chữ cái, + 10 số)
Nếu bạn muốn tạo mã Sêri cố định nào đó thì mình khuyến nghị nên dùng thuật toán random - ngẫu nhiên và sử dụng chuẩn mã hóa sha. Cái này là dạng mã hóa 1 chiều, không có chiều ngươc lại để làm chuỗi so sánh. (nhưng thuật nghữ kiểu MD5 Check-Sum là kiểu như thế đấy).
Và điểm quan trọng là bạn sẽ phải có một kho lưu trữ mã đã cấp để so sánh lại sau này.
Mã:Option Explicit
Public Function XORDecryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To (Len(DataIn) / 2)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Val("&H" & (Mid$(DataIn, (2 * lonDataPtr) - 1, 2)))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
Next lonDataPtr
XORDecryption = strDataOut
End Function
Public Function XOREncryption(CodeKey As String, DataIn As String) As String
Dim lonDataPtr As Long
Dim strDataOut As String
Dim temp As Integer
Dim tempstring As String
Dim intXOrValue1 As Integer
Dim intXOrValue2 As Integer
For lonDataPtr = 1 To Len(DataIn)
'The first value to be XOr-ed comes from the data to be encrypted
intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
'The second value comes from the code key
intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
temp = (intXOrValue1 Xor intXOrValue2)
tempstring = Hex(temp)
If Len(tempstring) = 1 Then tempstring = "0" & tempstring
strDataOut = strDataOut + tempstring
Next lonDataPtr
XOREncryption = strDataOut
End Function