اين مطلب رو ميتونين در اينجا بخونين :

http://weblog.mehrzad.net/index.asp?ID=49

برای خوندن مطلب اينجا کليک کنين...

17 بهمن، 1384 

خوب به سلامتی وبسايت رو هم راه انداختم آدرسش هست weblog.mehrzad.net/?cat=1 

همه ی مطالب اين وبلاگ هم داخلش هست بعلاوه مطالب جديد كه بهش اضافه ميشه...فكر نكنم اينجا رو ديگه آپديت كنم و ازين به بعد توی سايت جديد مطلب مينويسم...

سلام.

امروز ميخوام در مورد كار با Process ها يكم بنويسم.مخصوصن در مورد بستن Process برنامه ها.

واسه بستن  Processيه فايل اجرايي(طبق اين راهي كه من بلدم) :
اول بايد آيدي اون Process رو بدست بياريم.
بعد بايد با تابع OpenProcess يه هندل از اون Process بدست بياريم.
بعد با تابع TerminateProcess اون رو ببنديم .

واسه بدست آوردن آيدي Process با توجه به اطلاعاتي كه ما از اون برنامه داريم چند تا راه هست كه من 2 تاشو ميگم.
يكيش با استفاده از اسم يا مسير اون فايلي كه در حال اجراست.
يكيش با استفاده از داشتن هندل يكي از پنجره هاي اون برنامه.

توي راه اول ما با 3 تا تابع ليست Process ها و آيدي اونها رو بدست مياريم.هر كدوم اسمش با اسم مورد نظر ما يكي بود از آيديش استفاده ميكنيم و اون رو ميبنديم.

فعلا همينو ميگم بعد ميرم سراغ راه بعدي.
واسه ي كاري كه گفتم اول بايد با تابع CreateToolhelp32Snapshot (كه واسه بدست آوردن ليست Process ها و يا heap  ها ، Module  ها و... ي  Process بكار ميره) يه هندل ليست از   Process  ها بدست بدست بياريم:

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

بعد با تابع Process32First و Process32Next اطلاعاتي در مورد هر كدوم از Process ها مثل نام فايل و ProcessID  و ... كه با بقيش فعلا كاري بدست بياريم:

Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long

البته اين روش تا اين مرحله فقط اسم فايل رو به ما ميده مثل (notepad.exe) نه آدرس كامل اون رو كه در مورد بدست آوردن آدرس كامل هم توضيح ميدم.

آرگومان اول تابع CreateToolhelp32Snapshot بستگي به ليستي كه ميخواهيم بدست بياريم داره كه ما اينجا چون ميخواهيم ليست همه ي Process هاي سيستم رو بدست بياريم اون رو Private Const TH32CS_SNAPPROCESS = &H2 ميگذاريم.

آرگومان بعدي هم  آيدي Process يه كه ميخواهيم در موردش اطلاعات بدست بياريم كه چون ما اينجا نميخواهيم  اطلاعاتي (ليست Module  ها و ...) در مورد Process خاصي بدست بياريم (چون هنوز IDيي نداريم) و فعلا ميخواهيم خود ليست Process ها رو بدست بياريم و آرگومان اول رو هم TH32CS_SNAPPROCESS قرار داديم اينجا هرچي بگذاريم فرقي نداره. آرگومان دوم براي وقتيه كه آرگومان اول رو چيز ديگه اي بغير از ايني كه ما الان گذشتيم بگذاريم...(فكر كنم زيادي توضيح دادم!!!!)

حالا براي شروع بدست آوردن اطلاعات مورد نظرمون از Process32First استفاده ميكنيم.آرگومان اول هندليه كه با تابع قبلي بدست آورديم.بعدي يه متغير از نوع PROCESSENTRY32 هستش كه تابع اطلاعات مورد نظر رو توي اين قرار ميده:

CONST MAX_PATH = 260
Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * MAX_PATH
End Type

