Recent

Author Topic: Trying to send Image From Client to server, While loop.  (Read 2296 times)

Vladmir

  • Newbie
  • Posts: 6
Trying to send Image From Client to server, While loop.
« on: March 21, 2019, 02:22:40 pm »
Hello all.

This code triggers exceptions along the Line hence i decided to put on here , I followed the method last time to do screencapture.

Code looks like this :

Code: PHP  [Select][+][-]
  1. procedure SendImage();
  2. var
  3.         Socket: TInetSocket;
  4.         msg: string;
  5.         Bmp: Graphics.TBitmap;
  6. begin
  7.         while true do
  8.         begin
  9.                 Bmp := CaptureWindow(GetDesktopWindow);
  10.                 Bmp.Canvas.Changed
  11.                 try
  12.                 msg := 'sharesc';
  13.                 Socket:= TInetSocket.Create('loopback',4800);
  14.                 Socket.Write(Bmp);
  15.                 finally
  16.                 Socket.Free;
  17.                 end;
  18.                   WriteLn('Sent image!');
  19.         end;
  20.         except 
  21.                 On E : Exception do WriteLn('E.Message');
  22.         end;
  23.         ReadLn;
  24.  
  25.  
  26.  

Please what did i miss.

bigeno

  • Sr. Member
  • ****
  • Posts: 266
Re: Trying to send Image From Client to server, While loop.
« Reply #1 on: March 21, 2019, 03:00:48 pm »
You miss 'try' on line 6.
But... why while loop ? its for some move streaming  :o ?

Thaddy

  • Hero Member
  • *****
  • Posts: 14197
  • Probably until I exterminate Putin.
Re: Trying to send Image From Client to server, While loop.
« Reply #2 on: March 21, 2019, 03:14:57 pm »
The socket should be created before the loop and free'd after the loop....This is a bit silly code...
Specialize a type, not a var.

Vladmir

  • Newbie
  • Posts: 6
Re: Trying to send Image From Client to server, While loop.
« Reply #3 on: March 21, 2019, 04:04:52 pm »
Followed  what Thaddy said and So far here is what i have done and what the code looks like

I have fixed it and hence i want to have it send image from the client to the server as i wanted to create something like Teamviewer during the time

The code to send the image looks like this

(Server)

Code: Pascal  [Select][+][-]
  1. unit ScreenCapClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ssockets ,windows;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.  
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
  33. var
  34.   HCursor : THandle;
  35. begin
  36.   HCursor := GetCursor;
  37.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  38.               HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  39. end;
  40.  
  41. function CaptureWindow(const WindowHandle: HWnd): Graphics.TBitmap;
  42. var
  43.   DC: HDC;
  44.   wRect: TRect;
  45.   CurPos: TPoint;
  46. begin
  47.   DC := GetWindowDC(WindowHandle);
  48.   Result := Graphics.TBitmap.Create;
  49.   Result.PixelFormat := pf32bit;
  50.   try
  51.     GetWindowRect(WindowHandle, wRect);
  52.     Result.Width := wRect.Right - wRect.Left;
  53.     Result.Height := wRect.Bottom - wRect.Top;
  54.     BitBlt(Result.Canvas.Handle,
  55.            0,
  56.            0,
  57.            Result.Width,
  58.            Result.Height,
  59.            DC,
  60.            0,
  61.            0,
  62.            SRCCOPY);
  63.     GetCursorPos(CurPos);
  64.     DrawCursor(Result.Canvas, CurPos);
  65.   finally
  66.     ReleaseDC(WindowHandle, DC);
  67.   end;
  68. end;
  69.  
  70. procedure SendImage();
  71. var
  72.         Socket: TInetSocket;
  73.         Bmp: Graphics.TBitmap;
  74. begin
  75. Socket:= TInetSocket.Create('loopback',4800);
  76.         while true do
  77.         begin
  78.                 Bmp := CaptureWindow(GetDesktopWindow);
  79.                 Bmp.Canvas.Changed;
  80.                 try
  81.                 Socket.Write(Bmp,1000553);
  82.                 finally
  83.                 Socket.Free;
  84.                 end;
  85.                   showmessage('sent image');
  86.         end;
  87. end;
  88. procedure TForm1.Button1Click(Sender: TObject);
  89. var
  90.   Bmp: Graphics.TBitmap;
  91. begin
  92.   Bmp := CaptureWindow(GetDesktopWindow);
  93.   Bmp.Canvas.Changed;
  94.   //Bmp.SaveToFile('C:\Users\******\Desktop\test\FullScreenCap.bmp');
  95.   SendImage();
  96.   Bmp.Free;
  97.   //showmessage('Screen captured.');
  98. end;
  99.  
  100. end.
  101.  


