[Ahton]

Здравствуйте! Нужна помощь - попробовал сам набросать программку, суть программы такова: висит программа в трее, считает время, если 07:00 утра то сперва делает стоп сервису радмина и тут же старт, перезапускает в общем. Заметил что программа есть память, причем по возрастающей и не останавливается - с 4 метров до 20 метров дотерпел - пока она кушала
Сперва грешил на код минимизации в трей, но даже без этого кода приложение все также ест память... помогите пожалуйста, что я не так сделал? Может можно код упростить как то... выкладываю код с минимизацией в трей:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, XPMan, WinSVC, ExtCtrls, jpeg, ComCtrls,
  Menus;

type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    Button2: TButton;
    Button1: TButton;
    Image1: TImage;
    StatusBar1: TStatusBar;
    Timer2: TTimer;
    Timer3: TTimer;
    pmTreyMenu: TPopupMenu;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    {Трей}
    Procedure ControlWindow(Var Msg:TMessage); message WM_SYSCOMMAND;
    Procedure IconMouse(var Msg:TMessage); message WM_USER+1;
    Procedure  Ic(n:Integer;Icon:TIcon);
    Procedure OnMinimizeProc(Sender:TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0, nil, 'net', PChar('stop "rserver3"'),nil,sw_HIDE);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShellExecute(0, nil, 'net', PChar('start "rserver3"'),nil,sw_HIDE);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var ssStatus: SERVICE_STATUS;
    schSCManager: SC_HANDLE;
    schService: SC_HANDLE;
begin
  schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if schSCManager=0 then RaiseLastOSError;
  schService:=OpenService(schSCManager,'rserver3'#0,SERVICE_ALL_ACCESS);
  if schService=0 then RaiseLastOSError;
  if(QueryServiceStatus(schService,ssStatus)) then begin
    case ssStatus.dwCurrentState of
      SERVICE_STOPPED: Label2.Caption := 'Остановлена';
      SERVICE_RUNNING: Label2.Caption := 'Запущена';
    end;
  end;
end;


procedure TForm1.Timer2Timer(Sender: TObject);
Var
T: String;
Begin
T:=TimeToStr(Now);
If T='07:00:00' Then
Begin
ShellExecute(0, nil, 'net', PChar('stop "rserver3"'),nil,sw_HIDE);
ShellExecute(0, nil, 'net', PChar('start "rserver3"'),nil,sw_HIDE);
End;
End;

procedure TForm1.Timer3Timer(Sender: TObject);
begin
if Label2.Caption = 'Запущена' then Button2.Enabled := False else Button2.Enabled := True;
if Label2.Caption = 'Запущена' then Label2.Font.Color := clGreen;
if Label2.Caption = 'Запущена' then Label2.Font.Style := Label2.Font.Style + [fsBold];
if Label2.Caption = 'Остановлена' then Button1.Enabled := False else Button1.Enabled := True;
if Label2.Caption = 'Остановлена' then Label2.Font.Color := clRed;
if Label2.Caption = 'Остановлена' then Label2.Font.Style := Label2.Font.Style + [fsBold];
end;

procedure TForm1.IconMouse(var Msg:TMessage);
Var p:tpoint;
begin
 GetCursorPos(p);
 Case Msg.LParam OF
  WM_LBUTTONUP,WM_LBUTTONDBLCLK:
                   Begin
                    Ic(2,Application.Icon);
                    ShowWindow(Application.Handle,SW_SHOW);
                    ShowWindow(Handle,SW_SHOW);
                    Update;
                   End;
  WM_RBUTTONUP:
   Begin
    SetForegroundWindow(Handle);
    pmTreyMenu.Popup(p.X,p.Y);
    PostMessage(Handle,WM_NULL,0,0);
   end;
 End;
end;

Procedure TForm1.OnMinimizeProc(Sender:TObject);
Begin
 PostMessage(Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
End;

Procedure TForm1.ControlWindow(Var Msg:TMessage);
Begin
 IF Msg.WParam=SC_MINIMIZE then
  Begin
   Ic(1,Application.Icon);
   ShowWindow(Handle,SW_HIDE);
   ShowWindow(Application.Handle,SW_HIDE);
 End
 else inherited;
End;

Procedure TForm1.Ic(n:Integer;Icon:TIcon);
Var Nim:TNotifyIconData;
begin
 With Nim do
  Begin
   cbSize:=SizeOf(Nim);
   Wnd:=Self.Handle;
   uID:=1;
   uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
   hicon:=Icon.Handle;
   uCallbackMessage:=wm_user+1;
   szTip :='RADMIN Server 3.4 RESTARTER';
  End;
 Case n OF
  1: Shell_NotifyIcon(Nim_Add,@Nim);
  2: Shell_NotifyIcon(Nim_Delete,@Nim);
  3: Shell_NotifyIcon(Nim_Modify,@Nim);
 End;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
 ShowMessage('123' + #13#10 + '456:' + #13#10 + '789');
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Ic(2,Application.Icon);
Close;
end;




procedure TForm1.FormShow(Sender: TObject);
begin
 PostMessage(Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
end;

end.

ЗЫ: понял что открывается хэндл чтения состояния службы - и не закрывается. Как закрыть?

[Кодер]

В обработчике таймера (3) я бы исправил так:

Код:

if label2.caption='Заупщена' then
begin
   Button2.Enabled := False;
   Button1.Enabled := True;
   Label2.Font.Color := clGreen;
   Label2.Font.Style := Label2.Font.Style + [fsBold];
end
   else
begin
   Button2.Enabled := True;
   Button1.Enabled := False;
   Label2.Font.Color := clRed;
   Label2.Font.Style := Label2.Font.Style + [fsBold];
end;

[Pyro]

CloseServiceHandle/CloseHandle

[Кодер]

ЗЫ: понял что открывается хэндл чтения состояния службы - и не закрывается. Как закрыть?

Код:

CloseServiceHandle(__in  SC_HANDLE hSCObject);

[Ahton]

Неподарок спасибо за оптимизацию кода в обработчике таймера3
C закрытием разобрался:

Код:

procedure TForm1.Timer1Timer(Sender: TObject);
var ssStatus: SERVICE_STATUS;
    schSCManager: SC_HANDLE;
    schService: SC_HANDLE;
begin
  schSCManager:=OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
  if schSCManager=0 then RaiseLastOSError;
  schService:=OpenService(schSCManager,'rserver3'#0,SERVICE_ALL_ACCESS);
  if schService=0 then RaiseLastOSError;
  if(QueryServiceStatus(schService,ssStatus)) then begin
    case ssStatus.dwCurrentState of
      SERVICE_STOPPED: Label2.Caption := 'Остановлена';
      SERVICE_RUNNING: Label2.Caption := 'Запущена';
   end;
   CloseServiceHandle(schService);
    CloseServiceHandle(schSCManager);
  end;
end;

Спасибо за помощь

[Ahton]

Ребят, теперь новая проблема
вот код:

Код:

procedure TForm1.Timer2Timer(Sender: TObject);
Var
T: String;
Begin
T:=TimeToStr(Now);
If T='9:58:00' Then
Begin
showmessage('123');
End;
End;

Ради интереса и проверка работоспособности сделал вывод мессэджа. Во первых код работает если время указать без 0 в часах, т.е. не 09:58:00 а 9:58:00, ну это мелочи, а вот отработал он забавно - вылезло 61 окно сообщения хде грабли?
ЗЫ - это что получается, код перезапуска службы будет 61 раз выполняться - это же сразу DDoS локальный )