Windows 2000/XPおよび2003は、「サービスプログラム」と呼ばれるものをサポートしています。
（1）システムにログインせずに実行できます。
（2）プロセスマネージャーで終了することはできません。
2003年に会社のセットトップボックスプロジェクトを開発していたとき、コースウェアのアップロードとメディアサービスを書きました。
delphi7を実行し、メニューファイルを選択します - > other --->サービスプログラムのフレームワークは、servicedemo.dprとunt_main.pasとして保存します。フレームワークには、サービスがいくつかあります。
（1）displayName：サービスの表示名
（2）名前：サービス名。
ここでは、「Delphi Service Demo」に「Delphiservice」に変更します。 「Servicedemo.exe /インストール」を実行します。サービスと現在のステータスが表示されますが、このサービスは今でも何もできません。 Delphi7のIDEに戻ります。
私たちの計画は、このサービスのメインウィンドウを追加することです関数。
実際、サービスプログラムがWinlogonデスクトップで動作し、コントロールパネルを開いて、「デスクトップとの対話を許可する」ログインのプロパティを表示できます。チェックしてください。私は何をしますか？
ファイル - > new->フォームは、サービスにウィンドウfrmmainを追加し、ユニットをunit_frmmainとして保存し、このウィンドウを手動で作成するように設定します。
unit unit_main;
インタフェース
用途
Windows、メッセージ、Sysutils、クラス、グラフィックス、コントロール、SVCMGR、ダイアログ、Unit_frmmain;
タイプ
tdelphiservice = class（tservice）
手順ServiceContinue（Sender：Tservice; var Conting：Boolean）;
手順ServiceExecute（送信者：Tservice）;
手順ServicePause（送信者：Tservice; var paused：boolean）;
手順ServicesHutDown（送信者：Tservice）;
手順ServiceStart（Sender：Tservice; var Starting：boolean）;
手順ServiceStop（Sender：Tservice; var Stopped：boolean）;
プライベート
{プライベート宣言}
公共
関数GetServiceController：TserviceController;
{公開宣言}
終わり;
var
Delphiservice：tdelphiservice;
frmmain：tfrmmain;
実装
{$ r *.dfm}
手順ServiceController（ctrlcode：dword）;
始める
delphiservice.controller（ctrlcode）;
終わり;
関数tdelphiservice.getServiceController：tservicecontroller;
始める
結果：= ServiceController;
終わり;
手順tdelphiservice.servicecontinue（sender：tservice;
var継続：boolean）;
始める
終了していませんが
始める
睡眠（10）;
serviceThread.processRequests（false）;
終わり;
終わり;
手順tdelphiservice.serviceExecute（sender：tservice）;
始める
終了していませんが
始める
睡眠（10）;
serviceThread.processRequests（false）;
終わり;
終わり;
手順tdelphiservice.servicepause（sender：tservice;
var一時停止：boolean）;
始める
一時停止：= true;
終わり;
手順tdelphiservice.serviceshutdown（sender：tservice）;
始める
gbcanclose：= true;
frmmain.free;
ステータス：= csStopped;
ReportStatus（）;
終わり;
手順tdelphiservice.servicestart（sender：tservice;
var Starting：boolean）;
始める
Start：= true;
svcmgr.application.createform（tfrmmain、frmmain）;
gbcanclose：= false;
frmmain.hide;
終わり;
手順tdelphiservice.servicestop（sender：tservice;
var停止：boolean）;
始める
停止：= true;
gbcanclose：= true;
frmmain.free;
終わり;
終わり。
メインウィンドウユニットは次のとおりです。
unit unit_frmmain;
インタフェース
用途
窓、メッセージ、sysutils、バリアント、クラス、シェラピ、グラフィックス、コントロール、フォーム、
ダイアログ、extctrls、stdctrls;
const
wm_trayicon = wm_user + 1234;
タイプ
tfrmmain = class（tform）
Timer1：Ttimer;
Button1：Tbutton;
手順formcreate（sender：tobject）;
手順formclosequery（sender：tobject; var canclose：boolean）;
手順formdestroy（送信者：tobject）;
手順timer1timer（sender：tobject）;
手順button1click（sender：tobject）;
プライベート
{プライベート宣言}
icondata：tnotifyicondata;
手順Addicontotray;
手順デリコンフロムトレイ。
手順trayiconmessage（var msg：tmessage）;
手順sysbuttonmsg（var msg：tmessage）;
公共
{公開宣言}
終わり;
var
frmmain：tfrmmain;
gbcanclose：boolean;
実装
{$ r *.dfm}
手順tfrmmain.formcreate（sender：tobject）;
始める
formstyle：= fsstayontop;
SetWindowlong（application.handle、gwl_exstyle、ws_ex_toolwindow）;
gbcanclose：= false;
Timer1.interval：= 1000;
Timer1.Enabled：= true;
終わり;
手順tfrmmain.formclosequery（sender：tobject; var canclose：boolean）;
始める
canclose：= gbcanclose;
カンセルではない場合
始める
隠れる;
終わり;
終わり;
手順tfrmmain.formdestroy（sender：tobject）;
始める
Timer1.Enabled：= false;
DeliconFromtray;
終わり;
手順tfrmmain.addicontotray;
始める
Zeromemory（@icondata、sizeof（tnotifyicondata））;
icondata.cbsize：= sizeof（tnotifyicondata）;
icondata.wnd：= handle;
icondata.uid：= 1;
icondata.uflags：= nif_messageまたはnif_iconまたはnif_tip;
icondata.ucallbackmessage：= wm_trayicon;
icondata.hicon：= application.icon.handle;
ICONDATA.SZTIP：= 'Delphi Service Demo Program';
shell_notifyicon（nim_add、@icondata）;
終わり;
手順TFRMMAIN.DELICONFROMTRAY;
始める
shell_notifyicon（nim_delete、@icondata）;
終わり;
手順tfrmmain.sysbuttonmsg（var msg：tmessage）;
始める
if（msg.wparam = sc_close）または
（msg.wparam = sc_minimize）次に非表示にします
それ以外の場合は、デフォルトのアクションを実行します
終わり;
手順tfrmmain.trayiconmessage（var msg：tmessage）;
始める
if（msg.lparam = wm_lbuttondblclk）からshow（）;
終わり;
手順tfrmmain.timer1timer（sender：tobject）;
始める
Addicontotray;
終わり;
手順sendhokkey; stdcall;
var
hdesk_wl：hdesk;
始める
hdesk_wl：= opendesktop（ 'winlogon'、0、false、desktop_journalplayback）;
if（hdesk_wl <> 0）then
if（setthreaddesktop（hdesk_wl）= true）then
postmessage（hwnd_broadcast、wm_hotkey、0、makelong（mod_altまたはmod_control、vk_delete））;
終わり;
手順tfrmmain.button1click（sender：tobject）;
var
dwthreadid：dword;
始める
createThread（nil、0、@sendhokkey、nil、0、dwthreadid）;
終わり;
終わり。
補充：
（1）サービスプログラムのデモンストレーションプログラムについては、次のURLをご覧ください。http：//www.torry.net/pages.php?id=226には、システムサービスを制御および管理する方法を示す複数のコードが含まれています。
（2）覚えておいてください：たとえば、Windowsには複数のデスクトップがあります。画面の送信が発生する場合があります。画面のデスクトップには、現在の画面をデスクトップに切り替える必要があります。
（3）サービスプログラムとデスクトップの間には、次のような動的スイッチング方法もあります。
ユニットServiceDesktop;
インタフェース
関数initservicedesktop：boolean;
手順doneservicedesktop;
実装
Windows、sysutilsを使用します。
const
DefaultWindowStation = 'Winsta0';
defaultdesktop = 'default';
var
Hwinstasave：Hwinsta;
hdesksave：hdesk;
Hwinstauser：Hwinsta;
hdeskuser：hdesk;
関数initservicedesktop：boolean;
var
dwthreadid：dword;
始める
dwthreadid：= getCurrentThreadId;
//サービスウィンドウステーションとデスクトップへの接続を確保し、
//ハンドルを保存します。
hwinstasave：= getProcessWindowStation;
hdesksave：= getthreaddesktop（dwthreadid）;
hwinstauser：= openWindowStation（defaultWindowStation、false、maxim_allowed）;
hwinstauser = 0の場合
始める
outputdebugstring（pchar（ 'openWindowStation failed' + syserrormessage（getLasterRor）））;
結果：= false;
出口;
終わり;
SetProcessWindowStation（Hwinstauser）でない場合
始める
outputDebugstring（ 'setProcessWindowStation failed'）;
結果：= false;
出口;
終わり;
hdeskuser：= opendesktop（defaultdesktop、0、false、maxim_allowed）;
hdeskuser = 0の場合
始める
outputdebugstring（ 'opendesktop failed'）;
SetProcessWindowStation（Hwinstasave）;
CloseWindowStation（Hwinstauser）;
結果：= false;
出口;
終わり;
結果：= setThreadDeskTop（hdeskuser）;
結果ではない場合は、
outputdebugstring（pchar（ 'setthreaddesktop' + syserrormessage（getlasterror）））;
終わり;
手順doneservicedesktop;
始める
//ウィンドウステーションとデスクトップを復元します。
SetThreadDeskTop（HDESKSAVE）;
SetProcessWindowStation（Hwinstasave）;
hwinstauser <> 0の場合
CloseWindowStation（Hwinstauser）;
hdeskuser <> 0の場合
closedesktop（hdeskuser）;
終わり;
初期化
initservicedesktop;
ファイナライゼーション
doneservicedesktop;
終わり。
詳細なデモコードについては、http：//www.torry.net/samples/samples/os/isarticle.zipを参照してください
（4）サービスのインストール方法については、1つはレジストリを変更します現在、hkey_local_machine/controlset001にありますフォロー：
ユニットwinsvcex;
インタフェース
Windows、winsvcを使用します。
const
//
//サービス構成情報レベル
//
service_config_description = 1;
service_config_failure_actions = 2;
//
//インポートされた関数のdll名
//
advapidll = 'advapi32.dll';
タイプ
//
//サービスの説明文字列
//
pservicedescription = ^tservicedeScripta;
pservicedescriptionw = ^tservicedescriptionw;
pservicedescription = pservicedeScriptia;
{$ externalsym _service_descripta}
_service_descriptiona = record
lpdescription：パンシチャル;
終わり;
{$ externalsym _service_descriptionw}
_service_descriptionw = record
lpdescription：pwidechar;
終わり;
{$ externalsym _service_description}
_service_description = _service_descripta;
{$ externalsym service_descriptia}
service_description = _service_descripta;
{$ externalsym service_descriptionw}
service_descriptionw = _service_descriptionw;
{$ externalsym service_description}
service_description = _service_descripta;
tservicedescription = _service_descripta;
tservicedescriptionw = _service_descriptionw;
tservicedescription = tservicedeScripta;
//
//サービスの失敗を引き受けるアクション
//
{$ externalsym _sc_action_type}
_sc_action_type =（sc_action_none、sc_action_restart、sc_action_reboot、sc_action_run_command）;
{$ externalsym sc_action_type}
sc_action_type = _sc_action_type;
pserviceaction = ^tserviceaction;
{$ externalsym _sc_action}
_sc_action =レコード
atype：sc_action_type;
遅延：dword;
終わり;
{$ externalsym sc_action}
sc_action = _sc_action;
tserviceaction = _sc_action;
pservicefailureationsa = ^tservicefailureationsa;
pservicefailureationsw = ^tservicefailureationsw;
pservicefailureations = pservicefailureationsa;
{$ externalsym _service_failure_actionsa}
_service_failure_actionsa = record
dwresetperiod：dword;
LPREBOOTMSG：LPSTR;
LPCommand：LPSTR;
コクト：dword;
lpsaactions： ^sc_action;
終わり;
{$ externalsym _service_failure_actionsw}
_service_failure_actionsw =レコード
dwresetperiod：dword;
LPREBOOTMSG：LPWSTR;
LPCommand：LPWSTR;
コクト：dword;
lpsaactions： ^sc_action;
終わり;
{$ externalsym _service_failure_actions}
_service_failure_actions = _service_failure_actionsa;
{$ externalsym service_failure_actionsa}
service_failure_actionsa = _service_failure_actionsa;
{$ externalsym service_failure_actionsw}
service_failure_actionsw = _service_failure_actionsw;
{$ externalsym service_failure_actions}
service_failure_actions = _service_failure_actionsa;
tserviceFailureationsa = _service_failure_actionsa;
tservicefailureationsw = _service_failure_actionsw;
tserviceFailureations = tserviceFailureationsa;
///////////////////////////////////////////////// ///////////////////////////////////////////////// ///////
// API関数プロトタイプ
///////////////////////////////////////////////// ///////////////////////////////////////////////// ///////
tqueryserviceconfig2 = function（hservice：sc_handle; dwinfolevel：dword; lpbuffer：pointer;
cbbufsize：dword;
tchangeserviceconfig2 = function（hservice：sc_handle; dwinfolevel：dword; lpinfo：pointer）：stdcall;
var
hdll：thandle;
libloaded：boolean;
var
OsversionInfo：TosversionInfo;
{$ externalsym queryserviceconfig2a}
queryserviceconfig2a：tqueryserviceconfig2;
{$ externalsym queryserviceconfig2w}
queryserviceconfig2w：tqueryserviceconfig2;
{$ externalsym queryserviceconfig2}
queryserviceconfig2：tqueryserviceconfig2;
{$ externalsym chansewerviceconfig2a}
changeserviceconfig2a：tchangeserviceconfig2;
{$ externalsym chansewerviceconfig2w}
changeserviceconfig2w：tchangeserviceconfig2;
{$ externalsym chansewerviceconfig2}
changeserviceconfig2：tchangeserviceconfig2;
実装
初期化
osversionIninfo.dwosversionInfosize：= sizeof（osversioninfo）;
getVersionEx（osversionInfo）;
if（osversioninfo.dwplatformid = ver_platform_win32_nt）および（osversioninfo.dwmajorversion> = 5）then
始める
hdll = 0の場合
始める
hdll：= getModuleHandle（advapidll）;
libloaded：= false;
hdll = 0の場合
始める
hdll：= loadLibrary（advapidll）;
libloaded：= true;
終わり;
終わり;
hdll <> 0の場合
始める
@queryserviceconfig2a：= getProcAddress（hdll、 'queryserviceconfig2a'）;
@queryserviceconfig2w：= getProcAddress（hdll、 'queryserviceconfig2w'）;
@queryserviceconfig2：= @queryserviceconfig2a;
@changeserviceconfig2a：= getProcAddress（hdll、 'changeserviceconfig2a'）;
@changeserviceconfig2w：= getProcAddress（hdll、 'changeserviceconfig2w'）;
@changeserviceconfig2：= @chansewerviceconfig2a;
終わり;
終わり
それ以外
始める
@queryserviceconfig2a：= nil;
@queryserviceconfig2w：= nil;
@queryserviceconfig2：= nil;
@changeserviceconfig2a：= nil;
@changeserviceconfig2w：= nil;
@changeserviceconfig2：= nil;
終わり;
ファイナライゼーション
if（hdll <> 0）とその後libloaded
Freelibrary（HDLL）;
終わり。
ユニットwinntservice;
インタフェース
用途
Windows、winsvc、winsvcex;
関数installService（const strservicename、strdisplayname、strdescription、strfilename：string）：boolean;
// eg：installService（ 'Service Name'、 'Display Name'、 '説明情報'、 'Serviceファイル'）;
手順UninstallService（strservicename：string）;
実装
function strlcopy（dest：pchar; const Source：pchar; maxlen：cardinal）：PCHER;
ASM
プッシュedi
ESIを押します
EBXを押します
MOV ESI、EAX
Mov Edi、Edx
MOV EBX、ECX
Xor AL、AL
ECXをテスト、ECX
JZ @@ 1
repne scasb
jne @@ 1
INC ECX
@@ 1：sub ebx、ecx
MOV EDI、ESI
MOV ESI、Edx
MOV EDX、EDI
MOV ECX、EBX
Shr ECX、2
rep movsd
MOV ECX、EBX
およびECX、3
rep movsb
stosb
Mov Eax、Edx
ポップEBX
ポップESI
ポップエディ
終わり;
function strpchar（dest：pchar; const source：string）：pchar;
始める
結果：= strlcopy（dest、pchar（source）、length（source））;
終わり;
関数installService（const strservicename、strdisplayname、strdescription、strfilename：string）：boolean;
var
// ss：tservicestatus;
// PSTEMP：PCHAR;
HSCM、HSCS：Thandle;
srvdesc：pservicedeScription;
DESC：文字列;
// srvtype：dword;
lpserviceargvectors：pchar;
始める
結果：= false;
// PSTEMP：= nil;
// srvtype：= service_win32_own_processおよびservice_interactive_process;
hscm：= openscmanager（nil、nil、sc_manager_all_access）; //サービスデータベースを接続します
hscm = 0の場合、exit; // messagebox（handle、pchar（syserrormessage（getlasterror））、 'service program manager'、mb_iconerror+mb_topmist）;
hscs：= createService（//サービス機能を作成します
HSCM、//サービス制御管理ハンドル
pchar（strservicename）、//サービス名
pchar（strdisplayname）、//表示されたサービス名
service_all_access、//アクセス権
service_win32_own_processまたはservice_interactive_process、// service type_win32_share_process
service_auto_start、//起動タイプ
service_error_ignore、//エラー制御タイプ
PCHAR（StrfileName）、//サービスプログラム
nil、//グループサービス名
nil、//グループID
nil、//依存サービス
nil、//サービスアカウントを開始します
nil）; //サービスパスワードを開始します
hscs = 0の場合、exit; // messagebox（handle、pchar（syserrormessage（getlasterror））、pchar（application.title）、mb_iconerror+mb_topmist）;
割り当てられている場合（changeserviceconfig2）
始める
desc：= copy（strdescription、1,1024）;
getMem（srvdesc、sizeof（tservicedeScription））;
getmem（srvdesc^.lpdescription、length（desc） + 1）;
試す
strpcopy（srvdesc^.lpdescription、desc）;
changeserviceconfig2（hscs、service_config_description、srvdesc）;
ついに
Freemem（srvdesc^.lpdescription）;
Freemem（srvdesc）;
終わり;
終わり;
lpserviceargvectors：= nil;
StartService（HSCS、0、LPSERVICEARGVECTORS）でない場合は//サービスを開始します
exit; //messagebox（Hhandle、pchar（syserrormessage）、pchar（application.title）、mb_iconerror+mb_topmist）
closeServiceHandle（HSCS）;
結果：= true;
終わり;
手順UninstallService（strservicename：string）;
var
scmanager：sc_handle;
サービス：sc_handle;
ステータス：TserviceStatus;
始める
scmanager：= openscmanager（nil、nil、sc_manager_all_access）;
scmanager = 0の場合、終了します。
試す
サービス：= openservice（Scmanager、Pchar（strservicename）、service_all_access）;
ControlService（service、service_control_stop、status）;
deleteService（service）;
closeServiceHandle（service）;
ついに
closeServiceHandle（scmanager）;
終わり;
終わり;
終わり。
（5）サービスプログラムを残酷に閉じて、以前の「NTツールボックス」の機能を実現する方法は、プロセス名に基づいてプロセスを殺すことです。
TLHELP32を使用します。
関数KillTask（exefilename：string）：integer;
const
process_terminate = $ 0001;
var
ContinueLoop：bool;
fsnapshothandle：thandle;
FPROCESSENTRY32：TPROCESSENTRY32;
始める
結果：= 0;
fsnapshothandle：= createToolHelp32SNAPSHOT（TH32CS_SNAPPROCESS、0）;
fprocessentry32.dwsize：= sizeof（fprocessentry32）;
contionueloop：= process32first（fsnapshothandle、fprocessentry32）;
integer（continueloop）<> 0はします
始める
if（（大）（extractfileName（fprocessentry32.szexefile））=
大文字（exefilename））または（大文字（fprocessentry32.szexefile）=
大文字（exefilename））
結果：= integer（terminateprocess（
OpenProcess（process_terminate、
ブール（0）、
fprocessentry32.th32processid）、
0））;
continueLoop：= process32next（fsnapshothandle、fprocessentry32）;
終わり;
CloseHandle（fsnapshothandle）;
終わり;
ただし、サービスプログラムの場合、プログラムにデバッグ許可がある限り、「アクセス」を促します。
関数enabledebugprivilege：boolean;
function enablePrivilege（htoken：cardinal; privname：string; benable：boolean）：boolean;
var
TP：token_privileges;
ダミー：枢機inal;
始める
tp.privilegecount：= 1;
lookupprivilegevalue（nil、pchar（privname）、tp.privileges [0] .luid）;
ベニー可能な場合
tp.privileges [0] .attributes：= se_privilege_enabled
else tp.privileges [0] .attributes：= 0;
調整tokenprivileges（htoken、false、tp、sizeof（tp）、nil、dummy）;
結果：= getLasterRor = error_success;
終わり;
var
htoken：枢機inal;
始める
OpenProcessToken（getCurrentProcess、token_adjust_privileges、htoken）;
結果：= enablePrivilege（htoken、 'sedebugprivilege'、true）;
CloseHandle（htoken）;
終わり;
使い方：
enabledebugprivilege; //昇格許可
KillTask（ 'xxxx.exe'）; //サービスプログラムを閉じます。
-------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- -------------------------------------------------------------- ------ ----------