Application – Uygulama(kaynak1.v.basic)

Standart 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 SHGetSpecialFolder******** 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_********S"
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 SHGetSpecialFolder********(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