توي اين  szExeFile ٬Type  اسم فايل ، th32ProcessID هم همون آيدي مورد نظرمونه.با بقيش هم همونطور كه گفتم كاري نداريم.
(آرگومان هاي تابع Process3Next هم طبعا مثل Process32First هستش.)
بعد با يك حلقه تا زماني كه مقدار برگشتي تابع Process32Next  صفر نباشه به فراخواني اين تابع ادامه ميديم و توي هر بار فراخواني اطلاعات يكي از Process ها رو بدست مياريم.(وقتي كه تابع صفر برگردونه يعني به انتهاي ليست رسيديم)
بعد از بدست آوردن اطلاعات مورد نظر بايد هندلي كه با تابع CreateToolhelp32Snapshot بدست آورديم رو ببنديم :

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

خوب ميريم سراغ كد :

Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2

Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

Private Sub Command1_Click()
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
    hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    Process.dwSize = Len(Process)
    pResult = Process32First(hSnap, Process)
    Do While pResult <> 0
List1.AddItem Left$(Process.szExeFile, InStr(1, Process.szExeFile, Chr(0)) - 1) & " : " & Process.th32ProcessID
pResult = Process32Next(hSnap, Process)
    Loop
    CloseHandle hSnap
End Sub

همه چيزه اين كد رو به غير از 2 چيز كوچيك توضيح دادم.يكي ايكنه براي اينكه ميخواهيم متغير Process  كه از نوع  PROCESSENTRY32 هستش رو به تابع ارسال كنيم بايد طولش رو توي عضو .dwSize اون قرار بديم.(اين موضوع فقط مال اين تابع و اين نوع نيست...)
بعدي اينكه  از نام فايل اون مقدار مورد نظر رو كه ميخواهيم جدا كنيم و كاراكتر هاي (0) رو از اسم فايل جدا كنيم از Left  و Instr استفاده كرديم .مثل كاري كه توي پست قبلي توضيح دادم.(قبلا از Replace  استفاده ميكردم اما تابلوه كه اين روش سرعتش بيشتره)

خوب تا اينجا فعلا ليست اسم ها و آيدي Process ها رو بدست آورديم.با اين روش و با تابعي كه ميگم ميتونيم  برنامه  اي اسم فايل اجراييش رو داشته باشيم ببنديم.اما چون ممكنه فايل اجرايي 2 تا برنامه ي جدا 1 اسم داشته باشن ميتونه مشكل پيش بياد و بهتره با استفاده از مسير فايل ها كارمون رو انجام بديم كه هنوز روش بدست آوردن مسير رو نگفتم.
الان روش بستن Process به همين روش رو توضيح ميدم بعد ميرم سراغ بدست آوردن مسير...

همونطور كه اول گفتم بايد با OpenProcess يه هندل از Process  ايجاد كنيم :

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

آرگومان اول نوع دسترسي هستش كه ما  PROCESS_ALL_ACCESS = &H1F0FFF (همه ي دسترسي ها) رو ميگذاريم و خيال خودمون رو راحت ميكنيم.

آرگومان بعدي رو هم True بگذارين(تاثيري تو كار ما نداره).بعد هم همون آيديه  Process  هستش . حالا بايد مقدار  برگشتي رو به تابع TerminateProcess بديم :

Private Declare Function TerminateProcess Lib "kernel32" Alias "TerminateProcess" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

آرگومان اول همون هندله.دومي رو هم 0 قرار بدين.
حالا ميخواهيم يه برنامه بنوسيم كه هرچي برنامه ي NotePad كه در حال اجراس رو ببنده.(يا هر فايلي كه اسمش notepad.exe باشه ) :

Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, Uprocess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Sub Command1_Click()
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
Dim AppName As String, pID As Long, hProcess As Long

    hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    Process.dwSize = Len(Process)
    pResult = Process32First(hSnap, Process)
    Do While pResult <> 0
        AppName = Left$(Process.szExeFile, InStr(1, Process.szExeFile, Chr(0)) – 1)
        If StrComp(AppName, "notepad.exe", vbTextCompare) = 0 Then 'file name = notepad.exe  ?
            pID = Process.th32ProcessID
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pID)
            TerminateProcess hProcess, 0
            CloseHandle hProcess
        End If
        pResult = Process32Next(hSnap, Process)
       
    Loop
    CloseHandle hSnap
