sa22
|
分享:
▼
x0
|
[Basic][精華] 請問密碼解密的程式該怎寫?(加密已寫出來)
Dim myFile, myID, myPw, addpw(), cc As String, adPw addpw = Array("*", "(", ")", "_", "+", "c", "d", "e", &q .. 訪客只能看到部份內容,免費 加入會員 或由臉書 Google 可以看到全部內容
[ 此文章被codeboy在2005-06-05 13:06重新編輯 ]
|
|
x1
[樓 主]
From:台灣 | Posted:2005-01-24 22:17 |
|
|
panasonic732
|
分享:
▲
▼
晚點在幫你一個完整的答覆 不過阿基礎的編密 應該是把 基本碼(如ASC)+偏移量 在經由Mid拆解數字去取 Array陣列質 不過偏移量還是得紀錄在解密的程式理以供解密 或是包含在加密後的文字碼裡 我有練習過編碼加密 附件便是嚕 參考看看^^" 輸入 books 輸出 **hbieieiaii#f*** 複製程式
Sub main()
Dim Data1 As String, N1 As String, X1 As String, N2 As String
Dim I As Long, S As Long, D As Long
Open App.Path & "\Input.txt" For Input As #1 '開輸入文字檔
Open App.Path & "\Output.txt" For Output As #2 '開輸出文字檔
Input #1, Data1 '讀輸入文字檔到 Data1變數中
Data1 = UCase(Data1) '將變數中的英文強制轉換為大寫
R = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j") '編碼的陣列 如R(0)=a
I = 1
Do
N1 = Data1: X1 = X1 & Mid(Data1, I, 1)
If N1 = X1 Then: S = I: Exit Do
I = I + 1
Loop Until S < 0 '這個回圈用Len代替即可...目的在測出字串的字數
D = S '將字串長度丟給D
For I = 1 To S '此回圈在做排除空白鍵的動作 空白鍵ASCII 為32
If Asc(Mid(Data1, I, 1)) = 32 Then
D = D - 1
End If
Next I
For I = 1 To S '開始在做加密的動作
If Asc(Mid(Data1, I, 1)) = 32 Then '判斷是否為空白鍵 是的話則輸入空白鍵
N2 = N2 & " "
Else
N2 = N2 & Asc(Mid(Data1, I, 1)) + D Mod 10
'擷取字串轉換ASCII+偏移量(字串長度mod10)
End If
Next I
N1 = "": X1 = "": I = 1: Data = "**" '該題編碼規則開頭為兩個**
Do
N1 = N2: X1 = X1 & Mid(N2, I, 1) '這個部分用VB的F8單部執行就懂了
If Asc(Mid(N2, I, 1)) = 32 Then '如字串中的空白鍵輸出為*
Data = Data & "*"
Else
Data = Data & R(Val(Mid(N2, I, 1))) '轉化R陣列的值
End If
If N1 = X1 Then: Exit Do '長度相同跳出回圈
I = I + 1
Loop Until S < 0
I = 1: X1 = "": N2 = ""
Do
N1 = D: X1 = X1 & Mid(D, I, 1) '這個部分用VB的F8單部執行就懂了
N2 = N2 & R(Mid(D, I, 1)) '將偏移量轉化為R陣列的值
If N1 = X1 Then: S = I: Exit Do '長度相同跳出回圈
I = I + 1
Loop Until S < 0
Data = Data & "#" & N2 & "***" '編碼的資料尾端加上#偏移量###
Print #2, Data
Close #1
Close #2
End Sub
程式碼有點略長,因為小弟在撰寫程式,有個壞習慣 常常忘了有代替的函數可以用... 所以常常把程式寫的又臭又長...
[ 此文章被panasonic732在2005-01-28 09:23重新編輯 ]
此文章被評分,最近評分記錄財富:10 (by codeboy) | 理由: 好範例~^^ | |
|
|
|
憂慮不斷,心未寧靜
綿綿春雨,花失嬌艷
凋零磨滅,事情難回
得意失意,不再回想
放棄它吧,唯有如此
|
x0
[3 樓]
From:台灣中華電信
| Posted:2005-01-25 01:13 |
|
|
sa22
|
分享:
▲
▼
在看到你回覆的同時,我也寫到一半有個問題 QQ" 我將MOD去掉,取而代之的是用一個myInput來求出該字串所代表的數字再用addPW加密 複製程式
Private Sub CommandButton1_Click()
Dim myFile, myID, myPw, addPw(), cc As Integer, adPw, secPw(), myInputLen, N1, N2, N3, N4, myinput(), mySec
addPw = Array("0*", "1(", "1)", "1_", "1+", "1c", "1d", "1e", "1f", "1|", "1_", "1=", "1\", "1<", "1>", "1/", "1J", "1P", "1Q", "1R", "1W", "1X", "1Y", "1Z", "1S", "1T", "1U", "1V", "1a", "1b", "1h", "1i", "1j", "1k", "1l", "1~", "1!", "1@", "1#", "1$", "1%", "1^", "0*", "0(", "0)", "0_", "0+", "0c", "0d", "0e", "0f", "0|", "0_", "0=", "0\", "0<", "0>", "0/", "0J", "0P", "0Q", "0R", "0W", "0X", "0Y", "0Z", "0S", "0T", "0U", "0V", "0a", "0b", "0h", "0i", "0j", "0k", "0l", "0~", "0!", "0@", "0#", "0$", "0%", "0^")
myinput = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
'求陣列變數的數量
mySec = Second(Now())
a = UBound(myinput())
b = UBound(addPw())
N1 = Range("a1").Value
myInputLen = Len(N1)
For i = 1 To myInputLen
N2 = Mid(N1, i, 1): j = 0
Do Until j = b
If N2 = myinput(j) Then N3 = N3 & Format(j, "00"): N4 = N4 & addPw((j + Right(mySec, 1))): Exit Do Else j = j + 1
Loop
Range("a2").Value = N3
Next
Range("a2").Value = N3
Range("a3").Value = N4 & addPw(Right(mySec, 1))
End Sub
Private Sub CommandButton2_Click()
Dim myFile, myID, myPw, addPw(), cc As Integer, adPw, secPw(), myInputLen, N1, N2, N3, N4, myinput(), mySec
addPw = Array("0*", "1(", "1)", "1_", "1+", "1c", "1d", "1e", "1f", "1|", "1_", "1=", "1\", "1<", "1>", "1/", "1J", "1P", "1Q", "1R", "1W", "1X", "1Y", "1Z", "1S", "1T", "1U", "1V", "1a", "1b", "1h", "1i", "1j", "1k", "1l", "1~", "1!", "1@", "1#", "1$", "1%", "1^", "0*", "0(", "0)", "0_", "0+", "0c", "0d", "0e", "0f", "0|", "0_", "0=", "0\", "0<", "0>", "0/", "0J", "0P", "0Q", "0R", "0W", "0X", "0Y", "0Z", "0S", "0T", "0U", "0V", "0a", "0b", "0h", "0i", "0j", "0k", "0l", "0~", "0!", "0@", "0#", "0$", "0%", "0^")
myinput = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
'求陣列變數的數量
mySec = Second(Now())
a = UBound(myinput())
b = UBound(addPw())
'解密
N1 = Range("a3").Value
myInputLen = Len(N1) - 2
Debug.Print "myinputlen:" & myInputLen
mySec = Right(N1, 2): Debug.Print mySec: j = 0
Do Until mySec < b
If mySec = addPw(j) Then mySec = j: Exit Do Else j = j + 1
Loop
Debug.Print mySec
For i = 1 To myInputLen Step 2
N2 = Mid(N1, i, 2): j = 0
Do Until j = b
If N2 = addPw(j) Then j = j - mySec + 1: N3 = N3 & j: Exit Do Else j = j + 1
Loop
Next
Range("a4").Value = N3
End Sub
a1 是 加密前的文字 a2 是 該字串所代表的數字 a3 加密後的字串 a4 是 解密後的文字 還沒寫好a4解不出正確的a1 ,但要下班了 趁上班時間偷打的,先放上來,回家再研究
本帖包含附件 |
|
Book2.rar
(2022-06-09 14:01 / 15 KB) |
下載次數: | 9 |
|
|
x0
[4 樓]
From:台灣政府網際
| Posted:2005-01-28 18:41 |
|
|
panasonic732
|
分享:
▲
http://bbs.mychat.to/read.php?tid=117558我寫好一個新的編密嚕 大概是這樣 裡面有三種的編密 S1 S2 S3 S4是來亂的 s1 s2 s3是隨著時間改變編碼 有空我在去想...中文的部分要怎麼解決...OK之後 在嘗試量多是否能正確執行 DSL的編碼 滿複雜的 是我們來說... 了解其中的編碼後來解救會很快了 例如 jjen2baeO0bafO0aaen1cbn1bafS0bbfk0dcq0ifM2dcs0aabk1babT0aajk1 aafK1ajdO1jgdm2jjdS2cbt1bafT0aaeL1cbt1jiM0cbk1bbcn0babn0bbaK0 bbhs0ajdo1bafl0bbfM0baK2jgdS2aaeq1cbT1jiK0cbO1aabL1jgjT2bbaM0 aafO1baeK0bafL0jjdO2cbQ1jgdQ2bbfQ0baT2ifT2dcM0aabt1jgjT2bbao0 解出來的都是 this is a pen 仔細看我的編碼規則就出現嚕...呵呵... 一起努力吧 ^^
|
憂慮不斷,心未寧靜
綿綿春雨,花失嬌艷
凋零磨滅,事情難回
得意失意,不再回想
放棄它吧,唯有如此
|
x0
[5 樓]
From:台灣中華電信
| Posted:2005-01-29 01:32 |
|
|
|