Форум: "Начинающим";
Текущий архив: 2007.05.13;
Скачать: [xml.tar.bz2];

Вниз

затрата памяти   Найти похожие ветки 

← →
Romm ©   (2007-04-18 16:39) [0]

Уважаемые мастера, написанная мной программа "висит" в памяти и ждет команды. Только вот на это ожидание затрачивается аж 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.

---

← →
Сергей М. ©   (2007-04-18 16:41) [1]

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


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

---

← →
{RASkov}   (2007-04-18 16:43) [2]

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

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

---

← →
Romm ©   (2007-04-18 16:46) [3]

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


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

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

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

---

← →
Сергей М. ©   (2007-04-18 16:50) [4]

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


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

---

← →
Romm ©   (2007-04-18 16:54) [5]

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

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

---

← →
Сергей М. ©   (2007-04-18 16:58) [6]

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


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


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

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

---

← →
Desdechado ©   (2007-04-18 17:01) [7]

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

---

← →
Сергей М. ©   (2007-04-18 17:01) [8]

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


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

---

← →
Romm ©   (2007-04-18 17:03) [9]

ну просто я думал это много для проги, которая ничего не делает :)
А по оптимизации вы, которым до магазина, не подскажите по оптимизации что-нибудь новенького?? :)
Кстати,
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:07) [10]

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


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


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

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

---

← →
Сергей М. ©   (2007-04-18 17:12) [11]

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


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

program Proga;
begin
end;

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

---

← →
Romm ©   (2007-04-18 17:17) [12]

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

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


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

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


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

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

---

← →
Плохиш ©   (2007-04-18 17:28) [13]

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

---

← →
Romm ©   (2007-04-18 17:32) [14]

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

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

---

← →
Romm ©   (2007-04-18 17:34) [15]

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

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

---

← →
Плохиш ©   (2007-04-18 17:47) [16]

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

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

---

← →
Romm ©   (2007-04-18 17:54) [17]

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

ок :))

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

---

← →
Loginov Dmitry ©   (2007-04-18 18:02) [18]

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


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

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

где прочел?

---

← →
Romm ©   (2007-04-18 18:04) [19]

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

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

---

← →
{RASkov}   (2007-04-18 18:07) [20]

> var
> DeskTopDC: HDc;
> DeskTopCanvas: TCanvas;
> DeskTopRect: TRect;
> Bitmap:TBitmap;

Вот это вот все из procedure TMainForm.Timer1Timer(Sender: TObject);
не обязательно каждый раз создавать/убивать/высчитыать.....

---

← →
Romm ©   (2007-04-18 18:14) [21]

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

---

← →
{RASkov}   (2007-04-18 18:25) [22]

> , а высчитывать.. мне же "анимацию" рабочего стола нужно..

> DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);

Собственно это было про DeskTopRect: TRect; что не так страшно.... но тоже можно заранее определить этот Rect и при смене разрешения переопределить его и размеры битмапа(Bitmap:TBitmap), кстати у тебя они не выставляются.....!

---

← →
{RASkov}   (2007-04-18 18:27) [23]

> кстати у тебя они не выставляются.....!

> Bitmap:=TBitmap.Create;
> Bitmap.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);

В итоге мы в Bitmap ничего нихрена не имеем....

---

← →
Romm ©   (2007-04-18 18:27) [24]

>  размеры битмапа

нужно? щас сделаю... а нужно делать Bitmap.FreeImage?

---

← →
Romm ©   (2007-04-18 18:31) [25]

 if not Create then
   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;
     Str:=TMemoryStream.Create;
     Create:=true;
   end
 else
   begin
     Bitmap.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
     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);
   end;

так пойдет?

Bitmap.Free
DeskTopCanvas.Free делаю вместе с Timer1.Enable:=false;

---

← →
{RASkov}   (2007-04-18 18:39) [26]

> а нужно делать Bitmap.FreeImage?

а для чего ты это задумал?

> так пойдет?

Судя по твоим вопросам, и того куска кода что привел в [25] - ничего тебе не скажу.... не то что не хочу, а незнаю... что ты там наменял в твоем супер незаметном сервере.

> if not Create then

А вот это плохо, Ты что, булевую переменную назвал Create? Исправь... запутаешься.

---

← →
Romm ©   (2007-04-18 18:46) [27]

> а для чего ты это задумал?

просто метод увидел, решил спросить..


> что ты там наменял в твоем супер незаметном сервере

