Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

затрата памяти


Страницы:   1 2 3

Romm ©   (2007-04-18 16:39:00) 

Уважаемые мастера, написанная мной программа "висит" в памяти и ждет команды. Только вот на это ожидание затрачивается аж 3Мб памяти! О боже для такой-то цели 3Мб... Пожалуйста укажите на слабые места програмы...
Спасиб.

***********
unit MainUnit;

interface

uses
 Windows, Messages, ShellAPI, SysUtils, Graphics, Forms,
 ExtCtrls, ScktComp, Classes;

type
 TMainForm = class(TForm)
   ServerSocket1: TServerSocket;
   Timer1: TTimer;
   procedure ServerSocket1ClientRead(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure FormDestroy(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure FormPaint(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure ServerSocket1ClientError(Sender: TObject;
     Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
     var ErrorCode: Integer);
 private
 public
     Str:TMemoryStream;
 end;

var
 MainForm: TMainForm;

implementation

uses MessageUnit;

{$R *.dfm}

procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
 Socket: TCustomWinSocket);
var
 Mes:String;
 cr:TRect;
 h:HWND;
 hToken: THandle;
 tkp: TTokenPrivileges;
 ReturnLength: Cardinal;
begin
 Mes:=Socket.ReceiveText;
 if Mes='Sleep' then
   ShellExecute(Application.Handle,Pchar('Open'),Pchar('rundll32.exe'),Pchar('powrp rof.dll,SetSuspendState'),'',0);//спящий режим
 if Mes='Restart' then
   ShellExecute(Application.Handle,Pchar('Open'),Pchar('shutdown'),Pchar('-r -t 0'),'',0);//перезагрузка
 if Mes='Seance' then
   ShellExecute(Application.Handle,Pchar('Open'),Pchar('rundll32.exe'),Pchar('user3 2.dll,LockWorkStation'),'',0);//завершение сеанса
 if Copy(Mes,0,3)='Mes' then
   begin
     MessageForm.Show;
     MessageForm.Memo1.Lines.Add('['+TimeToStr(now)+'] Администратор: '+Copy(Mes,4,Length(Mes)-1));
   end;
 if Mes='Block' then
   begin
     cr:=Rect(Screen.Width-1,Screen.Height-1,Screen.Width,Screen.Height);
     ClipCursor(@cr);
     SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,1);//Выключение монитора
   end;
 if Mes='UnBlock' then
   begin
     cr:=Rect(0,0,Screen.Width,Screen.Height);
     ClipCursor(@cr);
     SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,-1);//Включение монитора
   end;
 if Mes='Kill' then
   begin
     h:=GetForegroundWindow;
     if h=0 then exit;
     SendMessage(h,WM_DESTROY,0,0);
   end;
 if Mes='PowerOff' then
   begin
     if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
       begin
         LookupPrivilegeValue(nil, 'SeShutdownPrivilege',tkp.Privileges[0].Luid);
         tkp.PrivilegeCount:=1;
         tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
         if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength)then
           ExitWindowsEx(EWX_SHUTDOWN or EWX_POWEROFF, 0);
       end;
   end;
 if Mes='Vidio' then
   begin
     Timer1.Enabled:=true;
   end;
 if Mes='NoVidio' then
   begin
     Timer1.Enabled:=false;
   end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
 ServerSocket1.Active:=false;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
 ServerSocket1.Active:=true;
end;

procedure TMainForm.FormPaint(Sender: TObject);
begin
 ShowWindow(Application.Handle,SW_HIDE);
 ShowWindow(Handle,SW_HIDE);
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
 DeskTopDC: HDc;
 DeskTopCanvas: TCanvas;
 DeskTopRect: TRect;
 Bitmap:TBitmap;
 Size:int64;
begin
 DeskTopDC := GetWindowDC(GetDeskTopWindow);
 DeskTopCanvas := TCanvas.Create;
 DeskTopCanvas.Handle := DeskTopDC;
 DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
 Bitmap:=TBitmap.Create;
 Bitmap.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
 Str:=TMemoryStream.Create;
 Str.Write(Bitmap,sizeof(Bitmap));
 Size:=Str.Size;
 ServerSocket1.Socket.Connections[0].SendBuf(Size,sizeof(Size));
 ServerSocket1.Socket.Connections[0].SendStream(str);
 ReleaseDC(GetDeskTopWindow, DeskTopDC);
 Bitmap.Free;
 DeskTopCanvas.Free;
end;

procedure TMainForm.ServerSocket1ClientError(Sender: TObject;
 Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
 var ErrorCode: Integer);
begin
 Timer1.Enabled:=false;
end;

end.
**********
unit MessageUnit;

interface

uses
 Forms, StdCtrls, Classes, Controls;

type
 TMessageForm = class(TForm)
   Memo1: TMemo;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 MessageForm: TMessageForm;

implementation

{$R *.dfm}

procedure TMessageForm.Button1Click(Sender: TObject);
begin
 Close;
end;

end.

Romm   (2007-04-18 18:04:00) [41]


> Loginov Dmitry ©   (18.04.07 18:02) [18]

там же :) Ну это задержка 1 секунда
ну да ладно, этого гадкого кода в моей проге больше нету.. :))

Loginov Dmitry   (2007-04-18 18:02:00) [42]

> пустое событие. благодаря ему компутер с работающим сервером
> не ощутит нагрузки... В умной книжке прочитал :))


а про такую "фичу"

WhEvent:=CreateEvent(nil,true,false,'et');
while (true) do
  begin
    WaitForSingleObject(WhEvent,1000);
    Application.ProcessMessages
  end;

