Sunday, December 11, 2011

10:14 AM
1
Pernahkah anda membayangkan aplikasi anda yang hanya memakai pemrogramman vb6 atau sering disebut VisualBasic Clasic Bisa berjalan sebagai Service/System di windows XP/VISTA/SEVEN(7) ? ,lalu apakah keuntungan Software/Aplikasi berjalan sebagai Service/System?,Untuk menjawab pertanyaan diatas mari kita bahas terlebih dahulu apa itu Service di Windows.

Windows service adalah sebuah aplikasi yang berjalan dari proses booting pada sistem operasi Microsoft Windows. Windows service berjalan di latar belakang dan menyediakan beberapa fungsi tertentu secara spesifik. Dalam Unix, konsep Windows service identik dengan daemon.
Windows service yang terdapat di dalam Windows NT, Windows 2000, Windows XP, dan Windows Server 2003 (beserta penerusnya) telah mendukung protokol Remote Procedure Call (RPC) dan dapat dipanggil dari komputer jarak jauh melalui jaringan dengan menggunakan Microsoft Management Console (MMC). sumber : wikipedia

Setelah anda membaca penjelasan dari wikipedia selanjutnya ini penjelasan dari saya
Windows service adalah sebuah aplikasi yang berjalan dari proses pemanggilan dari file services.exe , file services.exe ini otomatis dipanggil windows pada saat booting ,dan windows service berjalan di latar belakang(secara background) yang bertugas secara tertentu(tergantung kebutuhan programmer), aplikasi yang berjalan sebagai windows service ini mempunyai hak privilige secara khusus/mendapatkan privilige yang lebih tinggi dibandingkan aplikasi yang berjalan sebagai current user, aplikasi sebagai windows service tidak perlu mendaftarkan dirinya di registry startup karna secara default windows service akan berjalan pada saat windows baru loggon.

Setelah anda melihat penjelasan penjelasan gak jelas diatas pastinya anda sudah mengerti apa itu windows service,maka selanjutnya adalah cara aplikasi kita berjalan sebagai windows services .pada contoh kasus ini saya memakai bahasa pemrogramman VB6. kenapa saya memilih vb6?,karna vb6 adalah bahasa yang sangat mudah ,jadi untuh berbagi ilmu memakai vb6 lebih efisien waktu dibanding jika saya memakai bahasa low level Assembly atau C
Persiapan :
1. Buat sebuah project dengan nama service7
2. Tambahkan referense componen NTVBSvc.tlb
2. Tambah 1 buah form namai dengan nama form1
3. Tambahkan 2 buah commandbutton pada form
    beri nama command1 & command2
    - pada command1 beri caption "Install Service"
    - pada command2 beri caption "Start Service"
4. Tambahkan 1 buah timer dg nama timer1
5. Buat 2 buah module
6. hasilnya seperti ini

Pengkodean :
1. Pada Form1 copas kode dibawah ini
Option Explicit
Dim ServState As SERVICE_STATE
Dim Installed As Boolean
Private Sub Command1_Click()
CheckService
If Not Command1.Enabled Then Exit Sub
Command1.Enabled = False
If Installed Then
    DeleteNTService
Else
    SetNTService
End If
CheckService
End Sub
Private Sub Command2_Click()
CheckService
If Not Command2.Enabled Then Exit Sub
Command2.Enabled = False
If ServState = SERVICE_RUNNING Then
    StopNTService
ElseIf ServState = SERVICE_STOPPED Then
    StartNTService
End If
CheckService
End Sub
Private Sub Form_Load()
CheckService
End Sub
Private Sub Timer1_Timer()
CheckService
End Sub
Private Sub CheckService()
If GetServiceConfig() = 0 Then
Installed = True
Command1.Caption = "Uninstall Service"
ServState = GetServiceStatus()
Select Case ServState
    Case SERVICE_RUNNING
        Command1.Enabled = False
        Command2.Caption = "Stop Service"
        Command2.Enabled = True
    Case SERVICE_STOPPED
        Command1.Enabled = True
        Command2.Caption = "Start Service"
        Command2.Enabled = True
    Case Else
        Command1.Enabled = False
        Command2.Enabled = False
End Select
Else
Installed = False
Command1.Caption = "Install Service"
Command2.Enabled = False
Command1.Enabled = True
End If
End Sub
 2. Pada Module1 copy pastekan kode ini
