求救:局域網傳送文件完成后,關閉軟件時出現EOSError錯誤,Code:1400(100分)

G

guanglb

Unregistered / Unconfirmed
GUEST, unregistred user!
從本機電腦傳送文件到局域網的另一臺電腦,文件傳送完成后,關閉軟件時出現EOSError錯誤,0000DF9E,Code:1400.無效的視窗控制碼。
有那位大蝦碰到過這個問題,一定幫幫小弟,我查了幾天,都沒檢查出是那里除了問題。
 
把代码贴上来看看,是不是某些变量、资源没有正确释放所致?
 
//---------------------------傳送文件
procedure TwChat.N4Click(Sender: TObject);
//添加文件
begin
if OpenDialog1.Execute then
begin
Panel2.Visible:=True;
SpeedButton2.Visible:=True;
SpeedButton2.Enabled:=True;
SpeedButton3.Visible:=True;
SpeedButton4.Visible:=False;
SpeedButton5.Visible:=False;
ListBox1.Visible:=True;
if ListBox1.Items.IndexOf(OpenDialog1.FileName) = -1 then
begin
ListBox1.Items.Add(OpenDialog1.FileName);
end;
end;
end;

procedure TwChat.ListBox1DblClick(Sender: TObject);
//刪除傳送清單
begin
if ListBox1.ItemIndex >=0 then
begin
ListBox1.Items.Delete(ListBox1.ItemIndex);
LBSend.
Caption:='';
end;
end;

procedure TwChat.SpeedButton2Click(Sender: TObject);
//傳送
var
TemFiles:String;
begin
vIP:='';
Try
wChatIP:=TwChatIP.Create(Application);
if wChatIP.ShowModal=mrOK then
vIP:=Trim(wChatIP.Edit1.Text);
finally
FreeAndNil(wChatIP);
end;
if vIP='' then
Exit;
if vIP=IdIPWatch1.LocalIP then
begin
Memo1.Lines.Add('不能給自己發送文件!');
Exit;
end;

if ListBox1.Count > 0 then
begin
SpeedButton2.Enabled:=False;
TemFiles:=ListBox1.Items.CommaText;
IdTCPClient2.Host :=vIP;//服務器的地址
if IdTCPClient2.Connected then
IdTCPClient2.Disconnect;
Try
IdTCPClient2.Connect;
except
MessageBox(Handle,'服務器沒有開啟','提示',MB_OK);
LBSend.
Caption:='';
Exit;
end;

with IdTCPClient2do
begin
while Connecteddo
begin
try
WriteLn('SendFiles#'+ListBox1.Items.CommaText+'%');
//指定路徑
finally
Disconnect;//斷開連接
end;
end;
end;

end
else
begin
MessageBox(Handle,'請選擇要傳送的文件','提示',MB_OK);
end;
end;

procedure TwChat.SpeedButton4Click(Sender: TObject);
//接收
var
CurFilePath,SerFilePath:String;
FileName,TemStr:String;
i,TemInt:Integer;
begin
SpeedButton4.Enabled:=False;
do
wnFlag:=True;
TemStr:='';
TemInt:=0;
//SaveDialog1.DefaultExt:=GetExePath;
//SaveDialog1.FileName:=ExtractFileName(RecivList.Strings[0]);
//if SaveDialog1.Execute then
//begin
//CurFilePath:=ExtractFilePath(SaveDialog1.FileName);
CurFilePath:=GetExePath;
//自動保存到執行檔路徑
for i:=0 to RecivList.Count - 1do
begin
SerFilePath:=ExtractFilePath(RecivList.Strings);
FileName:=ExtractFileName(RecivList.Strings);
if not Act_DownFiles(CurFilePath,SerFilePath,FileName,FileName) then
begin
TemInt:=TemInt+1;
TemStr:=TemStr+ FileName;
end;
end;

if TemInt > 0 then
begin
Memo1.Lines.Add(TemStr+'所有沒有接收成功');
end
else
begin
Memo1.Lines.Add('所有文件接收成功');
end;

IdTCPClient1.Host :=SendIP;
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,'服務器沒有有開啟','提示',MB_OK);
Exit;
end;

with IdTCPClient1do
begin
while Connecteddo
begin
try
WriteLn('OK');
//指定路徑
finally
Disconnect;//斷開連接
end;
end;
end;

//Close;
//LBSend.
Visible:=False;
PB1.Position:=0;
PB2.Position:=0;
PB1.Visible:=False;
PB2.Visible:=False;
Panel2.Visible:=False;
//RecivList.Clear;
//RecivList.Free;
//ListBox1.Items.Clear;
ListBox1.Visible:=False
//end
//else
SpeedButton5Click(Sender);
//拒絕
end;

