VB 在EXE后附加信息(木马生

1、VB 在EXE后附加信息(木马生成器原理) Option ExplicitPrivate Const ExeInfoLen = 400 'exe文件后附加信息总长度Public Function WriteEXE(resFile() As Byte, FileName As String, info As String, infolen As Long) As BooleanOn Error GoTo Err Dim TempByte As Byte Dim UserData() As Byte Dim FileNum As Integer Dim I As Long ReDim Us

2、erData(infolen) FileNum = FreeFile Open FileName For Binary Access Write As #FileNum Put #FileNum, , resFile For I = 1 To Len(info) UserData(I) = Asc(Mid(info, I, 1) Next I If Len(info) < infolen Then For I = Len(info) + 1 To infolen UserData(I) = Asc(" ") Next I End If Put #FileNum, ,

3、UserData Close #FileNum WriteEXE = True Exit FunctionErr: WriteEXE = False Close #FileNumEnd FunctionPublic Function GetInfo(FileName As String, infolen As Long) As StringOn Error GoTo Err Dim FileNum As Integer Dim Record As Long Dim tempstr As Byte Dim I As Long FileNum = FreeFile Open FileName Fo

4、r Binary Access Read As #FileNum For I = 0 To infolen - 1 Record = LOF(FileNum) - infolen + I Get #FileNum, Record, tempstr If tempstr > 0 Then GetInfo = GetInfo & Chr(tempstr) End If Next IErr: GetInfo = Replace(GetInfo, Chr(0), "") GetInfo = Trim(GetInfo) Close #FileNumEnd Functio

5、nPublic Function GetCommand(strCmdLine As String, VarName As String) As StringOn Error Resume Next'取变量值 返回变量的值'strCmdLine 服务器返回的数据'varname 变量名If strCmdLine = "" Then Exit Function '参数必须存在Dim strCmd() As String, I% strCmd = Split(strCmdLine, "&") For I = 0 To U

6、Bound(strCmd) If Len(strCmd(I) > Len(VarName) Then If LCase(Left(strCmd(I), Len(VarName) = LCase(VarName) Then GetCommand = Mid(strCmd(I), InStr(strCmd(I), "=") + 1) End If End If NextEnd FunctionPublic Function Encdec(inputstrinG As String) As StringDim p As String, o As String, k As S

7、tring, s As String, tempstr As String, I As Integer, g As Integer If Len(inputstrinG) = 0 Then Exit Function g = 1 For I = 1 To Len(inputstrinG) p = Mid$(inputstrinG, I, 1) o = Asc(p) k = o Xor g s = Chr$(k) tempstr = tempstr & s If g = 255 Then g = 1 Else g = g + 1 Next IEncdec = tempstrEnd Fun

8、ction'从资源文件中读出数据并另存为磁盘文件Public Sub resDataFile(Id, resType, FileName As String)Dim resFile() As Byte, FileNum As IntegerOn Error GoTo Err resFile = LoadResData(Id, resType) FileNum = FreeFile Open FileName For Binary Access Write As #FileNum Put #FileNum, , resFile Close #FileNumExit SubErr: Msg

9、Box Err.Description & "：" & Err.Number, vbInformation, "错误"End SubPublic Function GetDataForFile(FileName As String) As Byte()On Error Resume Next Dim DAT() As Byte, FileNum As Integer, FileSize As Long FileNum = FreeFile FileSize = FileLen(FileName) ReDim DAT(FileSize -

10、1) As Byte Open FileName For Binary As #FileNum Get #FileNum, , DAT Close GetDataForFile = DATEnd FunctionPublic Function 读取EXE内信息(FileName As String) As StringOn Error Resume Next'从EXE尾读信息Dim base64 As New base64Dim URL As StringDim Strtem As StringStrtem = GetInfo(FileName, ExeInfoLen)'Str

11、tem = encdec(Strtem)Strtem = base64.Decode(Strtem)读取EXE内信息 = Strtem'Dim 网址 As String, 备注 As String'网址 = GetCommand(Strtem, "网址")'备注 = GetCommand(Strtem, "备注")Set base64 = NothingEnd FunctionPublic Function 写信息到EXE内(FileName As String, infoStr As String) As BooleanOn E

12、rror Resume Next Dim base64 As New base64 Dim Strtem As String Strtem = infoStr Strtem = base64.Encode(Strtem) 'Strtem = encdec(Strtem) Set base64 = Nothing If Len(Strtem) > ExeInfoLen Then MsgBox "信息过长", vbCritical, "错误" Exit Function End If 'WriteEXE LoadResData(101,

13、 "CUSTOM"), FileName, Strtem, ExeInfoLen '从资源文件中提取EXE WriteEXE GetDataForFile(FileName), FileName, Strtem, ExeInfoLenEnd FunctionPrivate Sub Command1_Click()写信息到EXE内 App.Path & "" & App.EXEName & ".exe", "username=abcd&password=1234&dns=sutu

14、"End SubPrivate Sub Command2_Click()dim Strtem as string Strtem= 读取EXE内信息(App.Path & "" & App.EXEName & ".exe")MsgBox GetCommand(Strtem, "username")MsgBox GetCommand(Strtem, "password")MsgBox GetCommand(Strtem, "dns")End Su

15、b'base64.clsOption ExplicitPublic Event BlockRead(ByVal lngCurrentBlock As Long, ByVal lngTotalBlocks As Long, ByVal lBlockMode As enBlockMode, ByRef bCancel As Boolean)Public Event FileDecodeComplete(strOriginalFile As String, strDecodedFile As String)Public Event FileEncodeComplete(strOriginal

16、File As String, strEncodedFile As String)Public Event ErrorOccured(ByVal lngCode As Long, ByVal strDescription As String)Public Event BeforeFileOpenIn(ByVal strFileName As String, ByRef bCancel As Boolean)Public Event BeforeFileOpenOut(ByVal strFileName As String, ByRef bCancel As Boolean)Public Eve

17、nt AfterFileCloseIn(ByVal strFileName As String)Public Event AfterFileCloseOut(ByVal strFileName As String)Private m_oXMLDoc As ObjectPrivate m_oXMLElement As ObjectPrivate m_bXMLObjectOK As BooleanPrivate m_lngLastErrorCode As LongPrivate m_strLastErrorDesc As StringPrivate m_lngEncBlockSize As Lon

18、gPrivate m_lngDecBlockSize As LongPrivate m_bCancel As BooleanPublic Enum enBlockMode b64Encode b64DecodeEnd EnumPrivate Const cMSXMLDom = "MSXML.DomDocument"Private Const cDefBlockSize = 1048576 '默认块大小: 1MbPrivate Sub Class_Initialize() Set m_oXMLDoc = fCreateObject(cMSXMLDom) ClearEr

19、ror m_bXMLObjectOK = Not m_oXMLDoc Is Nothing If Not m_bXMLObjectOK Then RaiseError "90001", "错误,建立必须 '" & cMSXMLDom & "' 对象" Else Set m_oXMLElement = m_oXMLDoc.createElement("TmpBase64") m_oXMLElement.dataType = "bin.base64" End If &

20、#39;初始化块大小大约 1Mb Me.BlockSize = cDefBlockSizeEnd SubPrivate Sub Class_Terminate() '释放对象 Set m_oXMLElement = Nothing Set m_oXMLDoc = NothingEnd SubPublic Function Encode(ByVal strIn As String) As String '编码字符串 Dim oElement As Object Dim sData As String Dim aData() As Byte On Error GoTo errEnc

21、ode: If m_bXMLObjectOK And Len(strIn) > 0 Then aData = StrConv(strIn, vbFromUnicode) m_oXMLElement.nodeTypedValue = aData Encode = m_oXMLElement.Text m_oXMLElement.Text = "" '释放内存 End If Exit FunctionerrEncode: RaiseError Err.Number, Err.DescriptionEnd FunctionPublic Function Decode

22、(ByVal strIn As String) As String '解码字符串 Dim oElement As Object On Error GoTo errDecode: If m_bXMLObjectOK And Len(strIn) > 0 Then m_oXMLElement.Text = strIn Decode = StrConv(m_oXMLElement.nodeTypedValue, vbUnicode) m_oXMLElement.Text = "" '释放内存 End If Exit FunctionerrDecode: Ra

23、iseError Err.Number, Err.DescriptionEnd FunctionPublic Function EncodeFile(ByRef strInFile As String, ByRef strOutFile As String) As Boolean EncodeFile = EncDecFile(strInFile, strOutFile, True)End FunctionPublic Function DecodeFile(ByRef strInFile As String, ByRef strOutFile As String) As Boolean De

24、codeFile = EncDecFile(strInFile, strOutFile, False)End FunctionPublic Property Get LastErrorCode() As Long LastErrorCode = m_lngLastErrorCodeEnd PropertyPublic Property Get LastErrorDescription() As String LastErrorDescription = m_strLastErrorDescEnd PropertyPublic Property Let BlockSize(ByVal lngBy

25、tes As Long) m_lngEncBlockSize = (lngBytes 54) * 54 + IIf(IsOnBoundary(lngBytes, 54), 0, 54) m_lngDecBlockSize = (lngBytes 584) * 584 + IIf(IsOnBoundary(lngBytes, 584), 0, 584)End PropertyPublic Sub ClearError() m_lngLastErrorCode = 0 m_strLastErrorDesc = ""End SubPrivate Function IsOnBoun

26、dary(lLen As Long, lBoundary As Long) As Boolean IsOnBoundary = lLen Mod lBoundary = 0End FunctionPrivate Sub RaiseError(ByVal lngCode As Long, ByVal strDescription As String) m_lngLastErrorCode = lngCode m_strLastErrorDesc = strDescription RaiseEvent ErrorOccured(lngCode, strDescription)End SubPriv

27、ate Function fCreateObject(sObject As String) As Object On Error GoTo errCreateObject Set fCreateObject = CreateObject(sObject) On Error GoTo 0 Exit FunctionerrCreateObject: Set fCreateObject = NothingEnd FunctionPrivate Function EncDecFile(strInFile As String, strOutFile As String, bEncode As Boole

28、an) '编码/解码文件 Dim lBlockCount As Long Dim lSize As Long Dim lMaxBlocks As Long Dim lRest As Long Dim strTMP As String Dim FFIn As Integer Dim FFOut As Integer Dim lBlockSize As Long Dim strOut As String On Error GoTo errEncDecFile If bEncode Then lBlockSize = m_lngEncBlockSize Else lBlockSize = m

29、_lngDecBlockSize m_bCancel = False lBlockCount = 0 If Len(Dir(strInFile) > 0 Then '文件是否存在 RaiseEvent BeforeFileOpenIn(strInFile, m_bCancel) If m_bCancel Then Exit Function FFIn = FreeFile '获取空闲文件句柄 Open strInFile For Binary As #FFIn RaiseEvent BeforeFileOpenOut(strOutFile, m_bCancel) If m

30、_bCancel Then Close #FFIn '关闭文件 Exit Function End If FFOut = FreeFile Open strOutFile For Binary As #FFOut lSize = LOF(FFIn) '获取文件大小 lMaxBlocks = lSize lBlockSize '定义读取的块数 lRest = lSize - (lMaxBlocks * lBlockSize) strTMP = String(lBlockSize, Chr(0) '初始化缓冲区 While Not EOF(FFIn) And (lBlockCount < lMaxBlocks) And (Not m_bCancel) '读取文件 Get #FFIn, , strTMP '读取块 If bEncode Then strOut = Me.Encode(strTMP) &