200分送二进制文件传送高手~!(200分)

我有一个传输屏幕图像的程序，曾经调通过 帖出来看看

利用流实现网络传输屏幕图像
unit Unit1;{服务端程序}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
JPEG,ExtCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
{自定义抓屏函数,DrawCur表示抓鼠标图像与否}
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MyStream: TMemorystream;{内存流对象}
implementation
{$R *.DFM}
procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap; DrawCur: Boolean);
var
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin
Mybmp := Tbitmap.Create; {建立BMPMAP }
Mycan := TCanvas.Create; {屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
R := Rect(0, 0, screen.Width, screen.Height);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;
Mycan.Handle := 0;
Mycan.Free;
if DrawCur then {画上鼠标图象}
begin
GetCursorPos(DrawPos);
MyCursor := TIcon.Create;
getcursorpos(mp);
hld := WindowFromPoint(mp);
Threadld := GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle := Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx := DrawPos.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor); {画上鼠标}
DeleteObject(pIconInfo.hbmColor);{GetIconInfo 使用时创建了两个bitmap对象.
需要手工释放这两个对象}
DeleteObject(pIconInfo.hbmMask);{否则,调用他后,他会创建一个bitmap,多次调用
会产生多个,直至资源耗尽}
Mycursor.ReleaseHandle; {释放数组内存}
MyCursor.Free; {释放鼠标指针}
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port := 3000; {端口}
ServerSocket1.Open; {Socket开始侦听}
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket1.Active then ServerSocket1.Close; {关闭Socket}
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
S, S1: string;
MyBmp: TBitmap;
Myjpg: TJpegimage;
begin
S := Socket.ReceiveText;
if S = 'cap' then {客户端发出抓屏幕指令}
begin
try
MyStream := TMemorystream.Create;{建立内存流}
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
Cjt_GetScreen(MyBmp, True); {True表示抓鼠标图像}
Myjpg.Assign(MyBmp); {将BMP图象转成JPG格式,便于在互联网上传输}
Myjpg.CompressionQuality := 10; {JPG文件压缩百分比设置,数字越大图像越清晰,
但数据也越大}
Myjpg.SaveToStream(MyStream); {将JPG图象写入流中}
Myjpg.free;
MyStream.Position := 0;{注意:必须添加此句}
s1 := inttostr(MyStream.size);{流的大小}
Socket.sendtext(s1); {发送流大小}
finally
MyBmp.free;
end;
end;
if s = 'ready' then {客户端已准备好接收图象}
begin
MyStream.Position := 0;
Socket.SendStream(MyStream); {将流发送出去}
end;
end;
end.

上面是服务端，下面我们来写客户端程序。新建一个工程，
添加Socket控件ClientSocket、图像显示控件Image、一个 Panel 、一个Edit、
两个 Button和一个状态栏控件StatusBar1。注意：把Edit1和两个 Button放在Panel1上
面。ClientSocket的属性跟ServerSocket差不多，不过多了一个Address属性，表示要连
接的服务端IP地址。填上IP地址后点"连接"将与服务端程序建立连接，如果成功就可以进
行通讯了。点击"抓屏"将发送字符给服务端。因为程序用到了JPEG图像单元，
所以要在Uses中添加Jpeg.
全部代码如下：
unit Unit2{客户端};
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,
StdCtrls,ScktComp,ExtCtrls,Jpeg, ComCtrls;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
StatusBar1: TStatusBar;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
MySize: Longint;
MyStream: TMemorystream;{内存流对象}
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
{-------- 下面为设置窗口控件的外观属性 ------------- }
{注意:把Button1、Button2和Edit1放在Panel1上面}
Edit1.Text := '127.0.0.1';
Button1.Caption := '连接主机';
Button2.Caption := '抓屏幕';
Button2.Enabled := false;
Panel1.Align := alTop;
Image1.Align := alClient;
Image1.Stretch := True;
StatusBar1.Align:=alBottom;
StatusBar1.SimplePanel := True;
{----------------------------------------------- }
MyStream := TMemorystream.Create; {建立内存流对象}
MySize := 0; {初始化}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not ClientSocket1.Active then
begin
ClientSocket1.Address := Edit1.Text; {远程IP地址}
ClientSocket1.Port := 3000; {Socket端口}
ClientSocket1.Open; {建立连接}
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Clientsocket1.Socket.SendText('cap'); {发送指令通知服务端抓取屏幕图象}
Button2.Enabled := False;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '成功建立连接!';
Button2.Enabled := True;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Errorcode := 0; {不弹出出错窗口}
StatusBar1.SimpleText := '无法与主机' + ClientSocket1.Address + '建立连接!';
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '断开连接!';
Button2.Enabled := False;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
MyBuffer: array[0..10000] of byte; {设置接收缓冲区}
MyReceviceLength: integer;
S: string;
MyBmp: TBitmap;
MyJpg: TJpegimage;
begin
StatusBar1.SimpleText := '正在接收数据......';
if MySize = 0 then {MySize为服务端发送的字节数，如果为0表示为尚未开始图象接收}
begin
S := Socket.ReceiveText;
MySize := Strtoint(S); {设置需接收的字节数}
Clientsocket1.Socket.SendText('ready'); {发指令通知服务端开始发送图象}
end
else
begin {以下为图象数据接收部分}
MyReceviceLength := socket.ReceiveLength; {读出包长度}
StatusBar1.SimpleText := '正在接收数据,数据大小为:' + inttostr(MySize);
Socket.ReceiveBuf(MyBuffer, MyReceviceLength); {接收数据包并读入缓冲区内}
MyStream.Write(MyBuffer, MyReceviceLength); {将数据写入流中}
if MyStream.Size >= MySize then {如果流长度大于需接收的字节数，则接收完毕}
begin
MyStream.Position := 0;
MyBmp := tbitmap.Create;
MyJpg := tjpegimage.Create;
try
MyJpg.LoadFromStream(MyStream); {将流中的数据读至JPG图像对象中}
MyBmp.Assign(MyJpg); {将JPG转为BMP}
StatusBar1.SimpleText := '正在显示图像';
Image1.Picture.Bitmap.Assign(MyBmp); {分配给image1元件 }
finally {以下为清除工作 }
MyBmp.free;
MyJpg.free;
Button2.Enabled := true;
{ Socket.SendText('cap');添加此句即可连续抓屏 }
MyStream.Clear;
MySize := 0;
end;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
MyStream.Free; {释放内存流对象}
if ClientSocket1.Active then ClientSocket1.Close; {关闭Socket连接}
end;
end.

程序原理：运行服务端开始侦听，再运行客户端，输入服务端IP地址建立连接，
然后发一个字符通知服务端抓屏幕。服务端调用自定义函数Cjt_GetScreen抓取
屏幕存为BMP，把BMP转换成JPG，把JPG写入内存流中，然后把流发送给客户端。
客户端接收到流后做相反操作，将流转换为JPG再转换为BMP然后显示出来。
注意：因为Socket的限制，不能一次发送过大的数据，只能分几次发。所以程序
中服务端抓屏转换为流后先发送流的大小，通知客户端这个流共有多大，客户端
根据这个数字大小来判断是否已经接收完流，如果接收完才转换并显示。

to yqwanwan:
辛苦了~
不过我早已经用类似的代码尝试过了,可能是我太菜了吧~
就是无法根据上面的例子写出传送"二进制文件"的代码来~
用 m:Tmemorystream
m.write 无法和二进制文件关联啊（我不会），一编译就报错：
写入内存地址为全零～～

要么就给出一堆汇编指令，而且全为‘？’～～

up

不是给你发代码了吗，没收到吗

继续顶～

to Tassadar:
没有啊～～
能麻烦你再发一次吗？
zzyy192@yahoo.com.cn
coco1922000@yahoo.com.cn
以上的都可以～～

直接下载吧，12点就关了
http://218.79.83.92/Socket.rar

谢谢～ 已经下载了，正在学习中。。。
一旦成功，马上给分～～

来晚了

对不起！
~~~~
一听到对不起，是不是感到失望？
我真的找不到那个小东东了。：（

不过，你也不用担心，我立即又找到一种更好的方法，并帮你写了出来还试验通过了！
什么文件都能传。
你自己改改吧：
{这是TFMain.pas}
unit TFMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, ScktComp, NMSTRM, Psock;

const
BUFFERSIZE = 128;

type
TForm1 = class(TForm)
Label1: TLabel;
edHost: TEdit;
Label2: TLabel;
edFile: TEdit;
btnOpen: TSpeedButton;
btnTrans: TButton;
NMStrmServ1: TNMStrmServ;
procedure btnOpenClick(Sender: TObject);
procedure btnTransClick(Sender: TObject);
procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
procedure edHostChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.btnOpenClick(Sender: TObject);
begin
with TOpenDialog.Create(nil) do begin
FileName := edFile.Text;
if Execute then
edFile.Text := FileName;
Free;
end;
end;

procedure TForm1.btnTransClick(Sender: TObject);
var
vFileStream :TFileStream;
begin
with TNMStrm.Create(nil) do
begin
Host := edHost.Text;
FromName := ExtractFileName(edFile.Text);
try
vFileStream := TFileStream.Create(edFile.Text, fmOpenRead);
try
PostIt(vFileStream);
Application.MessageBox('Congratulation: transfer success!', 'HAHA', MB_ICONINFORMATION + MB_OK);
except
Application.MessageBox('Transfer error!', 'ERROR', MB_ICONERROR + MB_OK);
end;
vFileStream.Free;
except
Application.MessageBox('Open file error!', 'ERROR', MB_ICONERROR + MB_OK);
end;
Free;
end;
end;

procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
begin
try
with TFileStream.Create('d:/' + sFrom, fmCreate) do
begin
try
CopyFrom(strm, strm.Size);
except
end;
Free;
end;
except
Application.MessageBox('Can not create file!', 'ERROR', MB_ICONERROR + MB_OK);
end;
end;

procedure TForm1.edHostChange(Sender: TObject);
begin
btnTrans.Enabled := (edHost.Text <> '') and (edFile.Text <> '');
end;

end.

{这是TFMain.DFM}
object Form1: TForm1
Left = 192
Top = 107
Width = 439
Height = 156
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 32
Top = 32
Width = 22
Height = 13
Caption = 'Host'
end
object Label2: TLabel
Left = 40
Top = 64
Width = 16
Height = 13
Caption = 'File'
end
object btnOpen: TSpeedButton
Left = 392
Top = 56
Width = 23
Height = 22
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
04000000000000010000130B0000130B00001000000000000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0033333333B333
333B33FF33337F3333F73BB3777BB7777BB3377FFFF77FFFF77333B000000000
0B3333777777777777333330FFFFFFFF07333337F33333337F333330FFFFFFFF
07333337F3FF3FFF7F333330F00F000F07333337F77377737F333330FFFFFFFF
07333FF7F3FFFF3F7FFFBBB0F0000F0F0BB37777F7777373777F3BB0FFFFFFFF
0BBB3777F3FF3FFF77773330F00F000003333337F773777773333330FFFF0FF0
33333337F3FF7F37F3333330F08F0F0B33333337F7737F77FF333330FFFF003B
B3333337FFFF77377FF333B000000333BB33337777777F3377FF3BB3333BB333
3BB33773333773333773B333333B3333333B7333333733333337}
NumGlyphs = 2
OnClick = btnOpenClick
end
object edHost: TEdit
Left = 64
Top = 24
Width = 321
Height = 21
TabOrder = 0
OnChange = edHostChange
end
object edFile: TEdit
Left = 64
Top = 56
Width = 321
Height = 21
TabOrder = 1
OnChange = edHostChange
end
object btnTrans: TButton
Left = 80
Top = 88
Width = 75
Height = 25
Caption = 'Trans'
Default = True
Enabled = False
TabOrder = 2
OnClick = btnTransClick
end
object NMStrmServ1: TNMStrmServ
Port = 6711
ReportLevel = 0
OnMSG = NMStrmServ1MSG
Left = 192
Top = 80
end
end

试试吧！

to Tassadar: 多谢你的东东啊~ 可我的目的刚好和程序相反,我是要服务器端向客户端
传送文件,而且是传送几个类型和大小都相同的文件.
我试着自己把你给的程序做修改,可是改了一个上午也没改好
procedure TfmServer.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
AThread.Data := TThreadData.Create;
with AThread.Data as TThreadData do
begin
State := dstNone;
end;
end;

尤其是上面这段程序,我想要改成客户端的,该怎么改啊~~
还有,是不是把所有的客户端和服务器端的程序对换就可以了啊(当然中间发送和接收的代码要
换)

to Kisber:
谢谢你啊~
可是我太菜了,你给的这段代码我看了半天也不明白,NMStrmServ1我从未接触过啊~
唉~看来要想琢磨透是很难了 因为我不得不全看懂啊,到时候老师要提问的~~~

我改一下，待会儿给你

好的~~谢谢~~

up~~

TNMStrmServ放在你的“服务器”端--也就是你的客户端用于接收。
当用户用TNMStrm的PostIt将一个流发送出去的时候，TNMStrmServ就会触发OnMSG事件。
参数里的strm就是发送过来的流。
把这个流写到文件就OK了。
但这读写文件都得靠TFileStream来做。正合你意！！！

改好了，有没有163.com或者163.net的邮箱，我上次给你发的邮件被退回来了

再说明一下，你想试验的话，把程序拷到要接收的机子上运行，别动它。
然后在发送文件的机子上也运行它，写好HOST和FILE传送就行了。

ftp://61.152.210.98/Socket.rar
这里下载吧，说明一下，你最好要理解idtcp那套东西的机制
server是自动实现threadblocking的，没一个链接都会创建
一个线程，所以server端不需要写什么代码就可以支持多用户，
对于每一个用户的数据可以保存在线程的data(自己写的对象)里面，
而且会被自动释放。简单好用

to Tassadar:
snowman192@163.com

to Kisber:
PostIt方法是不是传送完毕后自动断开啊~~??

Auto connect and auto disconnect!
爽吧！