1. مهمان گرامی، جهت ارسال پست، دانلود و سایر امکانات ویژه کاربران عضو، ثبت نام کنید.
    بستن اطلاعیه

سورس های کاربردی و پیشرفته

شروع موضوع توسط hector2141 ‏28/9/12 در انجمن Visual Basic

  1. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    بعلت عدم وجود اشاره گر در ويژوال بيسيک عمليات کار با فايلها در آن نسبتاً ساده می باشد .
    بطور کلی فايلها بر دو نوع هستند :
    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
     
  2. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

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



    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
     
  3. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    رجيستري چيست ؟
    سيستم عامل ويندوز تنظيمات سخت افزاري و نرم افزاري خود را بطور مرکزي در يک بانک اطلاعاتي با ساختار سلسله مراتبي ذخيره مي کند که رجيستري نام دارد . رجيستري جايگزيني براي بسياري از فايلهاي پيکربندي INI ، SYS و COM است که در نسخه هاي اوليه ويندوز موجود بود . رجيستري ، سيستم عامل را با مهيا کردن اطلاعات موردنيز براي اجراي برنامه ها و load شدن component ها ، کنترل مي کند .
    رجيستري شامل انواع مختلفي از اطلاعات مي باشد مثل :
    - اطلاعات سخت افزارهاي نصب شده روي سيستم
    - اطلاعات درايورهاي نصب شده روي سيستم
    - اطلاعات برنامه هاي نصب شده روي سيستم
    - اطلاعات پروتکلهاي شبکه اي مورد استفاده در سيستم
    ساختار رجيستري شامل چندين مجموعه رکورد است که داده هاي اين رکوردها توسط بسياري از برنامه ها و اجزاي سيستم عامل خوانده و يا نوشته مي شود .
    اجزاي رجيستري
    اجزاي تشکيل دهنده رجيستري عبارتند از :
    1 – subtree : Subtree ها همانند folder هاي موجود در ريشه يک درايو هارد هستند . رجستری ويندوز داراي پنج subtree مي باشد :
    - HKEY_LOCAL_MACHINE : شامل تمام داده هاي پيکربندي براي کامپيوتر مي باشد و شامل 5 key است :Hardware ، SAM ، Security ، Software و System
    - HKEY_USERS : شامل داده هاي مربوط به تنظيمات سيستم عامل براي هر user است مثل تنظيمات desktop و محيط ويندوز
    - HKEY_CURRENT_USER : شامل داده هاي کاربر فعلي سيستم
    - HKEY_CLASSES_ROOT : شامل اطلاعات پيکربندي نرم افزار است مثل داده هاي OLE و داده هاي کلاسهاي متناظر با فايل
    - HKEY_CURRENT_CONFIG : شامل اطلاعات مورد نياز براي تنظيمات داريورهاي سخت افزاري و غيره
    2 – Key : key ها همانند folder ها و subfolder هاي روي هارد هستند . هر key متناظر با object هاي نرم افزاري يا سخت افزاري مي باشد . subkey ها key هايي هستند که درون يکسري key قراردارند .
    3 – Entry : هر key داراي يک يا چند entry است . هر entry داراي سه بخش مي باشد :
    - نام Name
    - نوع داده اي Data Type : مقدار هر entry يکي از انواع داده هاي زير است :
    REG_DWORD ، REG_SZ ، REG_EXPAND_SZ ، REG_BINARY ،
    REG_MULTI_SZ ، REG_FULL_RESOURCE_DESCRIPTOT
    - مقدار Value
    نکته 1 : براي مشاهده رجيستري و اعمال تغييرات در آن ( لطفاً اگر هيچ تجربه اي در تنظيم کردن رجيستري نداريد اطلاعات آنرا تغيير ندهيد ) ، مي توانيد از برنامه regedit.exe و يا regedt32.exe موجود در ويندوز استفاده کنيد . براي اينکار کافيست نام برنامه را در کادر Run وارد کنيد .
    ---------------------
    براي کار با رجيستري در ويژوال بيسيک کلاس Registery.bas را مطابق مطالب زير ايجاد کرده و در پروژه هاي خود از آن استفاده کنيد :
     
  4. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    1 - تعريف ثابتهاي مورد نياز : براي نوشتن اين کلاس نياز به تعريف چهار دسته ثابت داريم :

    - ثابتهاي مربوط به تعريف data type هاي entry هاي رجيستري :
    Global Const REG_SZ As Long = 1
    Global Const REG_DWORD As Long = 4

    - ثابتهاي مربوط به تعريف key هاي رجيستري
    Global Const HKEY_CLASSES_ROOT = &H80000000
    Global Const HKEY_CURRENT_USER = &H80000001
    Global Const HKEY_LOCAL_MACHINE = &H80000002
    Global Const HKEY_USERS = &H80000003

    - ثابتهاي مربوط به خطاهاي کار با رجيستري
    Global Const ERROR_NONE = 0
    Global Const ERROR_BADDB = 1
    Global Const ERROR_BADKEY = 2
    Global Const ERROR_CANTOPEN = 3
    Global Const ERROR_CANTREAD = 4
    Global Const ERROR_CANTWRITE = 5
    Global Const ERROR_OUTOFMEMORY = 6
    Global Const ERROR_INVALID_PARAMETER = 7
    Global Const ERROR_ACCESS_DENIED = 8
    Global Const ERROR_INVALID_PARAMETERS = 87
    Global Const ERROR_NO_MORE_ITEMS = 259

    - ثابتهاي متفرقه
    Global Const KEY_ALL_ACCESS = &H3F
    Global Const REG_OPTION_NON_VOLATILE = 0
     
  5. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    2 - Declare کردن Api هاي مورد نياز : براي کار با رجيستري از توابع کتابخانه Advapi32.dll استفاده مي کنيم . اين توابع عبارتند از :

    - تابع RegCloseKey : آزاد کردن handle مربوط به يک key
    Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

    - تابع RegCreateKeyEx : ساخت يک key در رجيستري ( اگر key قبلاً وجود داشته باشد ، اين تابع آنرا باز مي کند ) :
    Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

    - تابع RegOpenKeyEx : باز کردن يک key
    Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

    - تابع RegQueryValueExLong : استخراج type و data ي يک نام متناظر با يک key باز شده
    Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

    Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long

    Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

    - تابع RegSetValueEx : ذخيره يک مقدار در فيلد value يک کليد باز
    Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

    Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

    - تابع RegDeleteKey : پاک کردن يک کليد و کليه اطلاعات مرتبط با آن
    Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)

    - تابع RegDeleteValue : حذف مقدار يک key
    Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String
     
  6. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    3 - توابع کمکي : براي نوشتن توابع اصلي کار با رجيستري نياز به نوشتن توابع کمکي زير است :

    - تابع SetValueEx : با توجه به نوع داده يک کليد ، مقدار موجود در آنرا در يک متغير ذخيره مي کند :
    Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
    Dim lValue As Long
    Dim sValue As String
    Select Case lType
    Case REG_SZ ' type of value is string
    sValue = vValue
    SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))x
    Case REG_DWORD ' type of value is Double word
    lValue = vValue
    SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)x
    End Select
    End Function

    - تابع QueryValueEx : سايز و نوع داده اي يک داده را که بايد خوانده شود مشخص مي کند .
    Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)x
    Select Case lType
    ' For strings
    Case REG_SZ:
    sValue = String(cch, 0)x
    lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)x
    If lrc = ERROR_NONE Then
    vValue = Left$(sValue, cch)x
    Else
    vValue = Empty
    End If
    ' For DWORDS
    Case REG_DWORD:
    lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)x
    If lrc = ERROR_NONE Then vValue = lValue
    Case Else
    'all other data types not supported
    lrc = -1
    End Select
    QueryValueExExit:
    QueryValueEx = lrc
    Exit Function
    QueryValueExError:
    Resume QueryValueExExit
    End Function
     
  7. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    4 - توابع اصلي : توابع مربوط به پاک کردن يک کليد از رجيستري ، ساخت يک کليد جديد در رجيستري و مقداردهي به يک کليد :

    - تابع DeleteKey : اين تابع يک کليد از رجيستري را حذف مي کند . داراي دو پارامتر ورودي است :
    Location که يکي از مقادير HKEY_CLASSES_ROOT ، HKEY_CURRENT_USER
    ، HKEY_LOCAL_MACHINE و يا HKEY_USERS است .
    KeyName که نام کليدي است که بايد از رجيستري حذف شود . اين کليد ممکنست شامل subkey هايي نيز باشد مثلاً Key1\SubKey1
    Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)x
    Dim lRetVal As Long
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)x
    DeleteKey = lRetVal ' return function value
    End Function

    - تابع DeleteValue : اين تابع يک entry را از کليد حذف مي کند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName که نام آن value را مشخص مي کند .
    Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x
    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
    lRetVal = RegDeleteValue(hKey, sValueName)x
    RegCloseKey (hKey)x
    DeleteValue = lRetVal
    End Function

    - تابع CreateNewKey : اين تابع يک کليد جديد ايجاد مي کند . داراي دو پارامتر ورودي است : Location و KeyName
    Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)x
    Dim hNewKey As Long
    Dim lRetVal As Long
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)x
    RegCloseKey (hNewKey)x
    CreateNewKey = lRetVal
    End Function

    - تابع SetKeyValue : اين تابع پارامتر data يک entry را تنظيم مي کند . داراي 5 پارامتر ورودي است : Location ، KeyName ، ValueName ، ValueSetting و ValueType
    Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)x
    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
    lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)x
    RegCloseKey (hKey)x
    SetKeyValue = lRetVal
    End Function

    - تابع QueryValue : اين تابع فيلد داده يک entry را برمي گرداند . داراي سه پارامتر ورودي است : Location ، KeyName و ValueName
    Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)x
    Dim lRetVal As Long
    Dim hKey As Long
    Dim vValue As Variant
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)x
    lRetVal = QueryValueEx(hKey, sValueName, vValue)x
    QueryValue = vValue
    RegCloseKey (hKey)x
    End Function
     
  8. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    ساخت يک انتصاب فايل يا File Association به يک برنامه

    در اين درس می خواهم با استفاده از کلاسی که در درس قبل معرفی شد تابعی بسازيم که توسط آن بتوانيم فايلهای با پسوندی مشخص را به يک برنامه اختصاص دهيم . بعبارت ديگر تابعی بنويسيم که اطلاعات لازم برای باز شدن فايلهايی با پسوند xxx را توسط برنامه MyApp.exe در رجيستری ثبت کند .

    Public Sub CreateAssociation(sExtension As String, sApplication As String, sAppPath As String)x
    Dim sPath, sAppExe As String
    CreateNewKey "." & sExtension, HKEY_CLASSES_ROOT
    SetKeyValue HKEY_CLASSES_ROOT, "." & sExtension, "", sApplication & ".Document", REG_SZ
    CreateNewKey sApplication & ".Document\shell\open\command", HKEY_CLASSES_ROOT
    SetKeyValue HKEY_CLASSES_ROOT, sApplication & ".Document", "", sApplication & " Document", REG_SZ
    sPath = sAppPath & " %1"x
    sAppExe = sApplication & ".exe"x
    SetKeyValue HKEY_CLASSES_ROOT, sApplication& ".Document\shell\open\command", "", sPath, REG_SZ
    CreateNewKey "Software\Microsoft\Windows\CurrentVersion\Exp lore r\FileExts\." & sExtension, HKEY_CURRENT_USER
    SetKeyValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Exp lore r\FileExts\." & sExtension, "Application", sAppExe, REG_SZ
    CreateNewKey "Applications\" & sAppExe & "\shell\open\command", HKEY_CLASSES_ROOT
    SetKeyValue HKEY_CLASSES_ROOT, "Applications\" & sAppExe & "\shell\open\command", "", sPath, REG_SZ
    End Sub

    کاربرد اين تابع بصورت زير است :
    CreateAssociation("xxx","MyApp","c:\MyApp.exe")x

    اجرا شدن يک برنامه در هنگام راه اندازی سيستم

    فرض کنيد می خواهيم برنامه ای بنويسيم که هر بار در هنگام راه اندازي سيستم بطور خودكار اجرا شود. البته نمي خواهم در startup ويندوز ديده شود .
    براي اين كار بايد برنامه موردنظر را در StartUp رجيستري قرار دهيم . به اين ترتيب كه در يكي از كليدهاي زير يك مقدار رشته اي جديد(String Value) ايجاد کنيم و آدرس برنامه را در آن وارد كنيم :
    HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\Curre ntVersion\Run
    HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\Curr entVersion\Run

    براي مثال اگه اسم برنامه مورد نظر MyApp و مسيرش C:\Windows\MyApp.exe است بايد بصورت زير عمل کرد :
    SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run ", "MyApp", "C:\MyApp.exe", REG_SZ


    نکته : البته دو تا راه ديگر برای اينکار وجود دارد که برخی تروجان ها هم از اين روشها استفاده می کنند تا روی سيستم باقی بمانند :
    يكي استفاده از win.ini و نوشتن نام فايل جلوي = run و ديگري استفاده از system.ini و نوشتن نام برنامه جلوي خط explorer.exe .
     
  9. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    نامرئی کردن قسمتهای اضافی فرم

    این کد خیلی کاربردیه، حتماً به دردتون مبخوره. این کد باعث میشه که گوشه ها و قسمتهای اضافی فرم حذف بشه و فقط جاهایی که شما میخواید، قابل رویت باشه. مانند اسکین های Windows Media Player که بسیار زیباست.

    یک پروژه جدید باز کنید و داخل فرمتون یک شئ Shape بذارید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

    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.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

    Const LWA_COLORKEY = &H1

    Const GWL_EXSTYLE = (-20)

    Const WS_EX_LAYERED = &H80000

    Const BM_SETSTATE = &HF3

    Private Sub Form_Load()

    Dim Ret As Long

    Dim CLR As Long

    Me.BackColor = RGB(1, 1, 1) '

    CLR = Me.BackColor

    Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)

    Ret = Ret Or WS_EX_LAYERED

    SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret

    SetLayeredWindowAttributes Me.hWnd, CLR, 0, LWA_COLORKEY

    End Sub
     
  10. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,318
    تشکر شده:
    2,702
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    اعمال مشخصه RightToLeft به کنترلهایی که فاقد این مشخصه اند

    در این روش شما میتونید به هر کنترلی این مشخصه رو اعمال کنید، حتی کنترلهایی که فاقد این مشخصه هستند مثل DirListBox به صورت از راست به چپ در میان. درضمن اگه با فرمتون اینکارو بکنید میبینید که واقعاً به صورت از راست به چپ درمیاد یعنی دکمه Close، Minimize و Maximize از سمت راست فرم به سمت چپ فرم انتقال پیدا میکنن.

    یک پروژه جدید باز کنید و یک DirListBox به فرمتون اضافه کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :

    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 Sub Form_Load()

    SetWindowLong Me.hWnd, -20, GetWindowLong(Me.hWnd, -20) Or &H400000

    SetWindowLong Dir1.hWnd, -20, GetWindowLong(Dir1.hWnd, -20) Or &H400000

    End Sub