Option Explicit
Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private ServiceStatus As SERVICE_STATUS
Private hServiceStatus As Long

Public AppPath As String

Private Type QUERY_SERVICE_CONFIG
    dwServiceType As Long
    dwStartType As Long
    dwErrorControl As Long
    lpBinaryPathName As Long
    lpLoadOrderGroup As Long
    dwTagId As Long
    lpDependencies As Long
    lpServiceStartName As Long
    lpDisplayName As Long
End Type

Private Declare Function OpenSCManager Lib "advapi32" Alias "OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName As String, ByVal dwDesiredAccess As Long) As Long
Private Declare Function OpenService Lib "advapi32" Alias "OpenServiceA" (ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal dwDesiredAccess As Long) As Long
Private Declare Function QueryServiceConfig Lib "advapi32" Alias "QueryServiceConfigA" (ByVal hService As Long, lpServiceConfig As QUERY_SERVICE_CONFIG, ByVal cbBufSize As Long, pcbBytesNeeded As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function CloseServiceHandle Lib "advapi32" (ByVal hSCObject As Long) As Long
Private Declare Function QueryServiceStatus Lib "advapi32" (ByVal hService As Long, lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function ControlService Lib "advapi32" (ByVal hService As Long, ByVal dwControl As SERVICE_CONTROL, lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function DeleteService Lib "advapi32" (ByVal hService As Long) As Long
Private Declare Function CreateService Lib "advapi32" Alias "CreateServiceA" (ByVal hSCManager As Long, ByVal lpServiceName As String, ByVal lpDisplayName As String, ByVal dwDesiredAccess As Long, ByVal dwServiceType As Long, ByVal dwStartType As Long, ByVal dwErrorControl As Long, ByVal lpBinaryPathName As String, ByVal lpLoadOrderGroup As String, ByVal lpdwTagId As String, ByVal lpDependencies As String, ByVal lp As String, ByVal lpPassword As String) As Long
Private Declare Function StartService Lib "advapi32" Alias "StartServiceA" (ByVal hService As Long, ByVal dwNumServiceArgs As Long, ByVal lpServiceArgVectors As Long) As Long
      
Private Const SC_MANAGER_CONNECT = &H1&
Private Const SERVICE_QUERY_CONFIG = &H1&
Private Const ERROR_INSUFFICIENT_BUFFER = 122&
Private Const SERVICE_QUERY_STATUS = &H4&
Private Const SC_MANAGER_CREATE_SERVICE = &H2&
Private Const SERVICE_AUTO_START As Long = 2
Private Const SERVICE_ERROR_NORMAL As Long = 1

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SERVICE_CHANGE_CONFIG = &H2&
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8&
Private Const SERVICE_START = &H10&
Private Const SERVICE_STOP = &H20&
Private Const SERVICE_PAUSE_CONTINUE = &H40&
Private Const SERVICE_INTERROGATE = &H80&
Private Const SERVICE_USER_DEFINED_CONTROL = &H100&
Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SERVICE_QUERY_CONFIG Or SERVICE_CHANGE_CONFIG Or SERVICE_QUERY_STATUS Or SERVICE_ENUMERATE_DEPENDENTS Or SERVICE_START Or SERVICE_STOP Or SERVICE_PAUSE_CONTINUE Or SERVICE_INTERROGATE Or SERVICE_USER_DEFINED_CONTROL)

Public Const Service_Name As String = "sharingberita-it.blogspot.com"
Public Const Service_Display_Name As String = "sharingberita-it.blogspot.com"
'Ganti nama dibawah ini dengan nama app kalian
Public Const Service_File_Name As String = "service7.exe -svc"

Public Function GetServiceConfig() As Long
Dim hSCManager As Long, hService As Long
Dim r As Long, SCfg() As QUERY_SERVICE_CONFIG, r1 As Long, s As String

hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
    hService = OpenService(hSCManager, Service_Name, SERVICE_QUERY_CONFIG)
    If hService <> 0 Then
        ReDim SCfg(1 To 1)
        If QueryServiceConfig(hService, SCfg(1), 36, r) = 0 Then
            If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
                r1 = r \ 36 + 1
                ReDim SCfg(1 To r1)
                If QueryServiceConfig(hService, SCfg(1), r1 * 36, r) <> 0 Then
                    s = Space$(255)
                    lstrcpy s, SCfg(1).lpServiceStartName
                    s = Left$(s, lstrlen(s))
                    'frmServiceControl.txtAccount = s
                Else
                    GetServiceConfig = Err.LastDllError
                End If
            Else
                GetServiceConfig = Err.LastDllError
            End If
        End If
        CloseServiceHandle hService
    Else
        GetServiceConfig = Err.LastDllError
    End If
    CloseServiceHandle hSCManager
Else
    GetServiceConfig = Err.LastDllError
End If
End Function

Public Function GetServiceStatus() As SERVICE_STATE
Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
    hService = OpenService(hSCManager, Service_Name, SERVICE_QUERY_STATUS)
    If hService <> 0 Then
        If QueryServiceStatus(hService, Status) Then
            GetServiceStatus = Status.dwCurrentState
        End If
        CloseServiceHandle hService
    End If
    CloseServiceHandle hSCManager
End If
End Function

Public Function DeleteNTService() As Long
Dim hSCManager As Long
Dim hService As Long, Status As SERVICE_STATUS

hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
    hService = OpenService(hSCManager, Service_Name, _
                       SERVICE_ALL_ACCESS)
    If hService <> 0 Then
' Stop service if it is running
        ControlService hService, SERVICE_CONTROL_STOP, Status
        If DeleteService(hService) = 0 Then
            DeleteNTService = Err.LastDllError
        End If
        CloseServiceHandle hService
    Else
        DeleteNTService = Err.LastDllError
    End If
    CloseServiceHandle hSCManager
Else
    DeleteNTService = Err.LastDllError
End If

End Function

Public Function SetNTService() As Long
Dim hSCManager As Long
Dim hService As Long, DomainName As String

hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CREATE_SERVICE)
If hSCManager <> 0 Then
    hService = CreateService(hSCManager, Service_Name, _
                       Service_Display_Name, SERVICE_ALL_ACCESS, _
                       SERVICE_WIN32_OWN_PROCESS Or SERVICE_INTERACTIVE_PROCESS, _
                       SERVICE_AUTO_START, SERVICE_ERROR_NORMAL, _
                       AppPath & Service_File_Name, vbNullString, _
                       vbNullString, vbNullString, "LocalSystem", _
                       vbNullString)
    If hService <> 0 Then
        CloseServiceHandle hService
    Else
        SetNTService = Err.LastDllError
    End If
    CloseServiceHandle hSCManager
Else
    SetNTService = Err.LastDllError
End If
End Function

Public Function StopNTService() As Long
Dim hSCManager As Long, hService As Long, Status As SERVICE_STATUS
hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
    hService = OpenService(hSCManager, Service_Name, SERVICE_STOP)
    If hService <> 0 Then
        If ControlService(hService, SERVICE_CONTROL_STOP, Status) = 0 Then
            StopNTService = Err.LastDllError
        End If
    CloseServiceHandle hService
    Else
        StopNTService = Err.LastDllError
    End If
CloseServiceHandle hSCManager
Else
    StopNTService = Err.LastDllError
End If
End Function

Public Function StartNTService() As Long
Dim hSCManager As Long, hService As Long
hSCManager = OpenSCManager(vbNullString, vbNullString, _
                       SC_MANAGER_CONNECT)
If hSCManager <> 0 Then
    hService = OpenService(hSCManager, Service_Name, SERVICE_START)
    If hService <> 0 Then
        If StartService(hService, 0, 0) = 0 Then
            StartNTService = Err.LastDllError
        End If
    CloseServiceHandle hService
    Else
        StartNTService = Err.LastDllError
    End If
CloseServiceHandle hSCManager
Else
    StartNTService = Err.LastDllError
End If
End Function

Function FncPtr(ByVal fnp As Long) As Long
    FncPtr = fnp
End Function
Public Function StartAsService() As Long
    Dim ThreadId As Long
    StartAsService = CreateThread(0&, 0&, AddressOf ServiceThread, 0&, 0&, ThreadId)
End Function
Private Sub ServiceThread(ByVal dummy As Long)
    Dim ServiceTableEntry As SERVICE_TABLE
    ServiceTableEntry.lpServiceName = ServiceNamePtr
    ServiceTableEntry.lpServiceProc = FncPtr(AddressOf ServiceMain)
    StartServiceCtrlDispatcher ServiceTableEntry
End Sub
Private Sub ServiceMain(ByVal dwArgc As Long, ByVal lpszArgv As Long)
    ServiceStatus.dwServiceType = SERVICE_WIN32_OWN_PROCESS Or SERVICE_INTERACTIVE_PROCESS
    ServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP Or SERVICE_ACCEPT_SHUTDOWN
    ServiceStatus.dwWin32ExitCode = 0&
    ServiceStatus.dwServiceSpecificExitCode = 0&
    ServiceStatus.dwCheckPoint = 0&
    ServiceStatus.dwWaitHint = 0&
    hServiceStatus = RegisterServiceCtrlHandler(Service_Name, AddressOf Handler)
    SetServiceState SERVICE_START_PENDING
    SetEvent hStartEvent
    WaitForSingleObject hStopEvent, INFINITE
End Sub
Private Sub Handler(ByVal fdwControl As Long)
    Select Case fdwControl
        Case SERVICE_CONTROL_SHUTDOWN, SERVICE_CONTROL_STOP
            SetServiceState SERVICE_STOP_PENDING
            SetEvent hStopPendingEvent
        Case Else
            SetServiceState
    End Select
End Sub
Public Sub SetServiceState(Optional ByVal NewState As SERVICE_STATE = 0&)
    If NewState <> 0& Then ServiceStatus.dwCurrentState = NewState
    SetServiceStatus hServiceStatus, ServiceStatus
End Sub
 3. Pada module2 copy pastekan kode dibawah ini :
Option Explicit
Public Const INFINITE = -1&
Private Const WAIT_TIMEOUT = 258&
Private Const msgSETFG = 4160

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion(1 To 128) As Byte
End Type
Public Const VER_PLATFORM_WIN32_NT = 2&
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Public hStopEvent As Long, hStartEvent As Long, hStopPendingEvent
Public IsNTService As Boolean
Public ServiceName() As Byte, ServiceNamePtr As Long
Private Sub MainSvc()
    Dim hnd As Long
    Dim h(0 To 1) As Long

    hStopEvent = CreateEvent(0, 1, 0, vbNullString)
    hStopPendingEvent = CreateEvent(0, 1, 0, vbNullString)
    hStartEvent = CreateEvent(0, 1, 0, vbNullString)
    ServiceName = StrConv(Service_Name, vbFromUnicode)
    ServiceNamePtr = VarPtr(ServiceName(LBound(ServiceName)))

        hnd = StartAsService
        h(0) = hnd
        h(1) = hStartEvent
        IsNTService = WaitForMultipleObjects(2&, h(0), 0&, INFINITE) = 1&
        If Not IsNTService Then
            CloseHandle hnd
            MessageBox 0&, "This program must be started as a service.", App.Title, msgSETFG
        End If
   
    If IsNTService Then
        SetServiceState SERVICE_RUNNING
        Do: DoEvents
        'tambah fungsi loop kalian disini
        Loop While WaitForSingleObject(hStopPendingEvent, 10&) = WAIT_TIMEOUT
       
        SetServiceState SERVICE_STOPPED
        SetEvent hStopEvent
        WaitForSingleObject hnd, INFINITE
        CloseHandle hnd
    End If
    CloseHandle hStopEvent
    CloseHandle hStartEvent
    CloseHandle hStopPendingEvent
End
End Sub
Public Function CheckIsNT() As Boolean
    Dim OSVer As OSVERSIONINFO
    OSVer.dwOSVersionInfoSize = LenB(OSVer)
    GetVersionEx OSVer
    CheckIsNT = OSVer.dwPlatformId = VER_PLATFORM_WIN32_NT
End Function

Sub Main()
If Not CheckIsNT() Then
    MsgBox "This program can Run in windows NT based"
    End
    Exit Sub
End If

AppPath = App.Path
If Right$(AppPath, 1) <> "\" Then AppPath = AppPath & "\"

 If Trim$(Command$) = "-svc" Then
  Call MainSvc
 Else
  Form1.Show
 End If
End Sub
Penyelesaian :
1. compile dengan nama service7.exe
2. jalankan sebagai administrator(jika windows vista/7)
3. tekan tombol install service
4. tekan tombol startservice
5. lihat di task manager
6. selesai

terimakasih comment dipersilakan
credit by ojixzzz

1 komentar:

  1. gan..file reference NTVBSvc.tlb yang di media fire sudah delete..saya bisa mendapatkan file tersebut dimana gan???mohon bantunannya....

    ReplyDelete