| Новости | Поиск | 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-19 10:01:00) [1]

> пришлось делать так, потому что когда я пытался сохранить
> скрин в поток jpeg.SateToStream(stream),
> то потом происходила ошибка на этой строчкеSize:=Stream.
> Size;

чуш!!!!

Вчера пол ночи искал ошибку, а нету ошибки!
Просто перед
Size:=Stream.Size;

нужно было написать

Stream.Position:=0;

:)


> нафик ты вообще занялся программированием

вот ради этого и занялся, чтобы искать пол ночи ошибки, а найдя их утром думать: "вот я умный какой..." :)))

---

Romm   (2007-04-19 07:52:00) [2]

Вот и "завтро" наступило :))
Привет всем Мастерам! Может это странно, но мой супер сервер начал подавать признаки жизни :)

Пока код очень некрасивый, глупый и неправильный, зато работает :)
Посмотрите в общем:

private
  stream:TFileStream;

procedure TMainForm.vidio;
var
 size:int64;
 DeskTopDC: HDc;
 DeskTopCanvas: TCanvas;
 DeskTopRect: TRect;
 Bitmap:TBitmap;
 JPEG:TJPEGImage;
begin
 DeskTopDC := GetWindowDC(GetDeskTopWindow);
 DeskTopCanvas := TCanvas.Create;
 DeskTopCanvas.Handle := DeskTopDC;
 DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
 Bitmap:=TBitmap.Create;
 Bitmap.Width:=Screen.Width;
 Bitmap.Height:=Screen.Height;
 Bitmap.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
 jpeg:=TJpegImage.Create;
 jpeg.Assign(Bitmap);
 jpeg.SaveToFile('screen.jpg');
 ReleaseDC(GetDeskTopWindow, DeskTopDC);

 Stream:=TFileStream.Create('screen.jpg',fmOpenRead);
 Size := Stream.Size;
 ServerSocket1.Socket.Connections[0].SendBuf(Size, SizeOf(Size));
 ServerSocket1.Socket.Connections[0].SendStream(Stream);
 Bitmap.Free;
 jpeg.Free;
end;

пришлось делать так, потому что когда я пытался сохранить скрин в поток jpeg.SateToStream(stream),
то потом происходила ошибка на этой строчке Size:=Stream.Size;

впринципе работает, и для начала нормально, но вот когда я принял поток -> загрузил в картинку и потом отображаю ее на TImage, то происходит сильное мерцание (еще бы *jpg 1024x768) можно как-то сгладить мерцание или вообще избавиться от него?!

PS за секунду передается 3 снимка :)

---

{RASkov}   (2007-04-18 22:46:00) [3]

> ждите завтра с новыми вопросами :)

нафик, нафик... :)

---

Romm   (2007-04-18 21:58:00) [4]

> RASkov}   (18.04.07 21:25) [55]

нифига, все так же.

сервер так и не стал функционировать :(
всем спасибо за помощь, ждите завтра с новыми вопросами :)
Вечный чайник, Romm :)

---

{RASkov}   (2007-04-18 21:25:00) [5]

> [52] Romm ©   (18.04.07 21:15)
> без комментариев :)

Ты вот это вот убери:
procedure TMainForm.FormPaint(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_HIDE);
ShowWindow(Handle,SW_HIDE);
end;
И проделай [50] :) Не верю, что после сворачивания твоего "сервера", остается 3Mb.... ;)

---

Romm   (2007-04-18 21:23:00) [6]

> Ctrl+F7 ?

да да да, вот я про Ctrl забыл :))

---

{RASkov}   (2007-04-18 21:22:00) [7]

> кстати, напомни как отследить размер/значение файла/переменной
> во время исполнения программы,

Ctrl+F7 ?

---

Romm   (2007-04-18 21:15:00) [8]

> А ты ее после запуска сверни... и посмотри в диспетчер и
> радуйся....


> Только вот на это ожидание затрачивается аж 3Мб памяти!


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


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

без комментариев :)

---

Romm   (2007-04-18 21:12:00) [9]

> Leonid Troyanovsky ©   (18.04.07 21:00) [49]
:)


