TO ：mail_cj
我做个和你一样的东东，现在还没完工 我用TCP/IP SOCKET
被截机上放SERVER，控制机放CLIEN
SEVER 源程序
unit smain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp,jpeg, StdCtrls;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
m1:tmemorystream;
implementation
{$R *.DFM}
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
s,s1:string;
desk:tcanvas;
bitmap:tbitmap;
jpg:tjpegimage;
begin
s:=socket.ReceiveText;
if s='gets' then //客户端发出申请
begin
bitmap:=tbitmap.Create;
jpg:=tjpegimage.Create;
desk:=tcanvas.Create; //以下代码为取得当前屏幕图象
desk.Handle:=getdc(hwnd_desktop);
m1:=tmemorystream.Create; //初始化流m1,在用sendstream(m1)发送流后，
//它将保留到socket对话结束，
//不能用手工free掉，否则会触发异常
with bitmap do
begin
width:=screen.Width;
height:=screen.Height;
canvas.CopyRect(canvas.cliprect,desk,desk.cliprect);
end;
jpg.Assign(bitmap); //将图象转成JPG格式
jpg.SaveToStream(m1); //将JPG图象写入流中
jpg.free;
m1.Position:=0;
s1:=inttostr(m1.size);
Socket.sendtext(s1); //发送图象大小
end;
if s='okok' then //客户端已准备好接收图象
begin
m1.Position:=0;
Socket.SendStream(m1); //发送JPG图象
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.open;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
m1.Free;
end;
end.
CLIENT 源程序
unit cmain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ExtCtrls,jpeg, Db, KDaoTable, ADODB, KDaoDataBase,
Grids, DBGrids, Buttons, Mask, ComCtrls, DBTables;
type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
KADaoTable1: TKADaoTable;
KADaoDatabase1: TKADaoDatabase;
Timer1: TTimer;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
Label2: TLabel;
KADaoTable1no_id: TAutoIncField;
KADaoTable1zx_name: TStringField;
KADaoTable1zx_ip: TStringField;
KADaoTable1p_datetime: TDateTimeField;
KADaoTable1p_screen: TBlobField;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
GroupBox1: TGroupBox;
Label3: TLabel;
Edit4: TEdit;
Edit5: TEdit;
DateTimePicker1: TDateTimePicker;
Label4: TLabel;
Label5: TLabel;
DateTimePicker2: TDateTimePicker;
Edit2: TEdit;
Edit3: TEdit;
Label6: TLabel;
SpeedButton4: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
zi,zj:integer;
zxname, zxip: array of string;
start ,GETING,connect:boolean;
starttime,endtime:tdatetime;
steptime:integer;
implementation
{$R *.DFM}
USES C_DAT,SHOWSCREEN,SELECT_ZX,MYSOCKET;
procedure TForm1.FormCreate(Sender: TObject);
begin
start:=false;
connect:=false;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SELF.KADaoDatabase1.CLOSE;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
VAR
m1:tmemorystream;
TBF:TBlobField;
J:TJPEGImage;
B:TBITMAP;
begin
m1:= tmemorystream.Create;
J:=TJPEGImage.Create;
B:=TBITMAP.CREATE;
SHOWSCREEN_FRM.Label1.Caption:='坐席名:'+ KAdaoTable1.FieldByName('ZX_NAME').ASSTRING ;
SHOWSCREEN_FRM.Label2.Caption:='时间:'+DATETIMETOSTR(KAdaoTable1.FieldByName('P_DATETIME').ASDATETIME );
TBF:=KAdaoTable1.FieldByName('p_screen') As TBlobField;
// KAdaoTable1.FieldByName('zx_name').asstring:=zx_name ;
// KAdaoTable1.FieldByName('zx_ip').asstring:=zx_ip;
// KAdaoTable1.FieldByName('p_datetime').asdatetime:=now;
TBF.SaveToStream(M1);
M1.Position:=0;
J.LoadFromStream(M1);
J.SaveToFile('./J.JPG');
B.Assign(J);
SHOWSCREEN_FRM.ScrollBox1.HorzScrollBar.Range:=1000;
SHOWSCREEN_FRM.ScrollBox1.VertScrollBar.Range:=1000;
SHOWSCREEN_FRM.Image1.Picture.Assign(B);
J.FREE;
B.FREE;
M1.FREE;
SHOWSCREEN_FRM.ShowModal;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
VAR
J,I: INTEGER;
begin
I:=0;
J:=0;
IF SELECT_ZX_FRM.ShowModal=MROK THEN
BEGIN
WITH SELECT_ZX_FRM DO
BEGIN
FOR I:=0 TO CHECKLISTBOX1.Items.Count-1 DO
BEGIN
IF CHECKLISTBOX1. Checked THEN
BEGIN
INC(J);
END;
END;
SetLength(zxname, J);
SetLength(zxip, J);
J:=0;
FOR I:=0 TO CHECKLISTBOX1.Items.Count-1 DO
BEGIN
IF CHECKLISTBOX1. Checked THEN
BEGIN
ZXNAME[J]:= CHECKLISTBOX1.ITEMS;
ZXIP[J]:=IP;
INC(J);
END;
END;
END
END;
end;
procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
TRY
STARTTIME:=STRTODATETIME(FORMATDATETIME('YYYY/MM/DD',SELF.DateTimePicker1.DATETIME)+' '+TRIM(EDIT4.TEXT)+':'+TRIM(EDIT5.TEXT)+':'+'00');
ENDTIME:=STRTODATETIME(FORMATDATETIME('YYYY/MM/DD',SELF.DateTimePicker2.DATETIME)+' '+TRIM(EDIT2.TEXT)+':'+TRIM(EDIT3.TEXT)+':'+'00');
EXCEPT
SHOWMESSAGE('日期设置有误!');
exit;
END ;
self.Timer1.Enabled:=true;
self.SpeedButton3.Enabled:=false;
self.SpeedButton4.Enabled:=TRUE;
self.SpeedButton2.Enabled:=false;
start:=true;
zi:=low(zxname);
zj:=high(zxname);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
TK1: ARRAY OF TMYSOCKET;
begin
//if start then exit;
//start:=true;
SETLENGTH(TK1,ZJ-ZI+1);
if now>endtime then
begin
self.SpeedButton4.Click;
exit;
end;
if start then
begin
for i:=zi to zj do TK1:=TMYSOCKET.Create(SELF.KADAOTABLE1,zxname,zxip);
//TK.FREE;
//showmessage(edit1.text+#13#10+'未开机或未安装服务程序');
end;
end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
self.Timer1.Enabled:=false;
self.SpeedButton3.Enabled:=true;
self.SpeedButton4.Enabled:=FALSE;
self.SpeedButton2.Enabled:=true;
end;
end.
TMYSOCKET 源程序unit mysocket;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, StdCtrls, ExtCtrls,jpeg, Db, KDaoTable, ADODB, KDaoDataBase,
Grids, DBGrids, Buttons, Mask, ComCtrls, DBTables;
type
Tmysocket = class(Tobject)
private
fcs:TClientSocket;
K: TKADaoTable;
C:INTEGER;
m:tmemorystream;
m1:tmemorystream;
ZXNAME,ZXIP:STRING;
procedure ClientSocket1Error(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject;Socket: TCustomWinSocket);
procedure ClientSocket1Connect(Sender: TObject;Socket: TCustomWinSocket);
protected
{ Protected declarations }
public
PROCEDURE GETPIC;
constructor Create(daotable: TKADaoTable;zx_name:string;zx_iP:string); OVERLOAD;
destructor Destroy; override;
{ Public declarations }
published
{ Published declarations }
end;
//procedure Register;
implementation
//procedure Register;
//begin
// RegisterComponents('Samp', [TMYSOCKET]);
//end;
procedure TMYSOCKET.ClientSocket1Connect(Sender: TObject;Socket: TCustomWinSocket);
begin
APPLICATION.MAINFORM.caption:='连接到'+ZXIP;
SELF.GETPIC;
end;
PROCEDURE TMYSOCKET.GETPIC;
BEGIN
FCS.Socket.SendText('gets');
END;
procedure TMYSOCKET.ClientSocket1Read(Sender: TObject;Socket: TCustomWinSocket);
var
buffer:array [0..10000] of byte; //设置接收缓冲区
len:integer;
ll:string;
b:tbitmap;
j:tjpegimage;
TBF:TBlobField;
//zx_ip,zx_name:string;
begin
if c=0 then //C为服务端发送的字节数，如果为0表示为尚未开始图象接收
begin
ll:=socket.ReceiveText;
c:=strtoint(ll); //设置需接收的字节数
SELF.fcs.Socket.SendText('okok'); //通知服务端开始发送图象
end else
begin //以下为图象数据接收部分
len:=socket.ReceiveLength; //读出包长度
socket.ReceiveBuf(buffer,len); //接收数据包并读入缓冲区内
m.Write(buffer,len); //追加入流M中
if m.Size>=c then //如果流长度大于需接收的字节数，则接收完毕
begin
m.Position:=0;
b:=tbitmap.Create;
j:=tjpegimage.Create;
try
j.LoadFromStream(m); //将流M中的数据读至JPG图像对象J中
b.Assign(j); //将JPG转为BMP
//Image1.Picture.Bitmap.Assign(b); //分配给image1元件
j.SaveToStream(m1);
m1.position:=0;
K.append;
TBF:=K.FieldByName('p_screen') As TBlobField;
K.FieldByName('zx_name').asstring:=zxname ;
K.FieldByName('zx_ip').asstring:=zxip ;
K.FieldByName('p_datetime').asdatetime:=now;
TBF.LoadFromStream(m1);
K.Post;
finally //以下为清除工作
b.free;
j.free;
//clientsocket1.Active:=false;
//clientsocket1.Active:=true;
m.Clear;
c:=0;
SELF.Free;
end;
end;
end;
end;
procedure TMYSOCKET.ClientSocket1Error(Sender: TObject;Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;var ErrorCode: Integer);
begin
//caption:='连接'+edit1.text+'失败';
//showmessage(edit1.text+#13#10+'未开机或未安装服务程序');
errorcode:=0;
SELF.Free;
end;
destructor tmysocket.Destroy;
begin
self.fcs.free;
//
end;
constructor Tmysocket.Create(daotable: TKADaoTable;zx_name:string;zx_iP:string);
begin
self.fcs:=tclientsocket.Create(nil);
fcs.Host:=zx_iP ;
FCS.Port:=2048;
k:=daotable;
m:=tmemorystream.Create;;
m1:=tmemorystream.Create;;
ZXNAME:=ZX_NAME;
ZXIP:=ZX_IP;
FCS.OnError:=SELF.ClientSocket1Error;
FCS.OnRead:=SELF.ClientSocket1Read;
FCS.OnConnect:=SELF.ClientSocket1Connect;
FCS.Open;
C:=0;
inherited create;
end;
end.
