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

نوشته شده توسط مهدی در یکشنبه 88/12/9 و ساعت 10:29 عصر | نظرات دیگران()

قرار دادن آیکون 32 بیتی برای برنامه

 همونطور که می دونید وی بی از آیکون 32 بیتی پشتیبانی نمیکنه و اگه شما آیکونی رو برای فرمتون در نظر بگیرید تنها در صورتی اون آیکون رو می پذیره که یکی یا همه سایزهای آیکون غیر 32 بیتی باشند (مثلا آیکون شما دارای سایز 48 در 48 32 بیتی و 32 در 32 - 32 بیتی و 16 در 16 24 بیتی باشه - وی بی آیکون 16 در 16 - 24 بیتی رو روی فرم نشون میده)

برای حل این مشکل یه آیکون 16 در 16 - 32 بیتی رو به بخش Custom  ریسورس برنامتون اضافه کنید و از تابع getMeICON در بخش Form Load استفاده کنید تا آیکون 32 بیتی روی فرم رسم بشه.

نوشته شده توسط مهدی در یکشنبه 88/12/9 و ساعت 10:23 عصر | نظرات دیگران()

تابعی برای تعیین باز بودن پروسس

Const MAX_PATH = 260
Const TH32CS_SNAPPROCESS = 2&

Private Type PROCESSENTRY32
    lSize            As Long
    lUsage           As Long
    lProcessId       As Long
    lDefaultHeapId   As Long
    lModuleId        As Long
    lThreads         As Long
    lParentProcessId As Long
    lPriClassBase    As Long
    lFlags           As Long
    sExeFile         As String * MAX_PATH
End Type

Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Private Declare Function CreateToolhelpSnapshot Lib "kernel32" _
    Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, _
    ByVal lProcessId As Long) As Long
   
Private Declare Function ProcessFirst Lib "kernel32" _
    Alias "Process32First" (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long
   
Private Declare Function ProcessNext Lib "kernel32" _
    Alias "Process32Next" (ByVal hSnapshot As Long, _
    uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long

Function IsProcessAlive(pId As Long) As Boolean
Dim sExeName   As String
Dim sPid       As String
Dim sParentPid As String
Dim lSnapShot  As Long
Dim r          As Long
Dim uProcess   As PROCESSENTRY32

Dim fProc As Long
IsProcessAlive = False
lSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
uProcess.lSize = Len(uProcess)
r = ProcessFirst(lSnapShot, uProcess)
 Do While r
    If uProcess.lProcessId = pId Then
     IsProcessAlive = True
     Exit Do
    End If
    r = ProcessNext(lSnapShot, uProcess)
Loop
CloseHandle (lSnapShot)

End Function
 

نوشته شده توسط مهدی در یکشنبه 88/12/9 و ساعت 10:15 عصر | نظرات دیگران()

تابعی برای بستن پروسس بر اساس آی دی پروسس

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, _
    ByVal uExitCode As Long) As Long

Public Sub EndProcessPerID(fProc As Long)
 
 Dim mProcID As Long
 mProcID = OpenProcess(1&, -1&, fProc)
 TerminateProcess mProcID, 0&

End Sub

نوشته شده توسط مهدی در یکشنبه 88/12/9 و ساعت 10:13 عصر | نظرات دیگران()

تابعی برای تبدیل hWnd به Pid

Private Const GW_HWNDNEXT = 2

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Public Function hWndToPid(ByVal My_hwnd As Long) As Long
Dim test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long

    " Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)

    " Loop until we find the target or we run out
    " of windows.
    Do While test_hwnd <> 0
        " See if this window has a parent. If not,
        " it is a top-level window.
        If GetParent(test_hwnd) = 0 Then
            " This is a top-level window. See if
            " it has the target instance handle.
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)

            If test_hwnd = My_hwnd Then
                " This is the target.
                hWndToPid = test_pid
                Exit Do
            End If
        End If

        " Examine the next window.
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

