VB.NET代码
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Pass = MD5("DMUIT", MD5_1)
AxShockwaveFlash1.Movie = Application.StartupPath & "/swf/目的.swf"
AxShockwaveFlash1.Playing = True
JM(AxShockwaveFlash1.Movie, Pass)
End Sub
MD5加密解密代码
Imports Microsoft.VisualBasic
Imports System.Text
Imports System.IO
Imports System.Data.OleDb
Module Module1
Public MD5_1 As Long 'MD5加密的位数(存放随机数)
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
Dim Md5OLD
Public Pass As String
'****************************
'* * * * * * * * * * * * * * * * *
'* SWF 文 件 加 密 程 序 *
'* * * * * * * * * * * * * * * * *
Public Sub JM(ByVal Patch As String, ByVal Pass As String)
If InStr(Patch, ".swf") > 0 Then
If Pass = MD5("DMUIT", MD5_1) Then
Dim SrcFile As String
Dim OutFile As String
'Dim DSX() As Byte
SrcFile = Patch
OutFile = Patch
'Open SrcFile For Binary Access Read As #1
'Open OutFile For Binary Access Write As #2
'unit = LOF(1)
'ReDim DSX(unit) As Byte
'Get #1, , DSX()
'DSX(0) = 56
'DSX(1) = 89
'DSX(2) = 87
'DSX(8) = 16
'DSX(9) = 54
'Put #2, 1, DSX()
'Close
#2, #
1
'读写文件号
FileOpen(1, SrcFile, OpenMode.Binary, OpenAccess.Read)
Dim fileInfo As New FileInfo(SrcFile)
Dim unit As Integer = fileInfo.Length
Dim DSX(unit) As Byte
FileGet(1, DSX(unit))
DSX(0) = 56
DSX(1) = 89
DSX(2) = 87
DSX(8) = 16
DSX(9) = 54
FileClose(1)
FileOpen(2, OutFile, OpenMode.Binary, OpenAccess.Write)
FilePut(2, DSX(unit))
FileClose(2)
End If
End If
End Sub
'* * * * * * * * * * * * * * * * *
'* SWF 文 件 解 密 程 序 *
'* 在 原 文 件 的 位 置 *
'* * * * * * * * * * * * * * * * *
Public Function zf1(ByVal Patch As String, ByVal Pass As String) As String
If Pass = MD5("DMUIT", MD5_1) Then
Dim SrcFile As String
Dim OutFile As String
'Dim DSX() As Byte
SrcFile = Patch
OutFile = Patch
'读写文件号
'Open SrcFile For Binary Access Read As #1
'Open OutFile For Binary Access Write As #2
'Dim unit = LOF(1)
'ReDim DSX(unit)
'Get #1, , DSX()
'DSX(0) = 67
'DSX(1) = 87
'DSX(2) = 83
'DSX(8) = 120
'DSX(9) = 156
'Put #2, 1, DSX(unit)
''Close
#2, #
1
'zf1 = Patch
'读写文件号
FileOpen(1, SrcFile, OpenMode.Binary, OpenAccess.Read)
Dim fileInfo As New FileInfo(SrcFile)
Dim unit As Integer = fileInfo.Length
Dim DSX(unit) As Byte
FileGet(1, DSX(unit))
DSX(0) = 67
DSX(1) = 87
DSX(2) = 83
DSX(8) = 120
DSX(9) = 156
FileClose(1)
FileOpen(2, OutFile, OpenMode.Binary, OpenAccess.Write)
FilePut(2, DSX(unit))
FileClose(2)
zf1 = Patch
End If
End Function
'* * * * * * * * * * * * *
'* M D 5 加 密 *
'* MD5(sMessage, stype) *
'* * * * * * * * * * * * *
Private Function LShift(ByVal lValue, ByVal iShiftBits)
If iShiftBits = 0 Then
LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
LShift = &H80000000
Else
LShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise(6)
End If
If (lValue And m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
Else
LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
End If
End Function
Private Function str2bin(ByVal varstr)
Dim varasc
Dim i
Dim varchar
Dim varlow
Dim varhigh
str2bin = ""
For i = 1 To Len(varstr)
varchar = Mid(varstr, i, 1)
varasc = Asc(varchar)
If varasc < 0 Then
varasc = varasc + 65535
End If
If varasc > 255 Then
varlow = Left(Hex(Asc(varchar)), 2)
varhigh = Right(Hex(Asc(varchar)), 2)
'str2bin = str2bin & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
str2bin = str2bin & Chr("&H" & varlow) & Chr("&H" & varhigh)
Else
'str2bin = str2bin & ChrB(Asc(varchar))
str2bin = str2bin & Chr(Asc(varchar))
End If
Next
End Function
Private Function RShift(ByVal lValue, ByVal iShiftBits)
If iShiftBits = 0 Then
RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And &H80000000 Then
RShift = 1
Else
RShift = 0
End If
Exit Function
ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
Err.Raise(6)
End If
RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
If (lValue And &H80000000) Then
RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function RotateLeft(ByVal lValue, ByVal iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function AddUnsigned(ByVal lX, ByVal lY)
Dim lX4
Dim lY4
Dim lX8
Dim lY8
Dim lResult
lX8 = lX And &H80000000
lY8 = lY And &H80000000
lX4 = lX And &H40000000
lY4 = lY And &H40000000
lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
If lX4 And lY4 Then
lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
ElseIf lX4 Or lY4 Then
If lResult And &H40000000 Then
lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
Else
lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
End If
Else
lResult = lResult Xor lX8 Xor lY8
End If
AddUnsigned = lResult
End Function
Private Function md5_F(ByVal x, ByVal y, ByVal z)
md5_F = (x And y) Or ((Not x) And z)
End Function
Private Function md5_G(ByVal x, ByVal y, ByVal z)
md5_G = (x And z) Or (y And (Not z))
End Function
Private Function md5_H(ByVal x, ByVal y, ByVal z)
md5_H = (x Xor y Xor z)
End Function
Private Function md5_I(ByVal x, ByVal y, ByVal z)
md5_I = (y Xor (x Or (Not z)))
End Function
Private Sub md5_FF(ByVal a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_GG(ByVal a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_HH(ByVal a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Sub md5_II(ByVal a, ByVal b, ByVal c, ByVal d, ByVal x, ByVal s, ByVal ac)
a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
a = RotateLeft(a, s)
a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(ByVal sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Const MODULUS_BITS = 512
Const CONGRUENT_BITS = 448
If Md5OLD = 1 Then
lMessageLength = Len(sMessage)
Else
'lMessageLength = LenB(sMessage)
'lMessageLength = ASCIIEncoding.Unicode.GetByteCount(sMessage)
lMessageLength = CStr(sMessage).Length
End If
lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
ReDim lWordArray(lNumberOfWords - 1)
lBytePosition = 0
lByteCount = 0
Do Until lByteCount >= lMessageLength
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
'lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(AscB(MidB(sMessage, lByteCount + 1, 1)), lBytePosition)
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
ConvertToWordArray = lWordArray
End Function
Private Function WordToHex(ByVal lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
Next
End Function
End Module