> Тебе еще и работу с IDE рассказать, нафик ты вообще занялся
> программированием?

сложно напомнить?! Ок, я не настаиваю, что ж так грубо?.. :)

только что написал простую прогу передающую *.jpeg , картинку короче. И что вы думаете - работает. Мда, придется с нуля переделывать :)

---

{RASkov}   (2007-04-18 21:11:00) [10]

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

А ты ее после запуска сверни... и посмотри в диспетчер и радуйся....
> [49] Leonid Troyanovsky ©   (18.04.07 21:00)

:)))

---

Leonid Troyanovsky   (2007-04-18 21:00:00) [11]

> Romm ©   (18.04.07 20:50) [47]

> с детства рисунки/картинки не любил :))

Я с детства не любил овал,
Я с детства - угол рисовал.

--
Regards, LVT.

---

{RASkov}   (2007-04-18 20:56:00) [12]

try    
TBmpFS:=TMemoryStream.Create;
MyDesk.Bitmap.SaveToStream(TBmpFS);
Size:=TBmpFS.Size;
TBmpFS.Position:=0;
.....
finally TBmpFS.Free; end;

> кстати, напомни как отследить размер/значение файла/переменной
> во время исполнения программы, вроде бы F7

Тебе еще и работу с IDE рассказать, нафик ты вообще занялся программированием?

---

Romm   (2007-04-18 20:50:00) [13]

> сорри

да ладно, я уже привык :)
с детства рисунки/картинки не любил :))

кстати, напомни как отследить размер/значение файла/переменной во время исполнения программы, вроде бы F7
?

---

{RASkov}   (2007-04-18 20:46:00) [14]

> я сомневаюсь, что с нуля напишу по другому...

А я уже сомневаюсь, что ты вообще что-то напишешь....сорри.

> Str.Write(MyDesk.Bitmap,sizeof(MyDesk.Bitmap));

sizeof(MyDesk.Bitmap) - всегда 4 байта

---

Romm   (2007-04-18 20:42:00) [15]

> А кто должен знать?

Виноват! :)

Млин, но это как-то глупо, что ошибка происходит при присваивании...

---

{RASkov}   (2007-04-18 20:38:00) [16]

> [42] Romm ©   (18.04.07 20:36)
> не знаю :)

А кто должен знать?

---

{RASkov}   (2007-04-18 20:38:00) [17]

> procedure TMainForm.Timer1Timer(Sender: TObject);
> .........
> ReleaseDC(GetDeskTopWindow, MyDesk.DeskTopDC);

Перенеси в
procedure TMainForm.FreeMyDesk;
begin
 ReleaseDC(GetDeskTopWindow, MyDesk.DeskTopDC);
 MyDesk.Bitmap.Free;
 MyDesk.IsCreate:=False;
 Str.Free; // А это или убери отсюда или в рекорд добавь, иначе както не связанно...
end;

---

Romm   (2007-04-18 20:36:00) [18]

> Затем

не знаю :)

[35]
[37]
попробую на простом примерчике..

---

{RASkov}   (2007-04-18 20:34:00) [19]

> [39] Romm ©   (18.04.07 20:25)

Ужос....
Ты нифика не понял ничего... :)
Например:
procedure TMainForm.FreeMyDesk;
begin
MyDesk.Bitmap.Free;
MyDesk.IsCreate:=False;
Str.Free;
end;
Затем, зачем вот это:
procedure TMainForm.Timer1Timer(Sender: TObject);
.........
ReleaseDC(GetDeskTopWindow, MyDesk.DeskTopDC);
.........

> Size:=Str.Size;//на второй раз тут ошибка (выше написал)

Сам то думал - почему?
Я сильно не вникал в твой последний код.... См [35], [37].

---

Leonid Troyanovsky   (2007-04-18 20:26:00) [20]

> Romm ©   (18.04.07 20:20) [38]

> перевидите на русский, люди добрые.

Используй шаг (можно бегом) для продолжения.
Путь длиной в 5000 миль начинается с первого шага.
Да достигнем мы все Дао.

--
Regards, LVT.

---

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

Наверх