T
tangyan
Unregistered / Unconfirmed
GUEST, unregistred user!
用api写的传输程序，在局域网一点问题也没又，在internet上报超时错误部分源码如下：盼高手请指点？
传输方：
Procedure Mysend(Mysocket:TSocket)
var
Data:Array [0..1023] of byte;
i:integer;
li_sendNum:integer;
BlockNum:integer;
RemainLen:integer;
begin
li_sendNum = 0;
BlockNum:=FileSize div 1024 //传输块数
RemainLen:=FileSize mod 1024 //最后块大小
While (FileSize >FinishSize) and (not Terminated) do
begin
if (li_SendNum<BlockNum) then
li_Send:= MaxSendBlock;
if (li_SendNum=blocknum) and (RemainLen=0) then
break;
if (li_SendNum=blocknum) and (RemainLen>0) then
li_Send:= RemainLen;
//进入临界区
EnterCriticalSection(CriticalSection);
//读取文件块
CopyMemory(@Data[0],FilePointer,li_Send); //FilePointer 为已经打开的文件指针
inc(FilePointer,li_Send);
LeaveCriticalSection(CriticalSection);
//传输数据
if WaitSendData(Mysocket) then
begin
I := send(Mysocket, Data, Size, 0);
if (I = SOCKET_ERROR) or (I < 0) then
begin
Status := WSAGetLastError;
Result := I;
end
else Result := I;
end
else
begin
Result := 0;
Status := WSAGetLastError;
end;
if i< 0 then
begin
//本次传输中断
FMessage := '线程'+FProtocol^.FileName + '传输出错';
Synchronize(UpdateMessage);
exit;
end
else if i = 0 and (FileSize >FinishSize) then
begin
FMessage := '文件'+FileName+'传输超时，将继续传输！';
Synchronize(UpdateMessage);
Application.ProcessMessages;
Sleep(50);
Application.ProcessMessages;
Continue;
end
else
begin
inc(li_SendNum);
FinishSize := FinishSize+i ;
end;
end;
接收方：
Procedure MyRecv(MYsocket:Tsocket);
begin
li_RecSize:=0;
while (FinishSize <FileSize) and (not Terminated) do
begin
if WaitforData(Mysocket) then
begin
li_RecSize:=recv(Mysocket, Data, Size, 0);
if (li_RecSize < 0) then
begin
FMessage :=
'文件'+FileName+'传输出错，所有线程中断.'
Synchronize(UpdateMessage);
break;
end
else if li_RecSize=0 then
begin
FMessage := '文件'+FileName+'传输超时，将继续接收';
Synchronize(UpdateMessage);
Application.ProcessMessages;
Sleep(50);
Application.ProcessMessages;
Continue;
end;
//进入临界区
EnterCriticalSection(CriticalSection);
Move(Data,MapFilePointer^,li_RecSize);
inc(MapFilePointer,li_RecSize);
LeaveCriticalSection(CriticalSection);
inc(FinishSize,li_RecSize);
//完成的字节
end;
end;
function WaitForData(Handle:Tsocket): boolean;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
TimeVal.tv_sec := Timeout div 1000;
TimeVal.tv_usec := (Timeout mod 1000) * 1000;
FD_ZERO(FDSet);
FD_SET(Handle, FDSet);
Result := select(0, @FDSet, nil, nil, @TimeVal) > 0;
end;
function WaitSendData(Handle:Tsocket): boolean;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
FD_ZERO(FDSet);
FD_SET(Handle, FDSet);
TimeVal.tv_sec := Timeout div 1000;
TimeVal.tv_usec := (Timeout mod 1000) * 1000;
Result:= Select(0, nil, @FDSet, nil, @TimeVal) > 0;
end;
函数都放在线程中的，每次发生超时错误后，就一直报超时错了，不能在传输下去了
我的本意是发生超时错后程序sleep(50)继续传输，但就是不能。初始代码太长没有贴出来。
传输方：
Procedure Mysend(Mysocket:TSocket)
var
Data:Array [0..1023] of byte;
i:integer;
li_sendNum:integer;
BlockNum:integer;
RemainLen:integer;
begin
li_sendNum = 0;
BlockNum:=FileSize div 1024 //传输块数
RemainLen:=FileSize mod 1024 //最后块大小
While (FileSize >FinishSize) and (not Terminated) do
begin
if (li_SendNum<BlockNum) then
li_Send:= MaxSendBlock;
if (li_SendNum=blocknum) and (RemainLen=0) then
break;
if (li_SendNum=blocknum) and (RemainLen>0) then
li_Send:= RemainLen;
//进入临界区
EnterCriticalSection(CriticalSection);
//读取文件块
CopyMemory(@Data[0],FilePointer,li_Send); //FilePointer 为已经打开的文件指针
inc(FilePointer,li_Send);
LeaveCriticalSection(CriticalSection);
//传输数据
if WaitSendData(Mysocket) then
begin
I := send(Mysocket, Data, Size, 0);
if (I = SOCKET_ERROR) or (I < 0) then
begin
Status := WSAGetLastError;
Result := I;
end
else Result := I;
end
else
begin
Result := 0;
Status := WSAGetLastError;
end;
if i< 0 then
begin
//本次传输中断
FMessage := '线程'+FProtocol^.FileName + '传输出错';
Synchronize(UpdateMessage);
exit;
end
else if i = 0 and (FileSize >FinishSize) then
begin
FMessage := '文件'+FileName+'传输超时，将继续传输！';
Synchronize(UpdateMessage);
Application.ProcessMessages;
Sleep(50);
Application.ProcessMessages;
Continue;
end
else
begin
inc(li_SendNum);
FinishSize := FinishSize+i ;
end;
end;
接收方：
Procedure MyRecv(MYsocket:Tsocket);
begin
li_RecSize:=0;
while (FinishSize <FileSize) and (not Terminated) do
begin
if WaitforData(Mysocket) then
begin
li_RecSize:=recv(Mysocket, Data, Size, 0);
if (li_RecSize < 0) then
begin
FMessage :=
'文件'+FileName+'传输出错，所有线程中断.'
Synchronize(UpdateMessage);
break;
end
else if li_RecSize=0 then
begin
FMessage := '文件'+FileName+'传输超时，将继续接收';
Synchronize(UpdateMessage);
Application.ProcessMessages;
Sleep(50);
Application.ProcessMessages;
Continue;
end;
//进入临界区
EnterCriticalSection(CriticalSection);
Move(Data,MapFilePointer^,li_RecSize);
inc(MapFilePointer,li_RecSize);
LeaveCriticalSection(CriticalSection);
inc(FinishSize,li_RecSize);
//完成的字节
end;
end;
function WaitForData(Handle:Tsocket): boolean;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
TimeVal.tv_sec := Timeout div 1000;
TimeVal.tv_usec := (Timeout mod 1000) * 1000;
FD_ZERO(FDSet);
FD_SET(Handle, FDSet);
Result := select(0, @FDSet, nil, nil, @TimeVal) > 0;
end;
function WaitSendData(Handle:Tsocket): boolean;
var
FDSet: TFDSet;
TimeVal: TTimeVal;
begin
FD_ZERO(FDSet);
FD_SET(Handle, FDSet);
TimeVal.tv_sec := Timeout div 1000;
TimeVal.tv_usec := (Timeout mod 1000) * 1000;
Result:= Select(0, nil, @FDSet, nil, @TimeVal) > 0;
end;
函数都放在线程中的，每次发生超时错误后，就一直报超时错了，不能在传输下去了
我的本意是发生超时错后程序sleep(50)继续传输，但就是不能。初始代码太长没有贴出来。