Sonuçlar 1 to 2 of 2

Konu: Application – Uygulama(kaynak1.v.basic)

  1. #1

    Default Application – Uygulama(kaynak1.v.basic)

    Application – Uygulama


    App.ExeName : Çalışan exe dosyasının ismi
    App.Title : Task Manager’da gösterilen isim
    App.Path : Çalışma anında geçerli olan yol
    App.PrevInstace : Program çalışıp çalışmadığı



    With App

    .CompanyName = "ProgKENT Yazılım"

    .EXEName = "Not Defteri.exe"

    .FileDescription = "Visual Basic Programlama Kodları"

    .LegalCopyright = "Ustaglu"

    .LegalTrademarks = "ProgKENT"

    .Major = 6 ‘ Versiyon

    .Minor = 0

    .Revision = 1

    .Title = "ProgKENT Programcının Not Defteri"

    End With



    Uygulamanın Aynı Anda Birden Fazla Çalışmasını Engellemek


    Private Sub Form_Load()
    If App.PrevInstace Then
    Msgbox "Pogram Çalışıyor"
    End
    End If
    End Sub



    Programın Akışını Bir Süre Durdurmak

    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



    Private Sub Command1_Click()

    Sleep (1800)

    MsgBox "Program 1800 mili saniye durdu"

    End Sub


    Program Sürüm Numarası



    Private Sub Command1_Click()

    Me.Caption = App.Title & " Version " & App.Major & "." _

    & App.Minor & "." & App.Revision

    End Sub


    Program İkonunu Görev Çubuğuna Yerleştirmek

    (General)(Declaration)

    Private 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

    Private Const NIM_ADD = &H0

    Private Const NIM_MODIFY = &H1

    Private Const NIM_DELETE = &H2

    Private Const WM_MOUSEMOVE = &H200

    Private Const NIF_MESSAGE = &H1

    Private Const NIF_ICON = &H2

    Private Const NIF_TIP = &H4

    Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _

    (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean

    Dim tk As NOTIFYICONDATA



    Public Sub trayicon(kontrol As Boolean)

    tk.cbSize = Len(tk)

    tk.hwnd = Form1.Picture1.hwnd

    tk.uId = 1&

    tk.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE

    tk.ucallbackMessage = WM_MOUSEMOVE

    tk.hIcon = Form1.Picture1.Picture ‘ İkon resmi

    tk.szTip = " Sarkıntı " & Chr$(0)

    If kontrol = False Then Shell_NotifyIcon NIM_DELETE, tk

    If kontrol = True Then Shell_NotifyIcon NIM_ADD, tk

    End Sub



    Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    If Hex(x) = "1E3C" Then

    Me.PopupMenu MnPr ‘ İkon PopUp mönüsü

    End If

    End Sub



    Private Sub Form_Load()

    trayicon True ' SysTray’e ikon eklenir

    End Sub

    Private Sub Form_Unload(Cancel As Integer)

    trayicon False ' SysTray’den ikon silinir

    End Sub


    Sistem Klasörleri


    (General)(Declaration)
    Option Explicit
    Private Type SHITEMID
    cb As Long
    abID As Byte
    End Type
    Private Type ITEMIDLIST
    mkid As SHITEMID
    End Type
    Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As Any) As Long
    Const MAX_PATH = 260

    Private Sub Form_Load()
    List1.AddItem "CSIDL_DESKTOP": List1.ItemData(List1.NewIndex) = &H0
    List1.AddItem "CSIDL_INTERNET": List1.ItemData(List1.NewIndex) = &H1
    List1.AddItem "CSIDL_PROGRAMS": List1.ItemData(List1.NewIndex) = &H2
    List1.AddItem "CSIDL_CONTROLS": List1.ItemData(List1.NewIndex) = &H3
    List1.AddItem "CSIDL_PRINTERS": List1.ItemData(List1.NewIndex) = &H4
    List1.AddItem "CSIDL_PERSONAL": List1.ItemData(List1.NewIndex) = &H5
    List1.AddItem "CSIDL_FAVORITES": List1.ItemData(List1.NewIndex) = &H6
    List1.AddItem "CSIDL_STARTUP": List1.ItemData(List1.NewIndex) = &H7
    List1.AddItem "CSIDL_RECENT": List1.ItemData(List1.NewIndex) = &H8
    List1.AddItem "CSIDL_SENDTO": List1.ItemData(List1.NewIndex) = &H9
    List1.AddItem "CSIDL_BITBUCKET": List1.ItemData(List1.NewIndex) = &HA
    List1.AddItem "CSIDL_STARTMENU": List1.ItemData(List1.NewIndex) = &HB
    List1.AddItem "CSIDL_DESKTOPDIRECTORY"
    List1.ItemData(List1.NewIndex) = &H10
    List1.AddItem "CSIDL_DRIVES": List1.ItemData(List1.NewIndex) = &H11
    List1.AddItem "CSIDL_NETWORK": List1.ItemData(List1.NewIndex) = &H12
    List1.AddItem "CSIDL_NETHOOD": List1.ItemData(List1.NewIndex) = &H13
    List1.AddItem "CSIDL_FONTS": List1.ItemData(List1.NewIndex) = &H14
    List1.AddItem "CSIDL_TEMPLATES": List1.ItemData(List1.NewIndex) = &H15
    List1.AddItem "CSIDL_COMMON_STARTMENU"
    List1.ItemData(List1.NewIndex) = &H16
    List1.AddItem "CSIDL_COMMON_PROGRAMS"
    List1.ItemData(List1.NewIndex) = &H17
    List1.AddItem "CSIDL_COMMON_STARTUP"
    List1.ItemData(List1.NewIndex) = &H18
    List1.AddItem "CSIDL_COMMON_DESKTOPDIRECTORY"
    List1.ItemData(List1.NewIndex) = &H19
    List1.AddItem "CSIDL_APPDATA": List1.ItemData(List1.NewIndex) = &H1A


    List1.AddItem "CSIDL_PRINTHOOD": List1.ItemData(List1.NewIndex) = &H1B
    List1.AddItem "CSIDL_LOCAL_APPDATA"
    List1.ItemData(List1.NewIndex) = &H1C
    List1.AddItem "CSIDL_ALTSTARTUP": List1.ItemData(List1.NewIndex) = &H1D
    List1.AddItem "CSIDL_COMMON_ALTSTARTUP"
    List1.ItemData(List1.NewIndex) = &H1E
    List1.AddItem "CSIDL_COMMON_FAVORITES"
    List1.ItemData(List1.NewIndex) = &H1F
    List1.AddItem "CSIDL_INTERNET_CACHE"
    List1.ItemData(List1.NewIndex) = &H20
    List1.AddItem "CSIDL_COOKIES": List1.ItemData(List1.NewIndex) = &H21
    List1.AddItem "CSIDL_HISTORY": List1.ItemData(List1.NewIndex) = &H22
    List1.AddItem "CSIDL_COMMON_APPDATA"
    List1.ItemData(List1.NewIndex) = &H23
    List1.AddItem "CSIDL_WINDOWS": List1.ItemData(List1.NewIndex) = &H24
    List1.AddItem "CSIDL_SYSTEM": List1.ItemData(List1.NewIndex) = &H25
    List1.AddItem "CSIDL_PROGRAM_FILES"
    List1.ItemData(List1.NewIndex) = &H26
    List1.AddItem "CSIDL_MYPICTURES": List1.ItemData(List1.NewIndex) = &H27
    List1.AddItem "CSIDL_PROFILE": List1.ItemData(List1.NewIndex) = &H28
    List1.AddItem "CSIDL_SYSTEMX86": List1.ItemData(List1.NewIndex) = &H29
    List1.AddItem "CSIDL_PROGRAM_FILESX86"
    List1.ItemData(List1.NewIndex) = &H2A
    List1.AddItem "CSIDL_PROGRAM_FILES_COMMON"
    List1.ItemData(List1.NewIndex) = &H2B
    List1.AddItem "CSIDL_PROGRAM_FILES_COMMONX86"
    List1.ItemData(List1.NewIndex) = &H2C
    List1.AddItem "CSIDL_COMMON_TEMPLATES"
    List1.ItemData(List1.NewIndex) = &H2D
    List1.AddItem "CSIDL_COMMON_DOCUMENTS"
    List1.ItemData(List1.NewIndex) = &H2E
    List1.AddItem "CSIDL_COMMON_ADMINTOOLS"
    List1.ItemData(List1.NewIndex) = &H2F
    List1.AddItem "CSIDL_ADMINTOOLS": List1.ItemData(List1.NewIndex) = &H30
    List1.AddItem "CSIDL_CONNECTIONS": List1.ItemData(List1.NewIndex) = &H31
    List1.ListIndex = 0
    End Sub

    Private Sub list1_Click()
    Dim idl As Long, aPath As String
    aPath = Space$(MAX_PATH)
    Label1.Caption = " * Yok *"
    If SHGetSpecialFolderLocation(hwnd, List1.ItemData(List1.ListIndex), idl) = 0 Then
    If SHGetPathFromIDList(idl, aPath) Then
    Label1.Caption = Left$(aPath, InStr(aPath, Chr$(0)) - 1)
    End If
    LocalFree idl
    End If
    End Sub


    Komut Satırı Parametresi Kullanmak


    Private Sub Form_Load()
    If Command = "" Then ‘ Komut satırı parametresi kontrol ediliyor
    MsgBox " Komut satırı parametresi yok"
    Else
    MsgBox "Komut satırı parametresi:" & Command
    End If
    End Sub


    TaskBar’ı Saklamak / Göstermek



    (General)(Declaration)
    Dim hWnd1 As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private 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
    Const SWP_HIDEWINDOW = &H80
    Const SWP_SHOWWINDOW = &H40

    Private Sub Command1_Click()
    hWnd1 = FindWindow("Shell_traywnd", "")
    Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) ' Saklar
    End Sub

    Private Sub Command2_Click()
    Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) ' Gösterir
    End Sub


    Uygulamanın Çalışma Klasörünü Bulmak / Değiştirmek


    Private Declare Function GetCurrentDirectory Lib "kernel32" Alias _
    "GetCurrentDirectoryA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long

    Private Declare Function SetCurrentDirectory Lib "kernel32" Alias _

    "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long

    Private Sub Form_Paint()
    Dim Klasor As String
    Klasor = String(255, 0)
    GetCurrentDirectory 255, Klasor ‘ Klasörü bulur
    MsgBox Klasor

    ‘ SetCurrentDirectory App.Path ‘ Klasörü değiştirir

    End Sub


    Shell - Uygulama İçerisinden Bir Başka Programı Çalıştırmak


    Private Sub Command1_Click()

    i = Shell("NotePad.Exe", 3) ‘ Notepad tüm ekranı kaplayacak

    End Sub ‘ şekilde çalıştırılır






    Uygulama İçerisinden Çalıştırılan Programın Bitişini Beklemek

    Function ShellAndWait(FileName As String)

    Dim objScript

    On Error GoTo ERR_OpenForEdit

    Set objScript = CreateObject("WScript.Shell")

    ShellApp = objScript.Run(FileName, 1, True)

    ShellAndWait = True

    EXIT_OpenForEdit:

    Exit Function

    ERR_OpenForEdit:

    MsgBox Err.Description

    GoTo EXIT_OpenForEdit

    End Function



    Private Sub Command1_Click()

    i = ShellAndWait("notepad.exe")

    MsgBox "NotePad kapatıldı"

    End Sub

    Bir Programın Form Sınırları İçerisinde Çalıştırmak

    (General)(Declaration)
    Option Explicit
    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
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long) As Long
    Private old_parent As Long
    Private child_hwnd As Long

    Private Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long
    Dim test_pid As Long
    Dim test_thread_id As Long
    test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
    Do While test_hwnd <> 0
    If GetParent(test_hwnd) = 0 Then
    test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
    If test_pid = target_pid Then
    InstanceToWnd = test_hwnd
    Exit Do
    End If
    End If
    test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
    End Function

    Private Sub Form_Resize()
    Dim hgt As Single
    hgt = ScaleHeight - Picture1.Top
    If hgt < 120 Then hgt = 120
    Picture1.Move 0, Picture1.Top, ScaleWidth, hgt
    End Sub

    Private Sub Command2_Click() ' Program serbest bırakılır form dışına çıkar
    SetParent child_hwnd, old_parent
    Command1.Enabled = True
    Command2.Enabled = False

    End Sub



    Private Sub Command1_Click() ' Program form içerisinde çalıştırır
    Dim pid As Long
    Dim buf As String
    Dim buf_len As Long
    pid = Shell("notepad.exe", vbNormalFocus) ‘ NotePad çalıştırılıyor
    If pid = 0 Then
    MsgBox "Hatalı İşlem"
    Exit Sub
    End If
    child_hwnd = InstanceToWnd(pid)
    old_parent = SetParent(child_hwnd, Picture1.hwnd)
    Command1.Enabled = False
    Command2.Enabled = True
    End Sub


    Uygulamanın TaskManager’da Görülmesini Engellemek

    (General)(Declaration)
    Const RSP_SIMPLE_SERVICE = 1
    Const RSP_UNREGISTER_SERVICE = 0
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function RegisterServiceProcess Lib "kernel32" _
    (ByVal dwProcessID As Long, ByVal dwType As Long) As Long

    Public Sub MakeMeService()
    Dim pid As Long, reserv As Long
    pid = GetCurrentProcessId()
    regserv = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
    End Sub

    Public Sub UnMakeMeService()
    Dim pid As Long, reserv As Long
    pid = GetCurrentProcessId()
    regserv = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
    End Sub

    Private Sub Form_Load()
    MakeMeService
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    UnMakeMeService
    End Sub


    Çalışmakta Olan Programların Listesi

    (General)(Declaration)

    Option Explicit

    Private 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

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

    Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _

    (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long

    Private Declare Function Process32First Lib "kernel32" _

    (ByVal hSnapshot As Long, lppe As Any) As Long

    Private Declare Function Process32Next Lib "kernel32" _

    (ByVal hSnapshot As Long, lppe As Any) As Long

    Private Const TH32CS_SNAPHEAPLIST = &H1

    Private Const TH32CS_SNAPPROCESS = &H2

    Private Const TH32CS_SNAPTHREAD = &H4

    Private Const TH32CS_SNAPMODULE = &H8

    Private Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST + _

    TH32CS_SNAPPROCESS + TH32CS_SNAPTHREAD + _

    TH32CS_SNAPMODULE)

    Private Const TH32CS_INHERIT = &H80000000



    Private Sub Form_Load() ' ListBox Kullanılıyor

    Dim hSnapshot As Long, lRet As Long, P As PROCESSENTRY32

    P.dwSize = Len(P)

    hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, ByVal 0)

    If hSnapshot Then

    lRet = Process32First(hSnapshot, P)

    Do While lRet

    List1.AddItem Left$(P.szExeFile, InStr(P.szExeFile, Chr$(0)) - 1)

    lRet = Process32Next(hSnapshot, P)

    Loop

    lRet = CloseHandle(hSnapshot)

    End If

    End Sub

  2. #2

Similar Threads

  1. Format – Print – Printer(v.basic-kaynak1)
    By Elektronik in forum Visual Basic
    CEvaplar: 1
    Son Mesaj: 26-07-08, 10:48
  2. Image – İmaj-(V.Basic-Kaynak1)
    By Elektronik in forum Visual Basic
    CEvaplar: 1
    Son Mesaj: 24-07-08, 14:21
  3. UpDown – Sayaç(kaynak1-v.basic.)
    By Elektronik in forum Visual Basic
    CEvaplar: 0
    Son Mesaj: 04-11-07, 14:47
  4. SSTab – Tab Kontrol(kaynak1-v.basic)
    By Elektronik in forum Visual Basic
    CEvaplar: 0
    Son Mesaj: 04-11-07, 14:47
  5. Slider – Cetvel(kaynak1.v.basic.)
    By Elektronik in forum Visual Basic
    CEvaplar: 0
    Son Mesaj: 04-11-07, 14:46

Tags for this Thread

Bookmarks

Gönderme izinleri

  • Yeni Konu açamazsınız
  • Konulara cevap yazamazsınız.
  • Eklenti gönderemezsiniz.
  • Mesajlarınızı düzenleme izniniz yok.
  •