Ana ekran: Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" As Long Private Declare Function ShellExecute Lib "shell32. dll" Alias "ShellExecuteA" As Long Dim nID As NOTIFYICONDATA Private Sub Check1_Click On Error Resume Next Dim reg Set reg = CreateObject 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 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 reg2. RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\TD Antivirus" End If End Sub Public Function Calisiyormu As Boolean On Error Resume Next Dim winobje, islem Set winobje = GetObject 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 As Boolean On Error Resume Next Dim winobje, islem Set winobje = GetObject 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 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 sezsonuc = Adodc1. Recordset. Fields tarama1 = TagYakala(veriler, Adodc1. Recordset. Fields("sez1"), Adodc1. Recordset. Fields("sez2")) If tarama1 = sezsonuc Then virusmu. Text = Val + Val 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 imzasonuc = Adodc1. Recordset. Fields tarama2 = TagYakala(veriler, Adodc1. Recordset. Fields("imza1"), Adodc1. Recordset. Fields("imza2")) If tarama2 = imzasonuc Then virusmu. Text = Val + Val End If wait 25 Next i2 End If End Sub Function TagYakala On Local Error Resume Next Dim arrs, arrb arrs = Split arrb = Split(arrs(1), tags) TagYakala = arrb(0) End Function Private Sub Check3_Click On Error Resume Next Dim reg Set reg = CreateObject 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 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 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 getwindir = Left$ 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 < 20000 Then Label8. Caption = taranacakdosyalar. List & " " 'Frame2. Caption = "Sistem taraması " veriler = dosyaoku(taranacakdosyalar. List virustarama If virusmu. Text seviye. Text > 50 Then 'Kill App. Path & "\ . td" Label8. Caption = taranacakdosyalar. List & " " 'Frame2. Caption = "Sistem taraması " virusludosyalar. AddItem taranacakdosyalar. List virusludosyaisimleri. AddItem Filenm(taranacakdosyalar. List taranacakdosyasayisi. Text = taranacakdosyasayisi. Text + 1 Call Command1_Click Else 'Kill App. Path & "\ . td" Label8. Caption = taranacakdosyalar. List & " " 'Frame2. Caption = "Sistem taraması " 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 boluneceksayi = dosyaboyutu \ 20000 Open taranacakdosyalar. List For Binary As #1 T = Int(LOF(1) / Val Rest = LOF(1) Mod Val Cont = 0 Do While Cont < Val Parcaismi = App. Path & "\Laboratuvar\Dosya" & Trim(Str(Cont + 1)) If Mid(taranacakdosyalar. List , InStrRev(taranacakdosyalar. List , ".")) > 0 Then Parcaismi = Parcaismi & ". td" Open Parcaismi For Binary As #2 If Cont < Val - 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 = 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 & " " 'Frame2. Caption = "Sistem taraması " veriler = dosyaoku virustarama If virus = boluneceksayi Then If virusmu. Text seviye. Text > 50 Then Kill App. Path & "\Laboratuvar\ . td" Label8. Caption = taranacakdosyalar. List & " " 'Frame2. Caption = "Sistem taraması " virusludosyalar. AddItem taranacakdosyalar. List virusludosyaisimleri. AddItem Filenm(taranacakdosyalar. List taranacakdosyasayisi. Text = taranacakdosyasayisi. Text + 1 Call Command1_Click Else Kill App. Path & "\Laboratuvar\ . td" Label8. Caption = taranacakdosyalar. List & " " 'Frame2. Caption = "Sistem taraması " 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 = runyollariisimleri. List Then silinecekrunidleri. AddItem runanahtarlari. List 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 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 . RegDelete "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & silinecekrunidleri. List("0") CreateObject . 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 = 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 gster" ElseIf Command7. Caption = "Değişiklikleri gster" 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 = 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 Next Close #1 End Sub Sub minimize_to_tray On Error Resume Next Me. Hide nID. cbSize = Len 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 gster" & 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 getwindir = Left$ 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 Next dosya 'File1. Path = sistemsurucusu & "Windows\system32\" DoEvents For dosya = 0 To File1. ListCount - 1 'taranacakdosyalar. AddItem sistemsurucusu & "Windows\system32\" & File1. List Next dosya File1. Path = sistemsurucusu & "Windows\system\" DoEvents For dosya = 0 To File1. ListCount - 1 taranacakdosyalar. AddItem sistemsurucusu & "Windows\system\" & File1. List Next dosya File1. Path = sistemsurucusu & "Windows\Temp\" DoEvents For dosya = 0 To File1. ListCount - 1 taranacakdosyalar. AddItem sistemsurucusu & "Windows\Temp\" & File1. List Next dosya File1. Path = sistemsurucusu DoEvents For dosya = 0 To File1. ListCount - 1 taranacakdosyalar. AddItem sistemsurucusu & File1. List Next dosya End Sub Private Sub explorer_Timer Dim reg Set reg = CreateObject 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 End Sub Private Sub Form_Load On Error Resume Next If App. PrevInstance = True Then End End If 'visiblefalse 'ayarlarframesi. Visible = True If Year & Month & Day > "2012428" Then MsgBox "Hosting süremiz bitti, güncelleme yapamayacağız" & Chr(13) & "Elle güncelleme için sitemizi ziyaret edin", , "TD Software " End If regkontrol = degeroku If regkontrol = "" Then Dim reg Set reg = CreateObject 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 If acilistabasla <> "" Then Check2. Value = 1 Else Check2. Value = 0 End If Check1. Value = degeroku Check3. Value = degeroku Check4. Value = degeroku seviye. Text = degeroku 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 getwindir = Left$ 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 'MsgBox RegArray(0) If (RegArray(0) <> "Nothing") Then For intLoop = 0 To UBound runanahtarlari. AddItem RegArray Next intLoop End If For i = 0 To runanahtarlari. ListCount - 1 runyolu = degeroku("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & runanahtarlari. List runyolu = Replace(runyolu, Chr(34), "") runyolu = Replace runyolu = Replace runyolu = Replace runyolu = Replace runyolu = Replace runyolu = Replace 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 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 - 3 dosyayolu = Right 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 dataguncelleme. Text = Inet1. OpenURL databasever. Text = degeroku If databasever. Text = "" Then reg. RegWrite "HKEY_CURRENT_USER\Software\TD Antivirus\Veritabanı ver", "20111024", "REG_SZ" End If End Sub Private Function Filenm As String On Error Resume Next Dim sps As Integer For sps = Len 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 As String On Error Resume Next Dim registry As Object Dim alinandeger Set registry = CreateObject alinandeger = registry. RegRead degeroku = alinandeger End Function Private Sub islemSonlandir On Error Resume Next Dim islem As Object For Each islem In GetObject . 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 If ExplorerPencereNo Then EnumChildWindows ExplorerPencereNo, AddressOf EnumChildProc, ByVal 0& 'EditText baslikuzunluk = GetWindowTextLength baslik = Space(baslikuzunluk + 1) suzunluk = GetWindowText(ExplorerPencereNo, baslik, baslikuzunluk + 1) baslik = Left yolkontrol = InStr 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 = 3 Then aktiftaranacakdosyalar. AddItem ensonalinanklasor. Text & File2. List Else aktiftaranacakdosyalar. AddItem ensonalinanklasor. Text & "\" & File2. List 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 = 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 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 Shell_NotifyIcon NIM_DELETE, nID ' del tray icon End Sub Private Sub Form_MouseMove 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 And databasever. Text < dataguncelleme. Text Then Dim intResponse As Integer intResponse = MsgBox 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 On Error Resume Next MsgBox "Veritabanı güncellendi :)" Dim reg Set reg = CreateObject 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 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 Rest = LOF(1) Mod Val Cont = 0 Do While Cont < Val 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 - 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 = 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 " veriler = dosyaoku virustarama If virus = boluneceksayi Then If virusmu. Text seviye. Text > 50 Then For X = 0 To guvenliexeler. ListCount - 1 If UCase(Trim(guvenliexeler. List = 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 Rest = LOF(1) Mod Val Cont = 0 Do While Cont < Val 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 - 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 = 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 " veriler = dosyaoku 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 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 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" 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 As String On Error Resume Next Dim sps As Integer For sps = Len 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 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 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" As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" As Long Public EditText As String Declare Function GetWindowText Lib "user32. dll" Alias _ "GetWindowTextA" As Long Declare Function GetWindowTextLength Lib "user32. dll" Alias _ "GetWindowTextLengthA" As Long Public Declare Function GetTickCount Lib "kernel32" As Long Public Sub wait 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 As Long Dim Classismi As String Dim Classuzunluk As Long Classismi = Space$(256) Classuzunluk = GetClassName(hWnd, Classismi, 256&) Classismi = Left$ If Classismi = "Edit" Then EditText = BaslikAl EnumChildProc = 0 Else EnumChildProc = 1 End If End Function Private Function BaslikAl 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 , ByVal BaslikAl) BaslikAl = Left$ 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" As Boolean Private Declare Function SetWindowPos Lib "user32" 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 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

edit..

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

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

: hacı full kodları vermek yerine az da açıklama yapsaydın güzeldi, misal algoritmayı az anlatsan, neye gre 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ı

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ş :)

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

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.

hacı full kodları vermek yerine az da açıklama yapsaydın güzeldi, misal algoritmayı az anlatsan, neye gre tarıyor, dosyaların md5lerini bulup virüslerle mi karşılaştırıyo ne yapıo yani

If Year & Month & Day > "2012428" Then MsgBox "Hosting süremiz bitti, güncelleme yapamayacağız" & Chr(13) & "Elle güncelleme için sitemizi ziyaret edin", , "TD Software " End If Bunu çok sevdim hemşerim :) Benimde kafamda antivirüs vardı, msne gelince grüşelim bu konuyu. seni 4 kere dverim yarın

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ı :)