CODE: [Copy to clipboard]
Set oStream = CreateObject("Adodb.Stream")
With oStream
.Type = 1
.Mode = 3
.Open
End With
Set oIE=WScript.CreateObject("InternetExplorer.Application","Event_")
With oIE
.MenuBar = 0
.AddressBar = 0
.ToolBar = 0
.StatusBar = 0
.Width = 350
.Height = 100
.Resizable = 0
.Navigate "about:blank"
.Left=Fix((oIE.Document.ParentWindow.Screen.AvailWidth-oIE.Width) / 2)
.Top=Fix((oIE.Document.ParentWindow.Screen.AvailHeight-oIE.Height) / 2)
.Visible = 1
End With
With oIE.Document
.Write "<HTML><BODY Scroll=No>"
.Write "<Input type='File' ID='ccc' />"
.Write "<Button ID='aaa'>加密</Button>"
.Write "<Button ID='bbb'>解密</Button>"
.Write "</body></html>"
End With
oIE.Document.All.aaa.OnClick=GetRef("aaa")
oIE.Document.All.bbb.OnClick=GetRef("bbb")
Do
WScript.Sleep 200
Loop
Sub Event_OnQuit
oStream.Close
Set oIE = Nothing
Set oStream = Nothing
WScript.Quit
End Sub
'***********************************************************************************
'加密
'***********************************************************************************
Sub aaa
Dim str
str = oIE.Document.All.ccc.Value
oStream.LoadFromFile str
oStream.Position = 0
Hex2Bin Bin2StrInc(oStream.Read),str & ".bak"
oStream.Close
oStream.Open
End Sub
'***********************************************************************************
'解密
'***********************************************************************************
Sub bbb
Dim str
str = oIE.Document.All.ccc.Value
oStream.LoadFromFile str
oStream.Position = 0
Hex2Bin Bin2StrDec(oStream.Read),Mid(str,1,Len(str) - 4)
oStream.Close
oStream.Open
End Sub
'***********************************************************************************
'2进制转换为16进制字符串并+1
'***********************************************************************************
Function Bin2StrInc(bin)
Dim i,str
For i = 1 To Lenb(bin)
str = Ascb(Midb(bin,i,1))
Bin2StrInc = Bin2StrInc & Right("0" & Hex(str + 1),2)
Next
End Function
'***********************************************************************************
'2进制转换为16进制字符串并-1
'***********************************************************************************
Function Bin2StrDec(bin)
Dim i,str
For i = 1 To Lenb(bin)
str = Ascb(Midb(bin,i,1))
Bin2StrDec = Bin2StrDec & Right("0" & Hex(str - 1),2)
Next
End Function
'***********************************************************************************
'16进制字符串转换为2进制流
'***********************************************************************************
Sub Hex2Bin(strHex,strFileName)
Dim objStream,objXML,objElement
Set objStream = Createobject("Adodb.Stream")
Set objXML = Createobject("Microsoft.XMLDOM")
Set objElement = objXML.CreateElement("oTmpElement")
objElement.DataType = "bin.hex"
objElement.NodeTypedValue = strHex
With objStream
.Type = 1
.Mode = 3
.Open
.Write objElement.NodeTypedValue
.SaveToFile strFileName
End With
objStream.Close
Set objStream = Nothing
Set objXML = Nothing
Set objElement = Nothing
End Sub
只是简单的例子,并未做任何Bug检测。