نوشته شده توسط مهدی در یکشنبه 88/12/9 و ساعت 10:11 عصر | نظرات دیگران()

تابعی برای تبدیل Pid به hwnd

Private Const GW_HWNDNEXT = 2

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

" Return the window handle for an instance handle.
Public Function PidTohWnd(ByVal target_pid As Long) As Long
Dim test_hwnd As Long
Dim test_pid As Long
Dim test_thread_id As Long

    " Get the first window handle.
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)

    " Loop until we find the target or we run out
    " of windows.
    Do While test_hwnd <> 0
        " See if this window has a parent. If not,
        " it is a top-level window.
        If GetParent(test_hwnd) = 0 Then
            " This is a top-level window. See if
            " it has the target instance handle.
            test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)

            If test_pid = target_pid Then
                " This is the target.
                PidTohWnd = test_hwnd
                Exit Do
            End If
        End If

        " Examine the next window.
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

دانلود

نوشته شده توسط مهدی در یکشنبه 88/12/9 و ساعت 10:8 عصر | نظرات دیگران()

ابنم یه سورس توپ

کارش فرستادن پیام برای برنامه در حال اجراست

اگه شما دوتا برنامه داشته باشین، که از تنظیمات یکسانی توی هردو استفاده کرده باشین، با این روش می تونید با تغییر تنظیمات در هر کدوم از برنامه ها، اون رو به اطلاع برنامه دیگه هم برسونید. به نظر من که عالیه.

نوشته شده توسط مهدی در سه شنبه 88/11/27 و ساعت 9:16 عصر | نظرات دیگران()

این تابع دو ورودی از نوع زمان را دریافت می کنه و اون دوتا رو از هم کم می کنه و میزان اختلاف رو بر می گردونه

Function deduceTime(tStart, tStop) As String
 Dim dtr, dtl, jml As Long
 dtl = (Hour(tStart) * 3600) + _
 (Minute(tStart) * 60) + (Second(tStart))

 dtr = (Hour(tStop) * 3600) + _
 (Minute(tStop) * 60) + (Second(tStop))

 If tStop < tStart Then
   jml = 86400
 Else
   jml = 0
 End If

 jml = jml + (dtr - dtl)

 deduceTime = Format(Str(Int((Int((jml / 3600)) Mod 24))), "00") _
 + ":" + Format(Str(Int((Int((jml / 60)) Mod 60))), "00") + ":" + _
 Format(Str(Int((jml Mod 60))), "00")

End Function

نوشته شده توسط مهدی در سه شنبه 88/11/27 و ساعت 9:2 عصر | نظرات دیگران()

با سلام

نرم افزار های زیر آپدیت گردید:

Wall20 - نرم افزار مدیریت wallpaper - نسخه 2.8

FlashSR - نرم افزار مدیریت فلش مموری - نسخه 1.1

نظر فراموش نشه

نوشته شده توسط مهدی در سه شنبه 88/11/27 و ساعت 8:59 عصر | نظرات دیگران()

یه تابع براتون میذارم که بوسیله اون می تونید به راحتی بر روی دسکتاپ از هر برنامه ای میانبر بسازید:

Public Sub CreateShortCut_Desktop(Target As String, LinkName As String, Deion As String, Optional Hotkey As String = "", Optional Argument As String = "")
 Dim WshShell, oShellLink
 Set WshShell = Create("W.Shell")
 strDesktop = WshShell.SpecialFolders("Desktop")
  a1 = InStrRev(Target, "\")
  a2 = Mid(Target, 1, Val(a1) - 1)
 Set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & LinkName & ".lnk")
 oShellLink.TargetPath = Target
 oShellLink.WindowStyle = 1
 oShellLink.Hotkey = Hotkey
 oShellLink.Deion = Deion
 oShellLink.Arguments = Argument
 oShellLink.WorkingDirectory = a2
 oShellLink.Save
End Sub

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 1:46 عصر | نظرات دیگران()