:) теперь так(только измененный кусок) :)

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

end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var
 DeskTopDC: HDc;
 DeskTopRect: TRect;
 Size:int64;
begin
 if not Create then
   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;
     Str:=TMemoryStream.Create;
     Create:=true;
   end
 else
   begin
     Bitmap.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
     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);
   end;
end;

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

ну и

program Server;

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

{$R *.res}

begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TMessageForm, MessageForm);
Application.Run;
end.

---

← →
{RASkov}   (2007-04-18 19:18) [28]

Плохо все еще пока.... давай дальше думай... Вот например:
type TMyDesk = record
     DeskTopDC: HDc;
     BitMap: TBitmap;
     DeskTopRect: TRect;
     IsCreate: Boolean;
    end;

var MyDesk: TMyDesk;

procedure CreateMyDesk;
procedure ReSizeMyDest;
procedure FreeMyDesk;
.............
procedure TMainForm.Timer1Timer(Sender: TObject);
var Size:int64;
begin
if not MyDesk.IsCreate then CreateMyDesk;
MyDesk.Bitmap.Canvas.CopyRect(MyDesk.DeskTopRect, MyDesk.DeskTopCanvas, MyDesk.DeskTopRect);
Str.Write(MyDesk.Bitmap,sizeof(MyDesk.Bitmap));
Size:=Str.Size;
ServerSocket1.Socket.Connections[0].SendBuf(Size,sizeof(Size));
ServerSocket1.Socket.Connections[0].SendStream(str);
end;
Ну и гденить в начале MyDesk.IsCreate:=False;, а в CreateMyDesk; в последнюю очередь вызвать ReSizeMyDest;. И ReSizeMyDest вызывать при необходимости....
Думай.... может даже лучше свой класс вместо рекорда сделать....

> а нужно делать Bitmap.FreeImage?

Нет, не нужно.... почитай в хелпе для чего это, но это не удаление рисунка...

---

← →
{RASkov}   (2007-04-18 19:20) [29]

> Ну и гденить в начале MyDesk.IsCreate:=False;, а в CreateMyDesk;

Не забудь только после создания в CreateMyDesk выставить MyDesk.IsCreate:=True; ;)

---

← →
{RASkov}   (2007-04-18 19:23) [30]

> MyDesk.Bitmap.Canvas.CopyRect(MyDesk.DeskTopRect, MyDesk.DeskTopCanvas, MyDesk.DeskTopRect);

Замени на BitBlt

---

← →
Romm ©   (2007-04-18 19:38) [31]

> {RASkov}   (18.04.07 19:18) [28]

спасибо


> {RASkov}   (18.04.07 19:20) [29]

ок :)


> Замени на BitBlt

как? :))

---

← →
Romm ©   (2007-04-18 19:42) [32]

Size:=Str.Size; когда таймер срабатывает второй раз - тут ошибка, первый нормально. Когда не указывал размеры bitmap"ки - не було такого

---

← →
Romm ©   (2007-04-18 19:43) [33]

было* :)

---

← →
{RASkov}   (2007-04-18 19:53) [34]

> > Замени на BitBlt
> как? :))

Типа так:
BitBlt(MyDesk.Bitmap.Canvas.Handle, 0, 0, MyDesk.Bitmap.Width, MyDesk.Bitmap.Height, MyDesk.DeskTopDC, 0, 0, SRCCOPY);
Ты сам когда начнешь думать?

---

← →
{RASkov}   (2007-04-18 19:56) [35]

> Size:=Str.Size; когда таймер срабатывает второй раз - тут
> ошибка, первый нормально. Когда не указывал размеры bitmap"ки
> - не було такого

Начни свой супер сервер с нуля делать... понаворатил там небось уже, сам запутался и других путаешь... Благо кода три с половиной строчки.

---

← →
Romm ©   (2007-04-18 20:04) [36]

> Начни свой супер сервер с нуля делать