function TwChat.Act_DownFiles(CurFilePath, SerFilePath, CurFileName,
SerFileName: String): Boolean;
var
TemFileName:String;
rbyte:array[0..4096] of Byte;
sFile:TFileStream;
iFileSize:Integer;
begin
PB1.Position:=0;
IdTCPClient1.Host :=SendIP;//服務器的地址
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,'服務器沒有開啟','提示',MB_OK);
Result:=False;
Exit;
end;

with IdTCPClient1do
begin
while Connecteddo
begin
try
PB1.Visible:=True;
TemFileName:=SerFilePath+SerFileName;
WriteLn(TemFileName);
//指定路徑 寫入文件
if ReadLn<>'文件不存在' then
begin
iFileSize:=IdTCPClient1.ReadInteger;
//讀取遠端文件
PB1.Max := iFileSize div 100 ;
sFile:=TFileStream.Create(CurFilePath+CurFileName,fmCreate);
While iFileSize>4096do
begin
ifdo
wnFlag then
begin
IdTCPClient1.ReadBuffer(rbyte,4096);// .ReadBuffer(rbyte,iLen);
sFile.Write(rByte,4096);
inc(iFileSize,-4096);
PB1.Position:= PB1.Position +(4096 div 100) ;
Application.ProcessMessages;
end
else
begin
Result:=False;
Exit;
end;
end;

IdTCPClient1.ReadBuffer(rbyte,iFileSize);// .ReadBuffer(rbyte,iLen);
最后一次長度
sFile.Write(rByte,iFileSize);
sFile.Free;
//if MessageBox(Handle,'打開剛接收的文件嗎?','一個文件接收成功',MB_YESNO)=mrYes then
//ShellExecute(0,nil,PChar(CurFilePath+CurFileName),nil,nil,SW_SHOWNORMAL);
PB1.Position:=PB1.Max;
end;

finally
Disconnect;//斷開連接
end;
end;
end;
Result:=True;
end;

procedure TwChat.IdTCPServer1Execute(AThread: TIdPeerThread);
var
RecevFileName:String;
iFileHandle:Integer;
iFileLen,cnt:Integer;
buf:array[0..4096] of Byte;
begin
if not AThread.Terminated and AThread.Connection.Connected then
//注意這里
begin
with AThread.Connection do
begin
Try
PB2.Visible:=True;
RecevFileName:=AThread.Connection.ReadLn;
if RecevFileName='OK' then
begin
PB2.Position:=0;
LBSend.
Caption:='All Files Send OK';
Memo1.Lines.Add('All Files Send OK');
Disconnect;
SpeedButton3Click(Self);
//接收完畢 取消
end;

if RecevFileName='RefusedAll' then
begin
LBSend.
Caption:='All Files are Refused';
Memo1.Lines.Add('All Files are Refused');
PB2.Position:=0;
SpeedButton2.Enabled:=True;
end;

if (RecevFileName<>'OK') and (RecevFileName<>'RefusedAll') then
begin
if FileExists(RecevFileName) then
begin
PB2.Position:=0;
WriteLn(RecevFileName);
LBSend.
Caption:='Send: '+RecevFileName;
Memo1.Lines.Add('Send: '+RecevFileName);
iFileHandle:=FileOpen(RecevFileName,fmOpenRead);
//得到此文件大小
iFileLen:=FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
AThread.Connection.WriteInteger(iFileLen,True);////hjh 20071009
PB2.Max := iFileLen div 100 ;
while iFileLen >0do
begin
cnt:=FileRead(iFileHandle,buf,4096);
AThread.Connection.WriteBuffer(buf,cnt,True);/////hjh20071009
iFileLen:=iFileLen-cnt;
PB2.Position:=PB2.Position +(4096 div 100) ;
Application.ProcessMessages;
end;

FileClose(iFileHandle);
end
else
begin
WriteLn('文件不存在');
end;
end;
Finally
Disconnect;//斷開連接
end;
end;
end;
end;

procedure TwChat.SpeedButton5Click(Sender: TObject);
//拒絕
begin
do
wnFlag:=False;
IdTCPClient1.Host :=SendIP;//服務器的地址
if IdTCPClient1.Connected then
IdTCPClient1.Disconnect;
Try
IdTCPClient1.Connect;
except
MessageBox(Handle,'服務器沒有開啟','提示',MB_OK);
Exit;
end;

with IdTCPClient1do
begin
while Connecteddo
begin
try
WriteLn('RefusedAll');
//指定路徑
finally
Disconnect;//斷開連接
end;
end;
end;

IdTCpClient1.Disconnect;
PB1.Visible:=False;
PB2.Visible:=False;
Panel2.Visible:=False;
RecivList.Clear;
//ListBox1.Items.Clear;
ListBox1.Visible:=False;
end;

