یه سری آموزش های فوق العاده جالب برای دوستان عزیز

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونه می توان درایو های سی دی را توسط vb تشخیص داد :
[TABLE]
[TR]
[TD="class: gutter"]1
2
[/TD]
[TD="class: code"]Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

[/TD]
[/TR]
[/TABLE]



[TABLE]
[TR]
[TD="class: gutter"]1
2
[/TD]
[TD="class: code"]Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

[/TD]
[/TR]
[/TABLE]



سپس ابتدا متغیر allDrives را که رشته ای 64 کاراکتری از space است بصورت زیر تعریف کنید :
[TABLE]
[TR]
[TD="class: gutter"]1
2
[/TD]
[TD="class: code"]allDrives$ = Space$(64)

[/TD]
[/TR]
[/TABLE]



حال با استفاده از تابع GetLogicalDriveStrings لیست کلیه درایوهای سیستم را استخراج می کنیم :
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
[/TD]
[TD="class: code"]ret& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
allDrives$ = Left$(allDrives$, ret&)

[/TD]
[/TR]
[/TABLE]



حال با استفاده از یک حلقه و چک کردن درایوها با استفاده از تابع GetDriveType می توانیم تشخیص دهیم این درایو مربوط به سی دی است یا نه . برای اینکار اگر مقدار بازگشتی تابع به ازای یک درایو برابر عدد 5 باشد آن درایو سی دی است :
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
[/TD]
[TD="class: code"]Do
pos% = InStr(allDrives$, Chr$(0))
If pos% Then
JustOneDrive$ = Left$(allDrives$, pos% - 1)
allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))
DriveType& = GetDriveType(JustOneDrive$)
If DriveType& = 5 Then
MsgBox UCase$(JustOneDrive$) & " is a CD Drive"
End If
End If
Loop Until allDrives$ = ""

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

استفاده از قلاب یا Hook : قلاب ، یک ابزار در مکانیزم مدیریت پیغام سیستم ویندوز است که توسط آن برنامه ها می توانند یک روتین را برای مدیریت و پردازش پیغامهای خاصی قبل از اینکه آن پیغامها به برنامه مقصد برسند نصب نمایند . قلابها باعث کندی سیستم می شوند زیرا حجم پردازشی سیستم روی هر پیغام را افزایش می دهند بنابراین بایستی زمانیکه واقعاً به قلاب نیاز دارید آنرا نصب نموده و هر چه زودتر آنرا حذف نمایید . سیستم ویندوز از انواع زیادی از قلابها پشتیبانی می کند که هر کدام امکان دستیابی به پیغامهای خاصی را مهیا می نمایند برای مثال یک برنامه کاربردی می تواند با استفاده از قلاب کیبرد برای مدیریت و پردازش پیغامهای مربوط به آن ( مثل فشرده شدن یک کلید خاص یا رها شدن آن ) استفاده کند .
برای نصب یک قلاب در برنامه از یک تابع کتابخانه ای به اسم SetWindowsHookEx استفاده می شود . این تابع یک قلاب را به زنجیره قلابهای سیستم اضافه می کند . نحوه declare کردن این تابع بصورت زیر است :
[TABLE]
[TR]
[TD="class: gutter"]1
[/TD]
[TD="class: code"]Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

[/TD]
[/TR]
[/TABLE]



همچنین برای آزاد کردن یک قلاب و حذف آن از زنجیره قلابها از تابع کتابخانه ای UnhookWindowsHookEx استفاده می گردد . نحوه declare کردن این تابع بصورت زیر است :
[TABLE]
[TR]
[TD="class: gutter"]1
[/TD]
[TD="class: code"]Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

[/TD]
[/TR]
[/TABLE]



برای ایجاد قلاب کیبرد همچنین نیاز به تعریف یک ثابت است که شماره قلاب کیبرد در آن قرار دارد :
[TABLE]
[TR]
[TD="class: gutter"]1
2
[/TD]
[TD="class: code"]Public Const WH_KEYBOARD = 2

[/TD]
[/TR]
[/TABLE]



