Код ест память
Здравствуйте! Нужна помощь - попробовал сам набросать программку, суть программы такова: висит программа в трее, считает время, если 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.
ЗЫ: понял что открывается хэндл чтения состояния службы - и не закрывается. Как закрыть?
|