Vb Anti Virüs [ Virüs Scanner ] Source - Kodlari - Yapimi

Arkadaslar
Artık Source paylaşma zamanı Geldi..Teşekkür zamanı Hadi
başlıyalım..Dogru düzgün böyle source paylaşan yok..emeğe saygı..

Source ;

[Linkleri görebilmek için üye olun veya giriş yapın.]

Görünüm ;


Kodlar ;


Kod:

Option Explicit
Dim myDir As String
Dim bronF As Long

Sub SikatProses(ID As Long)
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim myProcess As Long

Const TH32CS_SNAPPROCESS As Long = 2&

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)

Dim curID As Long, parentID As Long

curID = ID
rProcessFound = ProcessNext(hSnapshot, uProcess)

Do While rProcessFound
If curID = uProcess.th32ProcessID Then
myProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ + 1, False, uProcess.th32ProcessID)
Call TerminateProcess(myProcess, 0)
Call CloseHandle(myProcess)
parentID = curID
curID = 1
Else
If uProcess.th32ParentProcessID = ID Then
myProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ + 1, False, uProcess.th32ProcessID)
Call TerminateProcess(myProcess, 0)
Call CloseHandle(myProcess)
parentID = curID
curID = 1
Else
If uProcess.th32ParentProcessID = parentID Then
myProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ + 1, False, uProcess.th32ProcessID)
Call TerminateProcess(myProcess, 0)
Call CloseHandle(myProcess)
parentID = uProcess.th32ProcessID
End If
End If
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
DoEvents
Loop
Call CloseHandle(hSnapshot)
End Sub

Function HajarBrontok() As Long
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Const TH32CS_SNAPPROCESS As Long = 2&

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
rProcessFound = ProcessNext(hSnapshot, uProcess)
Dim i As Integer

Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
If szExename = "winlogon.exe" Then
If GetPathID(uProcess.th32ProcessID) <> StripPath(SysDir) & "winlogon.exe" Then
myDir = Replace(GetPathID(uProcess.th32ProcessID), "winlogon.exe", "")
End If
SikatProses uProcess.th32ProcessID
End If
If CRCbro(GetPathID(uProcess.th32ProcessID)) Then
SikatProses uProcess.th32ProcessID
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
DoEvents
Loop
Call CloseHandle(hSnapshot)
End Function
Sub HapusDefFile()
On Error Resume Next
SetAttr "C:\SandsLaSh.txt", vbNormal + vbArchive
Kill "C:\SandsLaSh.txt"
SearchViri StripPath(WinDir)
SearchViri StripPath("C:\********s and Settings")
SearchViri StripPath(WinDir) & "Tasks"
RmDir myDir
End Sub
Function CRCbro(nFilename As String) As Boolean
On Error GoTo Salah
If nFilename <> "" Then
If FileLen(nFilename) < 200000 Then
Dim data(1) As Byte
Open nFilename For Binary As #1
Get #1, FileLen(nFilename) - 1, data
Close #1
If (data(0) = &H48) And (data(1) = &HBE) Then
CRCbro = True
bronF = bronF + 1
End If
End If
End If
Exit Function
Salah:
Close #1
End Function

Private Sub Command1_Click()
If Command2.Enabled = False Then
If MsgBox("Durdurmak İstermisiniz?", 32 + vbYesNo) = vbYes Then
Unload Me
End If
Else
Unload Me
End If
End Sub

Private Sub Command2_Click()
Command2.Enabled = False
mnudrive.Enabled = False
bronF = 0
Status = 1
lblstatus(2).ForeColor = &H808080
shpBullet(2).BackColor = &HFF&
lblstatus(0).ForeColor = vbRed
shpBullet(0).BackColor = vbGreen
HajarBrontok
Status = 2
lblstatus(0).ForeColor = &H808080
shpBullet(0).BackColor = &HFF&
lblstatus(1).ForeColor = vbRed
shpBullet(1).BackColor = vbGreen
HapusDefFile
Status = 3
lblstatus(1).ForeColor = &H808080
shpBullet(1).BackColor = &HFF&
lblstatus(2).ForeColor = vbRed
shpBullet(2).BackColor = vbGreen
BalikanRegister
Status = 4
lblstatus(2).ForeColor = &H808080
shpBullet(2).BackColor = &HFF&
lblstatus(3).ForeColor = vbRed
shpBullet(3).BackColor = vbGreen
Dim i As Integer
For i = 0 To mnudrives.Count - 1
If mnudrives(i).Checked = True Then
SearchViri mnudrives(i).Caption
End If
Next i
Status = 0

Command2.Enabled = True
MsgBox "Virusler .....", 64
mnudrive.Enabled = True
End Sub

Private Sub Form_Load()
Me.Caption = "SandsLaSh / Virus Scanner" & Chr(0) & Chr(Int(Rnd * 255)) & Chr(Int(Rnd * 255))
App.Title = Me.Caption
LoadDrive
End Sub

Sub LoadDrive()
On Error Resume Next
Dim LDs As Long, Cnt As Long, sDrives As String
Dim i As Integer
LDs = GetLogicalDrives
For Cnt = 0 To 25
If (LDs And 2 ^ Cnt) <> 0 Then
If i > 0 Then
Load mnudrives(i)
End If
mnudrives(i).Caption = Chr$(65 + Cnt) & ":"
mnudrives(i).Visible = True
mnudrives(i).Checked = True
i = i + 1
End If
Next Cnt
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub

Private Sub Label1_Click()
On Error Resume Next
Shell "explorer.exe [Linkleri görebilmek için üye olun veya giriş yapın.] 1
End Sub

Private Sub lblFilename_Change()
On Error Resume Next
Dim Filename As String
Filename = lblFilename.Caption
If Status = 2 Then
If CRCbro(Filename) Then
SetAttr Filename, vbNormal + vbArchive
Kill Filename
virilocal.Add GetTitleFile(Filename)
End If
If myDir <> "" Then
If InStr(1, Filename, myDir, vbTextCompare) > 0 Then
SetAttr Filename, vbNormal + vbArchive
Kill Filename
virilocal.Add GetTitleFile(Filename)
End If
End If
ElseIf Status = 4 Then
If CRCbro(Filename) Then
SetAttr Filename, vbNormal + vbArchive
Kill Filename
End If
End If
lblbron.Caption = "Bulunan Tehditler: " & bronF
Animate
End Sub

Private Sub mnudrives_Click(Index As Integer)
mnudrives(Index).Checked = Not mnudrives(Index).Checked
End Sub

Sub Animate()
If shpfile = "[-]" Then
shpfile = "[\]"
ElseIf shpfile = "[\]" Then
shpfile = "[|]"
ElseIf shpfile = "[|]" Then
shpfile = "[/]"
ElseIf shpfile = "[/]" Then
shpfile = "[-]"
End If

End Sub