حال بایستی یک تابع پس زمینه یا Callback Function نوشت که به ازای فشرده شدن کیبرد اجرا شود و آدرس آنرا ( با استفاده از کلمه کلیدی Address Of ) بهمراه ثابت فوق به تابع SetWindowsHookEx فرستاد .

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونگی ساخت یک Splash Screen برای برنامه هایی که مینویسیم را براتون شرح بدم . خوب باز هم باید توابع مورد نیاز را فراخوانی کرده و همچنین ثوایت مورد نیاز را تعریف کنیم :
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
[/TD]
[TD="class: code"]Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal _
dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib _
"user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha _
As Byte, ByVal dwFlags As Long) As Long

[/TD]
[/TR]
[/TABLE]



نوع نمایش این Splash Screen به گونه ای است که میزان شفافیت فرم آن از 0 به 255 رسیده و دوباره کاهش یافته به صفر می رسد (یا بعبارت دیگر از حالت نامرئی به شفافیت کامل رسیده و دوباره از شفافیت آن کاسته شده و نامرئی می شود ) . خوب تنها Control که برای این برنامه نیاز داریمTimer می باشد . کدی که در Form_Load می بینید باعث می شود که فرم در ابتدای امر نامرئی باشد چون مقدار bAlfa آنرا 0 داده ام
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
[/TD]
[TD="class: code"]Private Sub Form_Load()

Dim Ret As Long
<i>'Set the window style to 'Layered'
</i> Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
<i> 'SetLayeredWindowAttributes Me.hWnd,0,(0-255),LWA_ALPHA
</i> SetLayeredWindowAttributes Me.hWnd,0,0,LWA_ALPHA
Timer1.interval = 1
End
End Sub

[/TD]
[/TR]
[/TABLE]

در مرحله بعد برای اینکه فرم از حالت نامرئی به مرئی برسد (یعنی مقدار آن از 0 به 255 برسد) یک حلقه For نوشتم . حال برای اینکه فرم دوباره از حالت مرئی به نامرئی برشد یک حلقه For دیگر با گام افزایش -1 نوشتم تا مقدار آنرا کاهش دهد . ​

[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
[/TD]
[TD="class: code"]Private Sub Timer1_Timer()

For i = 1 To 255
SetLayeredWindowAttributes Me.hWnd,0,CByte(i),LWA_ALPHA
Next i

For i = 255 To 1 Step -1
SetLayeredWindowAttributes Me.hWnd,0,CByte(i),LWA_ALPHA
Next i

Timer1.Enabled = False

End Sub

[/TD]
[/TR]
[/TABLE]


​

(*) یک نکته : این برنامه در سیستم عاملهای windows 2000 به بعد قابل اجراست , زیرا توابع مورد استفاده در این برنامه در ویندوزهای 98 و 95 وجود ندارد .
​

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونه می توانیم دستورات Dos را از طریق ویژوال بیسیک اجرا کنیم ؟ ابتدا Command Prompt را فراخوانی می کنیم , خوب برای فراخوانی از تابع Shell استفاده میکنیم که قبلا در مورد این تابع توضیح داده ام :
[TABLE]
[TR]
[TD="class: gutter"]1
[/TD]
[TD="class: code"]Shell "cmd.exe"

[/TD]
[/TR]
[/TABLE]



:: اکنون یک شیء ایجاد می کنیم تا بتوانیم از طیق آن به هسته Dos دسترسی داشته باشیم :
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
[/TD]
[TD="class: code"]Dim WinShell
Set WinShell = CreateObject("Wscript.shell")

[/TD]
[/TR]
[/TABLE]



خوب حالا می توانید به راحتی هر دستوری که دارید میتوانید اجرا کنید در آخر هم دستور تابع Sendkeys کلید Enter را اجرا کرده و دستور اجرا میشود:
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
[/TD]
[TD="class: code"]WinShell.SendKeys " <b>Dos</b> دستور مورد نظر برای اجرا در "
WinShell.SendKeys "{ENTER}"

[/TD]
[/TR]
[/TABLE]



به مثاهای زیر توجه کنید که به ترتیب اولی برای ایجاد پوشه ای به نام Visual Basic در درایو C و دستور دوم برای نمایش پوشه های موجود در درایو C و دستور سوم برای Format فلاپی دیسک می باشد .
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
[/TD]
[TD="class: code"]'For Create Folder With Dos Prompt :
WinShell.SendKeys "MD C:\Visual" & " Basic"
WinShell.SendKeys "{ENTER}"

'For Showing C Directory :
WinShell.SendKeys "Dir C:\"
WinShell.SendKeys "{ENTER}"

'For Format Floppy Disk Of Dos :
WinShell.SendKeys "format A:"
WinShell.SendKeys "{ENTER}"

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونه فرم هایی بصورت دایره و یا بیضی در ویژوال بیسیک طراحی کنیم . خوب ایتدا به فراخوانی توابع مورد نیاز ویندوز می پردازیم :[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
[/TD]
[TD="class: code"]Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
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 Boolean) As Long

[/TD]
[/TR]
[/TABLE]



خوب اکنون کد زیر را در رویداد (Event) مربوط به لحظه ای که کلید موس را بروی فرم فشردیم قرار می دهیم تا بتوانیم با فشردن موس در هر جای فرم به راحتی آن را جابجا کنیم .
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
[/TD]
[TD="class: code"]Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MousePointer = 15
Call ReleaseCapture
Call SendMessage(hWnd, &HA1, 2, 0&)
MousePointer = 1
End Sub

[/TD]
[/TR]
[/TABLE]



حال تابع SetWindowRgn را مقدار دهی میکنیم . ( این قطعه کد را در رویداد Form_Load بنویسید ) :
[TABLE]
[TR]
[TD="class: gutter"]1
[/TD]
[TD="class: code"]SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 200, 200), True

