Win Xp'de Ctrl + Alt + Del tuşları iptal etmek
KOD
____________________________________________________________________________
Private Sub Form_Load()
FileCopy "c:windowssystem32taskmgr.exe", "c:windowsrepairtaskmgr.exe"
Burada Taskmgr dosyasını yedekledik
Timer1.Interval = 10
End Sub
Private Sub Form_Unload(Cancel As Integer)
FileCopy "c:windowsrepairtaskmgr.exe", "c:windowssystem32taskmgr.exe"
End Sub
Private Sub Timer1_Timer()
On Local Error Resume Next
Kill "c:windowssystem32taskmgr.exe"
__________________________________________________________________________
Alıntıdır..
Uzaktan MAC adresi bulmak
KOD
________________________________________________________________________
'Projeye eklenmesi gerekenler:
' 2 adet textbox ve 1 adet buton
Option Explicit
Private Const NO_ERROR = 0
Private Declare Function inet_addr Lib "wsock32.dll" _
(ByVal s As String) As Long
Private Declare Function SendARP Lib "iphlpapi.dll" _
(ByVal DestIP As Long, _
ByVal SrcIP As Long, _
pMacAddr As Long, _
PhyAddrLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)
Private Sub Form_Load()
Text1.Text = "192.168.1.101"
Text2.Text = ""
Command1.Caption = "Get Remote Mac Address"
End Sub
Private Sub Command1_Click()
Dim sRemoteMacAddress As String
If Len(Text1.Text) > 0 Then
If GetRemoteMACAddress(Text1.Text, sRemoteMacAddress) Then
Text2.Text = sRemoteMacAddress
Else
Text2.Text = "(SendARP call failed)"
End If
End If
End Sub
Private Function GetRemoteMACAddress(ByVal sRemoteIP As String, _
sRemoteMacAddress As String) As Boolean
Dim dwRemoteIP As Long
Dim pMacAddr As Long
Dim bpMacAddr() As Byte
Dim PhyAddrLen As Long
Dim cnt As Long
Dim tmp As String
'convert the string IP into
'an unsigned long value containing
'a suitable binary representation
'of the Internet address given
dwRemoteIP = inet_addr(sRemoteIP)
If dwRemoteIP <> 0 Then
'set PhyAddrLen to 6
PhyAddrLen = 6
'retrieve the remote MAC address
If SendARP(dwRemoteIP, 0&, pMacAddr, PhyAddrLen) = NO_ERROR Then
If pMacAddr <> 0 And PhyAddrLen <> 0 Then
'returned value is a long pointer
'to the mac address, so copy data
'to a byte array
ReDim bpMacAddr(0 To PhyAddrLen - 1)
CopyMemory bpMacAddr(0), pMacAddr, ByVal PhyAddrLen
'loop through array to build string
For cnt = 0 To PhyAddrLen - 1
If bpMacAddr(cnt) = 0 Then
tmp = tmp & "00-"
Else
tmp = tmp & Hex$(bpMacAddr(cnt)) & "-"
End If
Next
'remove the trailing dash
'added above and return True
If Len(tmp) > 0 Then
sRemoteMacAddress = Left$(tmp, Len(tmp) - 1)
GetRemoteMACAddress = True
End If
Exit Function
Else
GetRemoteMACAddress = False
End If
Else
GetRemoteMACAddress = False
End If 'SendARP
Else
GetRemoteMACAddress = False
End If 'dwRemoteIP
End Function
_________________________________________________________________________
Rakamı Yazıya Çevirme
KOD
_________________________________________________________________________
Function Yazıyla$(sayi)
Dim b$(9)
Dim y$(9)
Dim m$(4)
Dim v(15)
Dim c(3)
b$(0) = ""
b$(1) = "Bir"
b$(2) = "İki"
b$(3) = "Üç"
b$(4) = "Dört"
b$(5) = "Beş"
b$(6) = "Altı"
b$(7) = "Yedi"
b$(8) = "Sekiz"
b$(9) = "Dokuz"
y$(0) = ""
y$(1) = "On"
y$(2) = "Yirmi"
y$(3) = "Otuz"
y$(4) = "Kırk"
y$(5) = "Elli"
y$(6) = "Altmış"
y$(7) = "Yetmiş"
y$(8) = "Seksen"
y$(9) = "Doksan"
m$(0) = "Trilyon"
m$(1) = "Milyar"
m$(2) = "Milyon"
m$(3) = "Bin"
m$(4) = ""
a$ = Str(sayi)
If Left$(a$, 1) = "-" Then pozitif = 1 Else pozitif = 0
a$ = Right$(a$, Len(a$) - 1)
For x = 1 To Len(a$)
If (Asc(Mid$(a$, x, 1)) > Asc("9")) Or (Asc(Mid$(a$, x, 1)) < Asc("0")) Then GoTo hata
Next x
If Len(a$) > 15 Then GoTo hata
a$ = String(15 - Len(a$), "0") + a$
For x = 1 To 15
v(x) = Val(Mid$(a$, x, 1))
Next x
s$ = ""
For x = 0 To 4
c(1) = v((x * 3) + 1)
c(2) = v((x * 3) + 2)
c(3) = v((x * 3) + 3)
If c(1) = 0 Then
e$ = ""
ElseIf c(1) = 1 Then
e$ = "Yüz"
Else
e$ = b$(c(1)) + "Yüz"
End If
e$ = e$ + y$(c(2)) + b$(c(3))
If e$ <> "" Then e$ = e$ + m$(x)
If (x = 3) And (e$ = "BirBin") Then e$ = "Bin"
s$ = s$ + e$
Next x
If s$ = "" Then s$ = "Sıfır"
If pozitif = 1 Then s$ = "Eksi" + s$
Yazıyla$ = s$
GoTo tamam
hata: Yazıyla$ = "Hata"
tamam:
End Function
Private Sub Command1_Click()
Text2.Text = Yazıyla(Text1.Text)
End Sub
_________________________________________________________________________
IP Doğrulama
KOD
_________________________________________________________________________
'Projenize 1 adet metin kutusu ve bir adet buton ekleyin
Public Function Valid_IP(IP As String) As Boolean
Dim i As Integer
Dim dot_count As Integer
Dim test_octet As String
Dim byte_check
IP = Trim$(IP)
' make sure the IP long enough before
' continuing
If Len(IP) < 8 Then
Valid_IP = False
'Show Message
MsgBox IP & " is Invalid", , "IP Validator"
Exit Function
End If
i = 1
dot_count = 0
For i = 1 To Len(IP)
If Mid$(IP, i, 1) = "." Then
' increment the dot count and
' clear the test octet variable
dot_count = dot_count + 1
test_octet = ""
If i = Len(IP) Then
' we've ended with a dot
' this is not good
Valid_IP = False
'Show Message
MsgBox IP & " is Invalid", , "IP Validator"
Exit Function
End If
Else
test_octet = test_octet & Mid$(IP, i, 1)
On Error Resume Next
byte_check = CByte(test_octet)
If (Err) Then
' either the value is not numeric
' or exceeds the range of the byte
' data type.
Valid_IP = False
Exit Function
End If
End If
Next i
' so far, so good
' did we get the correct number of dots?
If dot_count <> 3 Then
Valid_IP = False
Exit Function
End If
' we have a valid IP format!
Valid_IP = True
'Show Message
MsgBox IP & " is Valid", , "IP Validator"
End Function
Private Sub Command1_Click()
If Len(Text1) = 0 Then
MsgBox "Please type an IP Address in the textbox.", , "IP Validator"
Else
'Call the Function
Valid_IP Text1
End If
End Sub
_________________________________________________________________________
Alıntıdır..
|