End Sub

در ضمن بعد از اينكه Process رو بستيم هندل رو هم  با CloseHandle ميبنديم.

خوب حالا مياييم سراغ بدست آوردن آدرس كامل فايل هاي در حال اجرا.
اگه يادتون باشه واسه بدست آوردن يك ليست از كل Process ها وقتي از تابع CreateToolhelp32Snapshot استفاده كرديم آرگومان اول رو  TH32CS_SNAPPROCESS قرار داديم و چون با Process خاصي كار نداشتيم آرگومان دوم رو 0 گذاشتيم.براي اينكه بتونيم اطلاعات ديگه اي از Process ها مانند  اطلاعاتModule  هايي(dll  ها ocx  ها و ...) كه Process داره ازشون استفاده ميكنه (و مسير كامل فايل كه اين هم خودش آدرس يكي از همون Module هاست) رو بدست بياريم بايد روي يك Process تمركز كنيم و مثل دفعه قبل نيست كه با يك حلقه اطلاعاتي رو در مورد همه ي Process ها بدست بياريم.براي اين كار بعد از بدست آوردن آيدي هر  Process ،آرگومان اول تابع رو  Private Const TH32CS_SNAPMODULE = &H8 قرار ميديم و آرگومان دوم رو  هم آيدي اون رو.
حالا به جاي استفاده از Process32First و Process32Next از Module32First و Module32Next استفاده ميكنيم:

Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long

آرگومان اول كه ميدونين چيه.دومي يه متغير از نوع  MODULEENTRY32 هستش كه اطلاعات Module ها توش قرار ميگيره:

Private Const MAX_PATH = 260
Private Type MODULEENTRY32
  dwSize As Long
  th32ModuleID As Long
  th32ProcessID As Long
  GlblcntUsage As Long
  ProccntUsage As Long
  modBaseAddr As Long
  modBaseSize As Long
  hModule As Long
  szModule As String * 256
  szExePath As String * MAX_PATH
End Type

اوني كه ما باش كار داريم szExePath هستش كه مسير اون Module  هستش چون فايلي كه ما ميخواهيم آدرسش رو بدست بياريم هم يكي از همين Module  هاست(اولين Module كه توسط تابع Module32First  برگردونه ميشه) بنابر اين آدرس همون آدرسيه كه ما دنبالشيم.البته szModule  هم فقط اسم Module هستش(بدون مسير)

چون ما اينجا فقط ميخوايم آدرس اولين Module كه همون آدرس فايل Exe هستش رو بدست بياريم و با بقيه  Module  ها كاري نداريم ديگه واسه Module  ها از حلقه استفاده نميكنيم.شما اگه خواستين اين كار رو بكنين فرم كار مثل كد قبيليه كه گذشتم.
كد ما براي بدست آوردن آدرس همه ي فايل هاي در حال اجرا اينطوري ميشه :

Option Explicit
Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPMODULE = &H8
Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * MAX_PATH
End Type
Private Type MODULEENTRY32
  dwSize As Long
  th32ModuleID As Long
  th32ProcessID As Long
  GlblcntUsage As Long
  ProccntUsage As Long
  modBaseAddr As Long
  modBaseSize As Long
  hModule As Long
  szModule As String * 256
  szExePath As String * 260