[/TD]
[/TR]
[/TABLE]



مثلا مقادیر 200 و 200 شکل فرم بصورت دایره در می آید برای شکل بیضی شما میتوانید این مقادیر را 200 و 300 اختیار کنید .( بهتر است که خاصیت boarderStyle را 0-None در نظر بگیرید)

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري شود ؟
خوب با استفاده از تيکه کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کنيد
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
[/TD]
[TD="class: code"]<b>Private Sub Form_Load()
If App.PrevInstance = True Then
Dim Result As Integer
Result = MsgBox("</b>برنامه در حال اجراست<b>", vbInformation, "Warnnig")
Unload Me
End If
End Sub</b>

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونه می توان متن دلخواهی را در Statusbar قرار داد ؟[TABLE]
[TR]
[TD="class: gutter"]1
2
[/TD]
[TD="class: code"]StatusBar1.Panels(شماره پنل مورد نظر).Text = "ساعت جاری " & Format(Time, "hh:mm:ss")

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

چگونه می توان یک Explorer را اجرا کرد برای این کار می توان از راههای مختلفی استفاده کرد مثلاً از شیء Shell و . . . . برای اینکار از منوی Project آیتم Preference را انتخاب کنید , اکنون آیتم Microsoft Shell Controls and Automaton را انتخاب کنید . حالا مراحل زیر را انجام میدهیم .
[TABLE]
[TR]
[TD="class: gutter"]1
[/TD]
[TD="class: code"]Dim SH As New Shell

[/TD]
[/TR]
[/TABLE]



حالا می توانید از متدهای زیادی که این شیء در اختیارتان می گزارد استفاده کنید . از جمله این متد های اجرا Internet Explorer , Outlook , اجرای آیتم های موجود در کنترل پنل , نمایش پنجره جستجوی ویندوز و کلی کارهای مفید دیگه . به مثالهای زیر توجه کنید :
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
[/TD]
[TD="class: code"]SH.Open <a href="http://xxxx.com" target="_blank">http://xxxx.com</a>
SH.TrayProperties

SH.SetTime
SH.FindComputer 'System Search
SH.ControlPanelItem "sysdm.cpl" 'System Properties

SH.ControlPanelItem "inetcpl.cpl" 'Internet Options

SH.ControlPanelItem "'appwiz.cpl" 'Add/Remove Programs

[/TD]
[/TR]
[/TABLE]

این شیء دارای متدهای دیگری هم میباشد که به راحتی می توانید از آنها استفاده کنید .
​

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

