SaGoPa

[size=24px]Ip numarası görüntüle[/size]
'Aşağıdakileri modüle kopyalayın

Public Const MAX_WSADescription = 256

Public Const MAX_WSASYSStatus = 128

Public Const ERROR_SUCCESS As Long = 0

Public Const WS_VERSION_REQD As Long = &H101

Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&

Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&

Public Const MIN_SOCKETS_REQD As Long = 1

Public Const SOCKET_ERROR As Long = -1

Public Type HOSTENT

hName As Long

hAliases As Long

hAddrType As Integer

hLen As Integer

hAddrList As Long

End Type

Public Type WSADATA

wVersion As Integer

wHighVersion As Integer

szDescription(0 To MAX_WSADescription) As Byte

szSystemStatus(0 To MAX_WSASYSStatus) As Byte

wMaxSockets As Integer

wMaxUDPDG As Integer

dwVendorInfo As Long

End Type

Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long

Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, ByVal dwHostLen As Long) As Long

Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)



Public Function GetIPAddress() As String

Dim sHostName As String * 256

Dim lpHost As Long

Dim HOST As HOSTENT

Dim dwIPAddr As Long

Dim tmpIPAddr() As Byte

Dim i As Integer

Dim sIPAddr As String

If Not SocketsInitialize() Then

GetIPAddress = ""

Exit Function

End If

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPAddress = ""

MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."

SocketsCleanup

Exit Function

End If

sHostName = Trim$(sHostName)

lpHost = gethostbyname(sHostName)

If lpHost = 0 Then

GetIPAddress = ""

MsgBox "Windows Sockets are not responding. " & "Unable to successfully get Host Name."

SocketsCleanup

Exit Function

End If

CopyMemory HOST, lpHost, Len(HOST)

CopyMemory dwIPAddr, HOST.hAddrList, 4

ReDim tmpIPAddr(1 To HOST.hLen)

CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen

For i = 1 To HOST.hLen

sIPAddr = sIPAddr & tmpIPAddr(i) & "."

Next

GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

SocketsCleanup

End Function



Public Function GetIPHostName() As String

Dim sHostName As String * 256

If Not SocketsInitialize() Then

GetIPHostName = ""

Exit Function

End If

If gethostname(sHostName, 256) = SOCKET_ERROR Then

GetIPHostName = ""

MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has occurred. Unable to successfully get Host Name."

SocketsCleanup

Exit Function

End If

GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)

SocketsCleanup

End Function





Public Function HiByte(ByVal wParam As Integer)

HiByte = wParam \ &H100 And &HFF&

End Function



Public Function LoByte(ByVal wParam As Integer)

LoByte = wParam And &HFF&

End Function



Public Sub SocketsCleanup()

If WSACleanup() <> ERROR_SUCCESS Then

MsgBox "Socket error occurred in Cleanup."

End If

End Sub



Public Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA

Dim sLoByte As String

Dim sHiByte As String

If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then

MsgBox "The 32-bit Windows Socket is not responding."

SocketsInitialize = False

Exit Function

End If

If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD) & " supported sockets."

SocketsInitialize = False

Exit Function

End If

If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

"BUNLARI MODÜLE YAZ"
sHiByte = CStr(HiByte(WSAD.wVersion))

sLoByte = CStr(LoByte(WSAD.wVersion))

MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported by 32-bit Windows Sockets."

SocketsInitialize = False

Exit Function

End If

SocketsInitialize = True

End Function
"BUNLARI FORMA YAZ"

Private Sub Form_Load()

MsgBox "IP Host Name: " & GetIPHostName()

MsgBox "IP Address: " & GetIPAddress()

End Sub

__________________
Bu cinayet!...
Günahın en has hali ihanet
Hakkımı ver gideyim adalet
Son kozum olsun zorda sükunet
Kendime sarılır donarım

SaGoPa

[size=24px]Avı filmleri oynatmak[/size]
eclare Function mciSendString Lib ' mmsystem' (ByVal strCommand As String, ByVal strReturn As String, ByVal iReturnLength As Integer, ByVal hCallback As Integer)
Yukarıdaki satırı General - Declarations bölümüne yazdıktan sonra satırı herhangi bir altyordamdan aşağıdaki gibi çağırabilir, nReturn değişkenini okuyarak AVI dosyasının oynatılıp oynatılmadığını anlayabilirsiniz. Dim nReturn as Long
nReturn = mciSendString(' Open deneme.avi type AVIVideo Alias Video' , ' ' ,0,0)
nReturn = mciSendString(' Play Video FullScreen' ,' ' ,0,0)
nReturn = mciSendString(' Close Video' ,' ' ,0,0)


[size=24px]Basit bir resim gösterici......[/size]
rivate Sub Command1_Click()
Image1.Picture = LoadPicture(Text1)

End Sub

Private Sub Form_Load()

End Sub

[size=24px]Basit bir screen saver[/size]

Bir modül aç ve bu kodu pastele
Declare Function ShowCursor Lib "user32" (ByVal fShow As Integer) As Integer
Global maxLines As Integer
Sub endScrnSave()
showmouse
End
End Sub
Sub HideMouse()
While ShowCursor(False) >= 0
Wend
End Sub
Sub main()
BlankForm.Show
End Sub
Sub showmouse()
While ShowCursor(True) < 0
Wend
End Sub

'Formuna bir tane timer ekle interval=100 yap
'Formun özelliklerini border style=none yap
'Formun backcolor'unu siyah yap ve aşağıdaki kodu pastele.
'exe file yaparkende exe yi scr olarak değiştir windows\ system yapıştır.
'hadi kolay gelsin. Batuge'den

Dim lastX, lastY
Dim numlines
Sub form_Keydown(Keycode As Integer, Shift As Integer)
endScrnSave

End Sub
Private Sub Form_Load()
Move 0, 0, Screen.Width, Screen.Height
HideMouse
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsEmpty(lastX) Or IsEmpty(lastY) Then
lastX = X
lastY = Y
End If
If Abs(lastX - X) > 2 Or Abs(lastY - Y) > 2 Then
endScrnSave
End If
lastX = X
lastY = Y
End Sub




Private Sub Timer1_Timer()
Dim CX, CY, Radius, Limit
ScaleMode = 3
CX = ScaleWidth / 2
CY = ScaleHeight / 2
If CX > CY Then Limit = CY Else Limit = CX
For Radius = 0 To Limit
Circle (CX, CY), Radius, RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next Radius

End Sub

__________________
Bu cinayet!...
Günahın en has hali ihanet
Hakkımı ver gideyim adalet
Son kozum olsun zorda sükunet
Kendime sarılır donarım

x-treme

yaw sagopa biz bunları hangi modüle kopyalıycaz???

JackSparrow

aynen hangi modüle kopyalayacaz

SaGoPa

visual basic de kullanıcaksınız arkadşlar

__________________
Bu cinayet!...
Günahın en has hali ihanet
Hakkımı ver gideyim adalet
Son kozum olsun zorda sükunet
Kendime sarılır donarım

d4erth

çok yardımcı oldn abicm bunları kullanacağımız modülü bilmiorm eğer bilgin varsa sölermsn?