Antivirus Denemem (VB6)

18/Kas/11 16:50

Kısayol

Şikayet

Özel Mesaj

DE5TROY3R

Kayıt Tarihi: 04/Nisan/2007

Basit bir antivirus yapmaya çalıştım, kodlardan faydalanmak isteyen olur diye paylaşayım dedim

Alıntı yap

18/Kas/11 16:51

Kısayol

Şikayet

Özel Mesaj

DE5TROY3R

Kayıt Tarihi: 04/Nisan/2007

Ana ekran:

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Dim nID As NOTIFYICONDATA


Private Sub Check1_Click()
On Error Resume Next
Dim reg
Set reg = CreateObject("WScript.Shell")

If Check1.Value = 1 Then
aktifkoruma.Enabled = True
Shape1.BackColor = &H8000&
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Aktif Koruma", Check1.Value, "REG_SZ"

Else
aktifkoruma.Enabled = False
Shape1.BackColor = &HC0&
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Aktif Koruma", Check1.Value, "REG_SZ"

End If






End Sub

Private Sub Check2_Click()
On Error Resume Next
If Check2.Value = 1 Then
Dim reg
Set reg = CreateObject("WScript.Shell")
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\TD Antivirus", Chr(34) & App.Path & "\" & App.EXEName & ".exe" & Chr(34) & " /background", "REG_SZ"
Else
Dim reg2
Set reg2 = CreateObject("WScript.Shell")
reg2.RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\TD Antivirus"

End If


End Sub

Public Function Calisiyormu(ByVal exeismi As String) As Boolean
On Error Resume Next
Dim winobje, islem
Set winobje = GetObject("winmgmts:")
Set islem = winobje.ExecQuery("Select * from Win32_Process where name='" & exeismi & "'")
If islem.Count Then
Calisiyormu = True
Else
Calisiyormu = False
Shell App.Path & "\TDAntiKoruma.exe"
End If
End Function

Public Function explorercalistir(ByVal exeismi As String) As Boolean
On Error Resume Next
Dim winobje, islem
Set winobje = GetObject("winmgmts:")
Set islem = winobje.ExecQuery("Select * from Win32_Process where name='" & exeismi & "'")
If islem.Count Then
explorercalistir = True
Else
explorercalistir = False

Shell "explorer.exe", vbHide
explorer.Enabled = False
End If
End Function

Private Function dosyaoku(dosyayolu As String) As String
On Error Resume Next
Dim bytes() As Byte
Dim ff      As Integer
ff = FreeFile
Open dosyayolu For Binary As #ff
ReDim bytes(LOF(1))
Get #ff, 1, bytes
Close ff
dosyaoku = Replace(StrConv(bytes(), vbUnicode), vbNullChar, " ")
End Function

Sub virustarama()
On Error Resume Next
Dim toplamsezgi, i, sezdeger, sezsonuc, tarama1, toplamimza, i2, imzadeger, imzasonuc, tarama2
If Check3.Value = 1 Then

Adodc1.RecordSource = "select * from sezgisel"
Adodc1.Refresh
toplamsezgi = Adodc1.Recordset.RecordCount
For i = 1 To toplamsezgi
Dim sql As String
sql = "select * from sezgisel where sezgiid like '%" & i & "%'"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = sql
Adodc1.Refresh
sezdeger = Adodc1.Recordset.Fields("sezdeger")
sezsonuc = Adodc1.Recordset.Fields("sezsonuc")
tarama1 = TagYakala(veriler, Adodc1.Recordset.Fields("sez1"), Adodc1.Recordset.Fields("sez2"))
If tarama1 = sezsonuc Then
virusmu.Text = Val(virusmu.Text) + Val(sezdeger)
End If
wait 25
Next i
End If

If Check4.Value = 1 Then
Adodc1.RecordSource = "select * from imzalar"
Adodc1.Refresh
toplamimza = Adodc1.Recordset.RecordCount
For i2 = 1 To toplamimza
Dim sql2 As String
sql2 = "select * from imzalar where imzaid like '%" & i2 & "%'"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = sql2
Adodc1.Refresh
imzadeger = Adodc1.Recordset.Fields("imzadeger")
imzasonuc = Adodc1.Recordset.Fields("imzasonuc")
tarama2 = TagYakala(veriler, Adodc1.Recordset.Fields("imza1"), Adodc1.Recordset.Fields("imza2"))
If tarama2 = imzasonuc Then
virusmu.Text = Val(virusmu.Text) + Val(imzadeger)
End If
wait 25
Next i2

End If
End Sub





Function TagYakala(veri As String, tagb As String, tags As String)
On Local Error Resume Next
Dim arrs, arrb
arrs = Split(veri, tagb)
arrb = Split(arrs(1), tags)
TagYakala = arrb(0)
End Function






Private Sub Check3_Click()
On Error Resume Next
Dim reg
Set reg = CreateObject("WScript.Shell")

If Check3.Value = 1 Then
Label1.Enabled = True
seviye.Enabled = True
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Sezgisel Tarama", Check3.Value, "REG_SZ"

Else
Label1.Enabled = False
seviye.Enabled = False
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Sezgisel Tarama", Check3.Value, "REG_SZ"

End If

End Sub

Private Sub Check4_Click()
On Error Resume Next
Dim reg
Set reg = CreateObject("WScript.Shell")
If Check4.Value = 1 Then
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\imza Tarama", Check4.Value, "REG_SZ"
Else
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\imza Tarama", Check4.Value, "REG_SZ"

End If
End Sub

Private Sub Command1_Click()
On Error Resume Next

Dim reg
Set reg = CreateObject("WScript.Shell")

aktifkoruma.Enabled = False
Shape1.BackColor = &HC0&
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Aktif Koruma", "0", "REG_SZ"


Command1.Enabled = False
'taranacakdosyasayisi.Text = ""
virusmu.Text = ""
silinecekdosyaid.Text = ""

wait 1
Dim getwindir, sistemsurucusu, boluneceksayi, virus

If taranacakdosyasayisi.Text = taranacakdosyalar.ListCount Then
taranacakdosyalar.Clear
taranacakdosyalariyukle
Command1.Enabled = True
taranacakdosyasayisi.Text = "0"

