奇了。。多加几行（红色的字）。。出现连接失败 ( 积分: 100 )

  • 主题发起人 主题发起人 wlong01
  • 开始时间 开始时间
W

wlong01

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Winsock, ComCtrls;

const
wm_socket = WM_User + 2;//定义消息

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Button_SEND: TButton;
Button_STOP: TButton;
Button_EXIT: TButton;
OpenDialog1: TOpenDialog;
Label2: TLabel;
ProBar: TProgressBar;
CONNECT_: TButton;
procedure Button_EXITClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button_SENDClick(Sender: TObject);
procedure Button_STOPClick(Sender: TObject);
procedure CONNECT_Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
stopTrans,intrans:boolean;
Client:TSocket;

procedure TransFile(filename:string);
procedure SockEventProc(var msg: TMessage); message WM_socket;


end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button_EXITClick(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
aWSAData:TWSAData;
begin
if WSAStartup($0101,aWSAData)<>0 then
begin
showmessage('start Winsock dll error');
application.Terminate;
exit;
end;
//showmessage('ver: '+aWSAData.szDescription);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if inTrans then
begin
showmessage('traning file.....');
action:=caNone;
end
else
if WSACleanup<>0 then showmessage('clean winsock dll error');
end;

procedure TForm1.TransFile(filename: string);
const
BlockLen=1024*4;
var
Ftrans:file of byte;
Flen:integer;
BlockNum,ReMainLen:integer;
BlockBuf:array [0..BlockLen-1]of byte;
i:integer;
sendLen:integer;

ca:SOCKADDR_IN;
Hostaddr:U_Long;
begin
AssignFile(Ftrans,filename);
Reset(Ftrans);
FLen:=filesize(Ftrans);
BlockNum:=Flen div BlockLen;
probar.Max:=BlockNum+1;
RemainLen:=Flen mod BlockLen;
stopTrans:=false;
Intrans:=true;
sendLen:=1;

for i:=0 to BlockNum-1 do
begin
if (stopTrans)or(sendLen<=0)then break;
BlockRead(Ftrans,BlockBuf[0],BlockLen);
SendLen:=Send(Client,BlockBuf,BlockLen,0);
probar.Position:=i;
Application.ProcessMessages;
end;
if StopTrans then
begin
closeFile(Ftrans);
CloseSocket(client);
InTrans:=false;
exit;
end;
if SendLen<=0 then
begin
closeFile(Ftrans);
CloseSocket(client);
InTrans:=false;
exit;
end;

if RemainLen>0 then
begin
BlockRead(Ftrans,BlockBuf[0],RemainLen);
SendLen:=send(Client,BlockBuf,RemainLen,0);
if SendLen<=0 then
begin
closeFile(Ftrans);
CloseSocket(client);
InTrans:=false;
exit;
end;
end;

closeFile(Ftrans);
//CloseSocket(client);
InTrans:=false;
end;

procedure TForm1.Button_SENDClick(Sender: TObject);
begin
if(openDialog1.Execute)and(fileExists(openDialog1.FileName)) then
TransFile(openDialog1.FileName);
end;

procedure TForm1.Button_STOPClick(Sender: TObject);
begin
stopTrans:=true;
end;

procedure TForm1.SockEventProc(var msg: TMessage);
begin
{
case msg.LParamLo of
FD_CLOSE:
begin
//showmessage('connect ok');
connect_.Enabled:=false;
button_send.Enabled:=true;
button_stop.Enabled:=true;
end;
end;
}
end;

procedure TForm1.CONNECT_Click(Sender: TObject);
var
ca:SOCKADDR_IN;
Hostaddr:U_Long;
begin
client:=Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
if client=INVALID_SOCKET THEN
begin
showmessage('create socket error');
end;

////////////////////////////////////////////////////////
[red]{ //奇了。。多加一行。。出现无法失败
if WSAAsyncSelect(client,self.Handle,wm_socket,
(FD_READ or FD_WRITE or FD_CONNECT or FD_CLOSE or FD_ACCEPT))=SOCKET_ERROR then
begin
ShowMessage('Set Seocket Async Failed!');
exit;
end;
}[/red]
////////////////////////////////////////////////////////

hostaddr:=inet_addr(pchar(trim(edit1.Text)));
if hostaddr=-1 then
begin
showmessage('ip error');
closeSocket(Client);
exit;
end
else
begin
ca.sin_addr.S_addr:=hostaddr;
ca.sin_port:=htons(strtoint(trim(edit2.Text)));
ca.sin_family:=AF_INET;
if connect(client,ca,sizeof(ca))=Socket_ERROR then
begin
showmessage('connect server error');
closeSocket(client);
exit;
end;

connect_.Enabled:=false;
button_send.Enabled:=true;
button_stop.Enabled:=true;
end;

end;

end.
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Winsock, ComCtrls;

const
wm_socket = WM_User + 2;//定义消息

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Button_SEND: TButton;
Button_STOP: TButton;
Button_EXIT: TButton;
OpenDialog1: TOpenDialog;
Label2: TLabel;
ProBar: TProgressBar;
CONNECT_: TButton;
procedure Button_EXITClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button_SENDClick(Sender: TObject);
procedure Button_STOPClick(Sender: TObject);
procedure CONNECT_Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
stopTrans,intrans:boolean;
Client:TSocket;

procedure TransFile(filename:string);
procedure SockEventProc(var msg: TMessage); message WM_socket;


end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button_EXITClick(Sender: TObject);
begin
close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
aWSAData:TWSAData;
begin
if WSAStartup($0101,aWSAData)<>0 then
begin
showmessage('start Winsock dll error');
application.Terminate;
exit;
end;
//showmessage('ver: '+aWSAData.szDescription);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if inTrans then
begin
showmessage('traning file.....');
action:=caNone;
end
else
if WSACleanup<>0 then showmessage('clean winsock dll error');
end;

procedure TForm1.TransFile(filename: string);
const
BlockLen=1024*4;
var
Ftrans:file of byte;
Flen:integer;
BlockNum,ReMainLen:integer;
BlockBuf:array [0..BlockLen-1]of byte;
i:integer;
sendLen:integer;

ca:SOCKADDR_IN;
Hostaddr:U_Long;
begin
AssignFile(Ftrans,filename);
Reset(Ftrans);
FLen:=filesize(Ftrans);
BlockNum:=Flen div BlockLen;
probar.Max:=BlockNum+1;
RemainLen:=Flen mod BlockLen;
stopTrans:=false;
Intrans:=true;
sendLen:=1;

for i:=0 to BlockNum-1 do
begin
if (stopTrans)or(sendLen<=0)then break;
BlockRead(Ftrans,BlockBuf[0],BlockLen);
SendLen:=Send(Client,BlockBuf,BlockLen,0);
probar.Position:=i;
Application.ProcessMessages;
end;
if StopTrans then
begin
closeFile(Ftrans);
CloseSocket(client);
InTrans:=false;
exit;
end;
if SendLen<=0 then
begin
closeFile(Ftrans);
CloseSocket(client);
InTrans:=false;
exit;
end;

if RemainLen>0 then
begin
BlockRead(Ftrans,BlockBuf[0],RemainLen);
SendLen:=send(Client,BlockBuf,RemainLen,0);
if SendLen<=0 then
begin
closeFile(Ftrans);
CloseSocket(client);
InTrans:=false;
exit;
end;
end;

closeFile(Ftrans);
//CloseSocket(client);
InTrans:=false;
end;

procedure TForm1.Button_SENDClick(Sender: TObject);
begin
if(openDialog1.Execute)and(fileExists(openDialog1.FileName)) then
TransFile(openDialog1.FileName);
end;

procedure TForm1.Button_STOPClick(Sender: TObject);
begin
stopTrans:=true;
end;

procedure TForm1.SockEventProc(var msg: TMessage);
begin
{
case msg.LParamLo of
FD_CLOSE:
begin
//showmessage('connect ok');
connect_.Enabled:=false;
button_send.Enabled:=true;
button_stop.Enabled:=true;
end;
end;
}
end;

procedure TForm1.CONNECT_Click(Sender: TObject);
var
ca:SOCKADDR_IN;
Hostaddr:U_Long;
begin
client:=Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
if client=INVALID_SOCKET THEN
begin
showmessage('create socket error');
end;

////////////////////////////////////////////////////////
[red]{ //奇了。。多加一行。。出现无法失败
if WSAAsyncSelect(client,self.Handle,wm_socket,
(FD_READ or FD_WRITE or FD_CONNECT or FD_CLOSE or FD_ACCEPT))=SOCKET_ERROR then
begin
ShowMessage('Set Seocket Async Failed!');
exit;
end;
}[/red]
////////////////////////////////////////////////////////

hostaddr:=inet_addr(pchar(trim(edit1.Text)));
if hostaddr=-1 then
begin
showmessage('ip error');
closeSocket(Client);
exit;
end
else
begin
ca.sin_addr.S_addr:=hostaddr;
ca.sin_port:=htons(strtoint(trim(edit2.Text)));
ca.sin_family:=AF_INET;
if connect(client,ca,sizeof(ca))=Socket_ERROR then
begin
showmessage('connect server error');
closeSocket(client);
exit;
end;

connect_.Enabled:=false;
button_send.Enabled:=true;
button_stop.Enabled:=true;
end;

end;

end.
 
您必须登录或注册才可回复。

Similar threads

S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
取得当前光标处的颜色
回复
0
查看
607
import
I
I
作一个类似PhotoShop那样的取色板
回复
0
查看
606
import
I
I
执行控制台程序并且获得它的输出结果
回复
0
查看
640
import
I
后退
顶部