Windows servis uygulamasının windows kapanırkan engel olması

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
erolturk
Üye
Mesajlar: 14
Kayıt: 13 May 2016 04:49

Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen erolturk »

Merhaba Arkadaşlar

Windows servisin, windows kapanırken engel olmasını istiyorum. Bunu bir masa üstü uygulaması ile yapabiliyorum :
procedure WMQueryEndSession(var Msg: TWMQueryEndSession);message WM_QUERYENDSESSION;
procedure WMEndSession(var Msg: TWMEndSession);message WM_ENDSESSION;
.
.
procedure TfmMain.WMEndSession(var Msg: TWMEndSession);
begin
if Msg.EndSession = TRUE then
ShowMessage('Windows kapatılıyor. ');
inherited;
end;

procedure TfmMain.WMQueryEndSession(var Msg: TWMQueryEndSession);
begin
inherited;
if MessageDlg('Windows kapansınmı ?', mtConfirmation, [mbYes, mbNo], 0) = mrNo
then
Msg.Result := 0
else
Msg.Result := 1
end;


Ama bu yöntemi kendim yazdığım bir windows servise entegre ettiğimde, servis hiç bir müdahalede bulunmuyor ve windows kapanıyor. Bu olay bazen veri kayıplarına sebep olabiliyor. Yardımcı olacak arkadaşlar şimdiden çok teşekkür ederim. Kolay gelsin.
Kullanıcı avatarı
fesiharslan
Üye
Mesajlar: 591
Kayıt: 20 Eki 2006 11:37
Konum: Erzurum
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen fesiharslan »

Merhaba;
Kişisel fikrimi paylaşmak istiyorum.
Windows kapanırken öncelikle açık olan uygulamaları kapatır. Kapatamaz ise Kill yöntemiyle zorla kapatır. Dolayısıyla hangi kodu yazarsak yazalım Windows kapanırken mutlaka uygulamamızı kapatacaktır. Ayrıca Microsoft'un yeni Windows versiyonlarına ayak uydurmak (API yöntemiyle) oldukça zor ve geriye dönük uyumluluk açısından da sizi zorlayacaktır.
Kullanıcı avatarı
greenegitim
Üye
Mesajlar: 713
Kayıt: 28 Nis 2011 10:33
Konum: İstanbul

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen greenegitim »

daha önce çalıştıra shutdown -s -f -t 12 -c "dikkat kapanıyor" yazınca -t parametresindeki saniye kadar bekleyip kapatıyordu bunu durdurmak için
shutdown -a yaparak durduruyordum normal kapatmada bunu yermi denemek lazım.
Mücadele güzelleştirir!
Kullanıcı avatarı
vkamadan
Kıdemli Üye
Mesajlar: 1935
Kayıt: 17 Mar 2004 03:52
Konum: Adapazarı
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen vkamadan »

Merhabalar ,
Yıllar önce bende benzer bir konunun peşinden koşuyordum , uygulamamızın kapanmasını belki engelleyemeyeceğiz ancak en azından windows un birazdan kapanacak olduğunu bize bildirmesi o an ki aktif işleri bitirmek yada güvenli bir şekilde sonladırmak için bir fırsat yaratabilir bu açıdan böyle bir yapının sunulmuş olmasını faydalı buluyorum, vaktinde benim yaşadığım sorun WM_QUERYENDSESSION yada WM_ENDSESSION mesajlarını hizmetin içinden yakalayamayışım dı , mesajların servislere broadcast edilmediğini ya da farklı bir isimle servis edildiğini düşünüyorum ama ilginç bir konu takipteyim :)
Volkan KAMADAN
www.polisoft.com.tr
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen SimaWB »