Dim Temp As String * 256
Dim X As Integer
X = GetWindowsDirectory(Temp, Len(Temp))
getwindir = Left$(Temp, X)
sistemsurucusu = Left$(getwindir, 3)
Label8.Caption = sistemsurucusu

If virusludosyalar.ListCount <> 0 Then
Command5.Enabled = True

End If

Else
boluneceksayi = 0
veriler = ""
virusmu.Text = "0"
If FileLen(taranacakdosyalar.List(taranacakdosyasayisi.Text)) < 20000 Then
Label8.Caption = taranacakdosyalar.List(taranacakdosyasayisi.Text) & "(" & virus & "/" & boluneceksayi & ")"

'Frame2.Caption = "Sistem taraması (" & taranacakdosyasayisi.Text & "/" & taranacakdosyalar.ListCount & ")"
veriler = dosyaoku(taranacakdosyalar.List(taranacakdosyasayisi.Text))
virustarama

If virusmu.Text * seviye.Text > 50 Then
'Kill App.Path & "\*.td"
Label8.Caption = taranacakdosyalar.List(taranacakdosyasayisi.Text) & "(" & virus & "/" & boluneceksayi & ")"
'Frame2.Caption = "Sistem taraması (" & taranacakdosyasayisi.Text & "/" & taranacakdosyalar.ListCount & ")"
virusludosyalar.AddItem taranacakdosyalar.List(taranacakdosyasayisi.Text)
virusludosyaisimleri.AddItem Filenm(taranacakdosyalar.List(taranacakdosyasayisi.Text))

taranacakdosyasayisi.Text = taranacakdosyasayisi.Text + 1
Call Command1_Click
Else
'Kill App.Path & "\*.td"
Label8.Caption = taranacakdosyalar.List(taranacakdosyasayisi.Text) & "(" & virus & "/" & boluneceksayi & ")"
'Frame2.Caption = "Sistem taraması (" & taranacakdosyasayisi.Text & "/" & taranacakdosyalar.ListCount & ")"
taranacakdosyasayisi.Text = taranacakdosyasayisi.Text + 1
Call Command1_Click
End If
Else
bol2
End If

End If
End Sub


Sub bol2()
On Error Resume Next
Dim s As String, T As Long, Parcaismi As String
Dim Cont As Integer, XOut As Long, Rest As Long
Dim dosyaboyutu, boluneceksayi, virus
dosyaboyutu = FileLen(taranacakdosyalar.List(taranacakdosyasayisi.Text))
boluneceksayi = dosyaboyutu \ 20000
Open taranacakdosyalar.List(taranacakdosyasayisi.Text) For Binary As #1
T = Int(LOF(1) / Val(boluneceksayi))
Rest = LOF(1) Mod Val(boluneceksayi)
Cont = 0
Do While Cont < Val(boluneceksayi)
Parcaismi = App.Path & "\Laboratuvar\Dosya" & Trim(Str(Cont + 1))
If Mid(taranacakdosyalar.List(taranacakdosyasayisi.Text), InStrRev(taranacakdosyalar.List(taranacakdosyasayisi.Text), ".")) > 0 Then Parcaismi = Parcaismi & ".td"
Open Parcaismi For Binary As #2
If Cont < Val(boluneceksayi) - 1 Then
XOut = T
Else
XOut = T + Rest
End If
Do While XOut > 0
If XOut > 6400000 Then
s = Space(6400000)
XOut = XOut - 6400000
Else
s = Space(XOut)
XOut = 0
End If
Get #1, , s
Put #2, , s
DoEvents
Loop
Close #2
Cont = Cont + 1
Loop
Close #1



For virus = 0 To boluneceksayi
Label8.Caption = taranacakdosyalar.List(taranacakdosyasayisi.Text) & "(" & virus & "/" & boluneceksayi & ")"

'Frame2.Caption = "Sistem taraması (" & taranacakdosyasayisi.Text & "/" & taranacakdosyalar.ListCount & ")"
veriler = dosyaoku(App.Path & "\Laboratuvar\Dosya" & virus & ".td")
virustarama

If virus = boluneceksayi Then
If virusmu.Text * seviye.Text > 50 Then

Kill App.Path & "\Laboratuvar\*.td"
Label8.Caption = taranacakdosyalar.List(taranacakdosyasayisi.Text) & "(" & virus & "/" & boluneceksayi & ")"

'Frame2.Caption = "Sistem taraması (" & taranacakdosyasayisi.Text & "/" & taranacakdosyalar.ListCount & ")"
virusludosyalar.AddItem taranacakdosyalar.List(taranacakdosyasayisi.Text)
virusludosyaisimleri.AddItem Filenm(taranacakdosyalar.List(taranacakdosyasayisi.Text))

taranacakdosyasayisi.Text = taranacakdosyasayisi.Text + 1
Call Command1_Click
Else
Kill App.Path & "\Laboratuvar\*.td"
Label8.Caption = taranacakdosyalar.List(taranacakdosyasayisi.Text) & "(" & virus & "/" & boluneceksayi & ")"

'Frame2.Caption = "Sistem taraması (" & taranacakdosyasayisi.Text & "/" & taranacakdosyalar.ListCount & ")"
taranacakdosyasayisi.Text = taranacakdosyasayisi.Text + 1
Call Command1_Click
End If
End If

Next virus
End Sub

Private Sub Command3_Click()
On Error Resume Next
veriler = ""
virusmu.Text = 0
CommonDialog1.FileName = ""

CommonDialog1.InitDir = App.Path
CommonDialog1.Filter = "*.*"
CommonDialog1.ShowOpen

If FileLen(CommonDialog1.FileName) < 20000 Then
veriler = dosyaoku(CommonDialog1.FileName)
virustarama

If virusmu.Text * seviye.Text > 50 Then
Label2.Caption = "Şüpheli dosya tespit edildi!"
Kill App.Path & "/Laboratuvar/*.td"
Command4.Enabled = True
veriler.Text = ""
virusmu.Text = "0"
Else

Label2.Caption = "Dosya temiz.."
Kill App.Path & "/Laboratuvar/*.td"
veriler.Text = ""
virusmu.Text = "0"
End If

Else

