ورود

View Full Version : سوال: سوال در مورد جواب دادن به فشرده شدن كليد هاي كيبرد



m2011kh
دوشنبه 03 مرداد 1390, 15:40 عصر
من مي خوام فشرده شدن كليد هاي كيبرد رو تشخيص بدم(حتي در حالت Hide بودن فروم)
دوستمون كفتند با توابع API ميشه اين كارو كرد ولي جه جوري از اين توابع براي اين كار استفاده كنيم.
دوستان لطفا كمك كنيد خيلي واجبه.
Mohammad Mahdi Khalily
__________________________________________________ _____________________________________
:افسرده::افسرده::افسرده::افس ده::افسرده::افسرده::افسرده:: فسرده::افسرده::افسرده::افسر ه::افسرده::افسرده::افسرده::ا سرده::افسرده::افسرده::افسرد ::افسرده::افسرده::افسرده::اف رده::افسرده::افسرده::افسرده: :افسرده::افسرده::افسرده::افس ده::افسرده::افسرده::افسرده:: فسرده::افسرده:

محسن واژدی
سه شنبه 04 مرداد 1390, 08:46 صبح
سلام علیکم
از APIی GetAsyncKeyState همانند نمونه زیر استفاده کنید:

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyA) <> 0 Then
MsgBox "Pressed A"
End If
If GetAsyncKeyState(vbKeyControl) <> 0 And GetAsyncKeyState(vbKeyC) <> 0 Then
MsgBox "Pressed Ctrl+C"
End If
End Sub


موفق باشید

m2011kh
سه شنبه 04 مرداد 1390, 12:45 عصر
خيلي عالي بود دستتون درد نكنه.
راستي يه سوال ديكه بيش اومد كه من مي خوام درايوي كه براي فلش يا هر حافطه ي قابل حملي(فلش يا رم كوشي و غيره...)رو شناسايي كنم و كاري داخلش انجام بدم.
به غير اينكه اون را شناسايي كنم مي خوام مشخصاتشو هم بدست بيارم.
بازم متشكرم.
Mohammad Mahdi Khalily
__________________________________________________ ___________________________

محسن واژدی
سه شنبه 04 مرداد 1390, 16:39 عصر
مي خوام درايوي كه براي فلش يا هر حافطه ي قابل حملي(فلش يا رم كوشي و غيره...)رو شناسايي كنم

برای شناسایی درایو قابل حمل از تابع GetDriveType استفاده کنید:

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Function IsRemovableDrv(lpDrive$) As Boolean
IsRemovableDrv = GetDriveType(lpDrive$) = 2 '2:Removable
End Function




به غير اينكه اون را شناسايي كنم مي خوام مشخصاتشو هم بدست بيارم.

چه مشخصاتی را منظورتون هست؟

m2011kh
سه شنبه 04 مرداد 1390, 20:11 عصر
دستتون درد نكنه.
منطورم از مشخصات مثل اسم و نام اصلي(منطورم اينكه مثلا درايو A: هست يا D:\ و يا ....) كه واجبه
بعد ديكه اندازه و مشخصات دقيق كه واجب نيست.
واقعا دستتون درد نكنه.
اكه ميشد 100 بار اين دكمه تشكر رو ميزدم.
حيف كه نميشه.

محسن واژدی
سه شنبه 04 مرداد 1390, 22:30 عصر
کد زیر نیز نام، عنوان،نوع و سریال درایو مشخص شده را برمیگرداند:

Private Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim Serial As Long, VName As String, FSName As String
'Create buffers
VName = String$(255, Chr$(0))
FSName = String$(255, Chr$(0))
'Get the volume information
GetVolumeInformation "D:\", VName, 255, Serial, 0, 0, FSName, 255
'Strip the extra chr$(0)'s
VName = Left$(VName, InStr(1, VName, Chr$(0)) - 1)
FSName = Left$(FSName, InStr(1, FSName, Chr$(0)) - 1)
MsgBox "The Volume name of D:\ is '" + VName + "', the File system name of D:\ is '" + FSName + "' and the serial number of D:\ is '" + Trim(Str$(Serial)) + "'", vbInformation + vbOKOnly, App.Title
End Sub

این سورس از برنامه API-Guide گرفته شده که میتوانید بسته به نیاز انرا ویرایش و بخش های مختلف را به آن بیافزائید

موفق باشید

