VPF::NetMeeting - Форум программистов

Rodman

Дата 11.11.2006, 17:11 (ссылка)

(нет голосов)

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122

Дароф...

Вот на форуме был топик...

Я решил немного пееделать программу для реализации программы подобной NetMeeting...

Вот есть клиент

Код


unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,
  IdSocketHandle, ExtCtrls;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    IdUDPServer1: TIdUDPServer;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation
var
  FS: TFileStream;
  FSize: integer;
{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
IdUDPServer1.Active:=true;
end;

procedure TForm2.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  buffBin, BinBuff: string;
  BuffSize: integer;
  n, m, i: integer;
  SL: TStringList;
begin
  BuffSize:=AData.Size;
  SetLength(buffBin, BuffSize);
  AData.Read(buffBin[1], BuffSize);
  SL:=TStringList.Create;
  if(pos('AAACONNECTION', buffBin)=1)then
  begin
    SL.Delimiter:=':';
    SL.DelimitedText:=buffBin;
    Memo1.Lines.Add('Client connected: '+ SL.Strings[1]);
  end
  else
  begin
    if pos('AAAOPENFILE', buffBin)=1 then
    begin
      SL.Delimiter:=':';
      SL.DelimitedText:=buffBin;
      Memo1.Lines.Add('Recive file: '+ SL.Strings[2]+ ' of size '+SL.Strings[1]);
      FS:=TFileStream.Create('inbox\'+SL.Strings[2], fmCreate);
      FSize:=StrToInt(SL.Strings[1]);
      SL.Free;
    end;
    if pos('AAACLOSEFILE', buffBin)=1 then
    begin
      FS.Size:=FSize;
      FS.Free;
    end;
    if pos('AAADATAFILE', buffBin)=1 then
    begin
      FS.Write(buffBin[12], 1024);
    end;
  end;
end;

end.

и сервер

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdUDPClient,
  StdCtrls, JPEG;

type
  TForm1 = class(TForm)
    Button1: TButton;
    IdUDPClient1: TIdUDPClient;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    Function ReadComputerName:string;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function TForm1.ReadComputerName:string;
var i:DWORD;
    p:PChar;
begin
  i:=255;
  GetMem(p, i);
  GetComputerName(p, i);
  Result:=String(p);
  FreeMem(p);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FS: TFileStream;
  FS2:TStream;
  buffBin: string;
  BuffSize: integer;
  n, m, i: integer;
  JpegIm: TJpegImage;
  bm: TBitMap;
begin
//делаем скриншот
bm := TBitMap.Create; 
  bm.Width := Screen.Width; 
  bm.Height := Screen.Height;
  BitBlt(bm.Canvas.Handle, 0, 0,
    bm.Width, bm.Height,
    GetDC(0), 0, 0, SRCCOPY); 
  JpegIm := TJpegImage.Create; 
  JpegIm.Assign(bm);
  JpegIm.CompressionQuality := 75;
  JpegIm.Compress;
//JpegIm.SaveToFile('C:\Screen.jpg'); Лучше чтоб посылалось через СТРИМ без всяких сохранений. НО
//JpegIm.SaveToStream(FS); Это не работает хотя было бы очень просто - скрин в стрим и на клиенты
  bm.Destroy;
  JpegIm.Destroy;
//сделали... Ниже - посылка файла НО ПОСЛАТЬ нужно именно скриншот
    FS:=TFileStream.Create(OpenDialog1.FileName, fmOpenRead);
    buffBin:=Pchar('AAAOPENFILE:'+IntToStr(FS.Size)+':'+ExtractFileName(OpenDialog1.FileName));
    IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);
    BuffSize:=1024;
    SetLength(buffBin, BuffSize);
    n:=FS.Size div BuffSize;
    m:=FS.Size mod BuffSize;
    for I := 0 to n-1 do begin
      FS.ReadBuffer(buffBin[1], BuffSize);
      IdUDPClient1.Broadcast('AAADATAFILE'+buffBin, IdUDPClient1.Port);
    end;
    FS.ReadBuffer(buffBin[1], m);
    IdUDPClient1.Broadcast('AAADATAFILE'+buffBin, IdUDPClient1.Port);
    buffBin:=Pchar('AAACLOSEFILE');
    IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);
    FS.Free;
  end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FS: TFileStream;
  buffBin: string;
  BuffSize: integer;
  n, m, i: integer;