bol
End If
End Sub


Sub runayarla()
On Error Resume Next


For runsayisi = 0 To virusludosyaisimleri.ListCount - 1

For virusludosyarunid = 0 To runyollariisimleri.ListCount - 1
If virusludosyaisimleri.List(runsayisi) = runyollariisimleri.List(virusludosyarunid) Then
silinecekrunidleri.AddItem runanahtarlari.List(virusludosyarunid)
End If
Next virusludosyarunid

Next runsayisi

End Sub

Private Sub Command4_Click()
On Error Resume Next
Shell "taskkill /f /im " & Filenm(CommonDialog1.FileName), vbHide
wait 100
Kill CommonDialog1.FileName
Command4.Enabled = False
Label2.Caption = "Dosyanızı seçin"
End Sub


Sub bilgisayarsorunlari()
On Error Resume Next
Dim reg
Set reg = CreateObject("WScript.Shell")
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr", 0, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 0, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\WindowsNT\CurrentVersion\SystemRestore\DisableSR", 0, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Memory Management\DisablePagingExecutive", 1, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\StartMenuInit", 2, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\StartButtonBalloonTip", 2, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\NtfsDisableLastAccessUpdate", 1, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\NtfsMftZoneReservation", 2, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRemoteRecursiveEvents", 1, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\NoNetCrawling", 1, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoSaveSettings", 0, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\stisvc\Start", 4, "REG_DWORD"
reg.RegDelete "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\WinampAgent"
reg.RegDelete "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\AnyDVD"
reg.RegDelete "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\QuickTime Task"
reg.RegDelete "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\NeroFilterCheck"
reg.RegWrite "HKEY_CURRENT_USER\Control Panel\Accessibility\StickyKeys\Flags", 506, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\ServiceProvider\DnsPriority", 1, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\ServiceProvider\HostsPriority", 1, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\ServiceProvider\LocalPriority", 1, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Tcpip\ServiceProvider\NetbtPriority", 1, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\MaxConnectionsPerServer", 40, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\HungAppTimeout", 5000, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\WaitToKillAppTimeout", 4000, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\AutoEndTasks", 1, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Control Panel\Desktop\MenuShowDelay", 2, "REG_DWORD"
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Desktop\CleanupWiz\NoRun", 1, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\W32Time\Start", 4, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Messenger\Start", 4, "REG_DWORD"
reg.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\WaitToKillServiceTimeout", 3000, "REG_DWORD"


Dim cmdkomutu As String
cmdkomutu = "ipconfig/renew"
Shell "cmd /c " & cmdkomutu, vbHide

Shell "cmd.exe /c net start " & Chr(34) & "Security Center" & Chr(34), vbHide
Shell "netsh advfirewall set currentprofile state on", 0
Shell "netsh advfirewall set privateprofile state on", 0
End Sub


Private Sub Command5_Click()
On Error Resume Next
Dim silmek
runayarla
wait 500

For silmek = 0 To virusludosyalar.ListCount - 1

Shell "taskkill /f /im " & virusludosyaisimleri.List("0"), vbHide

virusludosyaisimleri.RemoveItem ("0")
wait 100
CreateObject("wscript.shell").RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & silinecekrunidleri.List("0")
CreateObject("wscript.shell").RegDelete "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & silinecekrunidleri.List("0")
silinecekrunidleri.RemoveItem ("0")
wait 100
Kill virusludosyalar.List("0")
virusludosyalar.RemoveItem ("0")
If virusludosyalar.ListCount = 0 Then
If MsgBox("İşlem tamamlandı, değişikliklerin etkili olabilmesi için reset atmanızı öneriririz. Reset atalım mı?", vbQuestion Or vbYesNo, "TD Antivirus") = vbYes Then
Shell "cmd /c shutdown /r", vbHide
Else
End If
End If
Next silmek
bilgisayarsorunlari
End Sub

Private Sub Command6_Click()

End Sub

Private Sub Command7_Click()
On Error Resume Next
If Command7.Caption = "Başlat" Then
Shell "regedit /e c:\eski.reg", vbHide
wait 100
Label7.Caption = "Dinleniyor, işleminizi yapın"
Command7.Caption = "Bitir"

ElseIf Command7.Caption = "Bitir" Then
Shell "regedit /e c:\yeni.reg", vbHide
wait 100
Label7.Caption = "İşlem tamamlandı"
Command7.Caption = "Değişiklikleri göster"

ElseIf Command7.Caption = "Değişiklikleri göster" Then
Command7.Caption = "Başlat"
Label7.Caption = ""
Shell "cmd /c fc /u c:\eski.reg c:\yeni.reg > C:\test.txt", vbHide
MsgBox "Değişiklikler 'C:\test.txt' yoluna kaydedildi", vbOKOnly, "TD Antivirus"

ShellExecute 0, vbNullString, "C:\test.txt", vbNullString, vbNullString, vbNormalFocus
'Kill "c:\*.reg"
End If
''Shell "regedit /e c:\yeni.reg"
''Shell "cmd /c fc /u c:\eski.reg c:\yeni.reg > C:\test.txt"

End Sub

Private Sub Command8_Click()

End Sub

Private Sub Command9_Click()
On Error Resume Next
For X = 0 To guvenliexeler.ListCount - 1
If UCase(Trim(guvenliexeler.List(X))) = UCase(Trim(Text1.Text)) Then
MsgBox "Zaten ekli"
Exit Sub
End If
Next

guvenliexeler.AddItem Text1.Text


Open App.Path & "\guvenli.td" For Output As #1
For i = 0 To guvenliexeler.ListCount - 1
Print #1, guvenliexeler.List(i)
Next
Close #1
End Sub



Sub minimize_to_tray()

On Error Resume Next
Me.Hide
nID.cbSize = Len(nID)
nID.hWnd = Me.hWnd
nID.uId = vbNull
nID.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nID.uCallBackMessage = WM_MOUSEMOVE
nID.hIcon = Me.Icon ' the icon will be your Form1 project icon
nID.szTip = "SanalTV'yi göster" & vbNullChar
Shell_NotifyIcon NIM_ADD, nID
End Sub