m2011kh
چهارشنبه 05 مرداد 1390, 20:55 عصر
اقا دستتون درد نكنه فقط من يه برنامه نوشتم كه بهتره سامشو نگم كه انتي ويروس بهش گير ميده اگه ميشه دوستان كمك كنند كه ديگه گير نده.
اين برنامه اي كه نوشتم رو از اينجا (http://up.iranblog.com/images/24sha7889ynwjhz7lhbv.rar) دانلود كنيد.
آقايون لطفا كمك كنيد خيلي ممنون ميشم.
آقايون مديران سايت هم لطفا بزارن جواب و نتيجه بگيرم بعد اين تايپيك رو حذف كنيد.(جون هر كي دوست داريد حذف نكنيد)

m2011kh
چهارشنبه 05 مرداد 1390, 20:57 عصر
راستي هر كي دانلود كرد اول انتي ويروسشو غير فعال كنه (چون كه گفتم انتي ويروس بهش گير ميده)
راستي اگه دانلود كرديد فايل اجرايي رو (.exe) رو باز نكنيد(حالا اختيار با خودتان است)كد هارو كه ديديد متوجه ميشيد چرا گفتم باز نكنيد.
هر چند انتي ويروس هم نميزاره باز كنيد.

m2011kh
چهارشنبه 05 مرداد 1390, 21:14 عصر
چند تا سوال هم دارم.
1.ميشه از صفحه در حال اجرا عكس گرفت؟
2.ميشه عكس درون PictureBox را در يك فايل با پسوند .gif و امثال اينها ذخيره كرد.

محسن واژدی
چهارشنبه 05 مرداد 1390, 21:43 عصر
راستي هر كي دانلود كرد اول انتي ويروسشو غير فعال كنه (چون كه گفتم انتي ويروس بهش گير ميده)
راستي اگه دانلود كرديد فايل اجرايي رو (.exe) رو باز نكنيد(حالا اختيار با خودتان است)كد هارو كه ديديد متوجه ميشيد چرا گفتم باز نكنيد.
هر چند انتي ويروس هم نميزاره باز كنيد.

سلام علیکم
آنتی ویروس رایانه بنده kis است، قبلا" گرفتار ویروس ناجوری شده بودم بنام "HEUR:Trojan.Win32.Generic"، که kis هم به آن نام تشخیص داد

موفق باشید

m2011kh
چهارشنبه 05 مرداد 1390, 22:09 عصر
منظورتون رو متوجه نشدم.

محسن واژدی
پنج شنبه 06 مرداد 1390, 00:26 صبح
منظورتون رو متوجه نشدم.


میبخشید، کامل توضیح ندادم؛
آنتی ویروس رایانه ام برنامه تان را به عنوان ویروس جنریک شناسایی میکرد البته همانگونه که در پست قبل هم عرض کردم این نام یک ویروس بود که به فایل های اجرایی تزریق میشد، و چون برنامه تان یک key-logger است این نام را بر روی آن گذاشته است


من يه برنامه نوشتم كه بهتره سامشو نگم كه انتي ويروس بهش گير ميده اگه ميشه دوستان كمك كنند كه ديگه گير نده.



چون برنامه تان عمل یک key-logger را انجام میدهد و چون این یک عمل مشابه عملکرد ویروسهاست آنتی ویروس ها بر روی برنامه های مشابه این گیر میدهند، بنده تا کنون برای اینکار تلاش نکرده ام چون برنامه ای مشابه داشتم که آنتی ویروس به محض انجام این گونه عملیاتها آنرا میبست، من هم زیاد پیگیرش نشدم
البته سورس های key-logger در این زمینه زیاد هستند که میتوانید آنها را دانلود و مطالعه کنید و روشهای بکار رفته در آنها را بکار بگیرید



ميشه از صفحه در حال اجرا عكس گرفت؟

کد زیر تصویری را از زمینه رایانه برروی picturebox چاپ میکند
بمنظور استفاده، محتویات کد زیر را در یک ماژول کپی کنید:

Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Dim frmH As Long
Dim magnify As Integer
Private Const HORZRES = 8
Private Const VERTRES = 10
Private Const RDW_ERASE = &H4
Private Const RDW_INVALIDATE = &H1
Private Const SRCCOPY = &HCC0020
Private Const WM_PAINT = &HF
Private Type POINTAPI
X As Long
y As Long
End Type
Dim cp As POINTAPI
Dim dsDC As Long
Dim lpPT As POINTAPI
Dim hr As Long
Dim vr As Long
Dim percent As Double
Dim lengthX As Long
Dim lengthY As Long
Dim offsetX As Long
Dim offsetY As Long
Dim blitAreaX As Long
Dim blitAreaY As Long
Dim ret As Long
Dim dsHWND As Variant

Public Sub ScreenScpture(hdc&)
dsDC = GetDC(0)
hr = GetDeviceCaps(dsDC, HORZRES)
vr = GetDeviceCaps(dsDC, VERTRES)
dsHWND = GetDesktopWindow()
lengthX = Screen.Width
lengthY = Screen.Height
offsetX = 0
offsetY = 0
blitAreaX = Screen.Width
blitAreaY = Screen.Height
ret = StretchBlt(hdc&, 0, 0, blitAreaX, blitAreaY, dsDC, cp.X - offsetX, cp.y - offsetY, lengthX, lengthY, SRCCOPY)
End Sub


نمونه استفاده:

Private Sub Command1_Click()
Me.AutoRedraw = True
ScreenScpture Me.hdc
Me.Refresh
End Sub






ميشه عكس درون PictureBox را در يك فايل با پسوند .gif و امثال اينها ذخيره كرد.

عکس گرفته شده با فرمت bitmap ذخیره میشود اما کامپوننت هایی نیز وجود دارند که تصویر را در فرمت های متفاوت ذخیره میکنند، در گوگل جستجو کنید حتما به نتیجه میرسید

موفق باشید

m2011kh
پنج شنبه 06 مرداد 1390, 08:16 صبح
من براي پيدا كردن پوشه ي ويندوز از اين تاب استفاده كردم:
a = Environ("windir")
هر جا از اين استفاده كرده ام در هر برنامه اي انتي ويروس بهش گير ميده بعضي وقت ها هم يه جورايي كد ها رو پيچيدم تو هم بعد ديگه انتي ويروس گير نداد ولي اين يكي رو هر كاري كردم نشد كه نشد.

m2011kh
پنج شنبه 06 مرداد 1390, 08:33 صبح
راستي يه سوال ديگه هم بود:
جه جوري ميشه فهميد كه رايانه اي كه برنامهي ما بر روي اون كار ميكنه به اينترنت وصل هست يا نه.
تا اينجا از راهنمايي ها خيلي متشكرم.

ramzdar
پنج شنبه 06 مرداد 1390, 10:18 صبح
اینا همه توی فروم هست
فقط کافی بود یه جستجو بکنی. مثلاً خودم این سوال رو یه بار پرسیدم و جواب گرفتم
اینم جواب شما دوست عزیز. فقط یه تایمر و یه تکست باکس بذار رو فرم و توی کد نویسی اینو کپی کن(چیز دیگه ای نذار که قشنگ متوجه بشی چیه)

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (lpdwFlags As Long, lpszConnectionName As Long, dwNameLen As Long, ByVal dwReserved As Long) As Long

Private Sub Timer1_Timer()
lNameLen = 256
lPtr = StrPtr(strConnectionName)
lNameLenPtr = VarPtr(lNameLen)
retval = InternetGetConnectedStateEx(lConnectionFlags, ByVal lPtr, ByVal lNameLen, 0)
If retval = 0 Then Text1 = "Disconnected" Else Text1 = "Connected"
End Sub

موفق باشی

محسن واژدی
پنج شنبه 06 مرداد 1390, 21:53 عصر
من براي پيدا كردن پوشه ي ويندوز از اين تاب استفاده كردم:
a = Environ("windir")
هر جا از اين استفاده كرده ام در هر برنامه اي انتي ويروس بهش گير ميده بعضي وقت ها هم يه جورايي كد ها رو پيچيدم تو هم بعد ديگه انتي ويروس گير نداد ولي اين يكي رو هر كاري كردم نشد كه نشد.


از APIی GetWindowsDirectory هم میتوانید برای گرفتن آدرس فولدر ویندوز استفاده کنید، هرچند که استفاده از environ بسیار ساده تر است (شاید در اینصورت آنتی ویروس نادیده بگیرد):

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Function GetWinDir$()
Dim win_dir$, lRet&
win_dir$ = String(255, Chr(0))
lRet& = GetWindowsDirectory(win_dir$, Len(win_dir$))
GetWinDir$ = Left(win_dir$, lRet&)
End Function


موفق باشید

IranVB
پنج شنبه 06 مرداد 1390, 22:44 عصر
سلام
تابع InetIsOffline هم وضعیت اتصال به اینترنت را بررسی میکند، همچنین بسیار آسانتر است:

Private Declare Function InetIsOffline Lib "url.dll" (ByVal dwFlags As Long) As Long
Private Sub Form_Load()
MsgBox InetIsOffline(0&)
End Sub


اگر مقدار برگشتی صفر باشد به منزله online بودن است

موفق باشید

محسن واژدی
پنج شنبه 06 مرداد 1390, 22:53 عصر
سلام
تابع InetIsOffline هم وضعیت اتصال به اینترنت را بررسی میکند، همچنین بسیار آسانتر است:


Private Declare Function InetIsOffline Lib "url.dll" (ByVal dwFlags As Long) As Long

Private Sub Form_Load()

MsgBox InetIsOffline(0&)

End Sub



اگر مقدار برگشتی صفر باشد به منزله online بودن است

موفق باشید

سلام علیکم
این تابع دارای دقت عمل بسیار پایینی نسبت به
InternetGetConnectedStateEx که جناب ramzdar به آن اشاره نمودند دارد بگونه ای که حتی ممکن است در زمان عدم اتصال به اینترنت هم مقدار online بودن را برگرداند

موفق باشید

m2011kh
جمعه 07 مرداد 1390, 12:24 عصر
آقا از راهنمايي هاي همتون متشكرم.
به همه ي اهدافم رسيدم از دوستان خيلي متشكرم.
انجمن خيلي خوبي هست فقط قانون هاش يه كم سخت گيرانست.

m2011kh
جمعه 07 مرداد 1390, 14:00 عصر
راستي دوستان من ميخوام همه ي پورت هاي CPU رو 1 كنم اگه راهي براي اينكار با VB6 هست بگيد

m2011kh
جمعه 07 مرداد 1390, 18:42 عصر
آقا جون من ميخوام Email بفرستم ولي نميدونم چه جوري.