begin
  //Серверу говорится что клиент приконектился ТОЛЬКО эта процедура должна быть на клиенте :)
  buffBin:=Pchar('AAACONNECTION:'+ReadComputerName);
  IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);
  button1.Enabled:=true;
  button2.Visible:=false;
end;

end.

в идеале мне необходимо что бы формировался скриншот (он уже формируется), его как нить надо поместить в какую нить стуктуру (я предполгаю что можно с помощью TFileStream, но не получается...).... а клиент должен получать и віводить в Image1.. т.е. без сохранения на жорсткий носитель, пересылка и открытие тоже не используя жорсткий носитель - ЖЕЛАТЕЛЬНО...

Спасибо...

--------------------

CRM с функцией АвтоОбзвона

Лотереи мира

drkot

Дата 15.11.2006, 12:55 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: 0
Всего: 8

Цитата(Rodman @ 11.11.2006, 17:11

)

TFileStream

Это уже и есть файл на диске. Есть еще TMemoryStream.

Цитата(Rodman @ 11.11.2006, 17:11

)

но не получается...

что конкретно? Пример кода.

Цитата(Rodman @ 11.11.2006, 17:11

)

а клиент должен получать и віводить в Image1..

Низкая скорость прорисовки + мерцание. В инете есть пример называется QDraw (типа быстрая прорисовка).

--------------------

Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.

Rodman

Дата 15.11.2006, 13:49 (ссылка)

(нет голосов)

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122

Код


JpegIm.SaveToStream(FS);

вот 66 строка... на этом месте вылетает ошибка... типа не могу сохранить...

--------------------

CRM с функцией АвтоОбзвона

Лотереи мира

drkot

Дата 15.11.2006, 13:56 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: 0
Всего: 8

А что создавать экземпляр потока уже необязательно?

Добавлено @ 13:59
Плз. читайте ошибки которые возникают в процессе работу. А то так и получается smile

. Чуть что шишки набивать, а код ошибки посмотреть слабо.

--------------------

drkot

Дата 15.11.2006, 14:28 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: 0
Всего: 8

Цитата(Tokagero @ 15.11.2006, 14:24

)

Ааа это что??

примерно вот это:

Код

FS:=TFileStream.Create(OpenDialog1.FileName, fmOpenRead);

Это сообщение отредактировал(а) drkot - 15.11.2006, 14:30

--------------------

Tokagero

Дата 15.11.2006, 14:31 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 112
Регистрация: 25.10.2006

Репутация: нет
Всего: нет

Цитата(drkot @ 15.11.2006, 14:28

)

OpenDialog1.FileName

Вот как раз я об этом и говорю, чтоб желательно небыло диалога. Чтоб был автоматом путь прописан сделать можно но мне кажецца что это будет ненадежно

Rodman

Дата 18.11.2006, 15:32 (ссылка)

(нет голосов)

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122

все самое не понятное записано в коментариях... smile

Код


unit Unit1;/////////////////попробовать скрин сразу в стрим загонять

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IdUDPClient,
  StdCtrls,IdSocketHandle, ExtCtrls, Jpeg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    IdUDPServer1: TIdUDPServer;
    Memo1: TMemo;
    Timer1: TTimer;
    IdUDPClient1: TIdUDPClient;
    procedure Button1Click(Sender: TObject);
    Function ReadComputerName:string;
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
    FS: TFileStream;
  FSize, count: integer;
  num:longint; nm:string;

implementation

{$R *.dfm}

Function TForm1.ReadComputerName:string;
var i:DWORD;
    p:PChar;
begin
  i:=255;
  GetMem(p, i);
  GetComputerName(p, i);
  Result:=String(p);
  FreeMem(p);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=true;
button1.Visible:=false;
num:=1;
end;



procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
 var
  buffBin, BinBuff: string;
  BuffSize: integer;
  n, m, i: integer;
  SL: TStringList;