Sub taranacakdosyalariyukle()
On Error Resume Next
Dim getwindir, sistemsurucusu, dosya, dosya2
Dim Temp As String * 256
Dim X As Integer
X = GetWindowsDirectory(Temp, Len(Temp))
getwindir = Left$(Temp, X)
sistemsurucusu = Left$(getwindir, 3)
Label8.Caption = sistemsurucusu

'File1.Pattern = "*.exe"
File1.Pattern = "*.exe;*.bat;*.com;*.scr;*.dll"

File1.Path = sistemsurucusu & "Windows\"
DoEvents
For dosya = 0 To File1.ListCount - 1
taranacakdosyalar.AddItem sistemsurucusu & "Windows\" & File1.List(dosya)
Next dosya
'File1.Path = sistemsurucusu & "Windows\system32\"
DoEvents
For dosya = 0 To File1.ListCount - 1
'taranacakdosyalar.AddItem sistemsurucusu & "Windows\system32\" & File1.List(dosya)
Next dosya
File1.Path = sistemsurucusu & "Windows\system\"
DoEvents
For dosya = 0 To File1.ListCount - 1
taranacakdosyalar.AddItem sistemsurucusu & "Windows\system\" & File1.List(dosya)
Next dosya
File1.Path = sistemsurucusu & "Windows\Temp\"
DoEvents
For dosya = 0 To File1.ListCount - 1
taranacakdosyalar.AddItem sistemsurucusu & "Windows\Temp\" & File1.List(dosya)
Next dosya
File1.Path = sistemsurucusu
DoEvents
For dosya = 0 To File1.ListCount - 1
taranacakdosyalar.AddItem sistemsurucusu & File1.List(dosya)
Next dosya
End Sub

Private Sub explorer_Timer()
Dim reg
Set reg = CreateObject("WScript.Shell")
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState\FullPath", 1, "REG_DWORD"
reg.RegWrite "HKEY_CLASSES_ROOT\exefile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\batfile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\regfile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\cmdfile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\3xefile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"

reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Güvenlik seviye", "3", "REG_SZ"
seviye.Text = "3"
'""
explorercalistir ("explorer.exe")

End Sub

Private Sub Form_Load()
On Error Resume Next
 
If App.PrevInstance = True Then
End
End If



'visiblefalse
'ayarlarframesi.Visible = True

If Year(Now) & Month(Now) & Day(Now) > "2012428" Then
MsgBox "Hosting süremiz bitti, güncelleme yapamayacağız" & Chr(13) & "Elle güncelleme için sitemizi ziyaret edin", , "TD Software [tdsoftware.tr.cx]"
End If

regkontrol = degeroku("HKEY_CURRENT_USER\Software\TD Antivirus\Aktif Koruma")
If regkontrol = "" Then
Dim reg
Set reg = CreateObject("WScript.Shell")
reg.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState\FullPath", 1, "REG_DWORD"
reg.RegWrite "HKEY_CLASSES_ROOT\exefile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\batfile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\regfile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\cmdfile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CLASSES_ROOT\3xefile\shell\TD Antivirus\command\", App.Path & "\" & App.EXEName & ".exe yol" & Chr(34) & "%V" & Chr(34), "REG_SZ"
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Aktif Koruma", "0", "REG_SZ"

Shell "taskkill /f /im explorer.exe", vbHide

explorer.Enabled = True
Else

acilistabasla = degeroku("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\TD Antivirus")
If acilistabasla <> "" Then
Check2.Value = 1
Else
Check2.Value = 0
End If
Check1.Value = degeroku("HKEY_CURRENT_USER\Software\TD Antivirus\Aktif Koruma")
Check3.Value = degeroku("HKEY_CURRENT_USER\Software\TD Antivirus\Sezgisel Tarama")
Check4.Value = degeroku("HKEY_CURRENT_USER\Software\TD Antivirus\imza Tarama")
seviye.Text = degeroku("HKEY_CURRENT_USER\Software\TD Antivirus\Güvenlik seviye")

Open App.Path & "\guvenli.td" For Input Access Read Shared As #1
Do Until EOF(1)
Line Input #1, layn
If layn <> "" Then
guvenliexeler.AddItem layn
End If
Loop
Close #1
End If

'YukarıdaTut Me, True

a = "d"
b = "a"
c = "l"
d = "m"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "/Veritabani.td;Persist Security Info=True;Jet OLEDB:Database Password=" & a & b & c & c & b & d & b


Dim getwindir, sistemsurucusu, dosya, dosya2
Dim Temp As String * 256
Dim X As Integer
X = GetWindowsDirectory(Temp, Len(Temp))
getwindir = Left$(Temp, X)
sistemsurucusu = Left$(getwindir, 3)
Label8.Caption = sistemsurucusu


Dim i
For i = 1 To 5
seviye.AddItem i
Next i


'HKEY_CLASSES_ROOT\exefile\shell\TD Antivirus

'Explorer yenileme gerekiyor

Dim RegArray() As String
Dim intLoop As Integer
    
