vb加密程序

‘壹’ VB中如何编写一个加密程序

编写一个加密软件，要求将源文件按字节逐位倒排序加密法加密。

字节逐位倒排序加密法是以比特为单位的换位加密方法，用vb实现的具体算法是：

(1) 以二进制模式打开源文件；

(2) 从源文件第i位读取一个字节，假设为字母“a”，得到“a”的ascii值为65；

(3) 将65转换成八位二进制串为“01000001”；

(4) 将“01000001”按字节逐位倒排序得另一个八位二进制串“10000010”；

(5) 将“10000010”转换成十进制再写回源文件第i位置，完成一个字节的加密；

(6) 重复(2)、(3)、(4)和(5)，直到所有字节加密结束。

为了使程序模块化，我们用函数过程bytetobin完成将字节型数据转换成二进制串（其实质就是将十进制数转换成八位二进制串）；用函数过程bintobyte将二进制串转换成字节型数据（实质是将八位二进制串转换成十进制数）：用函数过程reverse将八位二进制串逐位倒排序。具体程序如下：

function bytetobin(m as byte) as string ' 将字节型数据转换成八位二进制字符串
dim c$
c$ = ""
do while m <> 0
r = m mod 2
m = m \ 2
c$ = r & c$
loop
c$ = right("00000000" & c$, 8)
bytetobin = c$
end function
function reverse(m as string) as string ' 将八位二进制字符串颠倒顺序
dim i%, x$
x = ""
for i = 1 to 8
x = mid(m, i, 1) & x
next i
reverse = x
end function
function bintobyte(m as string) as byte ' 将八位二进制串转换成十进制
dim x as string * 1, y%, z%
z = 0
for i = 1 to 8
x = mid(m, i, 1)
y = x * 2 ^ (8 - i)
z = z + y
next i
bintobyte = z
end function
private sub command1_click()
dim x as byte, i%, fname$
fname = inputbox("请输入要加密的文件名！注意加上路径名：")
if dir(fname) = "" then
msgbox "文件不存在！"
exit sub
end if
open fname for binary as #1 ' 以二进制访问模式打开待加密文件
for i = 1 to lof(1) ' lof函数是求文件长度的内部函数
get #1, i, x ' 取出第i个字节
x = bintobyte(reverse(bytetobin(x))) ' 这里调用了三个自定义函数
put #1, i, x ' 将加密后的这个字节写回到文件原位置
next i
close
msgbox "任务完成！"
end sub

‘贰’ 用VB做一个加密程序。

你这个不是已经有了加密的算法吗？做加法接可以了？
加密前0 1 2 3 4 5 6 7 8 9 a b c d e f
相加值1 2 1 6 4 0 8 7 4 3 1 2 1 6 4 0
加密后1 3 3 9 8 5 d d b b b d d 4 3 f
就是：
加密前0、2、a、c，就加上1
加密前1、b，就加上2
加密前9，就加上3
加密前4、8、e，就加上4
加密前3、d，就加上6
加密前7，就加上7
加密前6，就加上8
加密前5、f，就加上0

‘叁’ 怎样给VB程序加密

读别人的源代码本来就不太容易。你既然要开源给对方，又不想让让人家更不容易读懂，建议这样做：
用批量替换的方法，把变量、常量、自定义函数、子程序、数组、控件的名称全部改成无意义的
比如，你可能会用
pananniannin
来表示判断年龄子程序，用
age来表示年龄变量，现在统一把
pananninanin来替换成
fmcc,把age
替换成
xyz.
自己则记下这个工程各名称的含义，我想，让他一方面要主动性懂程序，一方面还要推测你某个具体变更的含义，进而进一步了解程序的含义，就够让对方抓狂一阵子了

‘肆’ 如何对自己的VB程序加密

这样的话你就放心吧，别人不会得到你的源代码的。得到的是汇编语言。这样哪怕你再会加密也不可能连汇编码都不生成。所以说不用加密的。
而你如果真的用vb来编写卖钱的软件么，可以用注册码加密的方法。这样的话就看你的加密算法怎么样了。一般用md5就可以了

‘伍’ VB 加密与解密的程序代码

加密：

