现在有个循环的问题想要解决
算法是这样的 给你一个位数不确定的二进制数（大于9位，我们在这里称为A），对100110001做模2运算，算法我简单说一下
就是先取A的前9位，和100110001异或 ，然后得到一个数C，然后用C和A的剩下的几位连接&（就是与A取完9位以后剩下的字符），得到的数就是新的A，继续取新的A的前9位，进行异或（就是这里的循环不会）。直到新的A的位数等于9位停止。
我写的代码是这样的
n=len(Text1.Text)
Q=Mid (Text1.Text,1,9) '先去输入数字的前九位
s=0
For i =1 To 9
w=Mid (Q,i,1) '这里是先把输入的二进制数转换为十进制
s=s+2^(n-i)*w
c=s Xor 305 '这里是A的二进制数和B的二进制数进行异或
next i
Do ’这里是转换回二进制
ch = c Mod 2 & ch
c = c \ 2
Loop Until c = 0
SY= Mid (Text1.Text,10,n-9) '这里是取A中剩下的字符（就是取完前9位的）
NewQ = ch & SY
写到这里就不知道怎么写了 因为写到这里想要继续做上面的异或
用新产生的Q就是NewQ 继续做取9位的异或
[解决办法]
Option Explicit
Private Function HexToBin(ByVal sHex As String) As String
' 16进制转2进制
Const s1 As String = "0000101001101111000"
Const s2 As String = "0125A4936DB7FEC8"
Dim i As Long, sBin As String
sHex = UCase(sHex)
For i = 1 To Len(sHex)
sBin = sBin & Mid$(s1, InStr(1, s2, Mid(sHex, i, 1)), 4)
Next
HexToBin = sBin
End Function
Private Function BinToHex(ByVal sBin As String) As String
' 2进制转16进制
Const s1 As String = "0000101001101111000"
Const s2 As String = "0125A4936DB7FEC8"
Dim i As Long, sHex As String
sBin = String$(3 - (Len(sBin) - 1) Mod 4, "0") & sBin
For i = 1 To Len(sBin) Step 4
sHex = sHex & Mid$(s2, InStr(1, s1, Mid(sBin, i, 4)), 1)
Next
BinToHex = sHex
End Function
Private Sub Command1_Click()
Dim N&, M&, V&, p&
Dim strBinVal$, strTemp$
Call Randomize
M = CLng("&H" & BinToHex("100110001")) ' 预定义常数： 100110001
'M = 305
N = Rnd() * 9999999 + 512 ' 随机产生一个合法数值
'N = CLng("&H" & BinToHex(Text1.Text)) ' 如果你的数据是在Text1中输入的
Do
strTemp = HexToBin(Hex$(N))
p = InStr(strTemp, "1")
If (p) Then strBinVal = Mid$(strTemp, p)
V = CLng("&H" & BinToHex(Left$(strBinVal, 9))) Xor M
strTemp = HexToBin(Hex$(V))
p = InStr(strTemp, "1")
If (p) Then
strBinVal = Mid$(strTemp, p) & Mid$(strBinVal, 10)
Else
strBinVal = Mid$(strBinVal, 10)
End If
If (Len(strBinVal) = 9) Then Exit Do
N = CLng("&H" & BinToHex(strBinVal))
Loop
MsgBox strBinVal, 64 ' 最终结果：strBinVal
End Sub
Option Explicit
Function BinVal(ByVal Q As String) As Long
Dim v As Long
Dim n As Long
Dim w As Long
Dim i As Long
n = Len(Q)
For i = 1 To n
w = Mid(Q, i, 1) '这里是先把输入的二进制数转换为十进制
v = v + 2 ^ (n - i) * w
Next i
BinVal = v
End Function
Function BinStr(ByVal C As Long) As String
Dim ch As String
Do '这里是转换回二进制
ch = C Mod 2 & ch
C = C \ 2
Loop Until C = 0
BinStr = ch
End Function
Private Sub Command1_Click()
Dim A As String
Dim C As Long
A = Text1.Text
Debug.Print A
While Len(A) > 9
C = BinVal(Left$(A, 9)) Xor 305
A = BinStr(C) & Mid$(A, 10)
Debug.Print A
Wend
Text1.Text = A
End Sub
如果异或结果左边全部的0都去除，并且如果剩下9位做最后一次异或，代码如下，如果剩下9位之后，就不再做最后的异或，则将while的=去除
Option Explicit
Public Function BinToDec(s As String) As Long
Dim L As Long
Dim i As Long
Dim n As Long
L = 1
For i = Len(s) To 1 Step -1
n = n + Val(Mid(s, i, 1)) * L
L = L * 2
Next
BinToDec = n
End Function
Public Function DecToBin(n As Long) As String
Dim i As Long
Dim L As Long, K As Long
Dim s As String
Dim ss As String
L = Len(Hex(n)) * 4 - 1
K = 2 ^ L
For i = L To 0 Step -1
If n And K Then
ss = "1"
Else
ss = "0"
End If
If DecToBin <> "" Or ss = "1" Then
DecToBin = DecToBin & ss
End If
K = K / 2
Next
End Function
Public Function CalculateIt(n As Long, sBase As String) As String
Dim mBase As Long
Dim sDatum As String
Dim sLeft As String, sRight As String, sResult As String
Dim mA As Long, mB As Long
Dim lBase As Long
mBase = BinToDec(sBase)
sDatum = DecToBin(n)
lBase = Len(sBase)
While Len(sDatum) >= lBase
sLeft = Left(sDatum, lBase)
sRight = Mid(sDatum, lBase + 1)
mA = BinToDec(sLeft)
mB = mA Xor mBase
sResult = DecToBin(mB)
sDatum = sResult & sRight
Wend
CalculateIt = sDatum
End Function
