API

API شماره 1 : API اول درمورد تغییر برچسب درایو هاست . یعنی شما می تونید با این تابع برچسب درایوهارو عوض کنید.

تعریف تابع توی یک ماژول.

Public Declare Function SetVolumeLabelA Lib "kernel32.dll" (ByVal lpRootName As String, ByVal lpVolumeName As String) As Long

lpRootName : مسیر درایو ریشه مثل "C:\" میشه.

lpVolumeName : برچسب جدید درایو مثل "VisualBasic"

نحوه استفاده تو برنامه :شما اول یک متغییر از نوع Long البته با توجه به نوع خروجی تابع تعریف می کنید بعد به صورت زیر استفاده می کنید :

Dim A As Long

()Private Sub Commad1_Click

("A = SetVolumeLabelA("C:\", "VisualBasic

End Sub

>> اگه تابع درست کار کند مقدار A عددی غیر صفر ، در غیر این صورت A=0 خواهد بود.

َAPI شماره 2 : API دوم در مورد محاسبه زمان سپری شده از روشن شدن سیستم شماست . البته بر حسب میلی ثانیه.

--> تعریف تابع توی یک ماژول :

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

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

نحوه استفاده در برنامه : مانند تابع قبل یه منغییر از نوع Long تعریف میکنید و به صورت زیر استفاده می کنید :

Dim A as Long

()Private Sub Command1_Click

A = timeGetTime

Text1.Text = A

End Sub

>>اگر تابع درست کار کند A برابر با زمان سپری شده و در غیر این صورت A=0 خواهد بود.

َAPI شماره 3 : سومی درمورد کپی گرفتن از یک فایله .

تعریف تابع توی یک ماژول :

Public Declare Function CopyFileA Lib "kernel32.dll" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

lpExistingFileName : آدرس فایل مبدا مثل "C:\VB6.txt"

lpNewFileName : آدرس فایل مقصد مثل "D:\VB6.txt"

bFailIfExist : اين متغير مشخص مي کند در صورت وجود فايل مقصد عمليات کپي ادامه يابد يا نه. اگر صفر باشد انجام ميشود و اگر يک باشد انجام نميشود .

نحوه استفاده در برنامه : مانند تابع قبل یه منغییر از نوع Long تعریف میکنید و به صورت زیر استفاده می کنید :

Dim A as Long

()Private Sub Command1_Click

(A=CopyFileA( "C:\VB6.txt","D:\VB6.txt",0

End Sub

>> اگه تابع درست کار کند مقدار A عددی غیر صفر ، در غیر این صورت A=0 خواهد بود.البته میتونید نام فایل رو هم توی مقصد عوض کنید.

َAPI شماره 4 : چهارمی درمورد انتقال یک فایله . اين تابع براي انتقال يک فايل يا پوشه از محلي به محل ديگر مورد استفاده قرار مي گيرد ( توانايي تغيير نام فايل ها و پوشه ها را نيز دارد ).

تعریف تابع توی یک ماژول :

Private Declare Function MoveFile Lib "kernel32.dll" (ByVal lpExistingName As String, ByVal lpNewFileName As String) As Long

lpExistingName : مسير فايل مبدا

lpNewFileName : مسير فايل مقصد( اگر نام فايل متفاوت باشد درحين انتقال نام فايل نيز تغيير خواهدکرد )

نحوه استفاده در برنامه : مانند تابع قبل یه منغییر از نوع Long تعریف میکنید و به صورت زیر استفاده می کنید :

Dim A as Long

()Private Sub Command1_Click

("A=MoveFile( "C:\VB6.txt","D:\VB6.txt

End Sub

>> اگه تابع درست کار کند مقدار A عددی غیر صفر ، در غیر این صورت A=0 خواهد بود.

َAPI شماره 5 : برای باز و بسته کردن CDROM . این تابع از دستور متنی استفاده میکنه.با این تابع کارهای زیادی میشه کرد.

باز هم مثل همیشه کد تابع رو توی یه ماژول تعریف کنید :

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

برای باز شدن CDROM این کد رو بنویسید:

(&)Private Sub OpenCD_Click

&mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0

End Sub

برای بسته شدن CDROM هم کد زیر رو بنویسید :

()Private Sub CloseCD_Click

&mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0

End Sub

همینطور که می بینید این تابع از دستورات ساده چند رسانه ای برای باز کردن سی دی رام استفاده می کنه.

َAPI شماره 6 : برای مخفی کردن نوار TaskBar ویندوز. حال میده برا سر کار گذاشتن .

تعریف تابع و ثابتهای برنامه توی یه ماژول :

Public Hwnd1 As Long

Public Const SWP_HIDEWINDOW = &H80

Public Const SWP_SHOWWINDOW = &H40

Public 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

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

همینطور که می بینید باید با تابع FindWindow اول هندل نوار TaskBar رو پیدا کنیم بعدش با تابع SetWindowPos کار اصلی رو انجام بدیم.

کد مخفی کردن نوار توی یه Button :

()Private Sub HideTask_Click

("" ,"Hwnd1 = FindWindow("Shell_Traywnd

(Call SetWindowPos(Hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW

End Sub

کد نمایش نوار هم توی یه Button دیگه:

()Private Sub ShowTask_Click

(Call SetWindowPos(Hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW

End Sub

َAPI شماره 7 : این API برای مخفی کردن دکمه Start ویندوز.این یکی از تابع قبلی باحالتره.

مثل همیشه تعریف تابع توی یه ماژول.تو این برنامه سه تا تابع لازمه:

Public OP As Long

Public OH As Long

Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public 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

Public Const SW_HIDE = 0

Public Const SW_SHOW = 5

از تابع FindWindow برای پیدا کردن هندل TaskBar و از تابع FindWindowEx برای پیدا کردن هندل دکمه Start که در واقع فرم فرزند (ChildForm) TaskBar ویندوزه استفاده می کنیم.از تابع ShowWindow هم برای کار اصلی استفاده می کنیم.

حالا برای مخفی کردن دکمه Start کد زیر رو مینویسیم:

()Private Sub HideStart_Click

("" ,"OP& = FindWindow("Shell_TrayWnd

(OH& = FindWindowEx(OP&, 0, "Button", vbNullString

ShowWindow OH&, SW_HIDE

End Sub

این کد هم برای نمایش دوباره دکمه Start :

()Private Sub ShowStart_Click

("" ,"OP& = FindWindow("Shell_TrayWnd

(OH& = FindWindowEx(OP&, 0, "Button", vbNullString

ShowWindow OH&, SW_SHOW

End Sub

َAPI شماره 8 : از این تابع برای پیدا کردن مسیر پوشه ویندوز استفاده میشه که خیلی هم به درد می خوره.

کد تابع توی یه ماژول :

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

lpBuffer : مقدار اين بافر توسط تابع مقدار دهي مي شود و مقدار بر گشتي آن مسير نصب ويندوز خواهد بود.

nSize : طول بافر lpBuffer است.

کد اجرایی هم توی Form_Load برنامه :

()Private Sub Form_Load

Dim WINPath As String

Dim StrBuffer As String

((StrBuffer = String(255, Chr$(0

(((WINPath = Left$(StrBuffer, GetWindowsDirectory(StrBuffer, Len(StrBuffer

MsgBox "Windows Folder : " & WINPath

End Sub

API شماره 9 : این تابع لیست همه درایو های سیستم رو برای شما تهیه میکنه.

کد تابع توی یه ماژول :

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

توی این برنامه هم نقش اصلی رو بافر و طول بافر هر درایو که مشخص کننده اون درایوه بازی میکنه.

کد اصلی برنامه هم توی Form_Load :

()Private Sub Form_Load

Dim StrBuffer As String

Me.AutoRedraw = True

((StrBuffer = String(255, Chr$(0

(ret& = GetLogicalDriveStrings(255, StrBuffer

For I = 1 To 100

If Left$(StrBuffer, InStr(1, StrBuffer, Chr$(0))) = Chr$(0) Then Exit For

(Me.Print Left$(StrBuffer, InStr(1, StrBuffer, Chr$(0)) - 1

(((StrBuffer = Right$(StrBuffer, Len(StrBuffer) - InStr(1, StrBuffer, Chr$(0

Next I

End Sub

API شماره 10 : از این تابع برای جستجوی یک فایل استفاده می شه . این تابع برای پیدا کردن فایل مورد نظر همه قسمت های درایو رو جستجو میکنه و اگه فایل پیدا شد مسیر دقیق اون رو برای شما نمایش میده.

تعریف تابع توی ماژول :

Public Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long

Public Const MAX_PATH = 260

RootPath : مسیر محلی که باید جستجو بشه. مثل " C:\ "

InputPathName : اسم فایل با پسوند. مثل " Ali.TXT "

OutputPathBuffer : بافر مسیر خروجی.

ثابت MAX_PATH هم که حداکثر بافر مسیر مورد جستجو رو مشخص میکنه.

کد اصلی باز هم توی Form_Load برنامه :

()Private Sub Form_Load

Dim TempStr As String

Dim Result As Long

(TempStr = String(MAX_PATH, 0

(Result = SearchTreeForFile("C:\", "Ali.txt", TempStr

If Result <> 0 Then

(MsgBox "Located file at " + Left$(TempStr, InStr(1, TempStr, Chr$(0)) - 1

Else

"!MsgBox "File not found

End If

End Sub

از متغییر TempStr برای مقدار دهی به بافر خروجی استفاده شده.

خروجی تابع عددی خواهد شد که در متغییر Result قرارخواهد گرفت.اگر Result=0 باشد بیانگر این است که فایل مورد نظر یافت نشده و اگر Result عددی غیر صفر باشد فایل مورد نظر پیدا شده است.

API شماره 11 : کار این تابع عوض کردن زبان صفحه کلید از انگلیسی به فارسی و بر عکسه.

تابع توی یه ماژول :

Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long

pwszKLID : این متغییر رشته 9 رقمی است که کد زبان رو مشخص میکنه.

flags : مقدار این متغییر برابر (1) خواهد بود.

کد تبدیل به فارسی توی دکمه :

()Private Sub Command1_Click

(StrLocId = LoadKeyboardLayout("00000429", 1

End Sub

کد بازگشت به انگلیسی توی دکمه :

()Private Sub Command2_Click

(StrLocId = LoadKeyboardLayout(vbNull, 1

End Sub

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

برای این کار از تابع زیر استفاده می کنیم :

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

برای این که برنامه بتونه در هر زمان کلید فشرده شده رو تشخیص بده باید یه تایمر (Timer1) رو فرممون قرار بدیم.

کد برنامه :

()Private Sub Timer1_Timer

For i = 1 To 255

results = 0

(results = GetAsyncKeyState(i

If results <> 0 Then

(Label1.Caption = Label1.Caption & (Chr(i

End If

Next I

End Sub

شما باید Interval تایمر رو برابر 100 قرار بدید و یه لیبل هم رو فرم بزارید وخاصیت AutoSize اون رو برابر با True قرار بدید.

 

API شماره 13 : این تابع نوع درایو رو تشخیص میده . بیشتر برای تشخیص درایو CD استفاده میشه.

تابع مورد استفاده در ماژول :

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

nDrive : اسم درایو مثل "\:c"

کد برنامه توی Form_Load :

()Private Sub Form_Load

Me.AutoRedraw = True

("\:Select Case GetDriveType("C

Case Is = 2

"Me.Print "Removable

Case Is = 3

"Me.Print "Drive Fixed

Case Is = 4

"Me.Print "Remote

Case Is = 5

"Me.Print "Cd-Rom

Case Is = 6

"Me.Print "Ram disk

Case Else

"Me.Print "Unrecognized

End Select

End Sub

نکته : درایو سی دی رام و رایتر هر دو CD-Rom شناخته می شوند.

 

API شماره 14 : کار این تابع قفل کردن ماوس و صفحه کلیده .

تابع مور استفاده :

Public Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long

fBlock : اگر مقدار این تابع True باشد ماوس و صفحه کلید قفل خواهند شد و اگر False باشد آزاد خواهند گشت.

کد برنامه در Form_load برنامه :

()Private Sub Form_load

BlockInput True

End Sub

تذکر مهم : شما باید مواظب باشد تا کار دست خودتون ندید.برای همین یه تایمر به برنامه اضافه کنید و Interval اون رو برابر 5000 قرار بدید و کد زیر رو توش بنویسید تا بعد از 5 ثانیه ماوس و صفحه کلیدتون آزاد بشه.

()Private Sub Timer1_Timer

BlockInput False

End Sub

API شماره 15 : کار این تابع ساخت دایرکتوری های تودرتو است که کارش حرف نداره.

کد تابع :

Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

lpPath : مسیر مور نظر.

کد برنامه نمونه توی Form_load :

()Private Sub Form_Load

"\MakeSureDirectoryPathExists "C:\VB6\Is\Very\Good

End Sub

API شماره 16 : این تابع دایرکتوری مورد نظر را حذف می کند.البته اگر خالی باشد.

کد تابع :

Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long

کد برنامه :

()Private Sub Form_Load

"RemoveDirectory "C:\VB6

End Sub

نکته : برای حذف شدن پوشه VB6 هیچگونه پوشه یا فایل نباید داخل آن باشد.

 

API شماره 17 : کار این تابع باز کردن یک مسیر مشخص است.

تعریف تابع :

Public Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

کد نمونه :

()Private Sub Form_Load

WinExec "Explorer.exe C:\Windows", 10

End Sub

API شماره 18 : کار این تابع نمایش دیالوگ ShutDown کردن ویندوزه.

تعریف تابع :

Pubilc Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long

کد نمونه :

()Private Sub Form_Load

SHShutDownDialog 0

End Sub

API شماره 19 : کار این تابع نمایش دیالوگ Run ویندوزه.

تعریف تابع:

Public Declare Function SHRunDialog Lib "shell32" Alias "#61" (ByVal hOwner As Long, ByVal Unknown1 As Long, ByVal Unknown2 As Long, ByVal szTitle As String, ByVal szPrompt As String, ByVal uFlags As Long) As Long

کد نمونه :

()Private Sub Form_Load

Dim STitle As String

Dim SPrompt As String

"...STitle = "Start a program

"...SPrompt = "Type the name of a program

SHRunDialog Me.hWnd, 0, 0, StrConv(STitle, vbUnicode), StrConv(SPrompt, vbUnicode), 0

End Sub

API شماره20: با این تابع می تونیم درایوها رو فرمت بکنیم.(البته نمایش دیالوگ فرمت).

تعریف تابع و ثابت ها :

Const SHFD_CAPACITY_DEFAULT = 0 ' Default drive capacity

Const SHFD_CAPACITY_360 = 3 ' 360KB, applies to 5.25" drives only

Const SHFD_CAPACITY_720 = 5 ' 720KB, applies to 3.5" drives only

Const SHFD_FORMAT_QUICK = 0 ' Quick format

Const SHFD_FORMAT_FULL = 1 ' Full format

Const SHFD_FORMAT_SYSONLY = 2 ' Copies system files only (Win95)

Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long

کد نمونه :

()Private Sub Form_Load

SHFormatDrive Me.hWnd, 0, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK

End Sub

نکته : عدد 0 و عدد 1 برای فلاپی دیسک و عددهای بالاتر ( به تعداد درایو های شما بستگی دارد ) برای بقیه درایوهاست و اگر هر کدام را وارد کنید دیالوگ مر بوط به فرمت کردن آن درایو نمایش داده خواهد شد.(مثال: عدد 3 دیالوگ درایو C را نمایش خواهد داد ) .

API شماره21: کار این تابع بررسی اتصال شما به شبکه یا اینترنت است.

تعریف تابع :

Const NETWORK_ALIVE_AOL = &H4

Const NETWORK_ALIVE_LAN = &H1

Const NETWORK_ALIVE_WAN = &H2

Private Declare Function IsNetworkAlive Lib "SENSAPI.DLL" (ByRef lpdwFlags As Long) As Long

کد نمونه :

()Private Sub Form_Load

Dim CRes As Long

If IsNetworkAlive(CResult) = 0 Then

"!MsgBox " Not Connected to a Network

Else

MsgBox "Connected to a" & IIf(CRes = NETWORK_ALIVE_AOL, "AOL", IIf(CRes = "NETWORK_ALIVE_LAN, "LAN", "WAN")) & "Network

End If

End Sub

نکته : اگر شما به شبکه اینترنت متصل باشید خروجی شما اتصال شبکه ای WAN خواهد بود .

نکته : این تابع ها فقط در ویندوز اکس پی آزمایش شده اند.

موفق و پیروز باشید . ( Ali Media )