PrivateFunction JiaMi(ByVal varPass As String) As String '参数varPass是需要加密的文本内容

Dim varJiaMi As String * 20

Dim varTmp As Double

Dim strJiaMi As String

Dim I

For I = 1 To Len(varPass)

varTmp = AscW(Mid$(varPass, I, 1))

varJiaMi = Str$(((((varTmp * 1.5) / 5.6) * 2.7) * I))

strJiaMi = strJiaMi & varJiaMi

NextI

JiaMi = strJiaMi

EndFunction

解密函数：

PrivateFunction JieMi(ByVal varPass As String) As String '参数varPass是需要解密的密文内容

Dim varReturn As String * 20

Dim varConvert As Double

Dim varFinalPass As String

Dim varKey As Integer

Dim varPasslenth As Long

varPasslenth = Len(varPass)

For I = 1 To varPasslenth / 20

varReturn = Mid(varPass, (I - 1) * 20 + 1, 20)

varConvert = Val(Trim(varReturn))

varConvert = ((((varConvert / 1.5) * 5.6) / 2.7) / I)

varFinalPass = varFinalPass & ChrW(Val(varConvert))

NextI

JieMi = varFinalPass

EndFunction

(5)vb加密程序扩展阅读：

注意事项

编写加密程序，将用户输入的一个英文句子加密为加密字符串，然后输出加密字符串。假设句子长度不超过100个字符。

根据给定的句子加密函数原型SentenceEncoding，编写函数SentenceEncoding调用给定的字符加密函数CharEncoding完成句子加密。

然后，编写主程序提示用户输入英文句子，然后调用函数SentenceEncoding对句子加密，最后输出加密后的句子。

字符加密规则为大写字母和小写字母均加密为其补码, 我们定义ASCII码值相加为’A’+’Z’即155的两个大写字母互为补码，ASCII码值相加为’a’+’z’即219的两个小写字母互为补码。

空格用@代替,句号以#代替,其它字符用句点代替。

函数原型：

void SentenceEncoding(char *soure,char *code);

功能：对待加密字符串source加密后保存加密字符串到code.

参数：char *soure，指向待加密句子的字符串指针；

char *code 指向加密字符串的字符串指针；

字符加密函数代码。

‘陆’ 利用VB设计一个加密程序

简单判断吧

a = "ABCD"'要加密的大写字母

For i = 1 To 4'循环

b = Asc(Mid(a, i, 1)) + 4'分离字符串为单个

If b > 90 Then b = b - 26'如果大于90

Print Chr(b);'输出加密后字母

Next'循环结束

‘柒’ 怎样用vb程序给程序加密！！！

dim a as string
sub form_load
a=""'在""中输入正确密码
if not(inputbox("请输入密码")=a) then end
'……
'我也无法理解此代码，抄书的。
end sub

‘捌’ 用VB实现加密解密程序。

这里只给出按钮事件的过程，加密算法（函数）你自己想办法：
设加密算法函数名为encryptxt，解密算法函数名为unencryptxt，不带参数。
加密窗口“生成密文”按钮事件：
Private sub 生成密文_Click()
Frame1.Caption = encryptxt (Text1.text)
End Sub

解密窗口“解密”按钮事件：
Private Sub 解密_Click()
Frame2.Caption = unencryptxt(Rrame1.Caption)
End Sub

‘玖’ 用VB写个简单加密/解密程序

'图上的控件,你就照着摆上去,然后再把以下代码拷进去,就OK了
Dim lg As Integer
'加密
Private Sub Command1_Click()
Text2 = ""
Dim a(), b() As String
lg = Len(Text1)
ReDim a(lg), b(lg)
For i = 1 To lg
a(i) = Mid(Text1, i, 1)
b(i) = AscW(a(i)) Xor 4
Text2 = Text2 & ChrW(b(i))
Next
End Sub
'解密
Private Sub Command2_Click()
Text3 = ""
Dim a(), b() As String
lg = Len(Text2)
ReDim a(lg), b(lg)
For i = 1 To lg
a(i) = Mid(Text2, i, 1)
b(i) = AscW(a(i)) Xor 4
Text3 = Text3 & ChrW(b(i))
Next
End Sub