procedure TwChat.SpeedButton3Click(Sender: TObject);
//取消
begin
if (Trim(LBSend.
Caption)='') or (Trim(LBSend.
Caption)='All Files are Refused') then
begin
PB1.Visible:=False;
PB2.Visible:=False;
Panel2.Visible:=False;
//RecivList.Clear;
//ListBox1.Items.Clear;
ListBox1.Visible:=False;
end
else
if Trim(LBSend.
Caption)='All Files Send OK' then
begin
PB1.Visible:=False;
PB2.Visible:=False;
Panel2.Visible:=False;
//RecivList.Clear;
//ListBox1.Items.Clear;
ListBox1.Visible:=False;
end
else
begin
PB2.Position:=0;
IdTCPClient2.Host :=vIP;
//服務器的地址
if IdTCPClient2.Connected then
IdTCPClient2.Disconnect;
Try
IdTCPClient2.Connect;
except
MessageBox(Handle,'服務器沒有開啟','提示',MB_OK);
Exit;
end;

with IdTCPClient2do
begin
while Connecteddo
begin
try
WriteLn('RefuseSend');
//指定路徑
finally
Disconnect;//斷開連接
end;
end;
end;

end;
end;

procedure TwChat.IdTCPServer2Connect(AThread: TIdPeerThread);
begin
SendIP:=AThread.Connection.Socket.Binding.PeerIP;
end;

procedure TwChat.IdTCPServer2Execute(AThread: TIdPeerThread);
var
RecivStr,FileStr:String;
TemUser:String;
i:Integer;
begin
if not AThread.Terminated and AThread.Connection.Connected then
//注意這里
begin
with AThread.Connectiondo
begin
Try
FileStr:='';
RecivStr:=ReadLn;
if RecivStr <>'RefuseSend' then
begin
if Pos('SendFiles',RecivStr) > 0 then
begin
Panel2.Visible:=True;
//打開接收按鈕
SpeedButton2.Visible:=False;
SpeedButton3.Visible:=False;
SpeedButton4.Visible:=True;
SpeedButton5.Visible:=True;
//ListBox1.Items.Clear;
ListBox1.Visible:=False;
PB1.Position:=0;
PB1.Visible:=False;
PB2.Visible:=True;
ShowWindow(Handle, SW_SHOW);
//顯示窗口
ShowWindow(Application.handle, SW_SHOW);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
not (GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW));
RecivList.Clear;
RecivList.CommaText:=Copy(RecivStr,Pos('#',RecivStr)+1,Pos('%',RecivStr)-Pos('#',RecivStr)-1);
TemUser:=Copy(RecivStr,Pos('%',RecivStr)+1,Length(RecivStr)-Pos('%',RecivStr));
for i:=0 to RecivList.Count -1do
begin
FileStr:=FileStr+ExtractFileName(RecivList.Strings)+#13;
end;

Memo1.Lines.Add(TemUser+' 向您發送文件:'+FileStr+'請接收');
Disconnect;
SpeedButton4Click(Self);
//自動接收
end;
end;

if RecivStr='RefuseSend' then
begin
Memo1.Lines.Add('對方取消了發送文件');
PB1.Position:=0;
do
wnFlag:=False;
PB1.Visible:=False;
PB2.Visible:=False;
Panel2.Visible:=False;
end;

Finally
Disconnect;
end;
end;
end;
end;

procedure TwChat.MenuItem2Click(Sender: TObject);
//退出
begin
IdUDPClient1.Active:=False;
IdUDPServer1.Active:=False;
IdUDPClient2.Active:=False;
IdUDPServer2.Active:=False;
IdTCPClient1.Disconnect;
IdTCPClient2.Disconnect;
IdTCPServer1.Active:=False;
IdTCPServer2.Active:=False;
//RecivList.Clear;
RecivList.Free;
IdIPWatch1.Active:=False;
ACMWaveIn1.Close;
ACMWaveOut1.Close;
Application.Terminate;
end;
 
indy的不是线程安全的,你改改就可以了的
 
我觉得在退出的代码中,如果你的相关控件已经关闭或断开就可能有问题,例如:IdTCPClient1.Disconnect;这句,如果在退出前它已经断开了,在执行这句时会不会报错呢?我没用过IdTCPClient控件,这里只是给你一个提示,或者加上一个判断:处在连接状态再断开,还有,如果你前面的代码或异常控制的好的话在退出的代码中就不要写那么多语句了,就用一句Application.Terminate或Halt试试。
 
to:szhcracker
IdTCPClient1在已經斷開的狀態下在Disconnect不會出錯。
單用Application.Terminate或Halt 也行不通。
to:浪人情哥
您看出問題具體出在哪里了嗎,麻煩詳細告知小弟,謝謝!
 
自己頂一下!
 
問題已經解決,在線程中不能定義PB1.Visible:=True;
 
多人接受答案了。
 
顶部