7,762
社区成员
发帖
与我相关
我的任务
分享
Function GetRlt2(ByVal pM As Byte, ByVal pK As Byte, ByVal pN As Byte) As Long
'返回能找到的第一个结果
Dim tOutValue As Long '输出值
Dim tCheckSum As Long '校验和(循环历遍值)
Dim tMixValue As Long '组合值
Dim tHBit As Long '高位值
For tHBit = 1 To &H7FFF '历遍高位值
For tCheckSum = 0 To 255 '历遍校验和
tMixValue = tHBit * &H10000 + tCheckSum * &H100 + pM '组合值
If CheckSum(tMixValue) * pK + pN = tCheckSum Then '如果组合值的实际校验和等于循环历遍到的校验和
tOutValue = tMixValue '输出组合值
tCheckSum = 255: tHBit = &H7FFF '跳出双循环
End If
Next
Next
GetRlt2 = tOutValue '返回输出值
End Function
Function GetRlt(ByVal pM As Byte, ByVal pK As Byte, ByVal pN As Byte) As Long()
'返回所有可能的结果。
Dim tOutValues() As Long '输出数组
Dim tOutValues_Index As Long '输出数组指针
Dim tOutValues_Length As Long '输出数组长度
Dim tCheckSum As Long '校验和
Dim tMixValue As Long '组合值
Dim tHBit As Long '高位值
tOutValues_Length = &HFF '初始数组长度255
ReDim tOutValues(tOutValues_Length)
For tHBit = 1 To &H7FFF '历遍高位值
For tCheckSum = 0 To 255 '历遍校验和
tMixValue = tHBit * &H10000 + tCheckSum * &H100 + pM '组合值
If CheckSum(tMixValue) * pK + pN = tCheckSum Then '如果组合值的实际校验和等于循环历遍到的校验和则将此结果推到结果集中。
'数组长度检查,如果长度不足以容纳结果,则增加255个元素。
If tOutValues_Index > tOutValues_Length Then
tOutValues_Length = tOutValues_Length + &HFF
ReDim Preserve tOutValues(tOutValues_Length)
End If
tOutValues(tOutValues_Index) = tMixValue '当前结果写入数组。
tOutValues_Index = tOutValues_Index + 1 '指针递增。
End If
Next
Next
'裁切数组,只保留有效长度。
tOutValues_Length = tOutValues_Index - 1
ReDim Preserve tOutValues(tOutValues_Length)
GetRlt = tOutValues()
End Function
Function CheckSum(ByVal pValue As Long) As Long
'返回10进制校验和
Dim tOutCheckSum As Long
Dim tLoopValue As Long
Dim tLoopIndex As Long
tLoopValue = pValue
For tLoopIndex = 0 To 9
tOutCheckSum = tOutCheckSum + tLoopValue Mod 10
tLoopValue = tLoopValue \ 10
Next
CheckSum = tOutCheckSum
End Function
Function GetRlt2(ByVal pM As Byte, ByVal pK As Byte, ByVal pN As Byte) As Long
'返回能找到的第一个结果
Dim tOutValue As Long
Dim tCheckSum As Long
Dim tMixValue As Long
Dim tHBit As Long
tOutValues_Length = &HFF
ReDim tOutValues(tOutValues_Length)
For tHBit = 1 To &H7FFF
For tCheckSum = 0 To 255
tMixValue = tHBit * &H10000 + tCheckSum * &H100 + pM
If CheckSum(tMixValue) * pK + pN = tCheckSum Then
tOutValue = tMixValue
tCheckSum = 255: tHBit = &H7FFF
End If
Next
Next
GetRlt2 = tOutValue
End Function
Function GetRlt(ByVal pM As Byte, ByVal pK As Byte, ByVal pN As Byte) As Long()
'返回所有可能的结果。
Dim tOutValues() As Long
Dim tOutValues_Index As Long
Dim tOutValues_Length As Long
Dim tCheckSum As Long
Dim tMixValue As Long
Dim tHBit As Long
tOutValues_Length = &HFF
ReDim tOutValues(tOutValues_Length)
For tHBit = 1 To &H7FFF
For tCheckSum = 0 To 255
tMixValue = tHBit * &H10000 + tCheckSum * &H100 + pM
If CheckSum(tMixValue) * pK + pN = tCheckSum Then
If tOutValues_Index > tOutValues_Length Then
tOutValues_Length = tOutValues_Length + &HFF
ReDim Preserve tOutValues(tOutValues_Length)
End If
Debug.Print "&H" & Hex(tMixValue),
DoEvents
tOutValues(tOutValues_Index) = tMixValue
tOutValues_Index = tOutValues_Index + 1
End If
Next
Next
tOutValues_Length = tOutValues_Index - 1
ReDim Preserve tOutValues(tOutValues_Length)
GetRlt = tOutValues()
End Function
Function CheckSum(ByVal pValue As Long) As Long
'返回10进制校验和
Dim tOutCheckSum As Long
Dim tLoopValue As Long
Dim tLoopIndex As Long
tLoopValue = pValue
For tLoopIndex = 0 To 9
tOutCheckSum = tOutCheckSum + tLoopValue Mod 10
tLoopValue = tLoopValue \ 10
Next
CheckSum = tOutCheckSum
End Function
Function CheckSum(ByVal pValue As Long) As Long
Dim tOutCheckSum As Long
Dim tLoopValue As Long
tLoopValue = pValue
Do
tOutCheckSum = tOutCheckSum + tLoopValue Mod 10
tLoopValue = tLoopValue \ 10
Loop While tLoopValue
CheckSum = tOutCheckSum
End Function
Function fun(m, k, N) As Long
Dim a As Long, b As Long, flg As Boolean
Dim i1 As Long, i2 As Integer, i3 As Integer
For i1 = 0 To Val(&H7FFF)
For i2 = 0 To Val(&HFF)
a = "&H" & Hex(i1) & Hex(i2) & Hex(m)
For i3 = 1 To Len(Format(a))
b = b + Mid(a, i3, 1) * k + N
Next
If b = i2 Then
fun = a
Exit Function
Else
b = 0
End If
Next
Next
End Function
'我得出了以下结论:
'1. 当 N=0时.一定有解.
'所有的解为 [&H1 TO &H7FFF] * &HFFFF(65536)+ K * 256 + M
'2.因为你最大数为 &H7FFFFFFF(2147483647) 因此, 得到的数据每位数之和最大是(1999999999的和即82)
'因此以下面程序为例 i 的值最大不可能超过82
'又因为 i 的值是 每位数之和*N+K ;又因为每位数之和不可以是0 因此. i的值最小是 N+K
'且 每位数之和*N+K<256 于是有: (N +K)<= 每位数之和[ I 值] <= [(256-K)/N 与 82 之间的小者 ]
Private Function Fun(M, K, N) As Long
Dim i As Long
Dim j As Long
For i = 1 To &H7FFF '因为最高位是从 1 至 &H7FFF
For j = 0 To 90 '因为如果就算是 &H7FFF FFFF 最多10位十进制数.即 第二位 [HHc] 不可能超过90
'其实这里还可以加入条件. J 可以是 256/K(少于90)
If GetCount(i * 256 * 256 + j * 256 + M) * K + N = j Then '条件是否满足公式要求
Fun = i * 256 * 256 + j * 256 + M) * K + N
exit function '如果想得到所有,这里不要退出了.只得到一个要求,且有答案的,一秒内搞定
End If
Next
DoEvents
Next
End Function