fesiharslan yazdı:Merhaba;
Kişisel fikrimi paylaşmak istiyorum.
Windows kapanırken öncelikle açık olan uygulamaları kapatır. Kapatamaz ise Kill yöntemiyle zorla kapatır. Dolayısıyla hangi kodu yazarsak yazalım Windows kapanırken mutlaka uygulamamızı kapatacaktır. Ayrıca Microsoft'un yeni Windows versiyonlarına ayak uydurmak (API yöntemiyle) oldukça zor ve geriye dönük uyumluluk açısından da sizi zorlayacaktır.
Yanlış yada eksik bilgi olduğu için düzeltmekte fayda görüyorum:
Windows kapatma esnasında açık olan tüm uygulamalara WM_QUERYENDSESSION mesajı gönderir. Sizin uygulamanız bu mesaja cevap olarak FALSE döndürürse işletim sistemi PCyi kapatmaz. Windows XP'de (ve sanırım öncesinde) kapanma tamamen engellenebiliyordu. Windows Vista ve sonrasında "şu program kapanmayı engelliyor, durdurmayı zorla" gibisinden bir mesaj çıkar. Zorla kapamayı seçerseniz PC kananır. Zaten soruyu soran arkadaş da bunu başarabildiğini söylemiş.

Daha önce bu konuda sorun yaşamıştım ve epey araştırma fırsatım oldu: http://stackoverflow.com/questions/3085 ... -shut-down
Delphi'de bu konuda daha önce bir bug vardı sanırım çözüldü: http://qc.embarcadero.com/wc/qcmain.aspx?d=84886

@turk1979 ve @vkamadan; asıl problem servis uygulamalarının windows mesajlarını yakalayamamasıdır. Bunun sebebi de servis uygulamasının window handle'ı olmayışındandır. Bunun çözümü Message Loop oluşturmaktır. Basit şekliyle:

Kod: Tümünü seç

while(GetMessage(Msg, 0, 0, 0) > 0)
{
    TranslateMessage(&Msg);
    DispatchMessage(&Msg);
}
böyle bir yapınız olmadır.
Servis uygulaması içinde bunu gerçekleştirmenin en kolay yolu basit bir thread yazmak.
Thread'in Execute prosedür içeriği şu şekilde olmalı:

Kod: Tümünü seç

//  Msg: TMsg;
while GetMessage(Msg, 0, 0, 0) and not Terminated do begin
  try
    TranslateMessage(Msg);
    DispatchMessage(Msg);
    if Msg.Message = WM_QUERYENDSESSION then begin
        // Bilgisayar kapanacak işlemlerinizi tamalayın
    end;
  except    
  end;
end;;
There's no place like 127.0.0.1
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen SimaWB »

Şimdi aklıma gelen bir başka çözümü daha paylaşayım. Servis içerisinde uygulamanıza ait bir Window Handle oluşturmak için AllocateHWnd APIsini de kullanabilirsiniz.
Bu sayede aslında projeniz içinde görünmez bir form oluşturmuş olursunuz ve Windows Mesajlarını yakalayabilirsiniz.
There's no place like 127.0.0.1
Kullanıcı avatarı
Lost Soul
Üye
Mesajlar: 1064
Kayıt: 01 Nis 2007 02:55
Konum: mekan ANKARA toprak ELAZIĞ
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen Lost Soul »

Servis uygulamanızı aynı zamanda guard olarak kullanabilir ve engelleme işi yapan bir masaüstü uygulamasının açık kalmasını sağlayabilirsiniz.
erolturk
Üye
Mesajlar: 14
Kayıt: 13 May 2016 04:49

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen erolturk »

Merhaba SimaWB

Öncelikle ilgilendiğiniz için çok teşekkür ederim. Win api ler ile ilgili pek çalışmam olmadı. Rica etsem ikinci gönderdiğiniz mesajı biraz daha açabilir misiz ?
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen SimaWB »

Win API dediğimiz aslında Delphi'de kullandığınız diğer komutlardan farksız.
Service uygulaması olduğuna göre TService'den türetilen bir sınıfınız var. Onun içinde şu tanımları yapın:

Kod: Tümünü seç

WindowHandle: HWND;
procedure WindowProc(var Message: TMessage);
Servisin OnCreate olayında:

Kod: Tümünü seç

WindowHandle := AllocateHWND(WindowProc);
OnDestroy olayında:

Kod: Tümünü seç

DeallocateHWnd(WindowHandle);
Yazdığınız takdirde WindowProc prosedürü içerisinde Windows mesajlarını yakalayabilirsiniz. Örneğin WM_QUERYENDSESSION mesajıyla ilgilenecekseniz
WindowProc içerisinde

Kod: Tümünü seç

if (Message.Msg = WM_QUERYENDSESSION) then
begin
//
end 
else
  Msg.Result := DefWindowProc(WindowHandle, Message.Msg, Message.wParam, Message.lParam); 
Bu şekilde dilediğiniz mesajı yakalarsınız(Tabi Windows'un servis uygulamalarına gönderdiği mesajları)
There's no place like 127.0.0.1
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen SimaWB »

Not: AllocateHWND bir Windows APIsi değil.Yukarıda linkini verdiğim, Delphi'nin bir fonksiyonu.
There's no place like 127.0.0.1
erolturk
Üye
Mesajlar: 14
Kayıt: 13 May 2016 04:49

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen erolturk »

Merhaba SimaWB !

Anlattıklarınızı uyguladım. Evet, dediğiniz gibi oldu.Bu yöntemle Windows'un servis uygulamalarına gönderdiği mesajları yakalayabildim. Fakat yine Windows mesaja kayıtsız kalıyor ve kapanıyor. Mesajı yakaladığımın farkına şöyle vardım : WindowProc procedure sinin içine intlist.SaveToFile( 'C:\yakaladi.txt' ); komutu ekledim. Windows u kapatıp açınca "yakaladi.txt" metin dosyasının oluştuğunu gördüm. Tüm kodları aşağıda :

Kod: Tümünü seç

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs;



type
  TService7 = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
  private
    FWindowHandle: HWND;
    procedure WindowProc(var msg: TMessage);
    procedure WMQueryEndSession(var msg: TWMQueryEndSession);
      message WM_QUERYENDSESSION;
    procedure WMEndSession(var msg: TWMEndSession); message WM_ENDSESSION;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service7: TService7;

implementation

{$R *.dfm}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service7.Controller(CtrlCode);
end;

function TService7.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService7.ServiceCreate(Sender: TObject);
begin
  FWindowHandle := AllocateHWND(WindowProc);
end;

procedure TService7.ServiceDestroy(Sender: TObject);
begin
  DeallocateHWnd(FWindowHandle);
end;

procedure TService7.ServiceExecute(Sender: TService);
begin
  while not Terminated do
    ServiceThread.ProcessRequests(True);
end;

procedure TService7.WindowProc(var msg: TMessage);
var
 intList :TStringList;
begin

  if (msg.msg = WM_QUERYENDSESSION) then
  begin
     TWMQueryEndSession( msg ).Result := 0;

  [b]   try
       intList := TStringList.Create;
       intlist.Text :='LogOff_time = ' + DateTimeToStr(time);
       intlist.SaveToFile( 'C:\yakaladi.txt' );

     finally
        intlist.Free;[/b]

     end;

  end
  else
    msg.Result := DefWindowProc(FWindowHandle, msg.msg, msg.wParam, msg.lParam);
end;

procedure TService7.WMEndSession(var msg: TWMEndSession);
begin
  if msg.EndSession = True then
    ShowMessage('Windows kapatılıyor. ');
  inherited;
end;

procedure TService7.WMQueryEndSession(var msg: TWMQueryEndSession);
begin
  inherited;
  if MessageDlg('Windows kapansınmı ?', mtConfirmation, [mbYes, mbNo], 0) = mrNo
  then
    Msg.Result := 0
  else
    Msg.Result := 1;
end;

end.
Teşekkürler. Kolay gelsin.
mkysoft
Kıdemli Üye
Mesajlar: 3103
Kayıt: 26 Ağu 2003 12:35
Konum: Berlin
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen mkysoft »

Windows'un kapanmasını engelleyebiliyor olmak çok mantıklı gelmedi. Sistemi yöneten işletim sistemi. Kapatma isteğini yaratan ise kullanıcı. Bu nedenle kullanıcının başlattığı bir süreci durdurabilyor olmak ancak geçici bir çözüm olur. Kulağımızı tersten tutarak; kullanıcıların windows'u kapatma yetkisini kaldırsanız işinize yaramaz mı?
http://www.sevenforums.com/tutorials/12 ... roups.html
Kullanıcı avatarı
SimaWB
Üye
Mesajlar: 1316
Kayıt: 07 May 2009 10:42
Konum: İstanbul
İletişim:

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen SimaWB »

turk1979 yazdı:Anlattıklarınızı uyguladım. Evet, dediğiniz gibi oldu.Bu yöntemle Windows'un servis uygulamalarına gönderdiği mesajları yakalayabildim. Fakat yine Windows mesaja kayıtsız kalıyor ve kapanıyor. Mesajı yakaladığımın farkına şöyle vardım : WindowProc procedure sinin içine intlist.SaveToFile( 'C:\yakaladi.txt' ); komutu ekledim. Windows u kapatıp açınca "yakaladi.txt" metin dosyasının oluştuğunu gördüm. Tüm kodları aşağıda :
Öncelikle şöyle bi ek bilgi vereyim:
TService'in LogMessage adında fonksiyonu var. Servis uygulamarını log'lamak için harika bir çözüm. LogMessage fonksiyonu sayesinde Windows Olay Görüntüleyicisine mesaj yazabiliyorsunuz.

Servis uygulamasında, PCnin kapanmasını durdurma işlemi gerçekleşmiyorsa güvenlikle alakalı bir durum olabilir. Benim size tavsiyem ayrı bir program yazın. Kapanma mesajını burada yakalayın. Sizin servisiniz çalışıyorsa kapanmaya izin vermeyin, yada mesaj çıkartın vs. Kapanma mesajı önce Windows Form uygulamalarına gideceği için servis kapanmadan evvel mesajı yakalarsınız diye tahmin ediyorum.
Yazacağınız programı Taskbar'da görünmez yapın. OnCloseQuery'de servisin çalışıp çalışmadığını kontrol edin. Çalışıyorsa kapanmayı engelleyip mesaj gösterebilirsiniz. Ayrıca servis uygulaması çalışmaya başlayınca bu 2. programı servisin çalıştırmasını sağlayabilirsiniz.

Servis çalışıyor mu:

Kod: Tümünü seç

function TFormSDCtrl.IsServiceRunning(ServisIsim: string): Boolean;
var
  Svc: Integer;
  SvcMgr: Integer;
  ServSt : TServiceStatus;
begin
  Result := False;
  SvcMgr := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if SvcMgr = 0 then Exit;
  try
    Svc := OpenService(SvcMgr, PChar(ServisIsim), SERVICE_QUERY_STATUS);
    if Svc = 0 then Exit;
    try
      if not QueryServiceStatus(Svc, ServSt) then Exit;
      Result := (ServSt.dwCurrentState = SERVICE_RUNNING) or (ServSt.dwCurrentState = SERVICE_START_PENDING);
    finally
      CloseServiceHandle(Svc);
    end;
  finally
    CloseServiceHandle(SvcMgr);
  end;
end;
Uygulamayı gizlemek için:
dpr içerisinde

Kod: Tümünü seç

Application.ShowMainForm := False;
Ayrıca MainForm'un OnCreate'inde:

Kod: Tümünü seç

  ShowWindow(Application.Handle, SW_HIDE);
  SetWindowLong(Application.Handle, GWL_EXSTYLE,
          GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
  ShowWindow(Application.Handle, SW_SHOW);

  SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
          SWP_NOMOVE OR
          SWP_NOACTIVATE OR
          SWP_NOSIZE);
There's no place like 127.0.0.1
erolturk
Üye
Mesajlar: 14
Kayıt: 13 May 2016 04:49

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen erolturk »

Dediğinizi çok iyi anladım. Anlattıklarınızı proje yöneticimize daha önceden sundum. Ne yazık ki içerikte bir masa üstü uygulaması olduğu için kabul görmedi. İlginiz için çok teşekkür ederim.
erolturk
Üye
Mesajlar: 14
Kayıt: 13 May 2016 04:49

Re: Windows servis uygulamasının windows kapanırkan engel olması

Mesaj gönderen erolturk »

Merhabalar !

SimaWB arkadaşımızın dediği gibi mesaj yakalama işini bir masaüstü uygulamasına bıraktım. Ama sürekli çalışmayacak. Yazdığım serviste, veri tabanı ile etkileşimli kodlar çalışmadan önce masaüstü uygulaması çalıştırıp, servisin kodları işlemini bitirince kapatıyorum. Böylelikle servis arka planda işlem yaparken windows un kapanmasına engel oluyorum. Gayet güzel çalışıyor. Lakin SERVER İŞLETİM SİSTEMİNDE servisten exe çalıştıramadım. Sanal bir server 2012 işletim sisteminde yine sorunsuz çalışıyor. Service 'nin interactive özelliği : true, çalışan servisin özelliklerinde oturum açma/ Hizmetin Masaüstü ile etkileşimine izin ver : onaylı, Admin olarak çalıştırdım yine de olamadı.

Kodlar aşağıda :

Kod: Tümünü seç

procedure TService7.Timer1Timer(Sender: TObject);
var
  hToken: THandle;
  si: _STARTUPINFOW;
  pi: _PROCESS_INFORMATION;
  Ret: Cardinal;
  sTitle: string;
  sMsg: string;
  kapat: HWND;

  intList: TextFile;
begin

  inc(i);
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);
  si.lpDesktop := nil;
  if getTaskRunning(filename) = False then
  begin