RegArray = EnumKeyValues(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run")
'MsgBox RegArray(0)
If (RegArray(0) <> "Nothing") Then
    For intLoop = 0 To UBound(RegArray)
        runanahtarlari.AddItem RegArray(intLoop)
    Next intLoop
End If

For i = 0 To runanahtarlari.ListCount - 1
runyolu = degeroku("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & runanahtarlari.List(i))
runyolu = Replace(runyolu, Chr(34), "")
runyolu = Replace(runyolu, " /a", "")
runyolu = Replace(runyolu, " /min", "")
runyolu = Replace(runyolu, " /starttray", "")
runyolu = Replace(runyolu, " /noshow", "")
runyolu = Replace(runyolu, " /startup", "")
runyolu = Replace(runyolu, " -s", "")
runyollari.AddItem runyolu '
Next i
For i53 = 0 To runanahtarlari.ListCount - 1
runyollariisimleri.AddItem Filenm(runyollari.List(i53))
Next i53


Dim RegArray2() As String
Dim intLoop2 As Integer

RegArray2 = EnumKeyValues(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run")
If (RegArray2(0) <> "Nothing") Then
    For intLoop2 = 0 To UBound(RegArray2)
        runanahtarlari.AddItem RegArray2(intLoop2)
    run2 = run2 + 1
    Next intLoop2
End If

runbasla = runanahtarlari.ListCount - Val(run2)
For i2 = runbasla To runbasla + run2 - 1
runyolu2 = degeroku("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & runanahtarlari.List(i2))
runyolu2 = Replace(runyolu2, Chr(34), "")
runyolu2 = Replace(runyolu2, " /a", "")
runyolu2 = Replace(runyolu2, " /min", "")
runyolu2 = Replace(runyolu2, " /starttray", "")
runyolu2 = Replace(runyolu2, " /noshow", "")
runyolu2 = Replace(runyolu2, " /startup", "")
runyolu2 = Replace(runyolu2, " -s", "")
runyolu2 = Replace(runyolu2, " /background", "")
runyollari.AddItem runyolu2 '
Next i2

For i532 = runbasla To runbasla + run2 - 1
runyollariisimleri.AddItem Filenm(runyollari.List(i532))
Next i532



Dim dosyayolu As String
dosyayolu = Command$

If Left(dosyayolu, 3) = "yol" Then

visiblefalse
dosyataramasiframe.Visible = True
Command4.Enabled = False
Option6.Value = True
dysayisi = Len(dosyayolu) - 3
dosyayolu = Right(dosyayolu, dysayisi)
dosyayolu = Replace(dosyayolu, Chr(34), "")
CommonDialog1.FileName = dosyayolu
wait 50
veriler = ""
virusmu.Text = 0



If FileLen(CommonDialog1.FileName) < 20000 Then

veriler = dosyaoku(CommonDialog1.FileName)

virustarama

If virusmu.Text * seviye.Text > 50 Then
Label2.Caption = "Şüpheli dosya tespit edildi!"
Kill App.Path & "/Laboratuvar/*.td"
Command4.Enabled = True
veriler.Text = ""
virusmu.Text = "0"
Else
Label2.Caption = "Dosya temiz.."
Kill App.Path & "/Laboratuvar/*.td"
veriler.Text = ""
virusmu.Text = "0"
End If
Else
Form1.Show
wait 10
CommonDialog1.FileName = dosyayolu
bol
End If
Else
visiblefalse
ayarlarframesi.Visible = True
End If

Inet1.Cancel
wait 1
databaselink.Text = Inet1.OpenURL("http://maratonakademisi.com/dosyalar/TDAntivirus/veritabanilink.txt")
dataguncelleme.Text = Inet1.OpenURL("http://maratonakademisi.com/dosyalar/TDAntivirus/veritabanitarihi.txt")
  
databasever.Text = degeroku("HKEY_CURRENT_USER\Software\TD Antivirus\Veritabanı ver")
If databasever.Text = "" Then
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Veritabanı ver", "20111024", "REG_SZ"
End If


End Sub

Private Function Filenm(strx As String) As String
On Error Resume Next
Dim sps As Integer
For sps = Len(strx) To 1 Step -1
If Mid(strx, sps, 1) = "\" Then
Filenm = Mid$(strx, sps + 1)
Exit For
End If
Next
End Function


Private Function degeroku(Value As String) As String
On Error Resume Next

Dim registry As Object
Dim alinandeger
Set registry = CreateObject("wscript.shell")
alinandeger = registry.RegRead(Value)
degeroku = alinandeger
End Function

Private Sub islemSonlandir(exeismi As String)
On Error Resume Next
Dim islem As Object
For Each islem In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & exeismi & "'")
islem.Terminate
Next
End Sub


Private Sub aktifkoruma_Timer()
On Error Resume Next
Dim baslikuzunluk As Long
Dim baslik As String
Dim suzunluk As Long
Dim ExplorerPencereNo As Long
Dim yolkontrol As String

ExplorerPencereNo = FindWindow("CabinetWClass", vbNullString)

If ExplorerPencereNo Then
EnumChildWindows ExplorerPencereNo, AddressOf EnumChildProc, ByVal 0&
'EditText
baslikuzunluk = GetWindowTextLength(ExplorerPencereNo)
baslik = Space(baslikuzunluk + 1)
suzunluk = GetWindowText(ExplorerPencereNo, baslik, baslikuzunluk + 1)
baslik = Left(baslik, suzunluk)
yolkontrol = InStr(baslik, ":")


If yolkontrol <> "0" And baslik <> "" And baslik <> ensonalinanklasor.Text Then
aktifbasliklar.AddItem baslik
ensonalinanklasor.Text = baslik


If aktifbasliklar.ListCount <> 0 Then
'File2.Pattern = "*.exe"
File2.Pattern = "*.exe;*.bat;*.com;*.scr;*.dll"
File2.Path = aktifbasliklar.List("0")
DoEvents
For dosya = 0 To File2.ListCount - 1


If Len(ensonalinanklasor.Text) = 3 Then

aktiftaranacakdosyalar.AddItem ensonalinanklasor.Text & File2.List(dosya)

Else

aktiftaranacakdosyalar.AddItem ensonalinanklasor.Text & "\" & File2.List(dosya)

End If


Next dosya
aktifbasliklar.RemoveItem "0"
End If
End If
End If


If aktiftaranacakdosyalar.ListCount <> 0 Then

If FileLen(aktiftaranacakdosyalar.List("0")) < 20000 Then
veriler = dosyaoku(aktiftaranacakdosyalar.List("0"))
virustarama

If virusmu.Text * seviye.Text > 50 Then

For X = 0 To guvenliexeler.ListCount - 1
If UCase(Trim(guvenliexeler.List(X))) = UCase(Trim(aktiftaranacakdosyalar.List("0"))) Then
Kill App.Path & "/Laboratuvar/*.td"
aktiftaranacakdosyalar.RemoveItem "0"
Exit Sub
End If
Next

aktifkoruma.Enabled = False
Form2.Label2.Caption = aktiftaranacakdosyalar.List("0")
Form2.Show
Kill App.Path & "/Laboratuvar/*.td"
aktiftaranacakdosyalar.RemoveItem "0"
veriler.Text = ""
virusmu.Text = "0"

Else
'Label2.Caption = "Dosya temiz.."
aktiftaranacakdosyalar.RemoveItem "0"
Kill App.Path & "/Laboratuvar/*.td"
veriler.Text = ""
virusmu.Text = "0"
End If

Else
aktifbol
End If

End If

End Sub



Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
Dim secim
secim = MsgBox("Çıkmak istediğinizden emin misiniz?", 36, "TD Antivirus")
If secim = 6 Then
Shell "taskkill /f /im tdantikoruma.exe /im tdantivirus.exe", vbHide
End If
Cancel = -1
End Sub

Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon NIM_DELETE, nID ' del tray icon
End Sub


Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next

Dim Msg As Long
Dim sFilter As String
Msg = X / Screen.TwipsPerPixelX
Select Case Msg
Case WM_LBUTTONDOWN
Me.Show
Shell_NotifyIcon NIM_DELETE, nID
Case WM_LBUTTONUP
Case WM_LBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
Me.Show
Shell_NotifyIcon NIM_DELETE, nID
Case WM_RBUTTONDBLCLK
End Select
End Sub

Private Sub guncellemekontrol_Timer()
On Error Resume Next


If IsNumeric(dataguncelleme.Text) And databasever.Text < dataguncelleme.Text Then
Dim intResponse As Integer
intResponse = MsgBox("Yeni güncelleme bulundu, yükleyelimmi ?", vbYesNo + vbQuestion, "Veritabanı güncelleme")
If intResponse = vbYes Then
wait 100
Downloader1.BeginDownload databaselink.Text, App.Path & "\Veritabani.td"
End If
End If

guncellemekontrol.Enabled = False
End Sub

Private Sub guvenliexeler_Click()
On Error Resume Next
Dim X1 As Long
Dim Y1 As Long
Dim j1 As Long
j1 = 0
For X1 = 0 To guvenliexeler.ListCount - 1
If guvenliexeler.Selected(X1) = True Then
guvenliexeler.RemoveItem (X1)
Else
End If
Next
End Sub

Private Sub Downloader1_DownloadComplete(MaxBytes As Long, SaveFile As String)
On Error Resume Next
MsgBox "Veritabanı güncellendi :)"
Dim reg
Set reg = CreateObject("WScript.Shell")
reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Veritabanı ver", dataguncelleme.Text, "REG_SZ"

ShellExecute 0, vbNullString, "http://tdsoftware.tr.cx", vbNullString, vbNullString, vbNormalFocus

End Sub
Private Sub koruma_Timer()
On Error Resume Next
Calisiyormu ("TDAntiKoruma.exe")
End Sub


Sub aktifbol()
On Error Resume Next

'Label2.Caption = "Dosya hazırlanıyor"

Dim s As String, T As Long, Parcaismi As String
Dim Cont As Integer, XOut As Long, Rest As Long
Dim dosyaboyutu, boluneceksayi, virus
dosyaboyutu = FileLen(aktiftaranacakdosyalar.List("0"))
boluneceksayi = dosyaboyutu \ 20000

'Label2.Caption = CommonDialog1.FileName & " dosyası taranıyor (0/" & boluneceksayi & ")"

Open aktiftaranacakdosyalar.List("0") For Binary As #1
T = Int(LOF(1) / Val(boluneceksayi))
Rest = LOF(1) Mod Val(boluneceksayi)
Cont = 0
Do While Cont < Val(boluneceksayi)
Parcaismi = App.Path & "\Laboratuvar\Dosya" & Trim(Str(Cont + 1))
If Mid(aktiftaranacakdosyalar.List("0"), InStrRev(aktiftaranacakdosyalar.List("0"), ".")) > 0 Then Parcaismi = Parcaismi & ".td"
Open Parcaismi For Binary As #2
If Cont < Val(boluneceksayi) - 1 Then
XOut = T
Else
XOut = T + Rest
End If
Do While XOut > 0
If XOut > 6400000 Then
s = Space(6400000)
XOut = XOut - 6400000
Else
s = Space(XOut)
XOut = 0
End If
Get #1, , s
Put #2, , s
DoEvents
Loop
Close #2
Cont = Cont + 1
Loop
Close #1



For virus = 0 To boluneceksayi

'Label2.Caption = CommonDialog1.FileName & " dosyası taranıyor (" & virus & "/" & boluneceksayi & ")"
veriler = dosyaoku(App.Path & "/Laboratuvar/Dosya" & virus & ".td")
virustarama

If virus = boluneceksayi Then
If virusmu.Text * seviye.Text > 50 Then

For X = 0 To guvenliexeler.ListCount - 1
If UCase(Trim(guvenliexeler.List(X))) = UCase(Trim(aktiftaranacakdosyalar.List("0"))) Then
Kill App.Path & "/Laboratuvar/*.td"
aktiftaranacakdosyalar.RemoveItem "0"
Exit Sub
End If
Next


aktifkoruma.Enabled = False
Form2.Label2.Caption = aktiftaranacakdosyalar.List("0")
Form2.Show

Kill App.Path & "/Laboratuvar/*.td"
aktiftaranacakdosyalar.RemoveItem "0"
veriler.Text = ""
virusmu.Text = "0"
Else
Kill App.Path & "/Laboratuvar/*.td"
aktiftaranacakdosyalar.RemoveItem "0"
veriler.Text = ""
virusmu.Text = "0"
End If
End If

Next virus
End Sub

Sub bol()

On Error Resume Next
Label2.Caption = "Dosya hazırlanıyor"
wait 50
Dim s As String, T As Long, Parcaismi As String
Dim Cont As Integer, XOut As Long, Rest As Long
Dim dosyaboyutu, boluneceksayi, virus
dosyaboyutu = FileLen(CommonDialog1.FileName)
boluneceksayi = dosyaboyutu \ 20000

Label2.Caption = CommonDialog1.FileName & " dosyası taranıyor (0/" & boluneceksayi & ")"

Open CommonDialog1.FileName For Binary As #1
T = Int(LOF(1) / Val(boluneceksayi))
Rest = LOF(1) Mod Val(boluneceksayi)
Cont = 0
Do While Cont < Val(boluneceksayi)
Parcaismi = App.Path & "\Laboratuvar\Dosya" & Trim(Str(Cont + 1))
If Mid(CommonDialog1.FileName, InStrRev(CommonDialog1.FileName, ".")) > 0 Then Parcaismi = Parcaismi & ".td"
Open Parcaismi For Binary As #2
If Cont < Val(boluneceksayi) - 1 Then
XOut = T
Else
XOut = T + Rest
End If
Do While XOut > 0
If XOut > 6400000 Then
s = Space(6400000)
XOut = XOut - 6400000
Else
s = Space(XOut)
XOut = 0
End If
Get #1, , s
Put #2, , s
DoEvents
Loop
Close #2
Cont = Cont + 1
Loop
Close #1



For virus = 0 To boluneceksayi

Label2.Caption = CommonDialog1.FileName & " dosyası taranıyor (" & virus & "/" & boluneceksayi & ")"
veriler = dosyaoku(App.Path & "/Laboratuvar/Dosya" & virus & ".td")
virustarama

If virus = boluneceksayi Then
If virusmu.Text * seviye.Text > 50 Then
Label2.Caption = "Şüpheli dosya tespit edildi!"
Kill App.Path & "/Laboratuvar/*.td"
Command4.Enabled = True
veriler.Text = ""
virusmu.Text = "0"
Else
Label2.Caption = "Dosya temiz.."
Kill App.Path & "/Laboratuvar/*.td"
veriler.Text = ""
virusmu.Text = "0"
End If
End If

Next virus
End Sub

Private Sub Label4_Click()
ShellExecute 0, vbNullString, "http://tdsoftware.tr.cx", vbNullString, vbNullString, vbNormalFocus

End Sub

Private Sub Label5_Click()
ShellExecute 0, vbNullString, "http://tahribat.com", vbNullString, vbNullString, vbNormalFocus

End Sub

Private Sub Option1_Click()
visiblefalse
ayarlarframesi.Visible = True
End Sub

Private Sub Option2_Click()
On Error Resume Next
taranacakdosyalariyukle
visiblefalse
sistemtaramasiframe.Visible = True
End Sub


Private Sub Option4_Click()
visiblefalse
kayitdefteriframe.Visible = True
End Sub

Private Sub Option5_Click()
visiblefalse
hakkindaframe.Visible = True
End Sub

Sub visiblefalse()
guvenlilisteframe.Visible = False
ayarlarframesi.Visible = False
sistemtaramasiframe.Visible = False
dosyataramasiframe.Visible = False
kayitdefteriframe.Visible = False
hakkindaframe.Visible = False
End Sub

Private Sub Option6_Click()
If Check1.Value <> 1 Then
visiblefalse
dosyataramasiframe.Visible = True
Else
MsgBox "Aktif korumayı devre dışı bırakın"
End If
End Sub

Private Sub Option7_Click()
minimize_to_tray
End Sub

Private Sub Option8_Click()
visiblefalse
guvenlilisteframe.Visible = True
End Sub

Private Sub seviye_Change()
On Error Resume Next
Dim reg
Set reg = CreateObject("WScript.Shell")

reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Güvenlik seviye", seviye.Text, "REG_SZ"

End Sub

Private Sub seviye_Click()
On Error Resume Next
Dim reg
Set reg = CreateObject("WScript.Shell")

reg.RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Güvenlik seviye", seviye.Text, "REG_SZ"

End Sub

Virus yakalandi ekrani:

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1         '  play asynchronously

Dim viruscanavari

Sub canavarlarvisible()
Image1.Visible = False
Image2.Visible = False
Image3.Visible = False
Image4.Visible = False
Image5.Visible = False
Image6.Visible = False
Image7.Visible = False
Image8.Visible = False
Image9.Visible = False
End Sub



Private Sub Command1_Click()
Form1.aktifkoruma.Enabled = True
Shell "taskkill /f /im " & Filenm(Label2.Caption), vbHide
wait 100
Kill Label2.Caption
YukarıdaTut Form1, True
Unload Me
End Sub

Private Function Filenm(strx As String) As String
On Error Resume Next
Dim sps As Integer
For sps = Len(strx) To 1 Step -1
If Mid(strx, sps, 1) = "\" Then
Filenm = Mid$(strx, sps + 1)
Exit For
End If
Next
End Function

Private Sub Command2_Click()
Form1.guvenliexeler.AddItem Label2.Caption
Form1.aktifkoruma.Enabled = True
Open App.Path & "\guvenli.td" For Output As #1
For i = 0 To Form1.guvenliexeler.ListCount - 1
Print #1, Form1.guvenliexeler.List(i)
Next
Close #1
Form1.Show

YukarıdaTut Form1, True
Unload Me
End Sub

Private Sub Command3_Click()
Form1.aktifkoruma.Enabled = True
Form1.Show
Unload Me
End Sub

Private Sub Form_Load()
Call sndPlaySound(App.Path & "\Virus.wav", SND_ASYNC)
YukarıdaTut Me, True

End Sub

Private Sub Timer1_Timer()
Image10.Visible = False

If viruscanavari = 1 Then
canavarlarvisible
Image1.Visible = True
ElseIf viruscanavari = 2 Then
canavarlarvisible
Image2.Visible = True
ElseIf viruscanavari = 3 Then
canavarlarvisible
Image3.Visible = True
ElseIf viruscanavari = 4 Then
canavarlarvisible
Image4.Visible = True
ElseIf viruscanavari = 5 Then
canavarlarvisible
Image5.Visible = True
ElseIf viruscanavari = 6 Then
canavarlarvisible
Image6.Visible = True
ElseIf viruscanavari = 7 Then
canavarlarvisible
Image7.Visible = True
ElseIf viruscanavari = 8 Then
canavarlarvisible
Image8.Visible = True
ElseIf viruscanavari = 9 Then
canavarlarvisible
Image9.Visible = True
ElseIf viruscanavari = 10 Then
canavarlarvisible
Image10.Visible = True
End If

viruscanavari = viruscanavari + 1
If viruscanavari = 10 Then
viruscanavari = 1
End If
End Sub

Modül1:

Option Explicit
Private Const WM_GETTEXT = &HD&
Private Const WM_GETTEXTLENGTH = &HE&
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public EditText As String
Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32.dll" Alias _
"GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Sub wait(ByVal dblMilliseconds As Double)
    Dim dblStart As Double
    Dim dblEnd As Double
    Dim dblTickCount As Double
    dblTickCount = GetTickCount()
    dblStart = GetTickCount()
    dblEnd = GetTickCount + dblMilliseconds
    Do
    DoEvents
    dblTickCount = GetTickCount()
    Loop Until dblTickCount > dblEnd Or dblTickCount < dblStart
End Sub

Public Function EnumChildProc(ByVal hWnd As Long, _
ByVal lParam As Long) As Long
Dim Classismi As String
Dim Classuzunluk As Long
 
Classismi = Space$(256)
Classuzunluk = GetClassName(hWnd, Classismi, 256&)
Classismi = Left$(Classismi, Classuzunluk)
 
If Classismi = "Edit" Then
EditText = BaslikAl(hWnd)
EnumChildProc = 0
Else
EnumChildProc = 1
End If
End Function

Private Function BaslikAl(hWnd As Long) As String
Dim lRetVal As Long
lRetVal = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0&)
BaslikAl = String$(lRetVal + 1, vbNullChar)
lRetVal = SendMessage(hWnd, WM_GETTEXT, ByVal Len(BaslikAl), ByVal BaslikAl)
BaslikAl = Left$(BaslikAl, lRetVal)
End Function

Modül2:

Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
uCallBackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_LBUTTONDBLCLK = &H203 'Double-click
Public Const WM_LBUTTONDOWN = &H201 'Button down
Public Const WM_LBUTTONUP = &H202 'Button up
Public Const WM_RBUTTONDBLCLK = &H206 'Double-click
Public Const WM_RBUTTONDOWN = &H204 'Button down
Public Const WM_RBUTTONUP = &H205 'Button up

Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
Const SWP_NOMOVE As Long = &H2
Const SWP_NOSIZE As Long = &H1
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2

Public Sub YukarıdaTut(TheForm As Form, SetOnTop As Boolean)
    Dim lFlag
    If SetOnTop Then
        lFlag = HWND_TOPMOST
    Else
        lFlag = HWND_NOTOPMOST
    End If
    SetWindowPos TheForm.hWnd, lFlag, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub

Projesi

http://www.multiupload.com/31WTQ4XCN7

Alıntı yap

18/Kas/11 16:53

Kısayol

Şikayet

Özel Mesaj

SARI

Banlanmış Üye

Kayıt Tarihi: 29/Eylül/2009

Hacı sen ne yaptın ya ... Ellerine sağlık biraz araştıralım :D

Ban Sebebi : Molrada Haarket Eiğtti için Bdnlaanı... Türkçe öğretmenliği okuyan arkadaşım sana ders verebilir admin arkadaş :)

Alıntı yap

18/Kas/11 16:56

Kısayol

Şikayet

Özel Mesaj

YekteranBaymedir

Kayıt Tarihi: 10/Temmuz/2009

hacı full kodları vermek yerine az da açıklama yapsaydın güzeldi, misal algoritmayı az anlatsan,

neye göre tarıyor, dosyaların md5lerini bulup virüslerle mi karşılaştırıyo ne yapıo yani

Alıntı yap

18/Kas/11 17:16

Kısayol

Şikayet

Özel Mesaj

DE5TROY3R

Kayıt Tarihi: 04/Nisan/2007

Daft bunu yazdı:
-----------------------------

hacı full kodları vermek yerine az da açıklama yapsaydın güzeldi, misal algoritmayı az anlatsan,

neye göre tarıyor, dosyaların md5lerini bulup virüslerle mi karşılaştırıyo ne yapıo yani

-----------------------------

Veritabanında zararlı dosyaların imzalarının bulunduğu tablo var(turkojan, tdjan, ap0clpyso, pivy) bunlar ekli şua

Sezgisel taramada, zararlı apiler kısmı var, mesela 10 tane zararlı api varsa, zararlı diyor

MD5 taratsam kolay değiştirebilirdi, o yüzden içeriği tarıyor

Setup dosyası

Alıntı yap

18/Kas/11 18:17

Kısayol

Şikayet

Özel Mesaj

fastottoman

Kayıt Tarihi: 30/Kasım/2007

edit..

Alıntı yap

18/Kas/11 20:20

Kısayol

Şikayet

Özel Mesaj

EnableTurk

Kayıt Tarihi: 29/Eylül/2007

If Year(Now) & Month(Now) & Day(Now) > "2012428" Then
MsgBox "Hosting süremiz bitti, güncelleme yapamayacağız" & Chr(13) & "Elle güncelleme için sitemizi ziyaret edin", , "TD Software [tdsoftware.tr.cx]"
End If

Bunu çok sevdim hemşerim :) Benimde kafamda antivirüs vardı ,msne gelince görüşelim bu konuyu.

