to xsjs:
I have been just studying Net Programming,and I'v happened to make
one -----Using TCP/IP,not udp...
All the codes are :
//There are still some bugs(or called disadvantages)!It's only a not-so-good
//demo
----------------------------------------------------------------------------
{At Server party:}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp,jpeg,shellapi;
type
TState = (stWaiting,stWorking, stSending,stGoOnSending);
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormDestroy(Sender: TObject);
private
State:TState;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TmpStream:TMemoryStream;
TmpBuf:array[0..1023]of byte;
implementation
{$R *.DFM}
procedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
State := stWaiting;
TmpStream:=TMemoryStream.Create;
form1.Width:=0;
form1.Height:=0;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var BitMap:TBitMap;
DesktopCanvas:TCanvas;
JpegPic:TJpegImage;
TmpText:String;
count:LongInt;
begin
if State = stWaiting then
begin
TmpText:=socket.ReceiveText;
if TmpText='准备抓图' then
begin
Bitmap:=TBitmap.Create; DesktopCanvas:=TCanvas.Create;JpegPic := TJpegImage.Create;
DesktopCanvas.Handle:=GetDc(Hwnd_Desktop);
try
Bitmap.Width:=Screen.Width;
Bitmap.Height:=Screen.Height;
Bitmap.Canvas.CopyRect(BitMap.Canvas.ClipRect,DesktopCanvas,Bitmap.Canvas.ClipRect);
JpegPic.Assign(Bitmap);
JpegPic.CompressionQuality :=30;
JpegPic.Compress;
TmpStream.Position:=0;
JpegPic.SaveToStream(TmpStream);
finally
BitMap.Free; DesktopCanvas.Free; ReleaseDc(handle,hwnd_Desktop);
TmpStream.Position:=0; state:=stWorking;
end; //end of finally
Socket.SendText('准备完毕');
end;
end
else
if state=stWorking then
begin
TmpText:=Socket.ReceiveText;
if TmpText='开始抓图' then
begin
state:=stSending;
Count:=TmpStream.Read(TmpBuf,SizeOf(TmpBuf));
Socket.SendBuf(TmpBuf,Count);
if Count<sizeof(TmpBuf) then state := stWaiting else state:=stGoOnSending;
end;
end
else
if State=stGoOnSending then
begin
TmpText:=Socket.ReceiveText;
if Tmptext = '继续发送' then
begin
Count:=TmpStream.Read(TmpBuf,SizeOf(TmpBuf));
Socket.SendBuf(TmpBuf,Count);
if Count<sizeof(TmpBuf) then
begin state := stWaiting; TmpStream.Clear;TmpStream.position:=0; end;
end;
end;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
TmpStream.Free;
end;
end.
-------------------------------------------------------------------------------
{At Client party:}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, Menus, ExtCtrls,Jpeg;
type
TState = (stIdle,stWorking,stReceiving,stGoOnReceiving);
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
PopupMenu1: TPopupMenu;
host1: TMenuItem;
startS1: TMenuItem;
N1: TMenuItem;
exitE1: TMenuItem;
Timer1: TTimer;
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure exitE1Click(Sender: TObject);
procedure host1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure startS1Click(Sender: TObject);
procedure ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
private
State : TState;
Address:string;
_flag:boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var TmpStream:TMemoryStream;
JpegPic:TJpegImage;
TmpBuf:array[0..1023]of byte;
received:Longint;
times:Longint;
{$R *.DFM}
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
ShowMessage('Error occur...');
end;
procedure TForm1.exitE1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.host1Click(Sender: TObject);
var t:string;
begin
received:=0;
t:=InputBox('host address','enter your server address','192.168.1.29');
Form1.Address:=t;
Form1.startS1.Enabled:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
state:=stIdle; times:=0; _flag:=false;
TmpStream:=TMemoryStream.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
TmpStream.Free;
JpegPic.Free;
end;
procedure TForm1.startS1Click(Sender: TObject);
begin
ClientSocket1.Address:=Form1.Address;
ClientSocket1.Active:=true;
state :=stWorking;
end;
procedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Caption:='Trying connecting to '+ClientSocket1.Address;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Caption:='Successfully connected to'+Socket.RemoteAddress;
inc(times);
Socket.SendText('准备抓图');
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Caption:='DisConnected already...'
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var BitMap:TBitMap;
TempText:String;
count:LongInt;
begin
if state=stWorking then
begin
TempText:=Socket.ReceiveText;
if TempText='准备完毕' then begin state:=stReceiving; Socket.SendText('开始抓图')end
end
else
if state=stReceiving then
begin
count:=Socket.ReceiveBuf(TmpBuf,SizeOf(TmpBuf));
received:=received+count; Form1.Caption:=IntToStr(received);
TmpStream.Write(TmpBuf,count);
if count<SizeOf(TmpBuf) then state:=stIdle
else begin state:=stGoOnReceiving; Socket.SendText('继续发送'); end;
end
else
if State=stGoOnReceiving then
begin
count:=Socket.ReceiveBuf(TmpBuf,SizeOf(TmpBuf));
received:=received+count; Form1.Caption:=IntToStr(received);
TmpStream.Write(TmpBuf,count);
if count<SizeOf(TmpBuf) then state:=stIdle else Socket.SendText('继续发送');
if state=stIdle then
begin
if fileexists('c:/123.jpg') then deletefile('c:/123.jpg');
TmpStream.SaveToFile('c:/123.jpg');
TmpStream.Clear;
TmpStream.Position:=0;
Application.ProcessMessages;
Image1.Picture.LoadFromFile('c:/123.jpg');
TmpStream.Clear; _flag:=true;
end;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if _flag=true then
begin
_flag:=false;
startS1Click(self);
end;
end;
end.