半开源,关于另类加密算法,各种编程帝秒进拍砖。
kalimov2014/08/14软件综合 IP:广东
本帖最后由 kalimov 于 2014-8-14 22:22 编辑

QQ截图20140814221602.png

原帖地址:https://www.kechuang.org/t/66589首先应novakon的要求,在这里将贴出程序VB源代码。但是,曾听过不止一个DIY圈内的人说KC有山寨现象(即抄袭后拿去商业化、或者若干种嘚瑟用途),在帖子内的源代码我故意设置了不少bug,有数值的,也有逻辑的,有說出來的,也有沒說的。相信如果是编程高手,这方面的“武德”不会太差,毕竟写出来这东西不知道能用于什么用途,可大也可小,虽然它仅仅是个对称算法。如果有人能消化我的注解,就算不用看源代码自己也能写出一个99%类似的。不看注解的,就慢慢啃“生肉”吧。(我的是红烧芥末德国肉肠,在香肠机上转的那种,很快大家会知道为什么了。)
初步验证一下我的工具它的有效性,这里附上一个小题目。到上面地址中下载那个工具,如果缺少控件请看该贴二楼,然后运行主程序minen.exe

attachment icon 1.rar 200.32KB RAR 14次下载

题目密钥:223 152 145 56 220 100 45 88 179 2,看看是不是Hello, world!(这里有个程序bug,在后面无法输入220的时候,请先按一下size setting,因为尺寸大小导致了取模运算直接进行。 QQ截图20140814214859.png
如果验证完了,可以尝试自己加解密一些纯文字信息。注意ASCII和Unicode开关,中文只能用Unicode模式。 QQ截图20140814214833.png

好了,废话少说,贴上源代码。

‘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




+20  科创币    20!Dopaminor    2014/08/14 感谢分享
来自:计算机科学 / 软件综合
10
已屏蔽 原因:{{ notice.reason }}已屏蔽
{{notice.noticeContent}}
~~空空如也
张静茹
9年10个月前 IP:未同步
712788
如果 是C语言的话,我考虑仔细看看代码
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
myfantasy
9年10个月前 IP:未同步
712812
如果是汇编我会认真看代码
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
.........
9年10个月前 IP:未同步
712830
如果先说说是用的什么算法的话,我考虑仔细看看代码
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
kalimov作者
9年10个月前 IP:未同步
712831
......... 发表于 2014-8-15 00:18
如果先说说是用的什么算法的话,我考虑仔细看看代码


简单的凯撒算法和坐标移位算法组合。
英文的加密:
1.首先转换明文的ASCII码。
2.生成随机色彩图片框PL1和PL2,且PL2尺寸不小于PL1。
2.按明文字符个数/2,取在PL1内随机信标值。(由随机坐标计算)
3.将(明文1,信标,明文2)【视参数而定,默认参数顺序是这个】各自256之内凯撒移位,得到新的值,作为RGB值写入随机信标指定的坐标。
4.将PL1挪入PL2,坐标为密钥里所指定,如有超出图像部分用模算解决,即纵横两个方向循环。密文完成。
5.如有改进版,则将PL2移入PL3,新PL3移入PL4,一层套一层。

中文或其他字符:
不同之处就是每个有效信息像素只装载一个字符,默认参数为(低位,信标,高位)。其他步骤和英文步骤一样。
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
风枫
9年10个月前 IP:未同步
712836
张静茹 发表于 2014-8-14 22:29
如果 是C语言的话,我考虑仔细看看代码


赞同....毕竟现在用C的多...主要是我只会C.....
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
布布卡
9年10个月前 IP:未同步
712965
vb只在小学搞过 。。lz水平太高 基本看不懂 只是问一下为何注释有日文和繁体中文
嗯 大师的观点就是我的观点[s:9]
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
kalimov作者
9年10个月前 IP:未同步
713013
布布卡 发表于 2014-8-15 14:29
vb只在小学搞过 。。lz水平太高 基本看不懂 只是问一下为何注释有日文和繁体中文
嗯 大师的观点就是我的观 ...


我先寫註釋,然後再填充代碼,當時想到啥就寫啥,完全靠心情寫的。有些地方要靠歷史文學典故才能理解。
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
4869Aether
9年10个月前 IP:未同步
713036
费了好大劲。看个大概。感觉这个好巧妙[s:222]但其实我有也没看过几种加密,此乃原创?
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论
kalimov作者
9年10个月前 IP:未同步
713073
4869Aether 发表于 2014-8-15 18:23
费了好大劲。看个大概。感觉这个好巧妙但其实我有也没看过几种加密,此乃原创?


原創,找遍文獻找不到相同的,也許沒人想用這種笨辦法加密--用海量雜訊淹沒真正信息。
引用
评论
加载评论中,请稍候...
200字以内,仅用于支线交流,主线讨论请采用回复功能。
折叠评论

想参与大家的讨论?现在就 登录 或者 注册

所属专业
上级专业
同级专业
kalimov
进士 机友 笔友
文章
82
回复
887
学术分
0
2007/09/16注册,1年5个月前活动
暂无简介
主体类型:个人
所属领域:无
认证方式:手机号
IP归属地:未同步
文件下载
加载中...
{{errorInfo}}
{{downloadWarning}}
你在 {{downloadTime}} 下载过当前文件。
文件名称:{{resource.defaultFile.name}}
下载次数:{{resource.hits}}
上传用户:{{uploader.username}}
所需积分:{{costScores}},{{holdScores}}下载当前附件免费{{description}}
积分不足,去充值
文件已丢失

当前账号的附件下载数量限制如下:
时段 个数
{{f.startingTime}}点 - {{f.endTime}}点 {{f.fileCount}}
视频暂不能访问,请登录试试
仅供内部学术交流或培训使用,请先保存到本地。本内容不代表科创观点,未经原作者同意,请勿转载。
音频暂不能访问,请登录试试
支持的图片格式:jpg, jpeg, png
插入公式
评论控制
加载中...
文号:{{pid}}
投诉或举报
加载中...
{{tip}}
请选择违规类型:
{{reason.type}}

空空如也

加载中...
详情
详情
推送到专栏从专栏移除
设为匿名取消匿名
查看作者
回复
只看作者
加入收藏取消收藏
收藏
取消收藏
折叠回复
置顶取消置顶
评学术分
鼓励
设为精选取消精选
管理提醒
编辑
通过审核
评论控制
退修或删除
历史版本
违规记录
投诉或举报
加入黑名单移除黑名单
查看IP
{{format('YYYY/MM/DD HH:mm:ss', toc)}}