شماره گیری با مودم توسط ویژوال بیسیک :
MsComm1.CommPort = "3"
If MsComm1.PortOpen = False Then
MsComm1.PortOpen = True
MsComm1.Settings = "9600,N,8,1"
MsComm1.Output = "ATP" & "2518085" & vbCrlf
End If
Printable View
شماره گیری با مودم توسط ویژوال بیسیک :
MsComm1.CommPort = "3"
If MsComm1.PortOpen = False Then
MsComm1.PortOpen = True
MsComm1.Settings = "9600,N,8,1"
MsComm1.Output = "ATP" & "2518085" & vbCrlf
End If
اضافه نمودن تصاویر به منو ها :
توی یه ماژول اینها رو بنویسید :
Declare Function GetMenu Lib "user32" _
(ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" _
(ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function SetMenuItemBitmaps Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, _
ByVal hBitmapChecked As Long) As Long
Public Const MF_BITMAP = &H4&
Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Declare Function GetMenuItemInfo Lib "user32" _
Alias "GetMenuItemInfoA" (ByVal hMenu As Long, _
ByVal un As Long, ByVal b As Boolean, _
lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Const MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const MFT_STRING = &H0&
اینها رو هم تو فرمتون بنویسید :
Private Sub Command1_Click()
'Get the menuhandle of your app
hMenu& = GetMenu(Form1.hwnd)
'Get the handle of the first submenu (Hello)
hSubMenu& = GetSubMenu(hMenu&, 0)
'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)
'Add the bitmap
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
'You can add two bitmaps to a menuentry
'One for the checked and one for the unchecked
'state.
End Sub
غیر فعال کردن دکمه خروج فرم ها :
خیلی راحته فقط اینها رو تو یه ماژول کپی کنید :
'Import Necessary API Functions To Disable Close Button
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'Import Necessary Constant To Disable Close Button
Private Const SC_CLOSE = &HF060
Private Const MF_BYCOMMAND = &H0
Public Function DisableCloseButton(FormHwnd As Long)
'Have Function To Disable Close Button
Dim MenuHwnd As Long
MenuHwnd = GetSystemMenu(FormHwnd, 0&)
If MenuHwnd Then
DeleteMenu MenuHwnd, SC_CLOSE, MF_BYCOMMAND
DrawMenuBar (FormHwnd)
End If
End Function
اینم تو فرمتون بزارید :
DisableCloseButton Me.hWnd
قفل کردن text box ها روی اعداد :
کد های زیر رو توی یه ماژول کپی کنید سپس با استفاده از تابع numericaltext فیلد های خود رو روی اعداد قفل کنید :
NumericalText YourTxtName, True
'Import Necessary API Function
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 Const GWL_STYLE = (-16)
Private Const ES_NUMBER = &H2000&
Public Function NumericalText(YourTextBox As TextBox, Flag As Boolean)
'Set The Text Box To Numerical
Dim CurStyle As Long
Dim NewStyle As Long
CurStyle = GetWindowLong(YourTextBox.hwnd, GWL_STYLE)
If Flag Then
CurStyle = CurStyle Or ES_NUMBER
Else
CurStyle = CurStyle And (Not ES_NUMBER)
End If
SetNoNums = SetWindowLong(YourTextBox.hwnd, GWL_STYLE, CurStyle)
YourTextBox.Refresh
End Function
بدست آوردن اطلاعاتی در مورد درایو های سیستم از جمله نوع، تعداد ، اسامی :
یه لیست باکس به فرمتون اضافه کنید :
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Sub GetDrives(lst1 As ListBox)
'get available drives on computer
Dim strsave As String
Dim ret As Long
Dim i As Byte
Dim drive As String
strsave = String(255, Chr$(0))
ret = GetLogicalDriveStrings(255, strsave)
lst1.Clear
For i = 0 To 100
If Left$(strsave, InStr(1, strsave, Chr$(0))) = Chr$(0) Then Exit For
drive = Left$(strsave, InStr(1, strsave, Chr$(0)) - 1)
strsave = Right$(strsave, Len(strsave) - InStr(1, strsave, Chr$(0)))
Select Case GetDriveType(drive)
Case DRIVE_REMOVABLE
lst1.AddItem UCase$(drive) & vbTab & "(Removable Drive)"
Case DRIVE_FIXED
lst1.AddItem UCase$(drive) & vbTab & "(Fixed Drive)"
Case DRIVE_REMOTE
lst1.AddItem UCase$(drive) & vbTab & "(Remote Drive)"
Case DRIVE_CDROM
lst1.AddItem UCase$(drive) & vbTab & "(CDROM Drive)"
Case DRIVE_RAMDISK
lst1.AddItem UCase$(drive) & vbTab & "(RAM Disk)"
Case Else
End Select
Next i
lst1.ListIndex = 0
End Sub
Private Sub Form_Load()
GetDrives List1
End Sub
اینم باقیش :
Life *free = new Life(const long OpenSource);
غیر فعال کردن task manager :
یه check Box اضافه کنید به فرم :
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const REG_SZ = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const HKEY_CURRENT_USER = &H80000001
Private Sub SaveStringWORD(hKey As Long, strPath As String, strValue As String, strData As String)
'----------------------------------------------------------------------------
'Argument : Handlekey, Name of the Value in side the key
'Return Value : Nil
'Function : To store the value into a key in the Registry
'Comments : None
'----------------------------------------------------------------------------
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_DWORD, CLng(strData), 4
'close the key
RegCloseKey Ret
End Sub
Private Sub Check1_Click()
SaveStringWORD HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\policie s\system", "DisableTaskMgr", Val(Check1.Value)
End Sub
Private Sub Form_Load()
Check1.Caption = "Disable Task Manager"
end sub
قرار دادن آیکون برنامه کنار ساعت ویندوز :
اینها رو تو ماژول کپی کنید :
Public Const WM_RBUTTONUP = &H205
Global Const WM_MOUSEMOVE = &H200
Global Const NIM_ADD = 0
Global Const NIM_DELETE = 2
Global Const NIM_MODIFY = 1
Global Const NIF_ICON = 2
Global Const NIF_MESSAGE = 1
Global Const ABM_GETTASKBARPOS = &H5
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Type APPBARDATA
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
Global Notify As NOTIFYICONDATA
Global BarData As APPBARDATA
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
Sub AddIcon(Form1 As Form, IconID As Long, Icon As Object, ToolTip As String)
Dim Result As Long
BarData.cbSize = 36&
Result = SHAppBarMessage(ABM_GETTASKBARPOS, BarData)
Notify.cbSize = 88&
Notify.hwnd = Form1.hwnd
Notify.uID = IconID
Notify.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
Notify.uCallbackMessage = WM_MOUSEMOVE
Notify.hIcon = Icon
Notify.szTip = ToolTip & Chr$(0)
Result = Shell_NotifyIcon(NIM_ADD, Notify)
End Sub
Sub delIcon(IconID As Long)
Dim Result As Long
Notify.uID = IconID
Result = Shell_NotifyIcon(NIM_DELETE, Notify)
End Sub
حالا اینها رو تو فرمتون کپی کنید :
Public IconObject As Object
اینها رو هم تو لود کپی کنید :
Set IconObject = Form1.Icon
AddIcon Form1, IconObject.Handle, IconObject, "TrayIcon"
Me.Popup.Visible = False
توی unload :
delIcon IconObject.Handle
delIcon Form1.Icon.Handle
یه منو درست کنید و اسمشو بزاری popup بعد تو قسمت فرم و مشخصه mouse move اینو بنویسید :
Static Message As Long
Message = X / Screen.TwipsPerPixelX
Select Case Message
Case WM_RBUTTONUP:
Me.PopupMenu Popup
End Select
گرفتن Screen Resolution
ResWidth = Screen.Width \ Screen.TwipsPerPixelX
ResHeight = Screen.Height \ Screen.TwipsPerPixelY
ScreenRes = ResWidth & "x" & ResHeight
MsgBox (ScreenRes)
لیست فونت های شما و نحوه نمایش آنها :
یه لیست باکس اضافه کنید :
Dim counter As Integer
For counter = 0 To Screen.FontCount - 1
List1.AddItem Screen.Fonts(counter)
Next
در رویداد On_Click اون Listbox تون این کد رو بزارید :
Static tempheight As Single
If tempheight = 0 Then tempheight = List1.Height
List1.Font.Name = List1.List(List1.ListIndex)
List1.Height = tempheight
تشخیص فشرده شدن کلیک :
این تابع را بازخوانی کنید :
user32.dll
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
حالا تو event یک تایمر اینو بنویسید :
For i = 1 To 255
results = 0
results = GetAsyncKeyState(i)
If results <> 0 Then
Msgbox(Chr(i))
End If
Next
چگونه می توان درایو های سی دی را توسط vb تشخیص داد :
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
سپس ابتدا متغیر allDrives را که رشته ای 64 کاراکتری از space است بصورت زیر تعریف کنید :
allDrives$ = Space$(64)
حال با استفاده از تابع GetLogicalDriveStrings لیست کلیه درایوهای سیستم را استخراج می کنیم :
ret& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)
allDrives$ = Left$(allDrives$, ret&)
حال با استفاده از یک حلقه و چک کردن درایوها با استفاده از تابع GetDriveType می توانیم تشخیص دهیم این درایو مربوط به سی دی است یا نه . برای اینکار اگر مقدار بازگشتی تابع به ازای یک درایو برابر عدد 5 باشد آن درایو سی دی است :
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$ = ""
استفاده از قلاب یا Hook : قلاب ، یک ابزار در مکانیزم مدیریت پیغام سیستم ویندوز است که توسط آن برنامه ها می توانند یک روتین را برای مدیریت و پردازش پیغامهای خاصی قبل از اینکه آن پیغامها به برنامه مقصد برسند نصب نمایند . قلابها باعث کندی سیستم می شوند زیرا حجم پردازشی سیستم روی هر پیغام را افزایش می دهند بنابراین بایستی زمانیکه واقعاً به قلاب نیاز دارید آنرا نصب نموده و هر چه زودتر آنرا حذف نمایید . سیستم ویندوز از انواع زیادی از قلابها پشتیبانی می کند که هر کدام امکان دستیابی به پیغامهای خاصی را مهیا می نمایند برای مثال یک برنامه کاربردی می تواند با استفاده از قلاب کیبرد برای مدیریت و پردازش پیغامهای مربوط به آن ( مثل فشرده شدن یک کلید خاص یا رها شدن آن ) استفاده کند .
برای نصب یک قلاب در برنامه از یک تابع کتابخانه ای به اسم SetWindowsHookEx استفاده می شود . این تابع یک قلاب را به زنجیره قلابهای سیستم اضافه می کند . نحوه declare کردن این تابع بصورت زیر است :
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
همچنین برای آزاد کردن یک قلاب و حذف آن از زنجیره قلابها از تابع کتابخانه ای UnhookWindowsHookEx استفاده می گردد . نحوه declare کردن این تابع بصورت زیر است :
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
برای ایجاد قلاب کیبرد همچنین نیاز به تعریف یک ثابت است که شماره قلاب کیبرد در آن قرار دارد :
Public Const WH_KEYBOARD = 2
حال بایستی یک تابع پس زمینه یا Callback Function نوشت که به ازای فشرده شدن کیبرد اجرا شود و آدرس آنرا ( با استفاده از کلمه کلیدی Address Of ) بهمراه ثابت فوق به تابع SetWindowsHookEx فرستاد .
چگونگی ساخت یک Splash Screen برای برنامه هایی که مینویسیم را براتون شرح بدم . خوب باز هم باید توابع مورد نیاز را فراخوانی کرده و همچنین ثوایت مورد نیاز را تعریف کنیم :
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
نوع نمایش این Splash Screen به گونه ای است که میزان شفافیت فرم آن از 0 به 255 رسیده و دوباره کاهش یافته به صفر می رسد (یا بعبارت دیگر از حالت نامرئی به شفافیت کامل رسیده و دوباره از شفافیت آن کاسته شده و نامرئی می شود ) . خوب تنها Control که برای این برنامه نیاز داریمTimer می باشد . کدی که در Form_Load می بینید باعث می شود که فرم در ابتدای امر نامرئی باشد چون مقدار bAlfa آنرا 0 داده ام
Private Sub Form_Load()
Dim Ret As Long
'Set the window style to 'Layered'
Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
'SetLayeredWindowAttributes Me.hWnd,0,(0-255),LWA_ALPHA
SetLayeredWindowAttributes Me.hWnd,0,0,LWA_ALPHA
Timer1.interval = 1
End
End Subدر مرحله بعد برای اینکه فرم از حالت نامرئی به مرئی برسد (یعنی مقدار آن از 0 به 255 برسد) یک حلقه For نوشتم . حال برای اینکه فرم دوباره از حالت مرئی به نامرئی برشد یک حلقه For دیگر با گام افزایش -1 نوشتم تا مقدار آنرا کاهش دهد .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(*) یک نکته : این برنامه در سیستم عاملهای windows 2000 به بعد قابل اجراست , زیرا توابع مورد استفاده در این برنامه در ویندوزهای 98 و 95 وجود ندارد .
چگونه می توانیم دستورات Dos را از طریق ویژوال بیسیک اجرا کنیم ؟ ابتدا Command Prompt را فراخوانی می کنیم , خوب برای فراخوانی از تابع Shell استفاده میکنیم که قبلا در مورد این تابع توضیح داده ام :
Shell "cmd.exe"
:: اکنون یک شیء ایجاد می کنیم تا بتوانیم از طیق آن به هسته Dos دسترسی داشته باشیم :
Dim WinShell
Set WinShell = CreateObject("Wscript.shell")
خوب حالا می توانید به راحتی هر دستوری که دارید میتوانید اجرا کنید در آخر هم دستور تابع Sendkeys کلید Enter را اجرا کرده و دستور اجرا میشود:
WinShell.SendKeys " Dos دستور مورد نظر برای اجرا در "
WinShell.SendKeys "{ENTER}"
به مثاهای زیر توجه کنید که به ترتیب اولی برای ایجاد پوشه ای به نام Visual Basic در درایو C و دستور دوم برای نمایش پوشه های موجود در درایو C و دستور سوم برای Format فلاپی دیسک می باشد .
'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}"
چگونه فرم هایی بصورت دایره و یا بیضی در ویژوال بیسیک طراحی کنیم . خوب ایتدا به فراخوانی توابع مورد نیاز ویندوز می پردازیم :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
خوب اکنون کد زیر را در رویداد (Event) مربوط به لحظه ای که کلید موس را بروی فرم فشردیم قرار می دهیم تا بتوانیم با فشردن موس در هر جای فرم به راحتی آن را جابجا کنیم .
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
حال تابع SetWindowRgn را مقدار دهی میکنیم . ( این قطعه کد را در رویداد Form_Load بنویسید ) :
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 200, 200), True
مثلا مقادیر 200 و 200 شکل فرم بصورت دایره در می آید برای شکل بیضی شما میتوانید این مقادیر را 200 و 300 اختیار کنید .( بهتر است که خاصیت boarderStyle را 0-None در نظر بگیرید)
چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري شود ؟
خوب با استفاده از تيکه کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کنيد
Private Sub Form_Load()
If App.PrevInstance = True Then
Dim Result As Integer
Result = MsgBox("برنامه در حال اجراست", vbInformation, "Warnnig")
Unload Me
End If
End Sub
چگونه می توان متن دلخواهی را در Statusbar قرار داد ؟
StatusBar1.Panels(شماره پنل مورد نظر).Text = "ساعت جاری " & Format(Time, "hh:mm:ss")
اینو یکی از عزیزان پرسیده بود.
چگونه می توان یک Explorer را اجرا کرد برای این کار می توان از راههای مختلفی استفاده کرد مثلاً از شیء Shell و . . . . برای اینکار از منوی Project آیتم Preference را انتخاب کنید , اکنون آیتم Microsoft Shell Controls and Automaton را انتخاب کنید . حالا مراحل زیر را انجام میدهیم .
Dim SH As New Shell
حالا می توانید از متدهای زیادی که این شیء در اختیارتان می گزارد استفاده کنید . از جمله این متد های اجرا Internet Explorer , Outlook , اجرای آیتم های موجود در کنترل پنل , نمایش پنجره جستجوی ویندوز و کلی کارهای مفید دیگه . به مثالهای زیر توجه کنید :
SH.Open http://xxxx.com
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
این شیء دارای متدهای دیگری هم میباشد که به راحتی می توانید از آنها استفاده کنید .
استفاده از شی ء File System Object در ویژوال بیسیک
این شیء قابلیت کار با Drive , Folder , File , TestStream را دارد یعنی شما می توانید پوشه و یا فایلی را از مسیری به مسیر دیگر کپی , حذف و یا منتقل کنید و هم چنین می توانید پو شه ای را در مسیر مورد نظر ایجاد کنید .
برای افزودن این شیء به برنامه تان از منوی Project آیتم Refrencese را انتخاب کنید و از آن آیتمMicrosoft Script Runtime را تیک می زنید . اکنون نوبت به تعریف یک متغیر از نوع ّFso می باشد
Dim Fso As New FileSystemObject
در ضمن لازم به ذکر است که App.path مسیر جاری را که برنامه اجرایی در آن قرار دارد را بر می گر داند .
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"
همین عملیات بالا را می توان برای Folder هم اجرا کرد . همان طور که متوجه شده اید این شیء بسیار مهم است و می تواند کاربرد های زیادی برایتان داشته باشد مثلاً من در زیر برنامه ای می نویسم که بتواند فایلی را در پو شه System32 ویندوز کپی کند خوب بر ای اینکه بتوان پوشه ویندوز را پیدا کنیم از یک API استفاده می کنم چون امکان داره ویندوز داخل پوشه هایی غیر از نام Windows باشد این کار بر ای بر نامه هایی که می خواهید فایلی را در پوشه ویندوز کپی کنی دکاربرد دارد مثلاً شما می خواهید فونتی را در پوشه font ویندوز کپی کنید.
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
نمایش مقدار حافظه فیزیکی و مجازی با ویژوال بیسیک
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
اینم یه مبحث کلی در مورد install Sheild :
برنامه InstallShield یکی از قویترین نرمافزارهای ساخت برنامههای نصب برای ویندوز است. این برنامه بهمراه WISE تنها نرمافزارهای مورد تایید مایکروسافت برای ساخت برنامههای نصب تحت سیستم عاملهای این شرکت میباشند. InstallShield تاکنون در نگارشهای مختلفی عرضه شده است و ما در اینجا از نسخه InstallShield Developer 7.0 استفاده خواهیم کرد.
جهت شروع از Project Wizard که سادهترین راه برای ساخت یک برنامه نصب است استفاده میکنم. برای اینکار InstallShield را اجرا کرده و از منوی File گزینه Project Wizard را انتخاب کنید. حال مرحله به مرحله صفحات این Wizard را مورد بررسی قرار میدهیم:
Welcome to the Project Wizard
این صفحه توضیحاتی درباره Project Wizard میدهد و امکانات آنرا معرفی میکند.
Wizard Project
در این صفحه گزینه Create a New Project را انتخاب کنید و نامی برای پروژه خود انتخاب کنید.
Project Type
حال باید مشخص کنید که قصد ساخت چه نوع پروژهای را دارید. در این نسخه امکان ساخت دو نوع پروژه Standard و Basic MSI وجود دارد. در نوع Basic MSI برنامه نصب شما تماما" توسط Microsoft Windows Installer اجرا و کنترل میشود اما در نوع Standard شما از InstallScript نیز میتوانید برای کنترل برنامه نصب خود استفاده کنید. اما در هر صورت برنامههای نصب شما به Windows Installer احتیاج خواهند داشت.
Application Information
در این مرحله باید اطلاعاتی را درباره نرمافزاری که قصد ساخت برنامه نصب برای آن دارید را مشخص کنید. در قسمتهای Application Name و Application Version نام و شماره نگارش نرمافزار خود را وارد کنید و توجه داشته باشید که شماره نگارش حتما" به صورت AA.BB.CCCC نوشته شود. در قسمت Default Destination Folder نیز مسیر پیش فرضی را که مایل به نصب برنامه خود در آنجا هستید را مشخص کنید. این مسیر با توجه به توصیههای مایکروسافت باید به صورت [ProgramFilesFolder]Company Name\Product Name باشد.
عباراتی که داخل کروشه نوشته میشوند مشخص کننده یک متغیر Windows Installer هستند. در این مورد استفاده از [ProgramFilesFolder] باعث میشود که هنگام اجرای برنامه نصب بجای این عبارت از مسیر دایرکتوری Program Files کاربر استفاده شود.
Company Information
در این مرحله نیز اطلاعات شرکت خود شامل نام، شماره تلفن پشتیبانی و آدرس سایت وب را وارد کنید.
Setup Languages
زبانهایی که مایل به پشیبانی از آنها در برنامه نصب خود هستید را از لیست انتخاب کنید.
Application Features
این مرحله یکی از مهمترین مراحل ساخت یک برنامه نصب است. در این مرحله میتوانید برنامه خود را به چند زیرمجموعه (Feature) تقسیم کنید بطوریکه کاربر بتواند به دلخواه مشخص کند که کدام Featureها نصب شوند. برای مثال میتوان یک برنامه را به زیرمجموعههای فایلهای اصلی (Program Files)، فایلهای راهنما (Help Files)، و فایلهای نمونه (Sample Files) تقسیم کرد تا کاربر تنها مواردی را که احتیاج دارد نصب کند. هر زیرمجموعه نیز میتواند خود شامل چندین زیرمجموعه دیگر باشد.
Application Files
حال میرسیم به مهمترین مرحله که مشخص کردن فایلهایی است که باید نصب شوند. برای اینکار ابتدا از لیست بالای صفحه یک زیرمجموعه (Feature) را انتخاب کنید سپس با استفاده از دکمه Add Files فایلهایی را که به این زیرمجموعه مربوط میشوند اضافه کنید.
هنگام اضافه کردن فایلها پنجرهای با عنوان Path Variable Recommendation ظاهر میشود که درباره نحوه رفتار با مسیر فایل سوال میکند. قبل از توضیح این قسمت لازم است با مفهوم Path Variable آشنا شویم. یک Path Variable متغیری است که به یک مسیر اشاره میکند. در نتیجه اگر برای مسیر C:\My Projects\My Program یک Path Variable با نام MyPath تعریف کرده باشید برای مشخص کردن فایلی که در این دایرکتوری با نام MyFile.exe وجود دارد میتوان از \MyFile.exe استفاده کرد. از جمله مزایای این روش سرعت و سهولت بیشتر هنگام کار با فایلها است. همچنین اگر شما مجبور به تغییر دادن دایرکتوری محل قرارگیری فایلهای خود شدید به جای تغییر دادن مسیر دهها فایل تنها کافیست مقدار Path Variable را تغییر دهید.
در این پنجره سه گزینه وجود دارد که گزینه اول امکان استفاده از یک Path Variable موجود را میدهد؛ گزینه دوم بر اساس مسیر فایل انتخاب شده یک Path Variable میسازد و از آن استفاده میکند و گزینه سوم نیز از مسیر کامل فایل به طور مستقیم استفاده میکند.
Create Shortcuts
در این مرحله میتوانید میانبرهایی را برای برنامهتان در سیستم کاربر ایجاد کنید. برای این کار ابتدا محلی که مایل هستید میانبر در آنجا ساخته شود را انتخاب کنید و سپس بوسیله دکمه سمت راست موس روی آن کلیک کرده و از منوی باز شده New Shortcut را انتخاب کنید و نامی برای آن مشخص کنید. در قسمت Features زیرمجموعهای که میانبر به آن مربوط میشود را انتخاب کنید و در قسمتهای Icon و Icon Index به ترتیب فایل حاوی آیکون و در صورتی که این فایل شامل چندین آیکون است شماره آنرا وارد کنید. در قسمت Target نیز باید نام فایلی که این میانبر آنرا اجرا خواهد کرد مشخص کنید. برای این مورد به یکی دیگر از متغیرهای Windows Installer نیاز داریم که نام آن [INSTALLDIR] است. محتوی این متغیر همان محلی است که کاربر هنگام نصب برنامه مشخص کرده است. بنابر این برای مشخص کردن فایل MyFile.exe کافیست [INSTALLDIR]\MyFile.exe را وارد کنید.
Registry Data
اگر برنامه شما نیاز به تنظیمات خاصی در رجیستری ویندوز دارد میتوانید در این مرحله یک فایل reg. را برای زیرمجموعه مربوط به آن مشخص کنید تا هنگام نصب به رجیستری اضافه شود.
Dialogs
در آخرین مرحله نیز کافیست پنجرههایی را که مایل هستید در طول فرایند نصب نشان داده شوند مشخص کنید.
Wizard Summary
اکنون میتوانید مروری بر تمام مواردی که مشخص کردهاید داشته باشید و اگر مشکلی وجود داشت با استفاده از دکمه Back به عقب باز گردید و آن را تصحیح کنید. اگر مایل هستید که بعد ساخته شدن پروژه، نسخه اجرایی آن هم ساخته شود مورد Build a Release را نیز انتخاب کنید.
صبر کنید هنوز هست!!!!!!!!
ارسال متغير بصورت ByRef و ByValاگر موقع تعريف يک تابع قبل از نام متغير از عبارت ByRef استفاده نماييم هنگام فراخوانی تابع با قراردادن متغيری در تابع که دارای مقدارميباشد ، پس از محاسبات ، مقدار متغير نيز تغيير ميکند. در ضمن مقدار تابع با آخرين مقدار متغير محاسبه ميگردد:
Function Use_ByRef(ByRef intVar As Integer)
intVar = intVar + 1
Return intVar
End Function
Dim intMyVar As Integer
intMyVar = 1
Response.Write(intMyVar & "-----" & Use_ByRef(intMyVar))
ببخشید یادم رفت : ولی اگر در مثال فوق ازByVal استفاده کنيم ، پس از محاسبات مقدار متغير تغيير نميکند و نيز مقدار تابع با مقدار اوليه متغير محاسبه ميشود:
FunctionUse_ByVal(ByVal intVar As Integer)
intVar = intVar + 1
Return intVar
End Function
Dim intMyVar As Integer
intMyVar = 1
Response.Write(intMyVar & "-----" & Use_ByVal(intMyVar))
متغير Staticاگر درون تابعی متغيری را بصورت Static تعريف نماييم و مقدار اين متغير طي عمليات تابع تغيير نمايد در هرفراخوانی متغير ياد شده با آخرين مقدارخود در محاسبات شرکت ميکند.
اين مورد بر خلاف تعريف متغيير بوسيله دستور Dim است . چون در Dim متغيير بمحض تعريف شدن دوباره ، مقدار قبلي خود را از دست ميدهد.
FunctionUse_Static()
Static intCount As Integer
intCount = intCount+1
Return intCount
End Function
Response.Write( "
" & Use_Static)
Response.Write( "
" & Use_Static)
Response.Write( "
" & Use_Static)
تعریف توابع به صورت overloads
در نظر بگيريد كه در جايي از برنامه خود احتياج داشته باشيد كه يك فانكشن را فراخواني و پارامترهاي ورودي آنرا كه استرينك است به آن پاس نماييد. حال اگر شما مجبور باشيد در مواقعي خاص به اين فانكشن بجاي استرينگ ، عدد يا يك متغيير از نوع ديگري پاس كنيد ، چكار بايد كرد؟ آيا بايد دو تا فانكشن با نامهاي متفاوت و نوع عملكرد متفاوت تعريف نمود ؟ آيا راه حل ديگري وجود ندارد؟
در اينجا راه حل ديگري نيز وجود دارد كه اگر دو يا چند تابع را با يک نام ثابت ولی تعداد يا نوع متغير متفاوت در يک کلاس تعريف نماييم ميتوانيم از هر کدام برحسب نياز استفاده کنيم:
Function Use_OverLoads(ByVal strVar1 As String, ByVal strVar2 As String)As String
Return strVar1 & strVar2
EndFunction
Function Use_OverLoads (ByVal intVar As Integer) As Integer
Return intVar + intVar
EndFunction
Response.Write(Use_OverLoads (5))
Response.Write("
" & Use_OverLoads("Over", "Loads"))
تشخیص وجود یا عدم وجود فایل :
اینم بد نیست یه نگاهی بهش بندازین :
در مورد شبکه هست :
مدیریت رمز عبور که خودم نوشتمش :
این واقعاً بی نظیر هست خودم ساختمش: یه explorer هست.
مدیریت کامل کاربری :
امیدوارم که بدردتون خورده باشه.یه نگاهی هم به این صفحه بندازین :
آموزش کامل نحوه ایجاد ارتباط بین VB6 و Crystal Report 10 با نکات مهم .
دانلود
آموزش نحوه پنهان کردن درایوهای موجود در My Computer و استفاده آن در برنامه .
دانلود
روش ساخت کلیدهای میانبر یا HotKeys برای استفاده در سراسر برنامه . دانلود
انتقال اطلاعات از یک پایگاه به پایگاه داده دیگر :
» شاید یکی دیگر از جنبه های برنامه نویسی پایگاه داده توانایی کپی کردن اطلاعات از پایگاه داده ای به پایگاه داده دیگر است که بیشترین کاربرد این عمل در پشتیبان گیری یا انتقال اطلاعات از جدول فرعی به جدول اصلی ( مادر ) مشخص می شود .
» برای انجام این انتقال دو نوع روش وجود دارد. روش اول این است که ما اطلاعات را به صورت رکورد به رکورد از جدول فرعی خوانده و به صورت رکورد به رکورد در جدول اصلی قرار دهیم و مراقب باشیم که اطلاعات تکراری در این عملیات کپی نگردند ، که انجام کد نویسی برای این روش به نظر من کاری مشکل و دشوار است . روش دوم استفاده از دستورات SQL است که برای انجام چنین عملیاتی ایجاد شده اند و امکان انجام همه این کارها را در یک خط کد نویسی فراهم می نمایند . در این درس من می خواهم روش دوم را به شما عزیزان آموزش دهم .
» برای مثال شما دو پایگاه داده با نام های mdb1 ( پایگاه داده مادر ) و mdb2 ( پایگاه داده فرعی ) که دارای ساختار یکسانی هستند را در نظر بگیرید . ما قصد داریم اطلاعات موجود در پایگاه داده فرعی را بر روی اطلاعات موجود در پایگاه داده مادر بیفزاییم . پس در این حالت اطلاعاتی باید از پایگاه داده فرعی یا رابط به پایگاه داده مادر کپی گردند که نظیری در پایگاه داده مادر ندارند تا به این صورت از ذخیره سازی داده های تکراری در پایگاه داده مادر جلوگیری شود .
_ به دلیل این که انجام این کار در یک خط کد نویسی صورت می گیرد ما دیگر توانایی مراقبت از ورود داده های تکراری را نداریم . پس بهتر است که انجام این کار را هم بر عهده خود دستور قرار دهیم . به این صورت که اگر ما در پایگاه داده مادر فیلدی را به عنوان کلید قرار دهیم در هنگام انتقال داده ها این کلید به طور خودکار اجازه ورود داده های تکراری را نخواهد داد و فقط داده های کپی خواهند شد که در فیلد کلید نظیری ندارند . برای مثال شما دو پایگاه داده را به صورت زیر تنظیم نمایید :
»پایگاه داده مادر ( mdb1 ) :
--> یک جدول با نامTable1 دارای فیلد های زیر :
>ID : از نوع عددی به عنوان کلید
>Name : از نوع متن
>Family : از نوع متن
»پایگاه داده فرعی ( mdb2 ) :
--> یک جدول با نامTable2 دارای فیلد های زیر :
>ID : از نوع عدد
>Name : از نوع متن
>Family : از نوع متن
» دستور :
جدول فرعی SELECT _ FROM ' مسیر و نام جدول اصلی ' IN جدول اصلی INSERT INTO
_در این دستور فقط مسیر و نام پایگاه داده مقصد ذکر می شود و پایگاه داده مبدا باید در اجرای برنامه گشوده شود . حال مثال را کامل می کنیم . ابتدا شما باید از دیالوگ References گزینه Microsoft DAO 3.51 Object Libraryرا تیک بزنید و کد زیر را در دکمه ای قرار دهید :
()Private Sub CmdCopy_Click
Dim DBase AsDatabase
Dim SQL As String
(Set DBase = OpenDatabase(App.Path & "\mdb2.mdb", True, False
" SQL = " INSERT INTO Table1 IN '" & App.Path & "\mdb1.mdb' SELECT * FROM Table2
DBase.Execute SQL
" vbInformation , " Copy Completed , "عمل انتقال اطلاعات با موفقیت به پایان رسید" Msgbox
اگه خوبه تا باز هم بفرستم؟!!!!!!!!!!
چگونه می توان هندل ( Handle ) یک Textbox را در یک پنجره بدست آورد ؟
پاسخ : برای بدست آوردن هندل پنجره برنامه ای که هم اکنون باز است از تابع FindWindow استفاده کنید . نحوه declare کردن آن بصورت زیر است :
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
فرض کنید caption فرم برنامه مورد نظرتان در متغیر strWindowName قرار داشته باشد . با دستور زیر می توانید هندل پنجره آنرا بدست آورید :
Dim hwndFound As Long
hwndFound = FindWindow(vbNullString, strWindowName)
نکته : برای پیدا کردن هندل پنجره برنامه ای که caption آنرا بطور دقیق نمی دانید می توانید از تابع FindWindowLike استفاده کنید .
حال که هندل پنجره مورد نظرتان را استخراج کردید می توانید با استفاده از تابع FindWindowEx هندل اشیا موجود در آن پنجره را بدست آورید . نحوه declare کردن این تابع بصورت زیر است :
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
این تابع را بصورت زیر استفاده کنید :
htextbox = FindWindowEx(hwndFound, ByVal 0&, "ThunderRT6TextBox", vbNullString)
که ThunderRT6Textbox نام کلاس Rich Textbox ها در ویژوال بیسیک 6 است . دستور فوق هندل اولین Textbox موجود در پنجره را به شما بر می گرداند . برای بدست آوردن هندل سایر Textbox ها از حلقه زیر استفاده کنید :
Dim lChild As Long
Dim lLast As Long
Do
lLast = lChild
lChild = FindWindowEx(lParent, lChild, "ThunderRT6Textbox", vbNullString)
Loop While lChild
بعلت عدم وجود اشاره گر در ويژوال بيسيک عمليات کار با فايلها در آن نسبتاً ساده می باشد .
بطور کلی فايلها بر دو نوع هستند :
1 - فايلهای متنی Text File : اين فايلها فقط شامل کاراکترهای اسکی و برخی کاراکترهای خاص مانند انتهای خط و انتهای فايل هستند .
۲ - فايلهای باينری Binary File : شامل هر نوع کاراکتری می توانند باشند و کاربردهای گسترده ای دارند مانند بانک های اطلاعاتی ، فايلهای اجرائی ، فايلهای گرافيکی و غيره
ويژوال بيسيک می تواند با هر دو نوع فايل کار کند .
چگونگی باز کردن فايلها
قبل از اينکه بتوان عمليات ورودی/خروجی را روی يک فايل انجام داد ابتدا بايستی آنرا باز کرد . باز کردن فايلها در ويژوال بيسيک توسط دستور Open انجام می شود . فرمت کلی اين دستور بصورت زير است :
Open filename [For mode] [Access access][lock] As [#]filenumber [Len=reclen]x
[ پارامترهای داخل کروشه اختياری هستند . ]
filename نام فايلی است که می خواهيم آنرا باز کنيم .
mode حالت باز کردن فايل است . اين حالتها عبارتند از :
- Input : فايل بعنوان ورودی باز می شود .
- Output : فايل بعنوان خروجی باز می شود .
- Binary : فايل از نوع باينری باز می شود .
- Append : فايل طوری باز می شود که بتوان به انتهای آن چيزی اضافه کرد .
- Random
access نوع دسترسی به فايل را مشخص می کند . انواع دسترسيها عبارتند از :
- Read : خواندن فايل
- Write : نوشتن در فايل
- ReadWrite : خواندن و نوشتن فايل
lock نوع دسترسی ساير برنامه ها به اين فايل را مشخص می کند . انواع دسترسيها عبارتند از :
- Shared : دسترسی اشتراکی
- Lock Read
- Lock Write
- Lock Read Write
filenumber عددی است که ويژوال بيسيک از آن برای دسترسی به فايل استفاده می کند .اين عدد بايستی برای هر فايل منحصر بفرد و بين ۱ تا ۵۱۱ باشد . برای بدست آوردن اولين شماره آزاد می توان از تابع FreeFile استفاده کرد .
reclen :طول بافر فايل است . اين عدد بايستی از ۳۲۷۶۷ کو چکتر باشد .
در صورتی که فايلی که توسط filename مشخص شده وجود نداشته و فايل برای Append ، Binary ، Output و يا Random باز شده باشد در اينصورت يک فايل جديد با اين نام ساخته می شود .
در صورتی که فايل بصورت باينری باز شده باشد پارامتر Len ناديده گرفته می شود .
چگونگی بستن فايل
پس از پايان کار با فايل برای بستن آن از دستور Close استفاده می کنيم . فرمت اين دستور بصورت زير است :
Close #filenumber
دستور Close بدون هيچ پارامتری تمام فايلهای باز را می بندد .
کار با دايرکتوری
۱ - گرفتن Dir : توسط دستور Dir می توان نام فايلهای موجود در يک دايرکتوری را بر اساس پارامترهايي که به آن می دهيم پيدا کنيم . برای مثال :
Myfile=Dir$("c:\text\*.txt)"x
دستور فوق نام اولين فايل موجود در دايرکتوری C:\TEXT را که پسوند آنها txt باشد در متغير Myfile قرار می دهد . اگر دستور فوق را بدون پارامتر مجدداً اجرا کنيم نام دومين فايل برگرداننده می شد و الی آخر
Dir دارای يک پارامتر اختياری است که نوع فايلهای مورد نظر را نيز می توان با آن مشخص نمود . مثال :
Myfile=Dir$("c:\text\*.txt",vbNormal)x
مقادير ممکن اين پارامتر عبارتند از :
vbNormal ، vbHidden ، vbSystem ، vbDirectory
۲ - تغيير دايرکتوری : برای تغيير دايرکتوری از دستور ChDir استفاده می شود مثال :
ChDir "c:\windows\system32"x
۳ - تغيير درايو : برای تغيير درايو از دستور ChDrive استفاده می شود مثال :
ChDrive "E:"x
۴ - ساخت دايرکتوری : برای ايجاد دايرکتوری جديد از دستور MKDir استفاده می شود مثال :
MKDir "c:\MyFolder"x
۵ - حذف دايرکتوری : برای حذف دايرکتوری از دستور RmDir استفاده می شود مثال :
RmDir "C:\MyFoler"x
قسمت دوم :
ساير عمليات کار با فايل :
۱ - حذف فايل : برای حذف يک يا چند فايل از دستور Kill استفاده می شود :
Kill "C:\Temp\MyFile.txt"x
Kill "C:\Temp\*.txt"x
۲ - انتقال فايل : برای انتقال يک فايل از يک دايرکتوری به دايرکتوری ديگر از دستور Name استفاده می شود . مبدا و مقصد بايستی روی يک درايو باشند . اگر دايرکتوری مبدا و مقصد يکی باشد فايل تغيير نام داده می شود :
Name "C:\Temp\File1.txt" To "C:\Temp2\File2.txt"x
۳ - کپی کردن فايل : برای کپی کردن يک فايل از يک دايرکتوری به دايرکتوری ديگر از دستور FileCopy استفاده می شود :
FileCopy "\File1.txt\ To "C:\Temp\File2.txt"x
۴ - بدست آوردن تاريخ و زمان آخرين تغيير فايل و يا زمان ايجاد فايل : برای اين کار از دستور FileDateTime استفاده می شود . ابتدا بايستی يک متغير از نوع Variant تعريف کرده و سپس توسط اين دستور تاريخ و زمان موردنظر را استخراج کنيم :
Dim FileInfo As Variant
FileInfo=FileDateTime("C:\Temp\MyFile.txt")x
۵ - استخراج طول فايل : برای بدست آوردن طول يک فايل بر حسب بايت از دستور FileLen استفاده می شود :
FileSize=FileLen("C:\MyFile.txt")x
۶ - تغيير صفت يک فايل : برای تغيير صفت يک فايل از دستور SetAttr استفاده می شود . پارامترهای اين دستور عبارتند از :
0 : فايل معمولی
2 : فايل مخفی
4 : فايل سيستمی
SetAttr FileNumber,FileAttrib
مقابله با خطاهای کار با فايل :
در زمان کار با فايلهای احتمال زيادی وجود دارد که خطا بوجود آيد . بنابراين بايستی در زمان کار با فايلها در صورت ممکن از روتينهای مقابله با خطا استفاده کنيم . شايع ترين خطاهای کار با فايل عبارتند از :
۵۲ : شماره يا نام فايل صحيح نيست
۵۳ : فايل پيدا نشد
۵۴ : حالت فايل صحيح نيست
۵۵ : فايل قبلاً باز شده
۵۸ : فايل از قبل وجود دارد
۵۹ : طول رکورد صحيح نيست
۶۱ : ديسک پر است
۶۲ : عبور از انتهای فايل
۶۳ : شماره رکورد صحيح نيست
۷۰ : دسترسی ممنوع است
۷۱ : ديسک آماده نيست
۷۶ : مسير پيدا نشد
در هنگام مقابله با خطا بهتراست از يک ساختار Select-Case استفاده کنيد :
Select Case Err
Case 71
MsgBox "Drive is Not Ready"x
.
.
.
End Select
تابع پیدا کردن تعداد یک اسم مشخص در یک آرایه ای که اسامی در آن ذخیره شده اند. فقط کافیه شما اسمهایی را که می خواید توی اون آرایه ذخیره کنید و بعد این تابعو فراخوانی کنید.
Private Function GetCountOfName(strNames() As String, strKeyName As String) As Long
Dim i As Integer
Dim iUpperIndex As Integer
Dim lCounter As Long
iUpperIndex = UBound(strNames)
For i = 0 To iUpperIndex
If Trim(strNames(i)) = Trim(strKeyName) Then
lCounter = lCounter + 1
End If
Next i
GetCountOfName = lCounter
End Function
2-پیدا کردن مقلوب عدد:
Private Function GetReverseNumber(lInputNumber As Long) As Long
Dim strTemp As String
strTemp = CStr(lInputNumber)
strTemp = StrReverse(strTemp)
GetReverseNumber = CLng(strTemp)
End Function
ويندوز برای برقراری ارتباط با Internet Service Provide- ISP- شما از طريق مودم و خط تلفن در اتصالات dial-up networking ، از سرويسی خاص به اسم RAS (Remote Access Service) استفاده می کند . اين سرويس دارای يک واسط برنامه نويسی است که RAS API نام دارد . اين واسط شامل مجموعه ای از توابع است که شما می توانيد آنها را در برنامه خود صدا بزنيد . RAS API ابزاری بسيار قدرتمند و قابل انعطاف است همچنين بسيار پيچيده می باشد .
خوشبختانه برای استفاده راحتتر ، مايکروسافت تعدادی تابع را در مجموعه ای به اسم WinInet API قرار داده تا بتوان از آنها برای برقراری ارتباط و کنترل اتصال استفاده کرد .آشنايي با WinInet API :
WinInet API مجموعه ای از توابع است که امکان ايجاد و توسعه برنامه های اينترنتی را بصورتی ساده ، سريع و کارآمد برای برنامه نويسان مهيا می کند . با استفاده از اين مجموعه توابع شما می توانيد برنامه هايي بنويسيد که از منابع اينترنتی با استفاده از پروتکلهايي چون HTTP و FTP استفاده کنند . همچنين WinInet به شما اجازه می دهد تا بتوانيد ارتباطی dial-up با يک ISP ايجاد نموده و آنرا کنترل کنيد .
مزيـت اصلی توابع WinInet آينست که شما نيازی به دانستن ساختار پروتکلهای ارتباطی و نيز برنامه نويسی Socket نخواهيد داشت . بعبارت ديگر WinInet يک واسط سطح بالا را برای کار با منابع اينترنتی ارائه می دهد .
امکانات Dial-Up موجود در WinInet :
تا قبل از ارائه اينترنت اکسپلورر ورژن 4 ، WinInet تنها دارای دو تابع dial-up بود :
تابع InternetAttemptConnect : برای بررسی اينکه آيا يک ارتباط به اينترنت وجود دارد يا نه استفاده می شد . اگر هيچ اتصالی به اينترنت وجود نداشت اين برنامه کادر تبادلی dial-up networking را نمايش می داد و کاربر اجازه داشت تا يک اتصال را برای وصل شدن به اينترنت انتخاب کند .
تابع InternetCheckConnection : تابع با استفاده از انجام يک دستور ping به url ای که به تابع داده شده ، بررسی می کرد که آيا ارتباطی به اينترنت وجود دارد يا نه .
اين دو تابع دارای محدوديتهای فراوانی بودند . برای مثال تابع اول نمی تواند بطور اتوماتيک اتصال به اينترنت را برقرار کند و تابع دوم نيز نمی تواند هيچ اطلاعاتی در مورد نوع ارتباط به ما بدهد .
IE نسخه 4 ، تعدادی تابع جديد برای WinInet معرفی کرد که برخی از آنها عبارتند از :
تابع InternetGetConnectedState : اطلاعاتی در مورد نوع ارتباط استفاده شده را بيان می کند . برای مثال اين تابع اطلاع می دهد که نوع ارتباط به اينترنت از طريق مودم است يا شبکه LAN و يا از طريق پروکسی .
تابع InternetAutodial : اين امکان را فراهم می سازد تا يک ارتباط اينترنتی اتوماتيک از طريق مودم را با استفاده از مدخل اتصال پيش فرض که کاربر آنرا در dial-up networking مشخص کرده ايجاد کنيد .
تابع InternetDial : اين تابع کارآمدتر از تابع InternetAutodial است و کادری را نمايش می دهد که کاربر می تواند نوع مدخل مورد نظر خود برای ارتباط تلفنی با اينترنت را انتخاب کند .
تابع InternetAutodialHangup : برای قطع کردن اتصالی مودمی که از طريق تابع InternetAutodial برقرار شده استفاده می شود .
تابع InternetHangUp : برای قطع کردن اتصالی مودمی که از طريق تابع InternetDialبرقرار شده استفاده می شود .
تابع InternetSetDialState : برای تنظيم کردن وضعيت جاری ارتباط اينترنتی استفاده می شود .
توابع Dial-Up :
NameDescriptionInternetGetConnectedStateRetrieves the current state of the Internet connectionInternetAutodialInitiates an unattended dial-up connectionInternetAutodialHangupDisconnects a modem connection initiated byInternetDialInitiates a dial-up connectionInternetHangUpDisconnects a modem connection initiated by InternetDialInternetGoOnlinePrompts the user for permission to initiate a dial-up connection to the given URLInternetSetDialStateSets the current state of the Internet connectionتوابع عمومی اينترنت :Name
Description
InternetOpen
Initializes the Win32 Internet functions
InternetConnect
Opens an FTP, Gopher, or HTTP session for a given site
InternetCloseHandle
Closes a single Internet handle or a subtree of Internet handles
InternetErrorDlg
Displays a dialog box for the error that is passed to InternetErrorDlg
InternetFindNextFile
Continues a file search started as a result of a previous call to FtpFindFirstFile or GopherFindFirstFile
InternetGetLastResponseInfo
Retrieves the last Win32 Internet function error description or server response on the thread calling this function
InternetLockRequestFile
Allows the user to place a lock on the file being used
InternetQueryDataAvailable
Queries the amount of data available
InternetQueryOption
Queries an Internet option on the specified handle
InternetReadFile
Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
InternetReadFileEx
Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
InternetSetFilePointer
Sets a file position for InternetReadFile
InternetSetOption
Sets an Internet option
InternetSetStatusCallback
Sets up a callback function that Win32 Internet functions can call as progress is made during an operation
InternetStatusCallback
Placeholder for the application-defined status callback function
InternetTimeFromSystemTime
Formats a date and time according to the specified RFC format (as specified in the HTTP version 1.0 specification)
InternetTimeToSystemTime
Takes an HTTP time/date string and converts it to a SYSTEMTIME structure
InternetUnlockRequestFile
Unlocks a file that was locked using InternetLockRequestFile
InternetWriteFile
Writes data to an open Internet file
InternetConfirmZoneCrossing
Checks for changes between secure and nonsecure URLs
توابع URL :Name
Description
InternetCanonicalizeUrl
Canonicalizes a URL, which includes converting unsafe characters and spaces into escape sequences.
InternetCombineUrl
Combines a base and relative URL into a single URL. The resultant URL will be canonicalized.
InternetCrackUrl
Cracks a URL into its component parts.
InternetCreateUrl
Creates a URL from its component parts.
InternetOpenUrl
Begins reading a complete FTP, Gopher, or HTTP URL.
توابع FTP :Name
Description
FtpCreateDirectory
Creates a new directory on the FTP server
FtpDeleteFile
Deletes a file stored on the FTP server
FtpFindFirstFile
Searches the specified directory of the given FTP session
FtpGetCurrentDirectory
Retrieves the current directory for the given FTP session
FtpGetFile
Retrieves a file from the FTP server and stores it under the specified file name, creating a new local file in the process
FtpPutFile
Stores a file on the FTP server
FtpRemoveDirectory
Removes the specified directory on the FTP server
FtpRenameFile
Renames a file stored on the FTP server
FtpSetCurrentDirectory
Changes to a different working directory on the FTP server
توابع HTTP :Nameمنبع : dev.ir
Description
HttpAddRequestHeaders
Adds one or more HTTP request headers to the HTTP request handle
HttpEndRequest
Ends an HTTP request
HttpOpenRequest
Opens an HTTP request handle
HttpQueryInfo
Queries for information about an HTTP request
HttpSendRequest
Sends the specified request to the HTTP server
HttpSendRequestEx
Sends the specified request to the HTTP server
بررسی جزئيات توابع Dial-Up موجود در WinInet :
1 – تابع InternetAutodial : بطور اتوماتيک باعث شماره گيری اتصال پيش فرض اينترنت توسط مودم می شود . اگر اتصال با موفقيت انجام شود تابع مقدار true و در غير اينصورت false بر می گرداند .
پارامترهای ورودی تابع :
dwFlags : فلگ کنترل کننده عمليات اتصال می باشد و يکی از مقادير زير را می تواند داشته باشد :
- INTERNET_AUTODIAL_FORCE_ONLINE
- INTERNET_AUTODIAL_FORCE_UNATTENDED
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
2 – تابع InternetAutodialHangup : باعث قطع کردن يک اتصال dial-up اتوماتيک می شود . اگر قطع اتصال با موفقيت انجام شود تابع مقدار true و در غير اينصورت false برمی گرداند . تابع دارای يک پارامتر ورودی به اسم dwReserved است که رزرو شده بود و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
3 – تابع InternetDial : يک اتصال به اينترنت را با استفاده از يک ارتباط مودم مقداردهی اوليه می کند . پارامترهای ورودی آن عبارتند از :
hwndParent : هندل مربوط به پنجره parent
lpszConnectoid : نام ارتباط dial-up مورد استفاده
dwFlags : فلگ کنترل اتصال که يکی از مقادير زير را می تواند داشته باشد :
- INTERNET_AUTODIAL_FORCE_ONLINE
- INTERNET_AUTODIAL_FORCE_UNATTENDED
- INTERNET_DIAL_UNATTENDED : اتصال به اينترنت از طريق مودم بدون نمايش واسط کاربر
lpdwConnection : آدرس داده ای که شامل عدد متناظر با اتصال است .
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
4 – تابع InternetGetConnectedState : اين تابع وضعيت اتصال جاری به اينترنت را بر می گرداند . اگر اتصال برقرار باشد تابع مقدار true و در غير اينصورت false برمی گرداند .
پارامترهای ورودی تابع عبارتند از :
lpdwFlags : توصيف وضعيت اتصال . اين پارامتر يکی از مقادير زير را می تواند داشته باشد :
- INTERNET_CONNECTION_MODEM
- INTERNET_CONNECTION_LAN
- INTERNET_CONNECTION_PROXY
- INTERNET_CONNECTION_MODEM_BUSY
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
5 – تابع InternetGoOnline : پيغامی به کاربر برای دادن مجوز برای مقداردهی اوليه اتصال به يک URL را می دهد . اگر اينکار موفقيت آميز باشد مقدار true و در غير اينصورت false برمی گرداند . پارامترهای ورودی تابع عبارتند از :
lpszURL : URL وب سايت مورد نظر برای اتصال
hwndParent : هندل پنجره parent
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetGoOnline Lib "wininet.dll" (ByVal lpszURL As String, ByVal hwndParent As Long, ByVal dwReserved As Long) As Long
6 – تابع InyernetHangUp : به مودم می گويد که اتصال به اينترنت را قطع کند . پارامترهای اين تابع عبارتند از :
dwConnection : شماره مربوط به اتصالی که می خواهيم آنرا قطع کنيم .
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
7 – تابع InternetSetDialState : تنظيم نمودن وضعيت شماره گيری مودم . اگر تنظيم با موفقيت انجام شود تابع true و در غيراينصورت false برمی گرداند . پارامترهای ورودی تابع عبارتند از :
lpszConnectoid : نام اتصال dial-up
dwState : وضعيت مربوط به اتصال dial-up . در حال حاضر اين پارامتر تنها مقدار INTERNET_DIALSTATE_DISCONNECTED را می تواند داشته باشد .
dwReserved : پارامتری رزرو شده است و بايستی صفر باشد .
چگونگی declare کردن تابع :
Public Declare Function InternetSetDialState Lib "wininet.dll" (ByVal lpszConnectoid As String, ByVal dwState As Long, ByVal dwReserved As Long) As Long
بررسی فلگهای مورد استفاده در توابع dial-up :
1 – فلگهای تابع InternetDial :
Public Const INTERNET_DIAL_UNATTENDED = &H8000& '0x8000
Public Const INTERENT_GOONLINE_REFRESH = &H1 '0x00000001
Public Const INTERENT_GOONLINE_MASK = &H1 '0x00000001
2 – فلگهای تابع InternetAutoDial :
Public Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Public Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
Public Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4
3 – فلگهای تابع InternetGetConnectedState :
Public Const INTERNET_CONNECTION_MODEM = 1
Public Const INTERNET_CONNECTION_LAN = 2
Public Const INTERNET_CONNECTION_PROXY = 4
Public Const INTERNET_CONNECTION_MODEM_BUSY = 8
4 - فلگهای مربوط به dial handler اختصاصی :
Public Const INTERNET_CUSTOMDIAL_CONNECT = 0
Public Const INTERNET_CUSTOMDIAL_UNATTENDED = 1
Public Const INTERNET_CUSTOMDIAL_DISCONNECT = 2
5 – فلگهای عملياتی پشتيبانی شده برای dial handler اختصاصی :
Public Const INTERNET_CUSTOMDIAL_SAFE_FOR_UNATTENDED = 1
Public Const INTERNET_CUSTOMDIAL_WILL_SUPPLY_STATE = 2
Public Const INTERNET_CUSTOMDIAL_CAN_HANGUP = 4
6 - وضعيتهای مربوط به InternetSetDialState :
Public Const INTERNET_DIALSTATE_DISCONNECTED = 1
در اين بخش که آخرين بخش از مباحث WinInet API است برنامه ای نمونه برای کار با توابع مودمی اين کتابخانه ارائه خواهيم داد :
برای نوشتن برنامه ای که بتوان از طريق آن با استفاده از مودم به اينترنت متصل شد بصورت زير عمل می کنيم :
در ابتدا بايستی تابع InternetDial را Declare کنيم :
Private Declare Function InternetDial Lib "wininet.dll" Alias "InternetDialA" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
سپس وضعيت شماره گيری را در متغيری به اسم lOption قرار می دهيم . اين متغير می تواند مقادير زير را داشته باشد :
- DF_FORCE_ONLINE
- DF_FORCE_UNATTENDED
- DF_DIAL_FORCE_PROMPT
- DF_DIAL_UNATTENDED
حال نام اتصالی را که می خواهيم از آن استفاده شود در متغيری به اسم ConnectionName قرار می دهيم .
همچنين دو متغير به اسم ConnectionID و RetVal را از نوع long تعريف می کنيم .
حال تابع InternetDial را بصورت زير صدا می کنيم :
RetVal = InternetDial(Me.hwnd, ConnectionName, lOption, ConnectionID, 0)
اگر RetVal مخالف صفر باشد عمل Dial بدرستی انجام شده است .
برای قطع اتصال فوق بايستی از تابع InternetHangUp استفاده کنيم . برای اينکار ابتدا تابع فوق را Declare می کنيم :
Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
سپس اين تابع را بصورت زير فراخوانی می کنيم :
RetVal = InternetHangUp(ConnectionID, 0)
برای اينکه مودم را مجبور کنيم تا بطور اتوماتيک از اتصال پيش فرض سيستم برای شماره گيری استفاده کند از تابع InternetAutodial استفاده می کنيم .
برای اينکار ابتدا تابع را Declare می کنيم :
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal hwndParent As Long) As Long
سپس تابع را بصورت زير فراخوانی می کنيم :
RetVal = InternetAutodial(ADF_FORCE_UNATTENDED, Me.hwnd)
اگر RetVal مخالف صفر باشد عمل AutoDial بدرستی انجام شده است .
برای قطع اتصالی که توسط AutoDial ايجاد شده از تابع InternetAutodialHangup استفاده می کنيم . ابتدا اين تابع را Declare می کنيم :
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
فراخوانی اين تابع بصورت زير است :
Call InternetAutodialHangup(0)
برای اينکه بفهيم آيا اتصال به اينترنت وجود دارد يا نه از تابع InternetGetConnectedStateEx استفاده می کنيم . برای اينکار ابتدا تابع را Declare می کنيم :
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (lpdwFlags As Long, lpszConnectionName As Long, dwNameLen As Long, ByVal dwReserved As Long) As Long
سپس تابع را بصورت زير فراخوانی می کنيم :
strConnectionName = Space(256)
lNameLen = 256
lPtr = StrPtr(strConnectionName)
lNameLenPtr = VarPtr(lNameLen)
RetVal = InternetGetConnectedStateEx(lConnectionFlags, ByVal lPtr, ByVal lNameLen, 0)
که strConnectionName از نوع String و بقيه متغيرها از نوع Long هستند .
اگر RetVal مخالف صفر باشد اتصال برقرار است .
ثابتهايی که در کدهای فوق استفاده شده عبارتند از :
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1&
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2&
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = 4&
Private Const INTERNET_DIAL_FORCE_PROMPT = &H2000
Private Const INTERNET_DIAL_SHOW_OFFLINE = &H4000
Private Const INTERNET_DIAL_UNATTENDED = &H8000
TAPI چيست ؟
TAPI يا Telephony API يک کتابخانه استاندارد برای کار با مودم و نوشتن برنامه های تلفنی می باشد . برای نمونه می توان از برنامه های Phone Dialer ( شماره گير تلفن ) ، برنامه شبکه سازی تلفنی ( Dialup Networking ) ، برنامه تشخيص پالس مودم برای ضبط اطلاعات وارد شده از طرف کاربران و کاربردهای ديگر در اين زمينه نام برد . اين کتابخانه به شما کمک کمک می کند تا بدون درگير شدن با برنامه نويسی سخت افزار مودم و درايور آن بطور مستقيم بتوانيد برنامه های کاربردیي در اين زمينه بنويسيد .
مروری بر Microsoft Telephony :
Telephony امکان مجتمع سازی کامپيوترها با دستگاههای ارتباطی و شبکه ها را فراهم نموده است . معمولاً دستگاه ارتباطی يک مودم و خط ارتباطی نيز شبکه PSTN ( شبکه عمومی تلفن سوئيچينگ ) می باشد . برخی از کاربردهای Telephony عبارتند از :
۱ - کنفرانسهای مالتی مديا بصورت Multicast
۲ - VoIP
۳ - مرکز پاسخ گويي اتوماتيک
۴ - تماس تلفنی از طريق کامپيوتر روی شبکه PSTN
دياگرام زير معماری Microsoft Telephony را نشان می دهد :
برنامه های TAPI :
برای نوشتن برنامه های کاربردی با استفاده از TAPI بايستی ابتدا در مورد سطح سرويسی که می خواهيم ارائه دهيم تصميم گيری کنيم . برای مثال برای نوشتن يک برنامه شماره گير تلفن نياز به استفاده کامل از TAPI نيست و می توان از قابليتهای خود ويندوز در اين زمينه استفاده کرد ( Assisted Telephony ) . در بخشهای بعدی در مورد سطوح مختلف سرويس در TAPI بيشتر صحبت خواهم کرد .
دومين مطلبی که بايد مورد توجه قرار داد اينست که می خواهيم از TAPI 2.x استفاده کنيم يا از TAPI 3.x . تفاوت ايندو آنست که TAPI ورژن ۲ يک API برمبنای C است در حاليکه ورژن ۳ آن بر مبنای تکنولوژی COM می باشد . در بخشهای بعدی مطالب بيشتری در مورد تفاوتهای اين دو نسخه بيان خواهم کرد .
بخشهای اصلی يک برنامه کامل TAPI عبارتند از :
۱ - TAPI Initialization : شامل load کردن TAPI dll ، اتصال به TAPI Server ، مذاکره در مورد ورژن TAPI و برپاسازی سيستم اطلاع رسانی event می باشد .
۲ - Session Control : مقداردهی اوليه ، دريافت و کنترل تماسها
۳ - Device Control : دريافت و تنظيم اطلاعات دستگاه
۴ - Media Control : تشخيص و يا توليد تونها و ارقام ، کنترل stream
۵ - TAPI Shutdown : آزاد سازی منابع
مقداردهی اوليه TAPI :
عملکرد درست اجزای TAPI نياز به برپاسازی محيط ارتباطی روی کامپيوتر مورد نظر دارد . مراحل اين امر عبارتند از :
۱ - نصب TAPI : زمانيکه سخت افزار و يا نرم افزار برای اولين بار به کامپيوتر اضافه می شود انجام می گيرد . جزئيات کار به سيستم عامل و نرم افزار بستگی دارد .
۲ - مقداردهی ابتدائی : ساخت اشيا و مسيرهای ارتباطی
۳ - مذاکره در مورد ورژن TAPI : برای اطمينان از اينکه اجزای TAPI قادر به تبادل داده ها باشند .
۴ - استخراج اطلاعات منابع : بدست آوردن اطلاعاتی در مورد دستگاهی که می توان از آن در برنامه TAPI مورد نظرمان استفاده نمود .
۵ - Event notification : برپاسازی سيستم اطلاع رسانی event
مقداردهی اوليه TAPI در ويژوال بيسيک :
از منوی Project گزينه References را انتخاب کرده و از ليست مربوطه مورد Microsoft TAPI 3.0 Type Library را انتخاب کنيد .
حال وارد بخش کد نويسی فرمتان شويد و متغير objTAPI را بصورت زير تعريف کنيد :
Dim objTapi As TAPI
سپس در بخش مربوط به Form Load شی objTAPI را بصورت زير ايجاد می کنيم :
Set objTapi = New TAPI
همانطور که در بخشهای قبلی گفته شد ، قبل از فراخوانی هر تابع TAPI ابتدا بايستی آنرا مقداردهی اوليه کنيم . برای مقداردهی اوليه کردن شی TAPI عبارت زير را بنويسيد :
Call objTapi.Initialize
انتخاب يک آدرس :
کد زير نشان می دهد که چگونه می توان با استفاده از شی TAPI در ويژوال بيسيک منابع تلفنی در دسترس را برای يک آدرس که بتواند يک مجموعه مشخص از نيازها را مديريت کند ، بررسی کرد .
توجه داشته باشيد که قبل از انجام اين کار بايستی عمل مقداردهی اوليه TAPI را که در بخش قبل ررسی شد ، انجام دهيد .
نکته : در کد زير عمل error checking انجام نگرفته است و برای استفاده از کد زير در برنامه های واقعی بايستی بخش بررسی خطا را به آن اضافه کنيد .
۱ - تعريف يک شی آدرس و يک شی مجموعه آدرس :
Dim gobjAddress As ITAddress
Dim objCollAddresses As ITCollection
۲ - تنظيم شی objCollAddress بعنوان يک مجموعه آدرس از شی objTapi :
Set objCollAddresses = objTapi.Addresses
۳ - پيدا کردن آدرسی که بتواند از واسط مورد نظر ما پشتيبانی کند :
bFound = False
For indexAddr = 1 To objCollAddresses.Count
Set objCrtAddress = objCollAddresses.Item(indexAddr)x
Set objMediaSupport = objCrtAddress
Set objAddressCapabilities = objCrtAddress
If objMediaSupport.QueryMediaType( nSelectedType ) x
bFound = True
End If
Set objAddressCapabilities = Nothing
Set objMediaSupport = Nothing
Set objCrtAddress = Nothing
If bFound = True Then Exit For
Next indexAddr
در صورتيکه آدرس مورد نظزر پيدا شود برنامه از حلقه خارج شده و gobjAddress يک آدرس قابل استفاده خواهد بود :
Set gobjAddress = objcollAddresses.Item(indexAddr)x
انجام Event Handling در TAPI :
کد زير شامل يک event handler ساده برای TAPI ، رجيستر کردن واسط event ، تنظيم فيلتر event و رجيستر کردن تمام فراخوانيهای دادن اخطار است . هدف اصلی از اين کد اينست که مطمئن شويم بخشی از TAPI که event ها را دريافت می کند پردازشی را قبل از انتقال به بخشهای ديگر انجام دهد .
تعاريفها :
Dim WithEvents gobjTapiWithEvents As TAPI
Attribute gobjTapiWithEvents.VB_VarHelpID = -1
Dim glRegistrationToken As Long
Const TAPI3_CALL_EVENTS =TE_CALLMEDIA Or
TE_CALLNOTIFICATION Or TE_CALLSTATE
تنظيم eventfilter بصورتيکه تمام event های تعريف شده برای TAPI را بپذيرد :
objTapi.EventFilter = TAPI3_CALL_EVENTS
رجيستر کردن event ها :
Set gobjTapiWithEvents = objTapi
Dim fOwner As Boolean, fMonitor As Boolean
Dim lMediaTypes As Long, lCallbackInstance As Long
fOwner = True
fOwner = True
fMonitor = False
lMediaTypes = TAPIMEDIATYPE_AUDIO
lCallbackInstance = 1
glRegistrationToken = gobjTapi.RegisterCallNotifications(gobjAddress,fMo nitor,
fOwner,lMediaTypes,lCallbackInstance)x
انتخاب يک ترمينال :
+ قبل از اينکه يک ترمينال را برای برقراری ارتباط انتخاب کنيد بايستی TAPI Initialization و عمل انتخاب آدرس را انجام داده باشيد .
ابتدا يک متغير از نوع ITBasicCallControl ( واسط کنترل تماس ) تعريف می کنيم :
Dim objCallControl As ITBasicCallControl
Set objCallControl = gobjReceivedCallInfo
سپس يک متغير از نوع ITTerminalSupport ( کوئری از شی آدرس ) تعريف می کنيم :
Dim objTerminalSupport As ITTerminalSupport
Set objTerminalSupport = gobjAddress
سپس متغير ترمينال را تعريف کرده و توسط شی objTerminalSupport يک ترمينال را برای آن استخراج می کنيم :
Dim objTerminal As ITTerminal
Set objTerminal = objTerminalSupport.GetDefaultStaticTerminal(lMedia Type, dir)x
در اينجا ديگر نيازی به شی objTerminalSupport نيست بنابراين آنرا آزاد می کنيم :
Set objTerminalSupport = Nothing
سپس نياز به تعريف شی objStreamControl برای کنترل ترمينال است :
Dim objStreamControl As ITStreamControl
Set objStreamControl = objCallControl
در صورتيکه اين شی ايجاد شود ، به ازای استريم های موجود در ITCollection امکان ايجاد ترمينال در يک حلقه for بررسی می شود و ترمينال مناسب انتخاب می گردد :
If Not (objStreamControl Is Nothing) Then
Dim objITCollStreams As ITCollection
Set objITCollStreams = objStreamControl.Streams
Dim nIndex As Long, objCrtStream As ITStream
For nIndex = 1 To objITCollStreams.Count
Set objCrtStream = objITCollStreams.Item(nIndex)x
If objCrtStream.MediaType = lMediaType Then
If objCrtStream.Direction = dir Then
Call objCrtStream.SelectTerminal(objTerminal)x
End If
End If
Set objCrtStream = Nothing
Next nIndex
Set objITCollStreams = Nothing
Set objStreamControl = Nothing
End If
ايجاد يک تماس ( Make a Call ) :
+ قبل از اين بخش بايستی مراحل TAPI Initialization و عمل انتخاب آدرس انجام شده باشد .
اين بخش برای ايجاد يک شی تماس ، بررسی و مشخص کردن استريمی که با اين تماس در ارتباط است ، انتخاب و ايجاد ترمينالهای مناسب و کامل کردن ارتباط استفاده می شود .
قبل TAPI Initialization و عمل انتخاب آدرس و انتخاب ترمينال انجام شده باشد .
در ابتدا با استفاده از متد CreateCall يک شی تماس ساخته می شود :
Set gobjCall = gobjOrigAddress.CreateCall(strDestAddress, nSelectedType,lMediaTypes)x
سپس در اينجا بايستی کدی که در بخش اول اين درس برای انتخاب ترمينال نوشته شد آورده شود :
}
Select Terminal Code
{
سپس بايستی دستور Connect اجرا شود :
gobjCall.Connect (False)x
False بدين معناست که ارتباط بصورت آسنکرون برقرار می شود .
دريافت يک تماس :
کد زير برای يافتن و يا ايجاد يک ترمينال مناسب برای دريافت يک تماس بکار می رود . بايستی توجه داشته باشيد که قبل از اجرای کد زير بايستی مراحل مقداردهی اوليه ، انتخاب يک آدرس و رجيسر کردن event ها را انجام دهيد . همچنين در کد زير بايستی مرحله انتخاب ترمينال را نيز انجام دهيد . توجه داشته باشيد که در کد زير متغير pEvent يک اشاره گر برای واسط ITCallNotificationEvent است که توسط TAPI به event Handler داده می شود :
If TapiEvent = TE_CALLNOTIFICATION Then
Dim objCallNotificationEvent As ITCallNotificationEvent
Set objCallNotificationEvent = pEvent
Dim gobjReceivedCallInfo As ITCallInfo
Set gobjReceivedCallInfo = objCallNotificationEvent.Call
Dim objCallControl As ITBasicCallControl
Set objCallControl = gobjReceivedCallInfo
objCallControl.Answer
End If
گرفتن اطلاعات ورودی از کيبرد - ۱
Direct Input 8 همانطور که از نامش مشخص است به شما اجازه می دهد که بتوانيد برنامه هايي بنويسيد که توسط هر نوع دستگاه ورودی کنترل شود .
Direct Input 8 دارای چندين مزيت نسبت به استفاده از کنترلهای ورودی خود ويژوال بيسيک دارد – کنترلهايي مثل Form_KeyUp, Form_KeyDown, Form_MouseMove - و همچنين قابليت کنترل بيشتری نسبت به توابع استاندارد Win32 از قبيل GetCursorPos, GetKeyState دارد .
Direct Input 8 سريعتر ، کاراتر و قدرتمند تر بوده و برای ساخت بازيها طراحی شده بنابراين باعث کندی برنامه ها نخواهد شد .
چگونگی کار با Direct Input 8 برای گرفتن ورودی از کيبرد
دو روش برای استفاده از کيبرد در DirectX8 وجود دارد : روش polling و روش event-based که هر دو دارای مزايا و معايبی هستند .
بطور کلی در اغلب طراحيها از روش event-based استفاده می شود زيرا کار با آن راحت تر اسن . در اين روش هر پيغام فرستاده شده ازطرف دستگاه ورودی log می شود و برنامه نيازی به هيچگونه پردازشی بمنظور منتظر ماندن برای يک پيغام از طرف ورودی ندارد ، بنابر اين کاراتر است . در روش polling کنترل کمی دقيقتر و راحتر است .
اگر در مورد برنامه نويسی بر مبنای polling و بر مبنای event اطلاعات کافی نداريد می توانيد از منابع موجود در سايتهايي چون Gamasutra و GameDev استفاده کنيد .
روش Polling
مراحل اين روش عبارتند از :
1 – تعريفات Declerations : يک فرم ايجاد کرده و يک TextBox به نام txtOutput با خصوصيات Multiline ، Locked و Vertical Scroll Bar در آن قرار دهيد . کدهای زير را در بخش کدنويسی اين فرم بنويسيد :
Private Const UsePollingMethod As Boolean = True
Private Const UseEventMethod As Boolean = False
‘نکته مهم اينست که تنها يکی از دو ثابت فوق بايستی True باشد .
Private bRunning As Boolean
‘اين متغير برای polling استفاده می شود
Private DX As DirectX8
Private DI As DirectInput8
‘تعريف شی اصلی DirectX و شی DirectInput
Private DIDevice As DirectInputDevice8
Private DIState As DIKEYBOARDSTATE
‘اين دو شی برای دسترسی به دستگاه ورودی ( کيبرد ) استفاده می شوند
Private KeyState(0 To 255) As Boolean
‘آرايه ای برای تشخيص فشرده شدن کليد
Private Const BufferSize As Long = 10
‘ سايز بافر نگهدارنده event ها . در روش event-based اين مقدار برابر يک و در روش polling برابر 10 تا 20 است ( بسته به سرعت حلقه بازی )
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)x
‘ تابع Sleep برای متوقف کردن حلقه polling در صورت بالا بودن نرخ ورودی
2- مقدار دهی اوليه Initialisation : اين بخش سه مرحله دارد :
در مرحله اول اشيا و Device ها ساخته می شوند .
در مرحله دوم تنظيمات مربوط به Device انجام می شود .
در مرحله سوم به Device می گوئيم که می خواهيم شروع به استفاده از آن کنيم .
در Form_Load کدهای زير را بنويسيد :
Me.Show
Dim I As Long
Dim DevProp As DIPROPLONG
Dim DevInfo As DirectInputDeviceInstance8
Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
If UsePollingMethod And UseEventMethod Then
MsgBox "You must select only one of the constants before running"x
Unload Me
End
End If
If UsePollingMethod Then txtOutput.Text = "Using Polling Method" & vbCrLf
If UseEventMethod Then txtOutput.Text = "Using Event Based Method" & vbCrLf
‘مقداردهی اوليه روش انتخاب شده
Set DX = New DirectX8
Set DI = DX.DirectInputCreate
Set DIDevice = DI.CreateDevice("GUID_SysKeyboard")x
DIDevice.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDevice.SetCooperativeLevel frmMain.hWnd, DISCL_BACKGROUND Or ISCL_NONEXCLUSIVE
‘برپاسازی بافر
DevProp.lHow = DIPH_DEVICE
DevProp.lData = BufferSize
DIDevice.SetProperty DIPROP_BUFFERSIZE, DevProp
‘ به دايرکت ايکس می گوئيم که می خواهيم از دستگاه ورودی استفاده کنيم
DIDevice.Acquire
‘استخراج اطلاعاتی در مورد دستگاه ورودی
Set DevInfo = DIDevice.GetDeviceInfo()x
txtOutput.Text = txtOutput.Text & "Product Name: " & DevInfo.GetProductName & vbCrLf
txtOutput.Text = txtOutput.Text & "Device Type: " & DevInfo.GetDevType & vbCrLf
txtOutput.Text = txtOutput.Text & "GUID: " & DevInfo.GetGuidInstance & vbCrLf
‘در صورتی که بخواهيم به برنامه خاتمه بدهيم کدهای زير را می نويسيم
DIDevice.Unacquire
Set DIDevice = Nothing
Set DI = Nothing
Set DX = Nothing
Unload Me
End
3 – گرفتن ورودی از کيبرد : در اين بخش فرض کنيد بخواهيم يک بازی را در يک حلقه Do-Loop شبيه سازی کنيم . در اين حلقه هر بار فشرده شدن کليدهای کيبرد را چک می کنيم :
If Not Err.Number Then bRunning = True
Do While bRunning
‘دريافت اطلاعات شامل خواندن وضعيت کيبرد ، خواندن اطلاعات بافر و سپس خطا
DIDevice.GetDeviceStateKeyboard DIState
DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
If Err.Number = DI_BUFFEROVERFLOW Then
Msgbox(“BUFFER OVERFLOW (Compensating)...")x
GoTo ENDOFLOOP:
End If
‘بررسی فشرده شدن کليدها
For I = 0 To 255
If DIState.Key(I) = 128 And (Not KeyState(I) = True) Then
txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I))& vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
KeyState(I) = True
End If
Next I
‘بررسی رها شدن کليد
For I = 0 To BufferSize
If KeyState(pBuffer(I).lOfs) = True And pBuffer(I).lData = 0 Then
KeyState(pBuffer(I).lOfs) = False
txtOutput.Text = txtOutput.Text & "{ UP } " & KeyNames(CInt(pBuffer(I).lOfs)) & vbCrLf
txtOutput.SelStart = Len(txtOutput.Text)x
End If
Next I
Sleep (50)x
DoEvents
ENDOFLOOP:
Loop
در کد فوق يک تابع KeyName وجود دارد که نام کليد فشارداده شده را بر می گرداند . بخشی از اين تابع را در زير می بينيد :
Function KeyNames(iNum As Integer) As String
Dim aKeys(0 To 255) As String
aKeys(1) = "DIK_ESCAPE"
aKeys(2) = "DIK_1 On main keyboard"x
aKeys(3) = "DIK_2 On main keyboard"x
aKeys(4) = "DIK_3 On main keyboard"x
aKeys(5) = "DIK_4 On main keyboard"x
aKeys(6) = "DIK_5 On main keyboard"x
aKeys(7) = "DIK_6 On main keyboard"x
aKeys(8) = "DIK_7 On main keyboard"x
aKeys(9) = "DIK_8 On main keyboard"x
aKeys(10) = "DIK_9 On main keyboard"x
aKeys(11) = "DIK_0 On main keyboard"x
aKeys(12) = "DIK_MINUS On main keyboard"x
aKeys(13) = "DIK_EQUALS On main keyboard"x
aKeys(14) = "DIK_BACK BACKSPACE"x
aKeys(15) = "DIK_TAB"x
aKeys(16) = "DIK_Q"x
aKeys(17) = "DIK_W"x
aKeys(18) = "DIK_E"x
aKeys(19) = "DIK_R"x
aKeys(20) = "DIK_T"x
.
.
.
KeyNames = aKeys(iNum)x
End Function
موضوع : کنترل کيبرد با روش Event-Based
مقداردهی اوليه و مفاهيم اصلی در روش Event-Based مشابه روش Polling است و تنها بايستی ساختار بخش جمع آوری داده و حلقه پردازشی را تغيير دهيم . مراحل کار با روش Event-Based بصورت زير می باشد :
۱ - تعاريف و مقداردهی اوليه : در بخش تعاريف دو تعريف جديد بصورت زير داريم :
Dim hEvent As Long
Implements DirectXEvent8
hEvent يک پارامتر هندل برای يک می باشد .
نکته : زمانی که کليدی فشرده يا رها می شود ، DirectX اين امر با فراخوانی تابعی به اسم DirectXEvent8_DXCallback به برنامه شما اطلاع می دهد . ( اين نوع توابع را Call Back Function گويند ) . اين تابع به برنامه شما می گويد که يک رويداد اتفق افتاده است و بايستی بافرها را چک کند .
تنها تغييری که در بخش مقداردهی اوليه نياز است ، برپاسازی يک event می باشد :
If UseEventMethod Then
hEvent = DX.CreateEvent(frmMain)x
DIDevice.SetEventNotification hEvent
End If
در انتهای برنامه نيز کد زير را برای از بين بردن event اضافه کنيد :
If hEvent <> 0 Then DX.DestroyEvent hEvent
۲ - استفاده از event : برای اين بخش کدهايي را در داخل تابع DirectXEvent8_DXCallback می نويسيم :
Private Sub DirectXEvent8_DXCallback(ByVal eventid As Long)x
'متغيرهای موردنياز
Dim I As Long
Dim pBuffer(0 To BufferSize) As DIDEVICEOBJECTDATA
If eventid = hEvent Then
If DIDevice Is Nothing Then Exit Sub
'درصورت رخ دادن event داده را از کيبرد می گيريم
DIDevice.GetDeviceStateKeyboard DIState
DIDevice.GetDeviceData pBuffer, DIGDD_DEFAULT
'چک کردن تمام کليدها برای اينکه متوجه شويم چه اتفاقی افتاده است
For I = 0 To 255
'عدد ۱۲۸ نشان دهنده key_down event است .
If DIState.Key(I) = 128 Then
If pBuffer(0).lData = 128 Then
txtOutput.Text = txtOutput.Text & "{ DOWN } " & KeyNames(CInt(I)) & vbCrLf
End If
End If
'کد فوق برای بررسی فشرده شدن يک کليد بود . کد زير رها شدن کليد را بررسی می کند
If (pBuffer(0).lData = 0 And pBuffer(0).lOfs = I) Then
txtOutput.Text = txtOutput.Text & "{ UP }" & KeyNames(CInt(I)) & vbCrLf
End If
txtOutput.SelStart = Len(txtOutput.Text)x
Next I
End If
End Sub
موضوع : کنترل ماوس با DirectX Input
برای استفاده از ماوس در برنامه های مالتی مديا و بازيها همانند کی برد می توانيم از امکانات دايرکت ايکس استفاده کنيم . روش کنترل ماوس توسط DirectX Input بسيار ساده بوده و مشابه کنترل کيبرد می باشد بنابراين درصورتی که دو درس گذشته را نخوانده اين پيشنهاد می کنم ابتدا آنها را مطالعه کنيد .
برپاسازی Device :
علاوه بر متغيرهايي که در بخش کنترل کيبرد تعريف شد بايستی متغيرهای جديد زير را نيز در ابتدای برنامه تان تعريف کنيد :
Private Const mSpeed As Single = 2
Private Const BufferSize As Long = 10
Private mPosition As Point
mSpeed مقدار سرعت حرکت کرسر ماوس را مشخص می کند .
BufferSize سايز بافر DI می باشد .
mPosition موقعيت جاری کرسر ماوس را نشان می دهد .
در مرحله بعدی بايستی مقداردهي های اوليه لازم را انجام دهيد :
Set DIDevice = DI.CreateDevice("guid_SysMouse")x
Call DIDevice.SetCommonDataFormat(DIFORMAT_MOUSE)x
Call DIDevice.SetCooperativeLevel(frmMain.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)x
تفاوت عمده کدهای فوق با کدهای مقداردهی اوليه در بخش کی برد آنست که cooperativelevel تغيير کرده است . در اينجا گفته شده که ما می خواهيم از ماوس بصورت انحصاری در برنامه استفاده کنيم . اين حالت برای برنامه های window-base مناسب نيست و بهترست از آن در بازيهايي که بصورت full screan هستند استفاده کنيد .
خواندن ورودی از ماوس :
در اين بخش می توانيد هم از روش polling و هم event-based استفاده کنيد . نکته مهمی که در اينجا وجود دارد آنست که Direct Input فقط حرکت داده شدن ماوس و کليک شدن يک دکمه را به شما اطلاع می دهد و برای تشخيص حالتهای double click و single click خودتان بايستی کد بنويسيد برای مثال اگر فاصله زمانی بين دو کليک کمتر از ۴۰ ميلی ثانيه باشد آنگاه اين يک double click بوده است .
کد زير حرکت داده شدن ماوس و کليک يکی از سه دکمه آنرا اطلاع می دهد :
Dim DevData(1 To BufferSize) As DIDEVICEOBJECTDATA
Dim nEvents As Long
Dim I As Long
nEvents = DIDevice.GetDeviceData(DevData, DIGDD_DEFAULT)x
For I = 1 To nEvents
Select Case DevData(I).lOfs
Case DIMOFS_X
mPosition.x = mPosition.x + (DevData(I).lData * mSpeed)x
If mPosition.x < 0 Then mPosition.x = 0
If mPosition.x > frmMain.ScaleWidth Then mPosition.x = frmMain.ScaleWidth
imgCursor.Top = mPosition.y
imgCursor.Left = mPosition.x
lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
Case DIMOFS_Y
mPosition.y = mPosition.y + (DevData(I).lData * mSpeed)x
If mPosition.y < 0 Then mPosition.y = 0
If mPosition.y > frmMain.ScaleHeight Then mPosition.y = frmMain.ScaleHeight
imgCursor.Top = mPosition.y
imgCursor.Left = mPosition.x
lablel(1).Caption = "Mouse Coordinates: [" & mPosition.x & ", " & mPosition.y & "]"x
Case DIMOFS_BUTTON0
label(2).Caption = "Button 0 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON1
label(3).Caption = "Button 1 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON2
label(4).Caption = "Button 2 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
Case DIMOFS_BUTTON3
label(5).Caption = "Button 3 State: " & IIf(DevData(I).lData = 0, "Up", "Down")x
End Select
Next I
برای استفاده از کد فوق در روش Polling ، بايستی آنرا در يک حلقه Do while-Loop قرار دهيد .
برای استفاده از کد فوق در روش Event-Based ، بايستی آنرا درون روتين DirectXEvent8_DXCallback قرار دهيد .