begin
  BuffSize:=AData.Size;
  SetLength(buffBin, BuffSize);
  AData.Read(buffBin[1], BuffSize);
  SL:=TStringList.Create;
  if(pos('AAACONNECTION', buffBin)=1)then
  begin
    SL.Delimiter:=':';
    SL.DelimitedText:=buffBin;
    Memo1.Lines.Add('Client connected: '+ SL.Strings[1]);
  end
  else
  begin
    if pos('AAAOPENFILE', buffBin)=1 then
    begin
      SL.Delimiter:=':';
      SL.DelimitedText:=buffBin;
      Memo1.Lines.Add('Recive file: '+ SL.Strings[2]+ ' of size '+SL.Strings[1]);
//      FS:=TFileStream.Create(SL.Strings[2], fmCreate);
      FSize:=StrToInt(SL.Strings[1]);
      SL.Free;
    end;
        if pos('AAACLOSEFILE', buffBin)=1 then
    begin
      FS.Size:=FSize;
      FS.Free;
    end;
    if pos('AAADATAFILE', buffBin)=1 then
    begin
      FS.Write(buffBin[12], 1024);
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  FS: TFileStream;
  buffBin: string;
  BuffSize: integer;
  n, m, i: integer;
  JpegIm: TJpegImage;
  bm: TBitMap;
   CI: TCursorInfo;
  Icon: TIcon;
  II: TIconInfo;
  r: TRect;
begin
//----------------------------------
//Это сделано для того чтоб чередовать названия сохраняемых файлов так как
//При сохранении файла на существовавшее имя вылазит ошибка мол "Файл уже
//занят другим процессом." Если даже предварительно его удалить.
//Но даже это не помогает. Не работает.
  count:=count+1;
  if fileexists('picture1.jpg') then deletefile('picture1.jpg');
  if fileexists('picture2.jpg') then deletefile('picture2.jpg');
  if (count div 2)=0 then nm:='picture1.jpg'
  else nm:=('picture2.jpg');
//----------------------------------
  bm := TBitMap.Create;
  bm.Width := Screen.Width;
  bm.Height := Screen.Height;
  BitBlt(bm.Canvas.Handle, 0, 0,
    bm.Width, bm.Height,
    GetDC(0), 0, 0, SRCCOPY);
    Icon:=TIcon.Create;
r:=Rect(0,0,GetSystemMetrics(SM_CXSCREEN),GetSystemMetrics(SM_CYSCREEN));
CI.cbSize:=SizeOf(CI);
if (GetCursorInfo(CI)) and (CI.flags=CURSOR_SHOWING) then
 begin
  Icon.Handle:=CopyIcon(CI.hCursor);
  if GetIconInfo(Icon.Handle,II) then
  bm.Canvas.Draw(ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left, ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top, Icon);
 end;
  JpegIm := TJpegImage.Create;
  JpegIm.Assign(bm);
  JpegIm.CompressionQuality := 80;
  JpegIm.Compress;
  JpegIm.SaveToFile(nm);
  bm.Destroy;
  JpegIm.Destroy;
    FS:=TFileStream.Create(nm, fmOpenRead);
    buffBin:=Pchar('AAAOPENFILE:'+IntToStr(FS.Size)+':'+ExtractFileName(nm));
    IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);
    BuffSize:=1024;
    SetLength(buffBin, BuffSize);
    n:=FS.Size div BuffSize;
    m:=FS.Size mod BuffSize;
    Application.ProcessMessages;
    showmessage(inttostr(n)+' '+inttostr(I));
    Application.ProcessMessages;
// Это по идее разрезка файла на кусочки и их посылка. Я так понимаю. Но тут оно частенько зацыкливается.
    {    for I := 0 to n-1 do begin
      FS.ReadBuffer(buffBin[1], BuffSize);
      IdUDPClient1.Broadcast('AAADATAFILE'+buffBin, IdUDPClient1.Port);
    end;                           }
    FS.ReadBuffer(buffBin[1], m);
    IdUDPClient1.Broadcast('AAADATAFILE'+buffBin, IdUDPClient1.Port);
    buffBin:=Pchar('AAACLOSEFILE');
    IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);
    FS.Free;
