unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ScktComp, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient; type TForm1 = class(TForm) Panel1: TPanel; Panel2: TPanel; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; SpeedButton3: TSpeedButton; LBFiles: TLabel; SpeedButton4: TSpeedButton; SpeedButton5: TSpeedButton; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; PB2: TProgressBar; PB1: TProgressBar; ListBox1: TListBox; Label2: TLabel; IdTCPClient1: TIdTCPClient; IdTCPServer1: TIdTCPServer; LBSend: TLabel; Edit1: TEdit; Label1: TLabel; IdTCPClient2: TIdTCPClient; IdTCPServer2: TIdTCPServer; procedure SpeedButton1Click(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SpeedButton4Click(Sender: TObject); procedure IdTCPServer1Execute(AThread: TIdPeerThread); procedure SpeedButton5Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure IdTCPServer2Connect(AThread: TIdPeerThread); procedure IdTCPServer2Execute(AThread: TIdPeerThread); private { Private declarations } public Function Act_DownFiles(CurFilePath,SerFilePath,CurFileName,SerFileName:String):Boolean; end; var Form1: TForm1; UserName:String; RecivList:TStrings; SendIP:String; DownFlag:Boolean; implementation {$R *.dfm} procedure TForm1.SpeedButton1Click(Sender: TObject); begin if OpenDialog1.Execute then begin if ListBox1.Items.IndexOf(OpenDialog1.FileName) = -1 then begin ListBox1.Items.Add(OpenDialog1.FileName); end; end; end; procedure TForm1.ListBox1DblClick(Sender: TObject); begin if ListBox1.ItemIndex >=0 then ListBox1.Items.Delete(ListBox1.ItemIndex); end; procedure TForm1.FormCreate(Sender: TObject); begin self.Height:=267; IdTCPServer2.Active:=True; IdTCPServer1.Active:=True; UserName:='admin'; RecivList:=TStringList.Create; DownFlag:=True; end; procedure TForm1.SpeedButton2Click(Sender: TObject); var TemFiles:String; begin if ListBox1.Count > 0 then begin SpeedButton2.Enabled:=False; TemFiles:=ListBox1.Items.CommaText; IdTCPClient2.Host :=Trim(Edit1.Text);//服务器的地址 if IdTCPClient2.Connected then IdTCPClient2.Disconnect; Try IdTCPClient2.Connect; except MessageBox(Handle,'服务器没有开启','提示',MB_OK); Exit; end; with IdTCPClient2 do begin while Connected do begin try WriteLn('SendFiles#'+ListBox1.Items.CommaText+'%'+UserName); //指定路径 finally Disconnect;//断开连接 end; end; end; end else begin MessageBox(Handle,'请选择要传送的文件','提示',MB_OK); end; end; procedure TForm1.FormDestroy(Sender: TObject); begin RecivList.Free; end; procedure TForm1.SpeedButton4Click(Sender: TObject); var CurFilePath,SerFilePath:String; FileName,TemStr:String; i,TemInt:integer; begin SpeedButton4.Enabled:=False; DownFlag:=True; TemStr:=''; TemInt:=0; if SaveDialog1.Execute then begin CurFilePath:=ExtractFilePath(SaveDialog1.FileName); for i:=0 to RecivList.Count - 1 do begin SerFilePath:=ExtractFilePath(RecivList.Strings[i]); FileName:=ExtractFileName(RecivList.Strings[i]); if not Act_DownFiles(CurFilePath,SerFilePath,FileName,FileName) then begin TemInt:=TemInt+1; TemStr:=TemStr+ FileName; end; end; if TemInt > 0 then begin MessageBox(Handle,PChar(TemStr+'文件没有传输成功'),'提示',MB_OK); end else begin MessageBox(Handle,'所有文件传输成功','提示',MB_OK); end; IdTCPClient1.Host :=SendIP; if IdTCPClient1.Connected then IdTCPClient1.Disconnect; Try IdTCPClient1.Connect; except MessageBox(Handle,'服务器没有开启','提示',MB_OK); Exit; end; with IdTCPClient1 do begin while Connected do begin try WriteLn('OK'); //指定路径 finally Disconnect;//断开连接 end; end; end; Close; end; end; Function TForm1.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 IdTCPClient1 do begin while Connected do begin try 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>4096 do begin if DownFlag 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; PB1.Position:=PB1.Max; end; finally Disconnect;//断开连接 end; end; end; Result:=True; end; procedure TForm1.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 RecevFileName:=AThread.Connection.ReadLn; if RecevFileName='OK' then begin PB2.Position:=0; LBSend.Caption:='All Files Send OK'; end; if RecevFileName='RefusedAll' then begin LBSend.Caption:='All Files are Refused'; PB2.Position:=0; end; if (RecevFileName<>'OK') and (RecevFileName<>'RefusedAll') then begin if FileExists(RecevFileName) then begin PB2.Position:=0; WriteLn(RecevFileName); LBSend.Caption:='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 >0 do 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 TForm1.SpeedButton5Click(Sender: TObject); var i:integer; begin DownFlag:=False; IdTCPClient1.Host :=SendIP;//服务器的地址 if IdTCPClient1.Connected then IdTCPClient1.Disconnect; Try IdTCPClient1.Connect; except MessageBox(Handle,'服务器没有开启','提示',MB_OK); Exit; end; with IdTCPClient1 do begin while Connected do begin try WriteLn('RefusedAll'); //指定路径 finally Disconnect;//断开连接 end; end; end; IdTCpClient1.Disconnect; //Application.Terminate; end; procedure TForm1.SpeedButton3Click(Sender: TObject); var TemStr:String; begin if Trim(LBSend.Caption)='' then begin Close; end; if Trim(LBSend.Caption)='All Files Send OK' then begin Close; end else begin PB2.Position:=0; IdTCPClient2.Host :=Trim(Edit1.Text);//服务器的地址 if IdTCPClient2.Connected then IdTCPClient2.Disconnect; Try IdTCPClient2.Connect; except MessageBox(Handle,'服务器没有开启','提示',MB_OK); Exit; end; with IdTCPClient2 do begin while Connected do begin try WriteLn('RefuseSend'); //指定路径 finally Disconnect;//断开连接 end; end; end; end; end; procedure TForm1.IdTCPServer2Connect(AThread: TIdPeerThread); begin SendIP:=AThread.Connection.Socket.Binding.PeerIP; end; procedure TForm1.IdTCPServer2Execute(AThread: TIdPeerThread); var RecivStr,FileStr:String; TemList:TStrings; TemUser:String; i:integer; begin if not AThread.Terminated and AThread.Connection.Connected then //注意这里 begin with AThread.Connection do begin Try FileStr:=''; RecivStr:=ReadLn; if RecivStr <>'RefuseSend' then begin if Pos('SendFiles',RecivStr) > 0 then begin Self.Height:=130; Panel1.Visible:=False; 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 -1 do begin FileStr:=FileStr+ExtractFileName(RecivList.Strings[i])+','; end; LBFiles.Caption:=TemUser+' 向您发送文件:'+FileStr+'请接收'; end; end; if RecivStr='RefuseSend' then begin LBFiles.Caption:='对方取消了发送文件'; PB1.Position:=0; DownFlag:=False; end; Finally Disconnect; end; end; end; end; end.