Now the code to receive looks like this


Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,windows,ssockets;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Image1: TImage;
  16.     procedure FormCreate(Sender: TObject);
  17.   private
  18.  
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. procedure receiveImage();
  31. var
  32.  Socket: TInetSocket;
  33.  Bmp: Graphics.TBitmap;
  34. begin
  35.             Server := TMyServer.Create('loopback', 4800);
  36.             showmessage('ok i am receiving now');
  37.             while true do
  38.             begin
  39.             Server.StartAccepting;
  40.             // show image on imagebox where Image1 :Timage
  41. end;
  42.  
  43. end;
  44.  
  45. { TForm1 }
  46.  
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. begin
  49.   receiveImage();
  50. end;
  51.  


So I am completely new to using it to send images hence i need some help and some form of explaning here.

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: Trying to send Image From Client to server, While loop.
« Reply #4 on: March 21, 2019, 05:20:40 pm »
I don't think you really understood what Thaddy was trying to say. Try this:
Code: Pascal  [Select][+][-]
  1. unit ScreenCapClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ssockets ,windows;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.     FAbort: Boolean;
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
  33. var
  34.   HCursor : THandle;
  35. begin
  36.   HCursor := GetCursor;
  37.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  38.               HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  39. end;
  40.  
  41. function CaptureWindow(const WindowHandle: HWnd): Graphics.TBitmap;
  42. var
  43.   DC: HDC;
  44.   wRect: TRect;
  45.   CurPos: TPoint;
  46. begin
  47.   DC := GetWindowDC(WindowHandle);
  48.   Result := Graphics.TBitmap.Create;
  49.   Result.PixelFormat := pf32bit;
  50.   try
  51.     GetWindowRect(WindowHandle, wRect);
  52.     Result.Width := wRect.Right - wRect.Left;
  53.     Result.Height := wRect.Bottom - wRect.Top;
  54.     BitBlt(Result.Canvas.Handle,
  55.            0,
  56.            0,
  57.            Result.Width,
  58.            Result.Height,
  59.            DC,
  60.            0,
  61.            0,
  62.            SRCCOPY);
  63.     GetCursorPos(CurPos);
  64.     DrawCursor(Result.Canvas, CurPos);
  65.   finally
  66.     ReleaseDC(WindowHandle, DC);
  67.   end;
  68. end;
  69.  
  70. procedure DoCapture;
  71. var
  72.   Socket: TInetSocket;
  73.   Bmp: Graphics.TBitmap;
  74. begin
  75.   { Create the socket now and free it only when you're done with it}
  76.   Socket:= TInetSocket.Create('loopback',4800);
  77.   try
  78.     { You need some "scape". Infinite loops are ... bad }
  79.     while (not FAbort) and (not Application.Terminated) do begin
  80.       Bmp := CaptureWindow(GetDesktopWindow);
  81.       try
  82.         Bmp.Canvas.Changed;
  83.         Socket.Write(Bmp,1000553);
  84.       finally
  85.          {If you don't do this, you'll consume all the memory}
  86.         Bmp.Free;
  87.       end;
  88.       Application.ProcessMesages;
  89.     end;
  90.   finally
  91.     Socket.Free;
  92.   end;
  93. end;
  94.  
  95. procedure TForm1.Button1Click(Sender: TObject);
  96. begin
  97.   if Assigned(Sender) and Sender.InheritsForm(TControl) then begin
  98.     { Use the button to start/stop capture,
  99.       using the button's Tag as a flag to know in which mode we are. }
  100.     if (Sender as TControl).Tag < 0 then begin
  101.        FAbort := True;
  102.        (Sender as TControl).Caption := '&Start capture';
  103.        (Sender as TControl).Tag := 0;
  104.     end else begin
  105.        FAbort := False;
  106.        (Sender as TControl).Caption := '&Stop capture';
  107.        (Sender as TControl).Tag := -1;
  108.     end;
  109.     DoCapture;
  110.   end;    
  111. end;
  112.  
  113. end.
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

Vladmir

  • Newbie
  • Posts: 6
Re: Trying to send Image From Client to server, While loop.
« Reply #5 on: March 21, 2019, 07:56:16 pm »
Gives me an exception Error cannot connect to Loopback.

I have the receiver code, which looks like this

Code: Pascal  [Select][+][-]
  1. unit screenShowClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   windows, ssockets;
  10.  
  11. type
  12.  
  13.     { TMyServer }
  14.  
  15.   TMyServer=class(TInetServer)
  16.   public
  17.     Constructor Create(const aHost: string; const APort: Word; AHAndler : TSocketHandler = Nil);
  18.     Procedure RunNotePad(Sender : TObject; Data : TSocketStream);
  19.   end;
  20.  
  21. { TMyServer }
  22.  
  23.   { TForm1 }
  24.  
  25.   TForm1 = class(TForm)
  26.     Button1: TButton;
  27.     Image1: TImage;
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure Image1Click(Sender: TObject);
  31.     procedure Image2Click(Sender: TObject);
  32.   private
  33.  
  34.   public
  35.  
  36.   end;
  37.  
  38. var
  39.   Form1: TForm1;
  40.  
  41. implementation
  42.  
  43. {$R *.lfm}
  44.  
  45. procedure receiveImage();
  46. var
  47.  Server: TInetServer;
  48.  Bmp: Graphics.TBitmap;
  49.  JpegImage: TJpegImage;
  50.  
  51. begin
  52.             Server := TMyServer.Create('loopback', 4800);
  53.             showmessage('ok i am receiving now');
  54.             while true do
  55.             begin
  56.             Server.StartAccepting;
  57.             // show image on imagebox where Image1 :Timage
  58.             JpegImage.Assign(Bmp);
  59.             Form1.Image1.Canvas.Draw(0,0,JpegImage);
  60. end;
  61. end;
  62.  
  63. { TForm1 }
  64.  
  65. procedure TForm1.Button1Click(Sender: TObject);
  66. begin
  67.   receiveImage();
  68. end;
  69.  
  70. procedure TForm1.FormCreate(Sender: TObject);
  71. begin
  72.  
  73. end;
  74.  
  75.  

It shows some funny end of file errors I dont get .. Kindly help

I don't think you really understood what Thaddy was trying to say. Try this:
Code: Pascal  [Select][+][-]
  1. unit ScreenCapClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ssockets ,windows;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.     FAbort: Boolean;
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
  33. var
  34.   HCursor : THandle;
  35. begin
  36.   HCursor := GetCursor;
  37.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  38.               HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  39. end;
  40.  
  41. function CaptureWindow(const WindowHandle: HWnd): Graphics.TBitmap;
  42. var
  43.   DC: HDC;
  44.   wRect: TRect;
  45.   CurPos: TPoint;
  46. begin
  47.   DC := GetWindowDC(WindowHandle);
  48.   Result := Graphics.TBitmap.Create;
  49.   Result.PixelFormat := pf32bit;
  50.   try
  51.     GetWindowRect(WindowHandle, wRect);
  52.     Result.Width := wRect.Right - wRect.Left;
  53.     Result.Height := wRect.Bottom - wRect.Top;
  54.     BitBlt(Result.Canvas.Handle,
  55.            0,
  56.            0,
  57.            Result.Width,
  58.            Result.Height,
  59.            DC,
  60.            0,
  61.            0,
  62.            SRCCOPY);
  63.     GetCursorPos(CurPos);
  64.     DrawCursor(Result.Canvas, CurPos);
  65.   finally
  66.     ReleaseDC(WindowHandle, DC);
  67.   end;
  68. end;
  69.  
  70. procedure DoCapture;
  71. var
  72.   Socket: TInetSocket;
  73.   Bmp: Graphics.TBitmap;
  74. begin
  75.   { Create the socket now and free it only when you're done with it}
  76.   Socket:= TInetSocket.Create('loopback',4800);
  77.   try
  78.     { You need some "scape". Infinite loops are ... bad }
  79.     while (not FAbort) and (not Application.Terminated) do begin
  80.       Bmp := CaptureWindow(GetDesktopWindow);
  81.       try
  82.         Bmp.Canvas.Changed;
  83.         Socket.Write(Bmp,1000553);
  84.       finally
  85.          {If you don't do this, you'll consume all the memory}
  86.         Bmp.Free;
  87.       end;
  88.       Application.ProcessMesages;
  89.     end;
  90.   finally
  91.     Socket.Free;
  92.   end;
  93. end;
  94.  
  95. procedure TForm1.Button1Click(Sender: TObject);
  96. begin
  97.   if Assigned(Sender) and Sender.InheritsForm(TControl) then begin
  98.     { Use the button to start/stop capture,
  99.       using the button's Tag as a flag to know in which mode we are. }
  100.     if (Sender as TControl).Tag < 0 then begin
  101.        FAbort := True;
  102.        (Sender as TControl).Caption := '&Start capture';
  103.        (Sender as TControl).Tag := 0;
  104.     end else begin
  105.        FAbort := False;
  106.        (Sender as TControl).Caption := '&Stop capture';
  107.        (Sender as TControl).Tag := -1;
  108.     end;
  109.     DoCapture;
  110.   end;    
  111. end;
  112.  
  113. end.

Vladmir

  • Newbie
  • Posts: 6
Re: Trying to send Image From Client to server, While loop.
« Reply #6 on: March 21, 2019, 08:16:40 pm »
Now even worse it just freezes my compy and does not send the images or inter communicate.

Code looks like this

Server (Sending images)
Code: Pascal  [Select][+][-]
  1. unit ScreenCapClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ssockets ,windows;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.      FAbort: Boolean;
  19.   public
  20.  
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.lfm}
  29.  
  30. { TForm1 }
  31.  
  32. procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
  33. var
  34.   HCursor : THandle;
  35. begin
  36.   HCursor := GetCursor;
  37.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  38.               HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  39. end;
  40.  
  41. function CaptureWindow(const WindowHandle: HWnd): Graphics.TBitmap;
  42. var
  43.   DC: HDC;
  44.   wRect: TRect;
  45.   CurPos: TPoint;
  46. begin
  47.   DC := GetWindowDC(WindowHandle);
  48.   Result := Graphics.TBitmap.Create;
  49.   Result.PixelFormat := pf32bit;
  50.   try
  51.     GetWindowRect(WindowHandle, wRect);
  52.     Result.Width := wRect.Right - wRect.Left;
  53.     Result.Height := wRect.Bottom - wRect.Top;
  54.     BitBlt(Result.Canvas.Handle,
  55.            0,
  56.            0,
  57.            Result.Width,
  58.            Result.Height,
  59.            DC,
  60.            0,
  61.            0,
  62.            SRCCOPY);
  63.     GetCursorPos(CurPos);
  64.     DrawCursor(Result.Canvas, CurPos);
  65.   finally
  66.     ReleaseDC(WindowHandle, DC);
  67.   end;
  68. end;
  69.  
  70. procedure DoCapture;
  71. var
  72.   Socket: TInetSocket;
  73.   Bmp: Graphics.TBitmap;
  74.   FAbort: Boolean;
  75. begin
  76.   { Create the socket now and free it only when you're done with it}
  77.   Socket:= TInetSocket.Create('loopback',4800);
  78.   try
  79.     { You need some "scape". Infinite loops are ... bad }
  80.     while (not FAbort) and (not Application.Terminated) do begin
  81.       Bmp := CaptureWindow(GetDesktopWindow);
  82.       try
  83.         Bmp.Canvas.Changed;
  84.         Socket.Write(Bmp,1000553);
  85.       finally
  86.          {If you don't do this, you'll consume all the memory}
  87.         Bmp.Free;
  88.       end;
  89.       Application.ProcessMessages;
  90.     end;
  91.   finally
  92.     Socket.Free;
  93.   end;
  94. end;
  95.  
  96. procedure TForm1.Button1Click(Sender: TObject);
  97. begin
  98.     if Assigned(Sender) and Sender.InheritsFrom(TControl) then begin
  99.     { Use the button to start/stop capture,
  100.       using the button's Tag as a flag to know in which mode we are. }
  101.     if (Sender as TControl).Tag < 0 then begin
  102.        FAbort := True;
  103.        (Sender as TControl).Caption := '&Start capture';
  104.        (Sender as TControl).Tag := 0;
  105.     end else begin
  106.        FAbort := False;
  107.        (Sender as TControl).Caption := '&Stop capture';
  108.        (Sender as TControl).Tag := -1;
  109.     end;
  110.     DoCapture;
  111.   end;
  112. end;
  113.  
  114. end.
  115.  
  116.  
  117.  

And the client to receive and display the image looks like this

Code: Pascal  [Select][+][-]
  1. unit screenShowClassEx;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   windows, ssockets;
  10.  
  11. type
  12.  
  13.     { TMyServer }
  14.  
  15.   TMyServer=class(TInetServer)
  16.   public
  17.   end;
  18.  
  19. { TMyServer }
  20.  
  21.   { TForm1 }
  22.  
  23.   TForm1 = class(TForm)
  24.     Button1: TButton;
  25.     Image1: TImage;
  26.     procedure Button1Click(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.   private
  29.  
  30.   public
  31.  
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. {$R *.lfm}
  40.  
  41. procedure receiveImage();
  42. var
  43.  Server: TInetServer;
  44.  Bmp: Graphics.TBitmap;
  45.  JpegImage: TJpegImage;
  46.  
  47. begin
  48.             Server := TMyServer.Create('loopback', 4800);
  49.             showmessage('ok i am receiving now');
  50.             while true do
  51.             begin
  52.             Server.StartAccepting;
  53.             // show image on imagebox where Image1 :Timage
  54.             JpegImage.Assign(Bmp);
  55.             Form1.Image1.Canvas.Draw(0,0,JpegImage);
  56. end;
  57. end;
  58.  
  59. { TForm1 }
  60.  
  61. procedure TForm1.Button1Click(Sender: TObject);
  62. begin
  63.   receiveImage();
  64. end;
  65.  
  66. procedure TForm1.FormCreate(Sender: TObject);
  67. begin
  68.  
  69. end;
  70. end.
  71.  
  72.  
« Last Edit: March 21, 2019, 08:19:23 pm by Vladmir »

 

TinyPortal © 2005-2018