استفاده از شی ء File System Object در ویژوال بیسیک
این شیء قابلیت کار با Drive , Folder , File , TestStream را دارد یعنی شما می توانید پوشه و یا فایلی را از مسیری به مسیر دیگر کپی , حذف و یا منتقل کنید و هم چنین می توانید پو شه ای را در مسیر مورد نظر ایجاد کنید .
برای افزودن این شیء به برنامه تان از منوی Project آیتم Refrencese را انتخاب کنید و از آن آیتمMicrosoft Script Runtime را تیک می زنید . اکنون نوبت به تعریف یک متغیر از نوع ّFso می باشد
[TABLE]
[TR]
[TD="class: gutter"]1
[/TD]
[TD="class: code"]Dim Fso As New FileSystemObject

[/TD]
[/TR]
[/TABLE]



در ضمن لازم به ذکر است که App.path مسیر جاری را که برنامه اجرایی در آن قرار دارد را بر می گر داند .
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
[/TD]
[TD="class: code"]Fso.CopyFile App.Path & "\text.txt", "C:\", True ' True For Ovwerwrite
fso.MoveFile App.Path & "\text.txt", "C:\" ' For Move File Of Current Path to "C:\" Path
fso.DeleteFile "c:\text.txt"

[/TD]
[/TR]
[/TABLE]



همین عملیات بالا را می توان برای Folder هم اجرا کرد . همان طور که متوجه شده اید این شیء بسیار مهم است و می تواند کاربرد های زیادی برایتان داشته باشد مثلاً من در زیر برنامه ای می نویسم که بتواند فایلی را در پو شه System32 ویندوز کپی کند خوب بر ای اینکه بتوان پوشه ویندوز را پیدا کنیم از یک API استفاده می کنم چون امکان داره ویندوز داخل پوشه هایی غیر از نام Windows باشد این کار بر ای بر نامه هایی که می خواهید فایلی را در پوشه ویندوز کپی کنی دکاربرد دارد مثلاً شما می خواهید فونتی را در پوشه font ویندوز کپی کنید.
[TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
[/TD]
[TD="class: code"]Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long _
) As Long
Dim fso As New FileSystemObject
Public S As String
PublicSysDirectory As Long

Private Sub Command1_Click()
fso.CopyFile App.Path & "\vb.txt", S + "\System32\", True
End Sub

Private Sub Form_Load()
S = Space(255)
'Get the Windows directory
WinDirectory = GetWindowsDirectory(S, 255)
S = Left$(S, WinDirectory)

'#######################################

LblSource.Caption = "Source : " & App.Path & "\vb.txt"
LblDestination.Caption = "Destination : " & S & "\System32\"
End Sub

[/TD]
[/TR]
[/TABLE]

 

پاسخ : یه سری آموزش های فوق العاده جالب برای دوستان عزیز

نمایش مقدار حافظه فیزیکی و مجازی با ویژوال بیسیک [TABLE]
[TR]
[TD="class: gutter"]1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
[/TD]
[TD="class: code"]Private Type Memory
Length As Long
MemoryLoad As Long
TotalPhysMemory As Long
AvailablePhysMemory As Long
TotalPageFile As Long
AvailPageFile As Long
TotalVirtualMemory As Long
AvailableVirtualMemory As Long
End Type

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (M As Memory)

Private Sub Timer1_Timer()
Dim M As Memory
GlobalMemoryStatus M
'*************************************************
LblAvlMem.Caption = Format(CDbl(M.AvailablePhysMemory / 1048576), "#.## MB")
LblTotalPhMem.Caption = Format(CDbl(M.TotalPhysMemory / 1048576), "#.## MB")
LblUsedMemory.Caption = Format(CDbl((M.TotalPhysMemory - M.AvailablePhysMemory) / 1048576), "#.## MB")
LblPercentPhMem.Caption = Format(CDbl((M.AvailablePhysMemory / M.TotalPhysMemory)), "##.#%")
'*************************************************
LblVirtualMem.Caption = Format(CDbl(M.AvailableVirtualMemory / 1048576), "#.## MB")
LblTotalVirtualMem.Caption = Format(CDbl(M.TotalVirtualMemory / 1048576), "#.## MB")
LblUsedVirtualMem.Caption = Format(CDbl((M.TotalVirtualMemory - M.AvailableVirtualMemory) / 1048576), "#.## MB")
LblPercentVirtualMem.Caption = Format(CDbl((M.AvailableVirtualMemory / M.TotalVirtualMemory)), "##.#%")
'*************************************************

End Sub

[/TD]
[/TR]
[/TABLE]