времени нетуу :((
я же ЧеПятал весь код. Ну что там такого сверхЪестейственного?.. :)

---

← →
{RASkov}   (2007-04-18 20:09) [37]

> времени нетуу :((

Если хочешь сделать нормальную прогу - найдешь время, ибо на поиски глюков в глюкавом коде время нужно не меньше.....

---

← →
Romm ©   (2007-04-18 20:20) [38]

> {RASkov}   (18.04.07 20:09) [37]

я сомневаюсь, что с нуля напишу по другому...
А ошибка тем временем говорит:
Project Server.exe raised exception class EAccessViolation with message "Access violation at address 00000000. Read of adress 00000000". Process stopped. Use Step or Run to continue.
перевидите на русский, люди добрые.

---

← →
Romm ©   (2007-04-18 20:25) [39]

Еще раз код покажу - я не вижу ошибки...

unit MainUnit;

interface

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

type
 TMyDesk=record
   Bitmap:TBitmap;
   IsCreate:Boolean;
   DeskTopRect:TRect;
   DeskTopDc:HDc;
 end;

 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
 procedure CreateMyDesk;
 procedure FreeMyDesk;
 procedure ReSizeMyDesk;
 public
   Str:TMemoryStream;
 end;

var
 MainForm: TMainForm;
 MyDesk:TMyDesk;

implementation

uses MessageUnit;

{$R *.dfm}

procedure TMainForm.ReSizeMyDesk;
begin
 MyDesk.Bitmap.Width:=Screen.Width;
 MyDesk.Bitmap.Height:=Screen.Height;
end;

procedure TMainForm.FreeMyDesk;
begin
 MyDesk.Bitmap.Free;
 Str.Free;
end;

procedure TMainForm.CreateMyDesk;
begin
 MyDesk.DeskTopDc := GetWindowDC(GetDeskTopWindow);
 MyDesk.DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
 MyDesk.Bitmap:=TBitmap.Create;
 Str:=TMemoryStream.Create;
 MyDesk.IsCreate:=true;
 ReSizeMyDesk;
end;

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

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

procedure TMainForm.Timer1Timer(Sender: TObject);
var
 Size:int64;
begin
 if not MyDesk.IsCreate then
   CreateMyDesk
 else
   begin
     BitBlt(MyDesk.Bitmap.Canvas.Handle, 0, 0, MyDesk.Bitmap.Width, MyDesk.Bitmap.Height, MyDesk.DeskTopDC, 0, 0, SRCCOPY);
     Str.Write(MyDesk.Bitmap,sizeof(MyDesk.Bitmap));
     Size:=Str.Size;//на второй раз тут ошибка (выше написал)
     ServerSocket1.Socket.Connections[0].SendBuf(Size,sizeof(Size));
     ServerSocket1.Socket.Connections[0].SendStream(str);
     ReleaseDC(GetDeskTopWindow, MyDesk.DeskTopDC);
   end;
end;

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

end.

---

← →
Leonid Troyanovsky ©   (2007-04-18 20:26) [40]

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

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

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

--
Regards, LVT.

---

← →
{RASkov}   (2007-04-18 20:34) [41]

> [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].

---

← →
Romm ©   (2007-04-18 20:36) [42]

> Затем

не знаю :)

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

---

← →
{RASkov}   (2007-04-18 20:38) [43]

> 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;

---

← →
{RASkov}   (2007-04-18 20:38) [44]

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

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

---

← →
Romm ©   (2007-04-18 20:42) [45]

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

Виноват! :)

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

---

← →
{RASkov}   (2007-04-18 20:46) [46]

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

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

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

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

---

← →
Romm ©   (2007-04-18 20:50) [47]

> сорри

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

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

---

← →
{RASkov}   (2007-04-18 20:56) [48]

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

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

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

---

← →
Leonid Troyanovsky ©   (2007-04-18 21:00) [49]

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

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

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

--
Regards, LVT.

---

← →
{RASkov}   (2007-04-18 21:11) [50]

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

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

:)))

---

← →
Romm ©   (2007-04-18 21:12) [51]

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


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

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

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

---

← →
Romm ©   (2007-04-18 21:15) [52]

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


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


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


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

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

---

← →
{RASkov}   (2007-04-18 21:22) [53]

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

Ctrl+F7 ?

---

← →
Romm ©   (2007-04-18 21:23) [54]

> Ctrl+F7 ?

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

---

← →
{RASkov}   (2007-04-18 21:25) [55]

> [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:58) [56]

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

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

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

---

← →
{RASkov}   (2007-04-18 22:46) [57]

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

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

---

← →
Romm ©   (2007-04-19 07:52) [58]

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

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

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 снимка :)

---

← →
Romm ©   (2007-04-19 10:01) [59]

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

чуш!!!!

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

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

Stream.Position:=0;

:)


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

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

---

Страницы: 1 2 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.05.13;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.64 MB
Время: 0.044 c