//    AssignFile(intList, GetAppPath + '\PoliLog123.txt');
//    Rewrite(intList);
//    writeln(intList, DateTimeToStr(now) + ' => Deneme Başarılı');
//    CloseFile(intList);
    if WTSQueryUserToken(WtsGetActiveConsoleSessionID, hToken) then
    begin
      // SERVER İŞLETİM SİSTEMİNDE ÇALIŞIRKEN BURAYA HİÇ GİRMİYOR**********
      if CreateProcessAsUser(hToken, PChar(GetAppPath + '\' + filename), nil,
        nil, nil, False, 0, nil, nil, si, pi) then
      begin

        AssignFile(intList, GetAppPath + '\PoliLog.txt');
        Rewrite(intList);
        writeln(intList, DateTimeToStr(now) +
          ' => Exe Çalıştırma İşlemi Başarılı');
        CloseFile(intList);

      end;
    end;
      // *****************************************************************
  end;

  if (i mod 2) = 0 then
    KillTask('runnin3.exe')
    // [b]BU EXE Yİ MANUEL ÇALIŞTIRIRSAN "KillTask" GÖREVİNİ YAPIYOR.[/b]

end;
Acaba WTSQueryUserToken method unun server versiyonu mu var. Ya da Server işletim sistemlerinde win api lere ulaşmak için bir ayar mı gerekiyor,
register dan falan bir değişiklik mi yapmam gerekiyor ??? Konuyla ilgili tecrübe edinmiş arkadaşlar var ise yardımcı olabilir mi acaba.
Şimdiden çok teşekkür ederim.
Cevapla