End Type
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Sub Command1_Click()
'Process :
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
Dim pID As Long
'Module :
Dim hSnapM As Long, Module As MODULEENTRY32
    hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0(
    Process.dwSize = Len(Process(
    pResult = Process32First(hSnap, Process)
    Do While pResult <> 0
        pID = Process.th32ProcessID
'
        hSnapM = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID)
        Module.dwSize = Len(Module)
        Call Module32First(hSnapM, Module)
        List1.AddItem Left$(Module.szExePath, InStr(1, Module.szExePath, Chr(0)) – 1)
        CloseHandle hSnapM
'
        pResult = Process32Next(hSnap, Process)
       
    Loop
    CloseHandle hSnap
End Sub

البته با اين روش به دليلي كه نميدونم آدرس كامل يكسري از فايل ها كه تا اونجايي كه چك كردم Process  اون ها از نوع System  بود و آدرسون هم توي دايركتوريه سيستم(مثل svchost.exe) رو تابع برنميگردونه و فقط اسم اون ها رو برميگردونه!
بگذريم.حالا ميخواهيم برنامه اي كه قبل از اين نوشتيم رو با روش جديدي كه گفتم بنويسيم.يعني بجاي اينكه همه ي فايل هايي كه در حال اجرا هستن و اسمشون notepad.exe هستش رو ببنديم همه ي اونهايي كه آدرسشون c:\windows\systtem32\notepad.exe هست رو ببنديم.كدمون چيز جديدي نداره :

Option Explicit
Private Const MAX_PATH = 260
Private Const TH32CS_SNAPPROCESS = &H2
Private Const TH32CS_SNAPMODULE = &H8
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * MAX_PATH
End Type
Private Type MODULEENTRY32
  dwSize As Long
  th32ModuleID As Long
  th32ProcessID As Long
  GlblcntUsage As Long
  ProccntUsage As Long
  modBaseAddr As Long
  modBaseSize As Long
  hModule As Long
  szModule As String * 256
  szExePath As String * 260
End Type
Private Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Sub Command1_Click()
'Process :
Dim hSnap As Long, pResult As Long, Process As PROCESSENTRY32
Dim pID As Long, hProcess As Long, appPath As String
'Module :
Dim hSnapM As Long, Module As MODULEENTRY32
    hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    Process.dwSize = Len(Process)
    pResult = Process32First(hSnap, Process)
    Do While pResult <> 0
        pID = Process.th32ProcessID
'
        hSnapM = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID)
        Module.dwSize = Len(Modul(
        Call Module32First(hSnapM, Module)
        appPath = Left$(Module.szExePath, InStr(1, Module.szExePath, Chr(0)) – 1)
        If StrComp(appPath, "c:\windows\system32\notepad.exe", vbTextCompare) = 0 Then 'file name = notepad.exe
            pID = Module.th32ProcessID
            hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pID)
            TerminateProcess hProcess, 0
            CloseHandle hProcess
        End If

        CloseHandle hSnapM
'
        pResult = Process32Next(hSnap, Process)
       
    Loop
    CloseHandle hSnap
End Sub

براي تست برنامه فايل notepad.exe رو يكبار از پوشه ي سيستم يبار  هم  از پوشه ي ويندوز باز كنين.برنامه رو اجرا كنين ميبينين فقط اوني كه توي پوشه ي سيستم هستش بسته ميشه.
اينهايي كه تاحالا گفتم در مورد روش اول بدست آوردن ProcessID بود.راه ديگش همونطور كه اول كار اشاره كردم استفاده از هندل يكي از پنجره هاي برنامه هستش.با اين روش مثلا ميتونين برنامه اي كه موس روش هست رو ببندين.واسه اين كار از تابع GetWindowThreadProcessId  استفاده ميكنيم تا آيديه Process  رو بدست بياريم :

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

آرگومان اول هندل مورد نظر هست.دومي هم يك متغير از نوع Long  كه تابع آيديه Process رو توش قرار ميده .(مقدار برگشتي هم آيديه Thread هستش كه كاري باش نداريم) 
بعد از بدست آوردن آيديه Process رو بدست آورديم مثل قبل عمل ميكنيم و برنامه مورد نظر رو ميبنديم.
ميخواهيم برنامه اي بنوسيم كه وقتي روي يك دكمه فشار داده ميشه برنامه اي كه موس روشه بسته بشه.واسه اين كار با تابع هاي GetCursorPos و WindowFromPoint كه قبلا در موردشون گفتم(به آرشيو مراجعه كنين) هندل پنجره اي كه موس روشه رو بدست مياريم و با روشي كه گفتم ميبنديمش :

Option Explicit
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Sub Command1_Click()
Dim wHandle As Long, PAPI As POINTAPI, pID As Long, hProcess As Long
    GetCursorPos PAPI
   wHandle = WindowFromPoint(PAPI.x, PAPI.y)
   GetWindowThreadProcessId wHandle, pID
   hProcess = OpenProcess(PROCESS_ALL_ACCESS, True, pID)
   TerminateProcess hProcess, 0
   CloseHandle hProcess
End Sub

توي اين كد چون بايد موس روي برنامه اي باشه كه بايد بسته بشه با خود موس نميتونين روي دكمه كليك كنين چون برنامه ي خودتون بسته ميشه!!! Focus رو بهش بدين و با Enter كردن اونو فشار بدين!!!!!  :پي

توي اين پست روش هايي واسه بستن Processبرنامه ها  رو گفتم.هدف من از گفتن اين مطلب ها فقط راه بستن Process نبود..با بدست آوردن ProcessID كارهاي زيادي در مورد Process ها و Thread ها و .. ميشه كرد كه اينجا 2 تا روش براي اين كار گفتم...اگه حوصلشو داشتم بازم در مورد Process ها و مخصوصن خوندن memory برنامه ها كه يكي از استفاده هاي باحالش بدست آوردن پسورد ياهو مسنجر (يا برنامه هاي مشابه) هستش مطلب مينويسم(<مثل قبلي ها كه گفتي و ننوشتي؟؟؟:پي)

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

سلام
ميخوام در مورد درست كردن يه برنامه Console توي ويژوال بيسيك با API توضيح بدم(البته خيلي مختصر).خود ويبي امكان درست كردن Console Application رو نداره.

درسته كه برنامه هاي Console  ي كه توي Windows32 درست ميكنيم ظاهرا خيلي فرقي با برنامه هاي تحت داس ندارن اما در محيط داس قابل اجرا نيستن و فقط توي محيط ويندوز ميشه ازشون استفاده كرد.

كارهايي كه كلا بايد انجام بديم اينه كه اول يه instance از پنجره ي كنسول درست كنيم و  قسمتي از حافظه رو  به كنسول مورد نظرمون اختصاص بديم...يه هندل واسه نوشتن،يه هندل واسه خواندن و يه هندل براي دستگيري خطا درست كنيم و عمل خواندن و نوشتن رو  توي كنسول انجام بديم.وقتي اعمال خواندن و نوشتن اطلاعات (تبادل اطلاعات متني بين برنامه و كاربر كه تنها كاريه كه يه كنسول ميتونه بكنه!) تموم شد طبيعتا برنامه كنسول ما بايد تموم بشه پس اون رو ميبنديم و حافظه اي كه بش اختصاص داده شده رو آزاد ميكنيم.

پس براي اولين مرحله تابع AllocConsole  رو فراخواني ميكنيم :

Private Declare Function AllocConsole Lib "kernel32" Alias "AllocConsole" () As Long

كه آرگوماني هم نداره.
آخرين مرحله هم آزاد كردن كنسول هست كه از تابع FreeConsole  استفاده ميشه :

Private Declare Function FreeConsole Lib "kernel32" Alias "FreeConsole" () As Long

حالا براي مثال ما فقط ميخواهيم با لود شدن فرم يك كنسول رو نشون بديم  و با كليك كردن روي دكمه اون رو ببنديم قبل از اينکه اين کد رو توی پروژتون وارد کنين بخاطر مشکلاتی که ممکنه پيش بياد و ويژوال بيسيک ناگهانی بسته بشه(اند ضدحال) و هنگ کنه و اينا اگه به جای اينکه واسه اجرای برنامه از ديباگ استفاده کنين ٬ فايل Exe درست کنين و اونو اجرا کنين بهتره:

Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function AllocConsole Lib "kernel32" () As Long

Private Sub Command1_Click()
    FreeConsole
End Sub

Private Sub Form_Load()
    AllocConsole
End Sub

خوب اين كنسول ما هيچ كاري انجام نميده.ميريم سراغ عمل نوشتن و خواندن.
همونطور كه گفتم براي خواندن بايد يه هندل ايجاد كنيم.براي اين كار از تابع  GetSTDHandle استفاده ميشه:

Private Declare Function GetStdHandle Lib "kernel32" Alias "GetStdHandle" (ByVal nStdHandle As Long) As Long

اين تابع 1 آرگومان ميگيره كه يكي از اين ها ميتونه  باشه :

STD_ERROR_HANDLE  دستگيره براي خطا
STD_INPUT_HANDLE   دستگيره براي خواندن
STD_OUTPUT_HANDLE  دستگيره براي نوشتن

بعد از ايجاد هندل براي نوشتن توي كنسول از تابع WriteConsole  استفاده ميشه:

Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long

آرگومان اول همون هندل براي نوشتنه.دومي متني كه ميخواهيم چاپ بشه.بعدي تعداد كاراكتريه كه ميخواهيم چاپ بشه كه ما به طور پيشفرض طول متني كه ميخواهيم چاپ بشه رو ميگذاريم.2 تا آرگومان بعدي رو هم vbNull قرار بدين.

حالا همون برنامه ي قبلي رو طوري تغيير ميديم كه وقتي پنجره ي كنسول نشون داده شد يك متن چاپ بشه :

Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Const STD_ERROR_HANDLE = -12&
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&

Dim whandle As Long
Private Sub Command1_Click()
    FreeConsole
End Sub

Private Sub Form_Load()
    AllocConsole
    whandle = GetStdHandle(STD_OUTPUT_HANDLE)
SendOutPut "This is a w32 console application!"
End Sub
Sub SendOutPut(strOutPut As String)
     WriteConsole whandle, ByVal strOutPut, Len(strOutPut), vbNull, vbNull
End Sub

توي اين كد من براي نوشتن يه تابع جدا درست كردم.در ضمن به چگونگي ارسال متن به تابع توجه كنين.

حالا ميريم سراغ خوندن.اول با همون تابع GetSTDHandle و دادن آرگومان  STD_INPUT_HANDLEيه هندل واسه خواندن درست ميكنيم.بعد با تابع  ReadConsole يه متن رو ميخونيم:

Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long

آرگومان اول هندل ايجاد شدس.دومي يه متغير هستش كه متن خونده شده توش قرار ميگيره.سومي حداكثر تعداد كاراكتريه كه ميخواهيم خونده بشه و طبيعتا از طول متغيري كه به عنوان آرگومان دوم به تابع داديم نبايد بيشتر باشه.2 تاي ديگه رو هم vbNull  بزارين.

حالا برنامه رو طوري تغيير ميديم كه توي اون پنجره ي كنسول يه متن رو بخونه.بعد از خوندن متن يه پيغام كه حاوي متن هستش نشون داده بشه:

Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Const STD_ERROR_HANDLE = -12&
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&

Dim whandle As Long
Dim rhandle As Long
Dim Result As String
Private Sub Form_Load()
    AllocConsole
    whandle = GetStdHandle(STD_OUTPUT_HANDLE(
    rhandle = GetStdHandle(STD_INPUT_HANDLE(
    SendOutPut "This is a w32 console application! , Enter a text :" & vbCrLf
     Result = GetinPut
     MsgBox Result,vbSystemModal
     FreeConsole
End Sub
Sub SendOutPut(strOutPut As String(
     WriteConsole whandle, ByVal strOutPut, Len(strOutPut), vbNull, vbNull
End Sub
Function GetinPut() As String
    Dim strInput As String * 256
    ReadConsole rhandle, ByVal strInput, Len(strInput), vbNull, vbNull
    GetinPut =  Left(strInput, InStr(strInput,Chr(0)) - 3)
End Function

چون ما نميدونيم مقداري كه كاربر وارد ميكنه طولش چقدره يه مقدار پيشفرض در نظر ميگيريم(اينجا 256)  كه اين مقدار رو  به دلخواه ميتونيم تغيير بديم.
باز هم به چگونگي ارسال متغير -ي كه متن توش قرار ميگيره- كه به تابع ارسال ميشه توجه كنين.
البته متني كه خونده ميشه  كاراكتر هاي اضافه داره.همونطور كه گفتم چون ما طول رشته اي كه كاربر ميخواد  وارد كنه رو نميدونيم  يه طول پيشفرض در نظر گرفتيم و رشته رو از يه كاراكتر خاص پر كرديم مثلا از كاراكتر نال (كد اسكي 0)  .علاوه بر اين كاراكتر ها 2 تا كاراكتر اضافه ي ديگه هم به آخر وردوي اضافه ميشن.يكي كاراكتر با كد اسكي 13 و بعدي 10 (همون Newline  و Return و يا vbCrLf) مثلا اگه اول كار رشته اي كه به تابع داديم مقدارش توي حافظه اين بوده :

00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00

و وروديه كاربر متن API  بوده باشه رشته بعد از خوندن ميشه:

65 80 73 13 10 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00

كه ما با يه Left و ۳٬InStr تا كاراكتر اول رو جدا ميكنيم.

حالا با تركيب عمل خوندن و نوشتن يه برنامه مينويسيم كه يكي از سه مقدار  C B A  رو بگيره و در مقابل مقدار گرفته شده به ترتيب زمان ، تاريخ و يا هر دو رو چاپ كنه.اگه مقدار وارد شده چيزه ديگه اي بود، برنامه بسته بشه.
در ضمن اينجا ديگه از فرم استفاده نميكنيم چون ميخواهيم برنامه مثل يه Console  واقعي بشه.پس فرم رو حذف كنيد و يه Module  به پروژه اضافه كنين و كد زير رو توي Module  وارد كنين :

Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Const STD_ERROR_HANDLE = -12&
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&

Dim whandle As Long
Dim rhandle As Long
Dim Result As String
Private Sub Main()
    AllocConsole
    whandle = GetStdHandle(STD_OUTPUT_HANDLE)
    rhandle = GetStdHandle(STD_INPUT_HANDLE)
    SendOutPut "Press one of the following keys,any other key to exit :" & vbCrLf & _
        "A to get time" & vbCrLf & _
        "B to get date" & vbCrLf & _
        "C to get both" & vbCrLf
    While True
     Result = UCase(GetinPut)
     Select Case Result
        Case "A"
            SendOutPut "Time is " & CStr(Time) & vbCrLf
        Case "B"
            SendOutPut "Date is " & CStr(Date) & vbCrLf
        Case "C"
            SendOutPut "Now is " & CStr(Now) & vbCrLf
        Case Else
            FreeConsole
            End
    End Select
    Wend
End Sub
Sub SendOutPut(strOutPut As String)
     WriteConsole whandle, ByVal strOutPut, Len(strOutPut), vbNull, vbNull
End Sub
Function GetinPut() As String
    Dim strInput As String * 256
    ReadConsole rhandle, ByVal strInput, Len(strInput), vbNull, vbNull
    GetinPut = Left(strInput, InStr(strInput, Chr(0)) - 3)
End Function

خوب! اينم از اين مبحث.البته توابع مختلفي واسه كار با Console  ها هست مثلا واسه رنگي نوشتن و ... كه اگه حوصله كردم تو پست بعدي در همين مورد مينويسم.اميدوارم استفاده كرده باشين .تا برنامه ي بعدي همه ي شما عزيزان رو به خداي بزرگ ميسپارم.خدا نگه داررررررررر