end;

end.

--------------------

CRM с функцией АвтоОбзвона

Лотереи мира

drkot

Дата 20.11.2006, 13:31 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: 0
Всего: 8

В 143 строке попробуй
JpegIm.SaveToStream();
насколько я понимаю запись в поток унаследников TGraphic есть.

В своем оригинальном тексте программа глюков не имела. Следовательно глюки были привнесены с новой функциональностью или ввиду изменения структуры программы. smile

--------------------

Tokagero

Дата 25.11.2006, 14:54 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 112
Регистрация: 25.10.2006

Репутация: нет
Всего: нет

drkot,

Цитата(drkot @ 20.11.2006, 13:31

)

Следовательно глюки были привнесены с новой функциональностью или ввиду изменения структуры программы.

То есть я повтыкал не туда куда надо??

Цитата(drkot @ 20.11.2006, 13:31

)

JpegIm.SaveToStream();

Попробовал. А именно

Код


var
 JpegIm : TJpegImage;
 bm : TBitmap;
 FS : TFileStream;
begin
  bm := TBitmap.Create;

bm.Width := Screen.Width;
  bm.Height := Screen.Height;
  
  BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY);

  JpegIm := TJpegImage.Create;
  JpegIm.Assign(bm);
  JpegIm.CompressionQuality := 80;
  JpegIm.Compress;

  FS := TFileStream.Create(ExtractFilePath(application.ExeName)+'1.jpg', fmCreate);
  FS.Position := 0;
  JpegIm.SaveToStream(FS);
...

Потом идет посылка. В ней я до конца не разобрался, знаю что "так надо". Знаю что если файл большой то оно режет его по 1мб и кусками посылает. Но кто разобрался обьясните. Посылка:

Код


... //педидущий код
JpegIm.SaveToStream(FS); //save to stream

//Создание стрима. "application.ExeName+'1.jpg'" скриншот (путь к нему). Можно было просто '1.jpg'
 buffBin:=Pchar('AAAOPENFILE:'+IntToStr(FS.Size)+':'+ExtractFileName((application.ExeName+'1.jpg'));
    
    IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);
    BuffSize:=1024;
    SetLength(buffBin, BuffSize);
    n:=FS.Size div BuffSize;
    m:=FS.Size mod BuffSize;

//Это я так понимаю режется на куски по 1мб
   
    for I := 0 to n-1 do begin
      FS.ReadBuffer(buffBin[1], BuffSize);
      IdUDPClient1.Broadcast('AAADATAFILE'+buffBin, IdUDPClient1.Port);
    end;

    FS.ReadBuffer(buffBin[1], m);
    IdUDPClient1.Broadcast('AAADATAFILE'+buffBin, IdUDPClient1.Port);
    buffBin:=Pchar('AAACLOSEFILE');
    IdUDPClient1.Broadcast(buffBin, IdUDPClient1.Port);

    FS.Free;
    JpegIm.Free;
    bm.Free;

Ну короче если тут что-то неправельно то прошу сказать об этом. А вообще оно мне пишет
"Stream read error"

drkot

Дата 27.11.2006, 20:53 (ссылка)

(нет голосов)

Загрузка ...

Ищущий

Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: 0
Всего: 8

попробую по пунктам.
вместо FS : TFileStream; надо FS : TMemoryStream;
(без записи на диск)

после JpegIm.SaveToStream(FS); надо FS.Position:=0;
Установить позицию чтения.

Цитата(Tokagero @ 25.11.2006, 14:54

)

оно режет его по 1мб и кусками посылает

только по 1 килобайту

Цитата(Tokagero @ 25.11.2006, 14:54

)

"Stream read error"

программы две в какой из них?

Цитата

buffBin:=Pchar('AAAOPENFILE:'+IntToStr(FS.Size)+':'+ExtractFileName((application.ExeName+'1.jpg'));

это не входное имя, а выходное (под этим именем файл будет сохранен)

--------------------

Rodman

Дата 2.12.2006, 15:32 (ссылка)

(нет голосов)

Загрузка ...

CIO

Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122