seni 4 kere döverim yarın 🤙

Alıntı yap

18/Kas/11 20:54

Kısayol

Şikayet

Özel Mesaj

Twitter

Kayıt Tarihi: 13/Ekim/2007

Eyvallah hocam kodları yayınlaman birçok kişinin ufkunu açacaktır...

Emeğine sağlık . Umarım sponsor falanda bulurz sana :)

Tbt Dersimliler Derneği Başkanı :)

Alıntı yap

18/Kas/11 21:09

Kısayol

Şikayet

Özel Mesaj

iLLuMiNaTi

Kayıt Tarihi: 08/Mart/2007

işte ben buna çalışma derim bilader. aynen devam

Alıntı yap

18/Kas/11 22:01

Kısayol

Şikayet

Özel Mesaj

Mastika.
Absolut

Kayıt Tarihi: 04/Ağustos/2011

cidden buyuk emek var harika paylasim tebrik ediyorum ins bi kaliba oturtursun ticarete dokebilirsin :)

Nice babayigitler kirayi kim odeyecek, coluk cocuk ne yiyecek derdinden dolayi dunyayi degistiremiyor.

Alıntı yap

18/Kas/11 22:06

Kısayol

Şikayet

Özel Mesaj

Jilet_Boris

Kayıt Tarihi: 04/Mart/2009

Hocu biz derste 50 satır kod yazarken eriniyoruz sen nettin böyle :D helal olsun ne deyim devam projelerini bekliyorum

Alıntı yap