где прочел?

Romm   (2007-04-18 17:54:00) [43]


> Плохиш ©   (18.04.07 17:47) [16]

ок :))

Мастера, неужели у меня прога грамотнонаписана!
Покритикуйте основной код немножко :)

Плохиш   (2007-04-18 17:47:00) [44]


> Romm ©   (18.04.07 17:32) [14]

В следующий раз читай книжку глазами с включённым мозгом. Этот код у тебя ни на какую загрузку не влияет, так как он во время работы программы не выполняется.

Romm   (2007-04-18 17:34:00) [45]


> procedure TMainForm.FormPaint(Sender: TObject);
> begin
>  ShowWindow(Application.Handle,SW_HIDE);
>  ShowWindow(Handle,SW_HIDE);
> end;

кстати вот так прячу, а она (форма) мигает, когда прячется... как обойти такую подлянку? :)

Romm   (2007-04-18 17:32:00) [46]


> Плохиш ©   (18.04.07 17:28) [13]

:))
пустое событие. благодаря ему компутер с работающим сервером не ощутит нагрузки... В умной книжке прочитал :))

Плохиш   (2007-04-18 17:28:00) [47]


>  Application.Run;
>  WhEvent:=CreateEvent(nil,true,false,'et');
>  while (true) do
>    begin
>      WaitForSingleObject(WhEvent,1000);
>      Application.ProcessMessages
>    end;
А это чего за херня?

Romm   (2007-04-18 17:17:00) [48]


> Сергей М. ©   (18.04.07 17:12) [11]

Рррр.. ну это ясно, ну да ладно, пусть злой сервер живет как живет.
жду совета по оптимизации :)))


> Desdechado ©   (18.04.07 17:01) [7]

им и измеряю :))


> Сергей М. ©   (18.04.07 16:41) [1]

будь я ОС... ну скажем 1500 Кб максимум :)

Сергей М.   (2007-04-18 17:12:00) [49]


> Romm ©   (18.04.07 17:03) [9]


Я прямо-таки боюсь тебе намекнуть на страшную тайну  -
"прога", текст которой имеет вид

program Proga;
begin
end;

тоже, казалось бы, "ничего не делает", но тем не менее занимает несколько десятков дурацких килобайт).. С чего бы это ?)

Сергей М.   (2007-04-18 17:07:00) [50]


> Romm ©   (18.04.07 17:03) [9]


> проги, которая ничего не делает


Как это "ничего не делает" ?!

А все что между begin и end программы - это разве "ничегонеделанье" ?!!!

Romm   (2007-04-18 17:03:00) [51]

ну просто я думал это много для проги, которая ничего не делает :)
А по оптимизации вы, которым до магазина, не подскажите по оптимизациичто-нибудь новенького?? :)
Кстати,
program Server;

uses
 Forms,
 Windows,
 MainUnit in 'MainUnit.pas' {MainForm},
 MessageUnit in 'MessageUnit.pas' {MessageForm};

{$R *.res}

var
 WhEvent:THandle;
begin
 Application.Initialize;
 Application.CreateForm(TMainForm, MainForm);
 Application.CreateForm(TMessageForm, MessageForm);
 Application.Run;
 WhEvent:=CreateEvent(nil,true,false,'et');
 while (true) do
   begin
     WaitForSingleObject(WhEvent,1000);
     Application.ProcessMessages
   end;
end.

тут я правильно поступил?? Или, нафиг, оставить как дядя Борланд написал?

Сергей М.   (2007-04-18 17:01:00) [52]


> Romm ©   (18.04.07 16:54) [5]


И давай уже ответь на [1], коль истины жаждешь)...

Desdechado   (2007-04-18 17:01:00) [53]

Чем память измеряешь?
А то ведь диспетчер показывает все, что твоя программа подгрузила (например, системные DLL, даже если не только она и не полностью).

Сергей М.   (2007-04-18 16:58:00) [54]


> Romm ©   (18.04.07 16:54) [5]
>
>


> у тех кому как до магазина.


Ну а нам, которым до магазина, не понятны твои треволнения по поводу трех задрипаных мегабайт)

Таки не соизволишь ли прокомментировать, чем тебя эти мегабайты взволновали ?)

Romm   (2007-04-18 16:54:00) [55]


> Сергей М. ©   (18.04.07 16:50) [4]

во во.. :)) поэтому прошу совета у тех кому как до магазина... :)

Сергей М.   (2007-04-18 16:50:00) [56]


> значит не получится из моей проги маленького и незаметного
> сервера


Да уж)
До кулхацкера тебе еще пока как до китая раком)

Romm   (2007-04-18 16:46:00) [57]


> Сергей М. ©   (18.04.07 16:41) [1]


> {RASkov}   (18.04.07 16:43) [2]

значит не получится из моей проги маленького и незаметного сервера.. :))

Ну а по оптимизации что можно сделать получше? :)
Вот мне это IFне нравятся жутко.. Можно что-нибудь вроде case .. do сделать?

{RASkov}   (2007-04-18 16:43:00) [58]

> [0] Romm ©   (18.04.07 16:39)
> uses
> Windows, Messages, ShellAPI, SysUtils, Graphics, Forms,
> ExtCtrls, ScktComp, Classes;

А ты и вот это посчитай, и то что в uses у них..., UserGDI... иже ниже...

Сергей М.   (2007-04-18 16:41:00) [59]


> для такой-то цели 3Мб


Ну а, будь ты ОС, - сколько б ей "дал" ?)

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо