局部网可以传输,INTENET上面却一直处于等待状态.请帮忙看看这段代码 (100分)

  • 主题发起人 主题发起人 jingtao
  • 开始时间 开始时间
这么多,我看到代码就昏
 
明显的错误!
Stream.Read(buf,sizeof(buf));
Stream.Seek(i*sizeof(buf),soFromBeginning);
if s<>0 then Send(s,buf,sizeof(buf),0) //你没有检查Send的返回值,
Send()返回的就是你发送出去的数据包的大小,在LAN上没有问题,到了复杂的INTERNET上就
挂了
 
接受部分
procedure TForm1.ClientSocket2Read(Sender: TObject;
Socket: TCustomWinSocket);
var len:integer;
temp:string;
begin
if stStatue=stgetFile then
begin
Len:=Socket.ReceiveLength;
Temp:=Socket.ReceiveText;
filem.Write(PChar(Temp)^,len); //filem是一个文件流
inc(allLen,len);
if allLen=getfilesize then //allLen是文件长度,你先传送过来
ShowMessage('文件接受完毕!');
end;

发送部分
const
MAX_LEN=2048;

var
iSen:integer; //iSen发送出去的长度
iSize:integer; //文件长度 最好是全局变量
buf:array[1..MAXLEN]of char;
senlen:integer; //每次应该发送的长度
ret:integer; //实际发送的文件长度
filen:TFileStream; //最好是全局变量

iSen:=0;
while iSen<iSize do
begin
FillChar(buf,MAX_LEN,0);
if iSize-iSen>MAX_LEN then senlen:=MAX_LEN
else senLen:=iSize-iSen;
filen.Position:=iSen;
filen.Read(buf,senLen);
ret:=ClientSocket1.Socket.SendBuf(buf,senLen);
inc(iSen,ret);
end;
 
你先照 无忌 的提议去做了再说吧:)
 
把代码改成我这个样子的就行了,
const
MAX_LEN=2048;

var
iSen:integer; //iSen发送出去的长度
iSize:integer; //文件长度 最好是全局变量
buf:array[1..MAXLEN]of char;
senlen:integer; //每次应该发送的长度
ret:integer; //实际发送的文件长度
filen:TFileStream; //最好是全局变量

iSen:=0;
while iSen<iSize do
begin
FillChar(buf,MAX_LEN,0);
if iSize-iSen>MAX_LEN then senlen:=MAX_LEN
else senLen:=iSize-iSen;
filen.Position:=iSen;
filen.Read(buf,senLen);
ret:=ClientSocket1.Socket.SendBuf(buf,senLen);
inc(iSen,ret);
end;
 
各位:先发文件大小的话我也会做
我要的是修改上面的代码
 
关于多线程序SOCKET程序设计.很早就开始了.
比如说几年前OopsWare翻译C代码的时候就知道如何创建了.贴出来:
屏幕控制程序工作原理:

Server 端:
通过 TIMER 事件,获取屏幕信息,存为BITMAP,然后压缩,将数据
包通过TCP/IP发给Client。
OnSocketRead时,接受Client发来的“命令”列表,以此加入到
Windows的消息队列。
Client 端:
将键盘、鼠标事件格式为“命令”,发给Server。接受Server端的
数据解压,显示在屏幕中。

当前程序原理:
通讯使用Internet页中的TServerSocket, TClientSocket。阻塞模式。
数据压缩使用 Delphi 的未公开单元 zlib


注意:
随程序我发了一个zlib.zip文件,这是Borland的zlib压缩包的原程序
Delphi4所代的zlib.dcu未公开使用,而且有问题(Stream 解压缩过程
中,read 函数不能返回 EOF )! 请将其解压缩到delphi的lib目录,
并删除此目录中原zlib.dcu,当然你不想升级他的话,可把文件解压到
程序目录,并在项目中加入 zlib.pas单元
//-----------------------------------------------------
unit CltMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ScktComp, OopsClientThread, ExtCtrls, Menus;

type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
MainMenu1: TMainMenu;
C1: TMenuItem;
ScrollBox1: TScrollBox;
Image1: TImage;
C2: TMenuItem;
S1: TMenuItem;
N1: TMenuItem;
X1: TMenuItem;
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure C2Click(Sender: TObject);
procedure S1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
OopsClientThread1: TOopsClientThread;
rCommands: TList;


implementation

{$R *.DFM}

uses MyDefs, GetHost;

procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
begin
OopsClientThread1:=TOopsClientThread.Create(False);
C2.Enabled:=False;
S1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
rCommands:=TList.Create;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var i: Integer;
begin
ClientSocket1.Close;
if Assigned(rCommands) then
for i:=rCommands.Count-1 downto 0 do begin
FreeMem(rCommands);
rCommands.Delete(i);
end;
rCommands.Free;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var pKc: pKeyCommand;
begin
pKc := AllocMem(sizeof(TKeyCommand));
pKc^.CMD:='C';
pKc^.ID := 1;
pKc^.Key := Key;
pKc^.Shift := Shift;
rCommands.Add(pKc);
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var pKc: pKeyCommand;
begin
pKc := AllocMem(sizeof(TKeyCommand));
pKc^.CMD:='C';
pKc^.ID := 2;
pKc^.Key := Key;
pKc^.Shift := Shift;
rCommands.Add(pKc);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var pKc: pKeyCommand;
begin
pKc := AllocMem(sizeof(TKeyCommand));
pKc^.CMD:='C';
pKc^.ID := 3;
pKc^.Button := Button;
pKc^.Shift := Shift;
pKc^.X := X;
pKc^.Y := Y;
rCommands.Add(pKc);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var pKc: pKeyCommand;
begin
pKc := AllocMem(sizeof(TKeyCommand));
pKc^.CMD:='C';
pKc^.ID := 4;
pKc^.Shift := Shift;
pKc^.X := X;
pKc^.Y := Y;
rCommands.Add(pKc);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var pKc: pKeyCommand;
begin
pKc := AllocMem(sizeof(TKeyCommand));
pKc^.CMD:='C';
pKc^.ID := 5;
pKc^.Button := Button;
pKc^.Shift := Shift;
pKc^.X := X;
pKc^.Y := Y;
rCommands.Add(pKc);
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
C2.Enabled:=True;
S1.Enabled:=False;
end;

procedure TForm1.C2Click(Sender: TObject);
var s: string;
begin
if MyGetHost(s)<>ID_OK then Exit;
ClientSocket1.Address:=s;
ClientSocket1.Open;
end;

procedure TForm1.S1Click(Sender: TObject);
var i: Integer;
begin
ClientSocket1.Close;
if Assigned(rCommands) then
for i:=rCommands.Count-1 downto 0 do begin
FreeMem(rCommands);
end;
rCommands.Clear;
end;

end.
//---------------------------
unit OopsClientThread;

interface

uses
Windows, Messages, SysUtils, Classes, Forms, ScktComp, MyZlib, MyDefs;

type
TOopsClientThread = class(TThread)
private
inF: TStream;
Buffer: array[1..TALK_BUFFER_SIZE]of Char;
BufferSize: Integer;
protected
procedure Execute; override;
procedure GetNextRequest;
procedure ShowRemoteScreem;
end;

implementation

uses CltMain;

procedure TOopsClientThread.Execute;
var TheStream: TWinSocketStream;
TransingFile: Boolean;
begin
TheStream := TWinSocketStream.Create(Form1.ClientSocket1.Socket, THREAD_WAIT_TIME);
try
while (not Terminated) and (Form1.ClientSocket1.Active) do
begin
try
if inF = nil then begin // send commands
Synchronize(GetNextRequest);
TheStream.Write(Buffer[1], Sizeof(TKeyCommand));
if Buffer[1]='R' then inF:=TMemoryStream.Create;
end else begin // Continue Trans screen date file
StrCopy(@Buffer[1], 'NEXT');
TheStream.Write(Buffer[1], 4);
end;

if TheStream.WaitForData(1000) then // wait one secent for responds
begin
TransingFile:=(Buffer[1]<>'C'); // is not Commands state
BufferSize:=TheStream.Read(Buffer[1], TALK_BUFFER_SIZE);
if BufferSize=0 then Terminate;
if TransingFile then begin
inF.Write(Buffer[1], BufferSize);
if BufferSize<>TALK_BUFFER_SIZE then Synchronize(ShowRemoteScreem);
end;
end;

except
Terminate;
end;
end;
finally
TheStream.Free;
end;
end;

procedure TOopsClientThread.GetNextRequest;
begin
if rCommands.Count<>0 then begin
Move((PChar(rCommands[0]))^, Buffer[1], Sizeof(TKeyCommand));
rCommands.Delete(0);
end else StrCopy(@Buffer[1], 'REFRESH');
end;

procedure TOopsClientThread.ShowRemoteScreem;
var ouF, zpF: TStream;
i: integer;
begin
if inF.Size<>0 then begin
inF.Seek(0, soFromBeginning);
ouF:=TMemoryStream.Create;
zpF:=TDecompressionStream.Create(inF);
i:=zpF.Read(Buffer[1], 1024);
while i>0 do begin
ouF.Write(Buffer[1], i);
i:=zpF.Read(Buffer[1], 1024);
end;
ouF.Seek(0, soFromBeginning);
Form1.Image1.Picture.Bitmap.LoadFromStream(ouF);
ouF.Free;
zpF.Free;
end;
inF.Free;
inF:=nil;
end;

end.
//----------------------------------
unit SvrMain;

interface

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

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
CheckBox1: TCheckBox;
procedure ServerSocket1GetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1ThreadEnd(Sender: TObject;
Thread: TServerClientThread);
procedure ServerSocket1ThreadStart(Sender: TObject;
Thread: TServerClientThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses OopsServerThread;

procedure TForm1.ServerSocket1GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket; var SocketThread: TServerClientThread);
begin
SocketThread := TOopsServerThread.Create(false, ClientSocket);
SocketThread.FreeOnTerminate:=True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.Close;
end;

procedure TForm1.ServerSocket1ThreadEnd(Sender: TObject;
Thread: TServerClientThread);
begin
CheckBox1.Checked:=False;
end;

procedure TForm1.ServerSocket1ThreadStart(Sender: TObject;
Thread: TServerClientThread);
begin
CheckBox1.Checked:=True;
end;

end.
//------------------------------------------------------
unit OopsServerThread;

interface

uses
Windows, Forms, SysUtils, Classes, Controls, Graphics, ScktComp,
MyZlib, MyDefs;

type
TOopsServerThread = class(TServerClientThread)
private
ouF: TStream;
Buffer: array[1..TALK_BUFFER_SIZE] of Char;
BufferSize: Integer;
protected
procedure ClientExecute; override;
procedure CaptureScreen;
procedure ProcessCommands;
end;

implementation

uses SvrMain;

procedure TOopsServerThread.ClientExecute;
var Stream: TWinSocketStream;
begin
while (not Terminated) and ClientSocket.Connected do begin
try
Stream := TWinSocketStream.Create(ClientSocket, THREAD_WAIT_TIME);
try
if Stream.WaitForData(THREAD_WAIT_TIME) then begin // Wait for Commands
BufferSize:=Stream.Read(Buffer[1], TALK_BUFFER_SIZE);
if BufferSize=0 then ClientSocket.Close;
case Buffer[1] of
'R': begin
Synchronize(CaptureScreen);
BufferSize := ouF.Read(Buffer[1], TALK_BUFFER_SIZE);
if BufferSize<>0
then Stream.Write(Buffer[1], BufferSize)
else ouF.Free;
end;
'N': begin
BufferSize := ouF.Read(Buffer[1], TALK_BUFFER_SIZE);
if BufferSize<>0
then Stream.Write(Buffer[1], BufferSize)
else ouF.Free;
end;
'C': begin
BufferSize := ouF.Read(Buffer[1], TALK_BUFFER_SIZE);
Synchronize(ProcessCommands);
Stream.Write(Buffer[1], 1);
end;
end;
end else Terminate;
finally
Stream.Free;
end;
except
Terminate;
end;
end;
end;

procedure TOopsServerThread.CaptureScreen;
var
DC: HDC;
Canvas: TCanvas;
MyBitmap: TBitmap;
inF, zpF: TStream;
begin
Canvas := TCanvas.Create;
MyBitmap := TBitmap.Create;
DC := GetDC(0);
try
Canvas.Handle := DC;
with Screen do
begin
MyBitmap.Width := Width;
MyBitmap.Height := Height;
MyBitmap.Canvas.CopyRect(Rect(0, 0, Width, Height), Canvas, Rect(0, 0, Width, Height));
inF:=TMemoryStream.Create;
MyBitmap.SaveToStream(inF);
inF.Seek(0, soFromBeginning);
ouF:=TMemoryStream.Create;
zpF:=TCompressionStream.Create(clFastest, ouF); {clDefault}
zpF.CopyFrom(inF, 0);
zpF.Free;
inF.Free;
ouF.Seek(0, soFromBeginning);
end;
finally
ReleaseDC(0, DC);
MyBitmap.Free;
Canvas.Free
end;
end;

procedure TOopsServerThread.ProcessCommands;
var p: pKeyCommand;
begin
p:=@Buffer[1];
p^.X := Trunc(p^.X * 65535.0 / Screen.Width);
p^.Y := Trunc(p^.Y * 65535.0 / Screen.Height);
case p^.ID of
1: keybd_event(Byte(p^.Key),Byte(p^.Key),0,0);
2: keybd_event(Byte(p^.Key),Byte(p^.Key),KEYEVENTF_KEYUP,0);
3: case p^.Button of
mbLeft: mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, p^.X, p^.Y, 0, 0);
mbRight: mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN, p^.X, p^.Y, 0, 0);
end;
4: mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, p^.X, p^.Y, 0, 0);
5: case p^.Button of
mbLeft: mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, p^.X, p^.Y, 0, 0);
mbRight: mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP, p^.X, p^.Y, 0, 0);
end;
end;
end;

end.
//---------------------------------
unit MyDefs;

interface

uses
Classes, Controls;

const
TALK_BUFFER_SIZE = 2048;
THREAD_WAIT_TIME = 30000;

type
TKeyCommand = record
CMD: Char;
ID : Byte;
Key: Word;
Button: TMouseButton;
Shift: TShiftState;
X: Integer;
Y: Integer;
end;
pKeyCommand = ^TKeyCommand;

implementation

end.
//--------------------------------------------------------------


发送文件之前先发送大小.这种方法大家都知道.
问题在于上面的单元根本不用这么麻烦,所以很巧妙.
所以请修改上面的代码而不是更换方法.
 
下面是关于上面的一个调用例子.很简单的一个例子,在局部网内同时对N台电脑进行监控.
//----------------------
unit MyRecvStream;
interface

uses
Classes,Forms,Windows,Graphics,Sysutils,MySocket, ComCtrls,ExtCtrls,MyPing;

type
TRecvStreamThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
function LoadImage(Image1:TImage):Boolean;
public
RemoteAddress:String; // 远程主机IP
RemotePort:integer; // 远程主机Port
RemoteScreen:TImage; // 显示图象的对象指针
StatusBar: TStatusBar;
end;

implementation

{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TRecvStreamThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }

{ TRecvStreamThread }

procedure TRecvStreamThread.Execute;
begin
{ Place thread code here }
if (LoadImage(RemoteScreen))
then
StatusBar.SimpleText := '数据接收完毕'
else
StatusBar.SimpleText := '接收数据失败';

end;
function TRecvStreamThread.LoadImage(Image1:TImage):Boolean;
var
bRtn:boolean;
RecvSocket:integer;
Stream:TMemoryStream;
RecvPort:Pinteger;
begin
bRtn:= False; // 函数返回值初始为FALSE
StatusBar.SimpleText := '正在连接主机...';
bRtn:=Ping(RemoteAddress,4000);
if bRtn then
begin
bRtn:=False; //返回值再次初始为FALSE
new(RecvPort);
RecvPort^:=0;
RecvSocket := BindSocket(RecvPort); // 动态分配接收端口
if RecvSocket<>0 then
begin
if (SendMsg(RemoteAddress,RemotePort,inttostr(RecvPort^))) then// 向远程主机发送命令
begin
Stream:=TMemoryStream.Create;// 定义一个数据流并分配内存
try
// StatusBar.SimpleText := '正在接收数据...';
Application.ProcessMessages; // 处理系统消息
if (RecvStream(RecvSocket,Stream)) then // 开始接收图象到数据流中
begin
Image1.Picture.Bitmap.LoadFromStream(Stream);
MessageBeep(MB_OK); // 发出提示声音
bRtn := true; // 返回值为TRUE,表示成功
end
else
MessageBox(0,'接收数据流失败','',MB_ICONERROR);
finally
Stream.Free;
end; //try
end
else
MessageBox(0,'无法与主机建立连接', '',MB_ICONERROR);
end
else
MessageBox(0,'分配端口失败,无法继续接收数据','',MB_ICONERROR);
end
else
MessageBox(0,Pchar('主机'+RemoteAddress+'没有响应'),'',MB_ICONERROR);
Result:=bRtn;
end;
end.
//--------------------------------------------------
unit Main;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, ImgList, ScktComp, ExtDlgs;

type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
FileNewItem: TMenuItem;
FileCloseItem: TMenuItem;
Window1: TMenuItem;
Help1: TMenuItem;
N1: TMenuItem;
FileExitItem: TMenuItem;
WindowCascadeItem: TMenuItem;
WindowTileItem: TMenuItem;
WindowArrangeItem: TMenuItem;
HelpAboutItem: TMenuItem;
OpenDialog: TOpenDialog;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
Edit1: TMenuItem;
CutItem: TMenuItem;
CopyItem: TMenuItem;
PasteItem: TMenuItem;
WindowMinimizeItem: TMenuItem;
StatusBar: TStatusBar;
ActionList1: TActionList;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
FileNew1: TAction;
FileSave1: TAction;
FileExit1: TAction;
FileOpen1: TAction;
FileSaveAs1: TAction;
WindowCascade1: TWindowCascade;
WindowTileHorizontal1: TWindowTileHorizontal;
WindowArrangeAll1: TWindowArrange;
WindowMinimizeAll1: TWindowMinimizeAll;
HelpAbout1: TAction;
FileClose1: TWindowClose;
WindowTileVertical1: TWindowTileVertical;
WindowTileItem2: TMenuItem;
ToolBar2: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton9: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ImageList1: TImageList;
ServerSocket1: TServerSocket;
PortCheck: TMenuItem;
SavePictureDialog1: TSavePictureDialog;
procedure FileNew1Execute(Sender: TObject);
procedure HelpAbout1Execute(Sender: TObject);
procedure FileExit1Execute(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure PortCheckClick(Sender: TObject);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
procedure CreateMDIChild(const Name: string);
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

uses ChildWin, Myping,About, Unit1,MySocket,MyRecvStream,My_StreamManage;

procedure TMainForm.CreateMDIChild(const Name: string);
var
Child: TMDIChild;
begin
{ create a new MDI child window }
Child := TMDIChild.Create(Application);
Child.RemoteAddress:=Name;
Child.Caption := Name;
Child.Image1.OnDblClick(nil);
// if FileExists(Name) then Child.Memo1.Lines.LoadFromFile(Name);
end;

procedure TMainForm.FileNew1Execute(Sender: TObject);
begin
if ConfigForm.ShowModal=mrok then
CreateMDIChild(ConfigForm.ComboBox1.Text);// + IntToStr(MDIChildCount + 1));
end;

procedure TMainForm.HelpAbout1Execute(Sender: TObject);
begin
AboutBox.ShowModal;
end;

procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
Close;
end;

procedure TMainForm.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
sRecvString:string;
sRemoteAddress:string;
MyScreen:TMemoryStream;
begin
sRecvString:= Socket.ReceiveText; // 保存接收到的字符串
sRemoteAddress:= Socket.RemoteAddress; // 保存对方IP
MyScreen:=TMemoryStream.Create;
My_GetScreenToBmp(False,MyScreen);
SendStream(sRemoteAddress,strtoint(sRecvString),MyScreen);
{if SendStream(sRemoteAddress,strtoint(sRecvString),MyScreen)
then showmessage('ok')
else
Showmessage('no'); }

MyScreen.Free;

end;

procedure TMainForm.PortCheckClick(Sender: TObject);
begin
PortCheck.Checked:=NOT(PortCheck.Checked);
ServerSocket1.Active:=PortCheck.Checked;
end;

procedure TMainForm.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
MessageBox(0,'远程连接出错','',MB_ICONERROR); // 显示出错信息
end;

end.
//--------------------------------------------------------

至于屏幕发送,还是自己写了一个单元.800X600的情况下处理后只有560字节.
unit My_StreamManage;

interface
uses Windows,Classes,Graphics,Forms,Controls;
procedure My_GetScreenToBmp(DrawCur:Boolean;StreamName:TMemoryStream);
procedure My_CompareStream(MyFirstStream,MySecondStream,MyCompareStream:TMemorystream);
procedure My_ResumeStream(MyFirstStream,MySecondStream,MyCompareStream:TMemorystream);
implementation
procedure My_GetScreenToBmp(DrawCur:Boolean;StreamName:TMemoryStream);
var
Mybmp:Tbitmap;
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{GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN)});
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;
Mybmp.PixelFormat:=pf8bit; //256色
//Mybmp.SaveToFile(Filename);
Mybmp.SaveToStream(StreamName);
Mybmp.Free;

end;
procedure My_CompareStream(MyFirstStream,MySecondStream,MyCompareStream:TMemorystream);
begin
//MyFirstStream.Position:=0;MySecondStream.Position:=0;MyCompareStream.Position:=0; //必须
..............

 
你如果不知道流的大小如何知道你的数据接受完成了?
你必须发送一次流,就关闭套接字一次,这样资源消耗太大!
 
NO.
消耗资源差不多的.
实际上,发送大小的话,接受完毕后你处理一些其它事情乁差不多的.
可以测试一下.
 
各位.不要光说不练.
直接修改上面的代码成功就给分.注意两点:
1:我说N次了.用其它方法我还是会做的,不要叫我改用其它方法.
2:直接写出修改过的代码即可.不用提什么建议.不用提怎么修改.都是空话.因为我提问题,
就是说我自己不想花时间在上面.所以用分数来叫别人解决问题.所以只要修改后成功就给分.
 
var
iPos,iSend:integer;

iPos:=0;
while iPos<Stream.Size do
begin
Stream.Seek(iPos,soFromBeginning);
Stream.read(buf,sizeof(buf));
iSend:=Send(s,buf,sizeof(buf),0);
if iSend<0 then break;
inc(iPos,iSend);
end;
 
无人可以解决问题.
结束.
 
后退
顶部