本帖最后由 kalimov 于 2014-8-14 22:22 编辑
原帖地址:XXXXXXXXXXXXXXXXXXXXXXXX/t/66589首先应novakon的要求,在这里将贴出程序VB源代码。但是,曾听过不止一个DIY圈内的人说KC有山寨现象(即抄袭后拿去商业化、或者若干种嘚瑟用途),在帖子内的源代码我故意设置了不少bug,有数值的,也有逻辑的,有說出來的,也有沒說的。相信如果是编程高手,这方面的“武德”不会太差,毕竟写出来这东西不知道能用于什么用途,可大也可小,虽然它仅仅是个对称算法。如果有人能消化我的注解,就算不用看源代码自己也能写出一个99%类似的。不看注解的,就慢慢啃“生肉”吧。(我的是红烧芥末德国肉肠,在香肠机上转的那种,很快大家会知道为什么了。)
初步验证一下我的工具它的有效性,这里附上一个小题目。到上面地址中下载那个工具,如果缺少控件请看该贴二楼,然后运行主程序minen.exe
1.rar
200.32KB
RAR
14次下载
题目密钥:223 152 145 56 220 100 45 88 179 2,看看是不是Hello, world!(这里有个程序bug,在后面无法输入220的时候,请先按一下size setting,因为尺寸大小导致了取模运算直接进行。
如果验证完了,可以尝试自己加解密一些纯文字信息。注意ASCII和Unicode开关,中文只能用Unicode模式。
好了,废话少说,贴上源代码。
‘This tool aims to suck off the auto-cracking machine even someone knows the algorithm. The author, Kalimov Thomasovich Verblude, aka Kalimorf Von Kammel, also called as Lok Heng Long doesn't know what the result will be if it leaks out.
'-------------------------------------------------------
'Global varities
Option Explicit
Dim CH(), NP(), Rot(), Grun(), Blau() As Integer 'CH stands for character. NP stands for beacon of the next point. Rot, Grun, Blau für Werte der farbe von rot, grüne und blau.
Dim KaisarRot, KaisarGrun, KaisarBlau As Integer 'Kaisar ist Caesar, der den Caesar-Verschlüsselung erfunden.
Dim PL1W, PL1H, PL2W, PL2H As Integer 'この変量たちは暗号初期のサイズです。
Dim Unicode(), ZahyouX(), ZahyouY() 'Unicode is used for non-latin characters. そして、座標のXとYが必要なのです。
Dim R(), G(), B() 'R, G, B are templates in calculation.
Dim Low(), Med(), High() 'They are templates in convertion.
Dim i, j, t, u, v, h, l 'They are templates in loops.
Dim Aka, Midori, Aoi '逆算解析の中の赤い、緑、青いです。
Dim Pattern() 'Pattern is used to add some randomized characters to the origin.
'-------------------------------------------------------
Private Sub AAAA_Change()
On Error GoTo reset '若非數,則重設。
AAAA.Text = AAAA.Text \ 1
Exit Sub
reset: AAAA.Text = 160
End Sub
Private Sub BBBB_Change()
On Error GoTo reset '若非數,則重設。
BBBB.Text = BBBB.Text \ 1
Exit Sub
reset: BBBB.Text = 120
End Sub
Private Sub CCCC_Change()
On Error GoTo reset '若非數,則重設。
CCCC.Text = CCCC.Text Mod PL2.Width
Exit Sub
reset: CCCC.Text = 0
End Sub
Private Sub ClearText_Click()
Plain.Text = "" '一筆勾銷
End Sub
Private Sub DDDD_Change()
On Error GoTo reset '若非數,則重設。
DDDD.Text = DDDD.Text Mod PL2.Height
Exit Sub
reset: DDDD.Text = 0
End Sub
Private Sub Decrypt_Click()
XXXXXXXXXXXXption = "Initializing..."
Call ClearText_Click
Call SizeSetting_Click
Call Locking
Call Parameters_Load
Call ImageCut
XXXXXXXXXXXXption = "Original being reconstruted..."
Call PlainReconstruction
Call PA_Remove
Call MemoryClean
Call Locking
XXXXXXXXXXXXption = "Decryption accomplished./Ready..."
End Sub
Private Sub EEEE_Change()
On Error GoTo reset '若非數,則重設。若過大,則模算確定之。
EEEE.Text = EEEE.Text Mod PL1.Width
Exit Sub
reset: EEEE.Text = 0
End Sub
Private Sub Encrypt_Click()
XXXXXXXXXXXXption = "Initializing..."
Call Locking
Call SizeSetting_Click
Call PA_Click
Call Amountcheck
Call Parameters_Load
Call ClearImage
XXXXXXXXXXXXption = "Smoke preparing......"
Call NoiseGenerator
XXXXXXXXXXXXption = "Encoding and being injecting..."
If XXXXXXXXXXlue = True Then
Call ASCIIconverter
Else
Call UnicodeConverter
End If
Call CodeToColor
Call RandomCheck
Call Caesarize
Call GearExchange
Call PL1_Drawing
XXXXXXXXXXXXption = "Final step, please wait..."
Call RussianDoll
Call MemoryClean
Call Locking
XXXXXXXXXXXXption = "Encryption accomplished./Ready..."
End Sub
Private Sub FFFF_Change()
On Error GoTo reset '若非數,則重設。若過大,則模算確定之。
FFFF.Text = FFFF.Text Mod PL1.Height
Exit Sub
reset: FFFF.Text = 0
End Sub
Private Sub Form_Load()
'This procedure is used to self-check when the application is opening. P.S. Due to a fatal bug.
OutputWidth = 16
OutputHeight = 16
AAAA.Text = 15
BBBB.Text = 15
Plain.Text = 0
Call PatternLoad
'此處隱藏兩行代碼
Plain.Text = ""
OutputWidth = 320
OutputHeight = 240
AAAA.Text = 160
BBBB.Text = 120
Call SizeSetting_Click
Call NoiseGenerator
XXXXXXXXXXXXption = "Ready."
End Sub
Private Sub GGG_Change()
On Error GoTo reset '若非數,則重設。若過大,則模算確定之。
GGG.Text = GGG.Text Mod 256
Exit Sub
reset: GGG.Text = 0
End Sub
Private Sub HHH_Change()
On Error GoTo reset '若非數,則重設。若過大,則模算確定之。
HHH.Text = HHH.Text Mod 256
Exit Sub
reset: HHH.Text = 0
End Sub
Private Sub III_Change()
On Error GoTo reset '若非數,則重設。若過大,則模算確定之。
III.Text = III.Text Mod 256
Exit Sub
reset: III.Text = 0
End Sub
Private Sub JJJJ_Change()
On Error GoTo reset '若非數,則重設。若過大,則模算確定之。轉子之數也。
JJJJ.Text = JJJJ.Text Mod 6
Exit Sub
reset: JJJJ.Text = 0
End Sub
Private Sub LoadCipher_Click()
'This procedure is used to load a cipher.
On Error GoTo terminate
XXXXXXXXXXXXXXXXlter = "Bitmap file(*.bmp)|*.bmp"
XXXXXXXXXXXXXXXXowOpen
PL2.Picture = LoadPicture(XXXXXXXXXXXXXXXXleName)
OutputWidth.Text = PL2.Width
OutputHeight.Text = PL2.Height
terminate: Exit Sub
End Sub
Private Sub LoadPlain_Click()
'This procedure is used to load an origin text that is used to be encrypted.
On Error GoTo terminate
Dim TextLine
XXXXXXXXXXXXXXXXlter = "Text files(*.txt)|*.txt|HTML files(*.htm)|*.htm"
XXXXXXXXXXXXXXXXowOpen
Open XXXXXXXXXXXXXXXXleName For Input As #2
Do While Not EOF(1)
Line Input
#2, TextLine
Plain.Text = Plain.Text & vbCrLf
Loop
Close
#2
terminate: Exit Sub
End Sub
Private Sub Option1_Click()
'This procedure is used to shift to ASCII mode.
XXXXXXXXXXlue = True
XXXXXXXXXXlue = False
End Sub
Private Sub Option2_Click()
'This procedure is used to shift to unicode mode, which supports non-latin characters.
XXXXXXXXXXlue = False
XXXXXXXXXXlue = True
End Sub
Sub ASCIIconverter()
On Error Resume Next
ReDim CH(Len(Plain.Text) - 1) 'CH數列上限設定,西文字符總量減一。
For i = 1 To UBound(CH) '逐字讀取其ASCII碼值,然後輸入陣列。
CH(i) = CLng("&H" & Hex((Asc(Mid(Plain.Text, i + 1, 1)))))
Next i
End Sub
Sub UnicodeConverter()
'This procedure can execute all characters in computer. 但是,但純以例如英語或德語寫出在明文用此法加密則很不安全。
'左弓右長張也,上立下早章也。電腦字符雖不以此類之,然可類比之,謂之曰高位及低位。
ReDim Unicode(Len(Plain.Text) - 1) '字幾何,則載幾何。
For i = 1 To UBound(Unicode)
Unicode(i) = CLng("&H" & Hex((AscW(Mid(Plain.Text, i + 1, 1))))) '逐字讀取其Unicode碼值,然後輸入陣列
Next i
ReDim CH(Len(Plain.Text) * 2 - 1) 'CH數列上限設定,因全字符緣故,字符數量兩倍減一
For i = 1 To UBound(Unicode)
On Error Resume Next
CH(i * 2) = Unicode(i) \ 256 '取高位,以偏旁理解之。
CH(i * 2 + 1) = Unicode(i) Mod 256 '取低位,以部首理解之。
Next i
End Sub
Sub PlainReconstruction()
'This procedure is used to reconstruct the original text.
'天道茫茫,似混沌兮有序哉。
u = EEEE.Text Mod PL1.Width '載入密鈅值,第二層起始點。
v = FFFF.Text Mod PL1.Height
Do
DoEvents 'Show one character by one character.
t = PL1.Point(u, v) '讀取色彩信息
Call RGBCalculate(t) 'From colours to codes.
If XXXXXXXXXXlue = True Then 'ASCII mode
l = (Aka - KaisarRot) Mod 256 'Inversbetrieb von Kaisar
h = (Aoi - KaisarBlau) Mod 256
Midori = (Midori - KaisarGrun) Mod 256
Plain.Text = Plain.Text & Chr(l) & Chr(h) '還原信息
t = Midori + u '次のポイントを確認せよ。
u = t Mod PL1.Width
v = t \ PL1.Width + v
End If
If XXXXXXXXXXlue = True Then 'Unicode mode
l = (Aka - KaisarRot) Mod 256 'Inversbetrieb von Kaisar, und Wiederherstellung Unicode-Werte.
h = ((Aoi - KaisarBlau) Mod 256) * 256
Midori = (Midori - KaisarGrun) Mod 256
Plain.Text = Plain.Text & ChrW(l + h) '還原信息
t = Midori + u '次のポイントを確認せよ。
u = t Mod PL1.Width
v = t \ PL1.Width + v
End If
If Midori = 0 Then GoTo terminate 'もしもつぎのポイントはぜロたら,すべてを終了しました。
Loop
terminate: DoEvents
End Sub
Sub CodeToColor()
'This section only works on ASCII mode.
If XXXXXXXXXXlue = True Then
ReDim R(Len(Plain.Text) \ 2 + Len(Plain.Text) \ 2 - 1) '一格容兩字,倘字成單,多一格也。
ReDim B(UBound(R)) '赤有幾何,藍亦幾何。
For i = 1 To UBound(CH)
If i Mod 2 = 0 Then R(i Mod 2) = CH(i) '字序單者,赤載之。
If i Mod 2 = 1 Then B(i Mod 2) = CH(i) '字序單者,藍載之。
Next i
If Len(Plain.Text) Mod 2 = 1 Then B(UBound(B)) = 0 '字數成單,藍之末者為零也。
ReDim Rot(UBound(R)) 'Wie viele Reds, dann, wie viele Rotweine.
ReDim Grun(UBound(R)) 'Wie viele Greens, dann, wie viele Grüntone.
ReDim Blau(UBound(R)) 'Wie viele Blues, dann, wie viele Blau.
End If
'This section only works on Unicode mode.
If XXXXXXXXXXlue = True Then
ReDim R(Len(Plain.Text) + Len(Plain.Text) \ 2 - 1) '一格容兩形,倘形成單,多一格也。或杞人憂天耳。
ReDim B(UBound(R)) '赤有幾何,藍亦幾何。
For i = 1 To UBound(CH)
If i Mod 2 = 0 Then R(i Mod 2) = CH(i) '形序單者,赤載之。
If i Mod 2 = 1 Then B(i Mod 2) = CH(i) '形序單者,藍載之。
Next i
If Len(Plain.Text) Mod 2 = 1 Then B(UBound(B)) = 0 '形數成單,藍之末者為零也。
ReDim Rot(UBound(R)) 'Wie viele Reds, dann, wie viele Rotweine.
ReDim Grun(UBound(R)) 'Wie viele Greens, dann, wie viele Grüntone.
ReDim Blau(UBound(R)) 'Wie viele Blues, dann, wie viele Blau.
End If
End Sub
Sub GearExchange()
'This procedure is used to change the order of RGB.
'嘗有德意志人造密碼機,曰恩尼格瑪,意為謎也。其中有轉子三,按其排序有六。是故此機關曰吉爾伊斯慶沮,轉子互換之意也。
ReDim Low(UBound(R)), Med(UBound(R)), High(UBound(R)) '裝載臨時轉換數組
For i = 0 To UBound(R) 'For further varieties exchanging, we need some template arrays.
Low(i) = Rot(i)
Med(i) = Grun(i)
High(i) = Blau(i)
Next i
If JJJJ.Text Mod 6 = 0 Then '默認無需轉換
For i = 0 To UBound(R)
Rot(i) = Low(i) '低位
Grun(i) = Med(i) '中位
Blau(i) = High(i) '高位
Next i
End If
If JJJJ.Text Mod 6 = 1 Then
For i = 0 To UBound(R)
Rot(i) = Low(i) '低位
Grun(i) = High(i) '高位
Blau(i) = Med(i) '中位
Next i
End If
If JJJJ.Text Mod 6 = 2 Then
For i = 0 To UBound(R)
Rot(i) = Med(i) '中位
Grun(i) = Low(i) '低位
Blau(i) = High(i) '高位
Next i
End If
If JJJJ.Text Mod 6 = 3 Then
For i = 0 To UBound(R)
Rot(i) = Med(i) '中位
Grun(i) = High(i) '高位
Blau(i) = Low(i) '低位
Next i
End If
If JJJJ.Text Mod 6 = 4 Then
For i = 0 To UBound(R)
Rot(i) = High(i) '高位
Grun(i) = Med(i) '中位
Blau(i) = Low(i) '低位
Next i
End If
If JJJJ.Text Mod 6 = 5 Then
For i = 0 To UBound(R)
Rot(i) = High(i) '高位
Grun(i) = Low(i) '低位
Blau(i) = Med(i) '中位
Next i
End If
End Sub
Sub ImageCut()
'This procedure cuts the first encryption from the total encryption.
Dim x 'XとYは座標の用です。
Dim y
For j = 0 To BBBB '取密鈅之起始點,割圖再解。AAAA及BBBB為原圖縱橫。
For i = 0 To AAAA
If (i * j + 1) Mod 10000 = 0 Then DoEvents '管中窺豹,可見一斑。休要假死。
x = (i + CCCC) Mod PL2.Width 'CCCC及DDDD為密鈅之起始點,與新縱橫之和以原縱橫模算之,則座標入我轂中矣。
y = (j + DDDD) Mod PL2.Height
XXXXXXet (i, j), PL2.Point(x, y) 'Copy the colour from the final encryption and print it out.
Next i
Next j
End Sub
Sub RGBCalculate(Colour)
'反轉子排列運算
If JJJJ.Text Mod 6 = 0 Then
Aka = Colour Mod 256 '低位
Midori = (Colour \ 256) Mod 256 '中位
Aoi = Colour \ 65536 '高位
End If
If JJJJ.Text Mod 6 = 1 Then
Aka = Colour Mod 256 '低位
Midori = Colour \ 65536 '高位
Aoi = (Colour \ 256) Mod 256 '中位
End If
If JJJJ.Text Mod 6 = 2 Then
Aka = (Colour \ 256) Mod 256 '中位
Midori = Colour Mod 256 '低位
Aoi = Colour \ 65536 '高位
End If
If JJJJ.Text Mod 6 = 3 Then
Aka = (Colour \ 256) Mod 256 '中位
Midori = Colour \ 65536 '高位
Aoi = Colour Mod 256 '低位
End If
If JJJJ.Text Mod 6 = 4 Then
Aka = Colour \ 65536 '高位
Midori = (Colour \ 256) Mod 256 '中位
Aoi = Colour Mod 256 '低位
End If
If JJJJ.Text Mod 6 = 5 Then
Aka = Colour \ 65536 '高位
Midori = Colour Mod 256 '低位
Aoi = (Colour \ 256) Mod 256 '中位
End If
End Sub
Sub NoiseGenerator()
'This procedure is used to generate looked-like random colours. It may be the true random array but needs to be proved.
XXXXXXckColor = vbWhite '人之初,性本善。
XXXXXXckColor = vbWhite
For j = 0 To PL1.Height '小圖縱橫皆以隨機色所填。
For i = 0 To PL1.Width
If (i * j + i) Mod 10000 = 0 Then DoEvents '定時回魂,休要逝去。
Randomize '機緣重置
XXXXXXet (i, j), CLng(Rnd * 2 ^ 24) '夫顔色之數,一千六百萬餘,抓鬮填之紙上。
Next i
Next j
For j = 0 To PL2.Height '大圖縱橫皆以隨機色所填。
For i = 0 To PL2.Width
If (i * j + i) Mod 10000 = 0 Then DoEvents '定時回魂,休要逝去。
Randomize '機緣重置
XXXXXXet (i, j), CLng(Rnd * 2 ^ 24) '夫顔色之數,一千六百萬餘,抓鬮填之紙上。
Next i
Next j
'搓麻將
For j = 0 To PL1.Height 'Refill in the small area.
For i = 0 To PL1.Width
If (i * j + i) Mod 10000 = 0 Then DoEvents '定時回魂,休要逝去。
XXXXXXet (i, j), PL2.Point(CLng(Rnd * PL2.Width), CLng(Rnd * PL2.Height)) '以大圖隨機點之色填於小圖。
Next i
Next j
For j = 0 To PL2.Height 'Refill in the big area.
For i = 0 To PL2.Width
If (i * j + i) Mod 10000 = 0 Then DoEvents '定時回魂,休要逝去。
XXXXXXet (i, j), PL1.Point(CLng(Rnd * PL1.Width), CLng(Rnd * PL1.Height)) '以小圖圖隨機點之色填於大圖。
Next i
Next j
'もしも何度を繰り返したら,いいな結果を作るかも。だが、白いになる。
End Sub
Sub RandomCheck()
'用以確定信標點
'書卷密碼,《連城訣》、《金甲蟲》。
RC.Width = PL1.Width 'The size of the checking paper is the same as the first layer of cipher.
RC.Height = PL1.Height
XXXXXckColor = vbWhite '紙之初,色本白。
ReDim ZahyouX(UBound(R)) '赤者幾何,座標亦幾何。
ReDim ZahyouY(UBound(R))
ReDim NP(UBound(R)) '信標點亦幾何
ZahyouX(0) = EEEE.Text Mod RC.Width '最初のポイントを確認する。
ZahyouY(0) = FFFF.Text Mod RC.Height
XXXXXet (ZahyouX(0), ZahyouY(0)), vbBlack 'eine Markierung anbringen
For i = 1 To UBound(ZahyouX) 'Generate the beacons of next point.
Re: Randomize
NP(i - 1) = Int(Rnd * 255) '隨機信標點取值。
ZahyouX(i) = (ZahyouX(i - 1) + NP(i - 1)) Mod RC.Width '橫向超越邊界,返回。
ZahyouY(i) = (ZahyouY(i - 1) + (ZahyouX(i - 1) + NP(i - 1)) \ RC.Width) Mod RC.Height '縱向進位確定。
If RC.Point(ZahyouX(i), ZahyouY(i)) <> 0 Then '若該點名花有主,則重選之。
GoTo Re
Else '不然的话
XXXXXet (ZahyouX(i), ZahyouY(i)), vbBlack 'eine Markierung anbringen
End If
Next i
NP(UBound(NP)) = 0 '最期のポイント、終了の意味だ。
End Sub
Sub RussianDoll()
'This procedure is used to move the first encrypted message into a bigger layer to be contained.
'羅刹人有人偶,擧其蓋者,内亦人偶,與外無異。層層相曡,人異之。老夫之作,取其層層曡曡之意境。
For j = 0 To PL1.Heigh
For i = 0 To PL1.Widt
If (i * j + i) Mod 10000 = 0 Then DoEvents '莫要假死
XXXXXXet ((i + CCCC.Text) Mod PL2.Width, (j + DDDD) Mod PL2.Height), PL1.Point(i, j) '下の暗号を上に置いて、カモフラージュとトラップのため。
Next i
Next j
End Sub
Sub Amountcheck()
'This procedure prevents the error to occur due to random points beacon's over-density.
Do While Len(Plain.Text) <> 0 '如空信息,則全部跳過。
If PL1.Width * PL1.Height / Len(Plain.Text) <= 128 Then
PL1.Width = Int(PL1.Width * 1.3) '如信息量過度密集,則將容納圖形長與寬各增加30%
PL1.Height = Int(PL1.Height * 1.3)
AAAA.Text = PL1.Width '重定密鈅
BBBB.Text = PL1.Height
End If
If PL1.Width * PL1.Height / Len(Plain.Text) > 128 Then '如無意外,則設定大小
Call SizeSetting_Click
Exit Do
End If
Loop
End Sub
Sub SizeCheck()
'If the first encrypted layer is larger than its container, then exchange their sizes.
Dim a '裝載臨時變量,用來交換數據
If PL2.Width < PL1.Width Then '大圖寬不小於小圖寬,否則互相交換寬度。
a = PL1.Width
PL1.Width = PL2.Width
PL2.Width = a
AAAA = PL1.Width
OutputWidth = PL2.Width
End If
If PL2.Height < PL1.Height Then '大圖高不小於小圖高,否則互相交換高度。
a = PL1.Height
PL1.Height = PL2.Height
PL2.Height = a
BBBB = PL1.Height
OutputHeight = PL2.Height
End If
RC.Width = PL1.Width '重新設置檢查變量
RC.Height = PL2.Height
End Sub
Sub Caesarize()
'實質信息凱撒雙表變換,加上信標三表變換。
For i = 0 To UBound(Rot)
Rot(i) = (R(i) + KaisarRot) Mod 256
Grun(i) = (NP(i) + KaisarGrun) Mod 256
Blau(i) = (B(i) + KaisarBlau) Mod 256
Next i
End Sub
Sub PL1_Drawing()
'This procedure generates the first layer of encryption.
For i = 0 To UBound(Rot) '一つも残らず注入せよ。
XXXXXXet (ZahyouX(i), ZahyouY(i)), RGB(Rot(i), Grun(i), Blau(i)) '座標のポイントに、暗号を注入する。
'MsgBox Rot(i)
Next i
End Sub
Sub Locking()
'All green, proceed without any jams.
Plain.Locked = Not Plain.Locked
AAAA.Locked = Not AAAA.Locked
BBBB.Locked = Not BBBB.Locked
CCCC.Locked = Not CCCC.Locked
DDDD.Locked = Not DDDD.Locked
EEEE.Locked = Not EEEE.Locked
FFFF.Locked = Not FFFF.Locked
GGG.Locked = Not GGG.Locked
HHH.Locked = Not HHH.Locked
III.Locked = Not III.Locked
JJJJ.Locked = Not JJJJ.Locked
TextHead.Locked = Not TextHead.Locked
TextTail.Locked = Not TextTail.Locked
OutputWidth.Locked = Not OutputWidth.Locked
OutputHeight.Locked = Not OutputHeight.Locked
ClearText.Enabled = Not ClearText.Enabled
Encrypt.Enabled = Not Encrypt.Enabled
Decrypt.Enabled = Not Decrypt.Enabled
SavePlain.Enabled = Not SavePlain.Enabled
SaveCipher.Enabled = Not SaveCipher.Enabled
LoadPlain.Enabled = Not LoadPlain.Enabled
LoadCipher.Enabled = Not LoadCipher.Enabled
SizeSetting.Enabled = Not SizeSetting.Enabled
PA.Enabled = Not PA.Enabled
Parameters_Switch.Enabled = Not Parameters_Switch.Enabled
Option1.Enabled = Not Option1.Enabled
Option2.Enabled = Not Option2.Enabled
End Sub
Private Sub OutputHeight_Change()
On Error GoTo reset
Exit Sub
reset: OutputWidth.Text = 240
End Sub
Private Sub OutputWidth_Change()
On Error GoTo reset
Exit Sub
reset: OutputWidth.Text = 320
End Sub
Private Sub PA_Click()
'藏首畏尾,一葉障目。
tem.Text = ""
If TextHead.Text = 0 Then GoTo skip '無需填料,則跳過。
For i = 1 To TextHead.Text * 2 '掛羊頭
Randomize
tem.Text = Pattern(Int(Rnd * UBound(Pattern))) & tem.Text
Plain.Text = tem.Text & Plain.Text
Next i
skip: tem.Text = ""
If TextTail.Text = 0 Then GoTo terminate '賣狗肉
For i = 1 To TextTail.Text * 2
Randomize
tem.Text = Pattern(Int(Rnd * UBound(Pattern))) & tem.Text
Plain.Text = Plain.Text & tem.Text
Next i
terminate: tem.Text = ""
End Sub
Private Sub Parameters_Switch_Click()
'This procedure is used to show or hide the parameters of key.
If XXXXXXXsible = True Then
XXXXXXXsible = False
XXXXXXXsible = False
XXXXXXXsible = False
XXXXXXXsible = False
XXXXXXXsible = False
XXXXXXXsible = False
XXXXXXsible = False
XXXXXXsible = False
XXXXXXsible = False
XXXXXXXsible = False
Parameters_XXXXXXXXXption = "Show Parameters(&H)"
Else
XXXXXXXsible = True
XXXXXXXsible = True
XXXXXXXsible = True
XXXXXXXsible = True
XXXXXXXsible = True
XXXXXXXsible = True
XXXXXXsible = True
XXXXXXsible = True
XXXXXXsible = True
XXXXXXXsible = True
Parameters_XXXXXXXXXption = "Hide Parameters(&H)"
End If
End Sub
Private Sub SaveCipher_Click()
'This procedure is used to save the cipher.
On Error GoTo terminate
XXXXXXXXXXXXXXXXlter = "Bitmap file(*.bmp)|*.bmp"
XXXXXXXXXXXXXXXXowSave
SavePicture XXXXXXage, XXXXXXXXXXXXXXXXleName
terminate: Exit Sub
End Sub
Private Sub SavePlain_Click()
'This procedure is used to save the origin text.
On Error GoTo terminate
XXXXXXXXXXXXXXXXlter = "Text files(*.txt)|*.txt|HTML files(*.htm)|*.htm"
XXXXXXXXXXXXXXXXowSave
Open XXXXXXXXXXXXXXXXleName For Output As #1
Print
#1, Plain.Text
Close
#1
terminate: Exit Sub
End Sub
Private Sub SizeSetting_Click()
'This procedure is used to adjust the sizes of layers contain the encryption.
PL1.Width = AAAA.Text
PL1.Height = BBBB.Text
PL2.Width = OutputWidth.Text
PL2.Height = OutputHeight.Text
RC.Width = PL1.Width
RC.Height = PL1.Height
Call SizeCheck '檢查載體大小
End Sub
Sub ClearImage()
'前塵往事皆涅磐,諸色衆相都成白。
XXXXXXckColor = vbWhite
XXXXXXckColor = vbWhite
XXXXXckColor = vbWhite
End Sub
Sub Parameters_Load()
'This procedure is used to load the Caesar Change.
KaisarRot = GGG.Text
KaisarGrun = HHH.Text
KaisarBlau = III.Text
End Sub
Sub MemoryClean()
'This procedure is used to clean all varieties in the memory.
ReDim CH(0), R(0), G(0), B(0), Rot(0), Grun(0), Blau(0), NP(0), Low(0), Med(0), High(0), Unicode(0)
ReDim ZahyouX(0), ZahyouY(0)
KaisarRot = 0
KaisarGrun = 0
KaisarBlau = 0
Aka = 0
Midori = 0
Aoi = 0
i = 0
j = 0
t = 0
l = 0
h = 0
u = 0
v = 0
PL1W = 0
PL1H = 0
PL2W = 0
PL2H = 0
End Sub
Private Sub TextHead_Change()
On Error GoTo terminate '若非數,則重設。
TextHead.Text = TextHead.Text \ 1
Exit Sub
terminate: TextHead.Text = 0
End Sub
Private Sub TextTail_Change()
On Error GoTo terminate '若非數,則重設。
TextTail.Text = TextTail.Text \ 1
Exit Sub
terminate: TextTail.Text = 0
End Sub
Sub PatternLoad()
ReDim Pattern(135) 'Verwendet als Tarnung
For i = 32 To 126
Pattern(i - 32) = Chr(i)
Next i
For i = 128 To 168
Pattern(i - 33) = Chr(i)
Next i
End Sub
200字以内,仅用于支线交流,主线讨论请采用回复功能。