Question

请帮我写一个VBS程序

请帮我写一个VBS程序可以加密\解密图片文件(包括:*.jpg,*.bmp,*.gif......)
请给出源代码.
在这里先谢了!
Happy "牛" Year!
我会追加100分.把它发到laoyusheng@163.com,把文件的原码加密.

Answer 1

喂，抱怨下，分太少啊~~
还有，你想怎么加密啊？
########
哥们，等高手吧

Answer 2

可以啊...转成vbs文件,然后自己设置密码..支持jpg,bmp,gif,exe,rar等...有什么问题的话请发消息给我...(程序已经通过测试!)

key=inputbox("请设置该文件的打开密码:","系统提示","0")
key=ChgStr(key,2)
filename=wscript.arguments(0)
set fso=createobject("scripting.filesystemobject")
set ws=createobject("wscript.shell")
ext=fso.getExtensionName(filename)

with createobject("adodb.stream")
.type=1:.open:.loadfromfile filename:str=.read:sl=lenb(str)
end with
with createobject("scripting.filesystemobject").opentextfile(replace(filename,ext,"vbs"),2,true)
.write "data="""
for i=1 to sl
bt=ascb(midb(str,i,1))
if bt<16 then .write "0"
.write hex(bt)
next
.write""""
.writeline empty
.writeline"thisfilecode="&""""&""&key&""&""""&""
.writeline"thiscode=ChgStr(thisfilecode,1)"
.writeline"key=inputbox("&""""&"请输入您的密码:"&""""&")"
.writeline"if key<>thiscode then"
.writeline"msgbox"&""""&"密码错误!"&""""&",4096+64,"&""""&"系统提示"&""""&""
.writeline"wscript.quit"
.writeline"end if"
.writeline"Function ChgStr(str,flag)"
.writeline"s1="&""""&"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"&""""&""
.writeline"s2="&""""&"SGk7B4arX8UFecwJ9O6y2ihWMNKDp1ZE0gsmlTAQ5HYLjVIzqfuobvCxtPR3nd"&""""&""
.writeline"If Not flag=1 Then t=s1:s1=s2:s2=t"
.writeline"For i=1 To Len(str)"
.writeline"before=Mid(str,i,1)"
.writeline"For j=1 To 62 "
.writeline"after=Replace(before,Mid(s1,j,1),Mid(s2,j,1))"
.writeline"If Not before=after Then ChgStr=ChgStr&after:Exit For"
.writeline"Next"
.writeline"Next"
.writeline"End Function "
.writeline"Function ExtractFile(FileName)"
.writeline"With CreateObject("&""""&"ADODB.Stream"&""""&")"
.writeline".Type = 1"
.writeline".Open"
.writeline".Write StrToByte(data)"
.writeline".SaveToFile FileName, 2"
.writeline".Close:End With"
.writeline"End Function "
.writeline"ExtractFile "&""""&"c:\windows\preview."&ext&""&""""&""
.writeline"set fso=CreateObject("&""""&"Scripting.filesystemobject"&""""&")"
.writeline"return=CreateObject("&""""&"WScript.Shell"&""""&").Run("&""""&"c:\windows\preview."&ext&""&""""&",,true)"
.writeline"if return<>2 then:fso.deletefile"&""""&"c:\windows\preview."&ext&""&""""&":end if"
.writeline"Function StrToByte(str)"
.writeline"Set xmldoc = CreateObject("&""""&"Microsoft.XMLDOM"&""""&")"
.writeline"xmldoc.loadXML "&""""&"<?xml version="&""""&""&""""&"1.0"&""""&""&""""&"?>"&""""&" "
.writeline"Set pic = xmldoc.createElement("&""""&"pic"&""""&")"
.writeline"pic.dataType = "&""""&"bin.hex"&""""&""
.writeline"pic.nodeTypedValue = str"
.writeline"StrToByte = pic.nodeTypedValue"
.writeline"End Function "
end with
ws.popup"转换成功!",3,"制作 BY:飘零",64+4096
set ws=nothing

Function ChgStr(str,flag)
s1="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
s2="SGk7B4arX8UFecwJ9O6y2ihWMNKDp1ZE0gsmlTAQ5HYLjVIzqfuobvCxtPR3nd"
If Not flag=1 Then t=s1:s1=s2:s2=t
For i=1 To Len(str)
before=Mid(str,i,1)
For j=1 To 62
after=Replace(before,Mid(s1,j,1),Mid(s2,j,1))
If Not before=after Then ChgStr=ChgStr&after:Exit For
Next
Next
End Function

Answer 3

图片有什么可加密解密的呢？
这个没听说过。
先标记一下，看看高手是怎么回答的。呵呵。