高分求一个能跑的indyUDP传输文件的代码 ( 积分: 100 )

尽量简洁 最好都步骤说明 谢谢各位了 我想了好多方法最后都不能跑～

尽量简洁 最好都步骤说明 谢谢各位了 我想了好多方法最后都不能跑～

http://www.aidelphi.com/6to23/docu/MyUDP(Delphi6_7).rar

检查过了，可以下载

完全看不懂啊～.....怎么没有代码部分呢？

不好意思 刚才点错了 才没看到

代码比较全了，是个范例，需要自己摸索

我有，我在用这，跟其他的传输不同，你作少少改动就可以实现 ”断点续传“，
贴在这里
unit SendFile;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, CaptionGauges, myControls, Grids,
msgView, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, ImgList, BaseForm,
srToolButton, srListview;

const
LEN = 2048;
type

TDlgMsg = (Wait_Acc, Rec_StandBy, Rec_Acc, Rec_Rej, Sender_Cancel, Rec_cancel, File_size,
File_begin, File_TotalSize, File_Data, cf_Receive, File_Complete, chk_finish, ReSend_Req,
RecAll_Complete);

pPackInfo = ^TPackInfo;

TPackinfo = PACKED record
fileNo : integer;
FilePos : int64;
pkNo : integer;
Size : int64;
DlgMsg : TDlgMsg;
cfReceive : boolean;
id : integer;
end;

TsrFormClass = class of TsrForm;

TsrForm = class(TfmBase)
Panel2: TPanel;
Panel1: TPanel;
Panel3: TPanel;
moMsg: TMemo;
Panel5: TPanel;
pnMsg: TPanel;
Gauge: TCaptionGauge;
srPanel1: TsrPanel;
srPanel2: TsrPanel;
srPanel3: TsrPanel;
Panel4: TPanel;
btnAct: TsrToolButton;
btnSelectFile: TsrToolButton;
FileList: Tsrlistview;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure oFileListGetImageIndex(Sender: TObject; Item: TListItem);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
protected
user: string;
Host: string;
FParentWnd: HWnd;
FDlgMsg: TDlgMsg;
procedure SetDlgMsg(const Value: TDlgMsg); virtual;
procedure createParams(var params: TCreateParams); override;
procedure addFiles(Files: TStrings); virtual;
procedure WarningMe; virtual;
procedure showAndFlashWindow;
public
{ Public declarations }
procedure settingColors; override;
function pkSize: integer;
function getFileSize(fileName: string): integer;
Constructor CreateExe(Auser, Ip: string; Files: string = ''; msg: String = '');
property DlgMsg: TDlgMsg read FDlgMsg write SetDlgMsg;
end;

const
dlgs: array[TDlgMsg] of string = ('Wait_Acc', 'Rec_StandBy', 'Rec_Acc', 'Rec_Rej', 'Sender_Cancel', 'Rec_cancel', 'File_size',
'File_begin', 'File_TotalSize', 'File_Data', 'cf_Receive', 'File_Complete', 'chk_finish', 'ReSend_Req',
'RecAll_Complete');

implementation

{$R *.dfm}

{ TfmSendFile }

uses math, myfunctions, commCtrl, CommX;

procedure TsrForm.addFiles(Files: TStrings);
begin
//
end;

procedure TsrForm.createParams(var params: TCreateParams);
begin
inherited createParams(params);
params.WndParent:=Fparentwnd;
params.ExStyle:=params.ExStyle or WS_EX_APPWINDOW;
end;

function TsrForm.getFileSize(fileName: string): integer;
var
f : TFileStream;
begin
f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
Result :=f.Size;
F.Free;
end;

procedure TsrForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=caFree;
end;

constructor TsrForm.CreateExe(Auser, IP, Files, msg: String);
var
FList: Tstrings;
RunByOtherProcess: boolean;
begin
RunByOtherProcess:=(Files<>'') and (ClassName<>'TfmReceiveFile');
FParentWnd:=ifthen(RunByOtherProcess, 0, application.Handle);
user:=Auser;
Host:=Ip;
with inherited create(application) do
begin
moMsg.Text:=msg;
if Files<> '' then
begin
Flist:=TStringList.Create;
try
Flist.Text:=Files;
AddFiles(Flist);
if RunByOtherProcess then btnSelectFile.Visible:=false;
finally
FList.Free;
end;
end;
caption:=caption+user;
show;
end;
end;

function TsrForm.pkSize: integer;
begin
result:=sizeof(TPackinfo);
end;

procedure TsrForm.oFileListGetImageIndex(Sender: TObject; Item: TListItem);
var
cmFile: string;
begin
cmfile:=ExtractFileExt(item.Caption);
item.ImageIndex:=GetFileExtIconIndex(cmFile);
end;

procedure TsrForm.FormCreate(Sender: TObject);
var
imgHandle: integer;
begin
inherited;
imgHandle:=getSysImageHwnd(true);
SendMessage(FileList.Handle, LVM_SETIMAGELIST, LVSIL_SMALL, imgHandle);
end;

procedure TsrForm.WarningMe;
begin
//
end;

procedure TsrForm.SetDlgMsg(const Value: TDlgMsg);
begin
//FDlgMsg := Value;
end;

procedure TsrForm.showAndFlashWindow;
var
i: integer;
begin
showWindow(handle, SW_SHOWNORMAL);
for i:=0 to 8 do
begin
FlashWindow(handle, true);
delay(1200);
end;
end;

procedure TsrForm.settingColors;
var
i: integer;
begin
inherited;
Gauge.ForeColor:=clslEnd;
for i:=0 to ComponentCount-1 do
if Components is TsrPanel then
begin
TsrPanel(Components).BeginColor:=clEnd;
TsrPanel(Components).EndColor:=clBegin;
TsrPanel(Components).FrameColor:=getAlphacolor(clEnd, clWhite, 128);
end;
FileList.clTitleBegin:=clBegin;
FileList.clTitleEnd:=clEnd;
FileList.clBegin:=clEnd;
FileList.clSelected:=clslEnd;
FileList.clFrame:=clDark;
end;

end.

*************
unit SendFileExe;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SendFile, CaptionGauges, StdCtrls, myControls, ExtCtrls, ComCtrls,
IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient, IdTCPConnection,
IdUDPServer, IdSocketHandle, IdTCPServer, IdThreadMgr, IdThreadMgrDefault,
IdTCPClient, commx, srToolButton, srListview;

type

TfmSendFileExe = class;

TSendThread = class(TThread)
private
FForm: TfmSendFileExe;
FStream: TFileStream;
MStream: TMemoryStream;
fpkSend: integer;
fpkCount: integer;
protected
procedure upDateGauge;
procedure udState;
procedure DoSendFile;
function SendBlock(pkNo: integer): integer;
procedure ReSendBlock(pkNo: integer);
procedure Execute; override;
procedure DoTerminate; override;
public
sendFile: integer;
FileName: string;
FileSize: int64;
procedure Terminate;
constructor Create(AForm: TfmSendFileExe; ASize: int64; AName: string);
end;

TfmSendFileExe = class(TsrForm)
openDlg: TOpenDialog;
TcpSever: TIdTCPServer;
UdpClient: TIdUDPClient;
TcpClient: TIdTCPClient;
procedure PickExe(Sender: TObject);
procedure btnActClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TcpSeverConnect(AThread: TIdPeerThread);
procedure TcpSeverExecute(AThread: TIdPeerThread);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
FSendThr: TSendThread;
FileTotalSize: int64;
idCount: integer;
pkId: integer;
procedure sendMsg(DlgMsg: TDlgMsg);
procedure sendFilebuffer(var buffer; Size: integer; PkNo: integer);
procedure SendPacket(pack: TPackInfo);
procedure AskFor;
procedure wmClose(var msg: TMessage); message WM_CLOSE;
procedure cmSelectFile(var msg: TMessage); message CM_SELECTFILE;
protected
procedure SetDlgMsg(const Value: TDlgMsg); override;
procedure addFiles(Files: TStrings); override;
public
{ Public declarations }
function fileName(index: integer): string;
Constructor CreateExe(Auser, Ip: string; Files: string = ''; msg: String = '');
end;

var
fmSendFileExe: TfmSendFileExe;
byteSend: int64 = 0;

implementation

uses dmMain, myfunctions;

{$R *.dfm}

procedure TfmSendFileExe.PickExe(Sender: TObject);
begin
if openDlg.Execute then addFiles(openDlg.Files);
end;

procedure TfmSendFileExe.btnActClick(Sender: TObject);
begin
if btnAct.Caption='发送(&S)' then AskFor
else
if btnAct.Caption='取消(&C)' then
begin
try
if assigned(FSendThr) then FSendThr.Terminate;
sendMsg(Sender_cancel);
finally
pnMsg.Caption:=' 你取消了文件传送...';
btnAct.Caption:='关闭(&C)';
end;
end
else
if btnAct.Caption='关闭(&C)' then
begin
if assigned(FSendThr) then FSendThr.Terminate;
application.ProcessMessages;
close;
end;
end;

procedure TfmSendFileExe.addFiles(Files: TStrings);
var
i: integer;
FSize: int64;
begin
for i:=0 to Files.Count-1 do
with Filelist.Items.add do
begin
FSize:=getFileSize(Files);
inc(FileTotalSize, Fsize);
caption:=Files;
SubItems.Add(FileSizeToStr(FSize));
SubItems.Add('')
end;
btnAct.Enabled:=Files.Count>0;
end;

procedure TfmSendFileExe.FormCreate(Sender: TObject);
begin
inherited;
FileTotalSize:=0;
idCount:=0;
pkId:=0;
TcpSever.Bindings.Clear;
TcpSever.Bindings.Add.Port:=7878;
TcpSever.Active:=true;
end;

procedure TfmSendFileExe.sendMsg(DlgMsg: TDlgMsg);
var
pkInfo: TPackInfo;
begin
pkInfo.DlgMsg:=DlgMsg;
SendPacket(pkInfo);
end;

{ TSendThread }

constructor TSendThread.Create(AForm: TfmSendFileExe; Asize: int64; AName: string);
begin
FForm:=AForm;
byteSend:=0;
FileSize:=ASize;
FileName:=AName;
mStream:=TMemoryStream.Create;
inherited create(false);
FreeOnTerminate:=true;
end;

procedure TSendThread.DoSendFile;
var
pkNo: integer;
bsSize: integer;
begin
// FForm.moMsg.Lines.Add('do sendFile');
if FStream<>nil then FreeAndNil(FStream);
FStream:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
FileSize:=FStream.Size;
if FileSize Mod LEN = 0 then
fpkCount:=FStream.Size div LEN
else
fpkCount:=FStream.Size div LEN + 1;
for pkNo:=0 to fpkCount-1 do
begin
if Terminated then break;
bsSize:=SendBlock(pkNo);
inc(byteSend, bsSize);
fpkSend:=pkNo+1;
if (100*fpkSend div fpkCount)<>(100*(fpkSend-1) div fpkCount) then
Synchronize(upDateGauge);
end;
if not Terminated then
begin
Synchronize(udState);
Suspend;
end;
end;

procedure TSendThread.DoTerminate;
begin
inherited;
if FStream<> nil then FreeAndNil(FStream);
if mStream<>nil then FreeAndNil(mStream);
end;

procedure TSendThread.Execute;
begin
while not Terminated do DoSendFile;
end;

procedure TfmSendFileExe.sendFilebuffer(var buffer; Size: integer; PkNo: integer);
function cfSend: boolean;
var
pki: TPackInfo;
begin
result:=false;
UdpClient.SendBuffer(buffer, size);
try
UdpClient.ReceiveBuffer(pki, pkSize, 500);
except
exit;
end;
if pki.cfReceive and (pki.pkNo=pkNo) then result:=true;
end;
begin
repeat until cfSend;
// cfSend;
end;

procedure TSendThread.ReSendBlock(pkNo: integer);
begin
SendBlock(pkno);
end;

function TSendThread.SendBlock(pkNo: integer): integer;
var
buf: Array[0..LEN+Sizeof(TPackInfo)-1] of byte;
pkInfo: TPackInfo;
psize, pos: integer;
begin
pSize:=LEN;
pos:=LEN*pkNo;
if FStream.Size-pos<LEN then pSize:=FStream.Size-Pos;
pkInfo.FilePos:=pos;
pkInfo.pkNo:=pkNo;
pkInfo.Size:=psize;
pkInfo.DlgMsg:=File_Data;
mStream.Size:=LEN+sizeOf(pkInfo);
mStream.Position:=0;
mStream.Write(pkInfo, sizeof(pkInfo));
FStream.Position:=pos;
mStream.CopyFrom(FStream, psize);
mStream.Position:=0;
mStream.Read(buf, psize+sizeof(pkInfo));
FForm.sendFilebuffer(buf, psize+sizeof(pkInfo), pkNo);
result:=psize;
end;

procedure TSendThread.Terminate;
begin
inherited Terminate;
if Suspended then Resume;
sleep(10);
end;

procedure TSendThread.udState;
var
pkInfo: TpackInfo;
begin
pkInfo.fileNo:=SendFile;
pkInfo.DlgMsg:=File_Complete;
FForm.SendPacket(pkInfo);
end;

procedure TSendThread.upDateGauge;
begin
FForm.Gauge.Progress:=byteSend;
FForm.FileList.Items[sendFile].SubItems[1]:=inttoStr(100*fpkSend div fpkCount)+'%';
end;

procedure TfmSendFileExe.AskFor;
var
sl: TStrings;
i: integer;
begin
sl:=TStringlist.Create;
try
for i:=0 to FileList.Items.Count-1 do
sl.Add(ExtractFileName(FileList.Items.Caption));
dm.AskForTranFiles(user, moMsg.Text, sl.Text);
finally
sl.Free;
end;
Gauge.MaxValue:=FileTotalSize;
end;

procedure TfmSendFileExe.SetDlgMsg(const Value: TDlgMsg);
begin
FDlgMsg:=value;
case FDlgMsg of
Rec_Rej :
begin
btnAct.Caption:='关闭(&C)';
pnMsg.Caption:=' 对方拒绝接收文件...';
end;
RecAll_Complete :
begin
pnMsg.Caption:=' 传送完毕...';
btnAct.Caption:='关闭(&C)';
if assigned(FSendThr) then FSendThr.Terminate;
showAndFlashWindow;
end;
Rec_Cancel :
begin
pnmsg.Caption:=' 传送被对方终止...';
btnAct.Caption:='关闭(&C)';
if assigned(FSendThr) then FSendThr.Terminate;
showAndFlashWindow;
end;
end;
end;

function TfmSendFileExe.fileName(index: integer): string;
begin
result:=FileList.Items[index].Caption;
end;

procedure TfmSendFileExe.TcpSeverConnect(AThread: TIdPeerThread);
begin
btnAct.caption:='取消(&C)';
btnSelectFile.Enabled:=false;
pnMsg.Caption:=' 等候对方接收...';
TcpClient.Connect;
end;

procedure TfmSendFileExe.TcpSeverExecute(AThread: TIdPeerThread);
var
pkInfo: TPackInfo;
spk: TPackinfo;
begin
AThread.Connection.ReadBuffer(pkInfo, pkSize);
AThread.Connection.WriteBuffer(pkInfo, pkSize);
DlgMsg:=pkInfo.DlgMsg;
case pkInfo.DlgMsg of
Rec_StandBy:
begin
spk.DlgMsg:=File_TotalSize;
SPK.Size:=FileTotalSize;
SendPacket(spk);

spk.fileNo:=pkInfo.fileNo;
spk.DlgMsg:=File_begin;
spk.Size:=getFileSize(fileName(pkInfo.fileNo));
SendPacket(spk);
end;
Rec_Acc :
begin
pnMsg.Caption:=' 传送进行中...';
FileList.Items[pkInfo.fileNo].Selected:=true;
if FSendThr<>nil then
begin
FSendThr.FileName:=fileName(pkInfo.fileNo);
FSendThr.sendFile:=pkInfo.fileNo;
FSendThr.FileSize:=pkInfo.Size;
sleep(20);
FSendThr.Resume;
end
else
FSendThr:=TSendThread.Create(self, pkInfo.Size, fileName(pkinfo.fileNo));
end;
ReSend_Req:
begin
FsendThr.ReSendBlock(pkInfo.pkNo);
end;
chk_finish:
begin
spk.fileNo:=pkInfo.fileNo;
spk.DlgMsg:=File_Complete;
SendPacket(spk);
end;
end;

end;

procedure TfmSendFileExe.SendPacket(pack: TPackInfo);
function cfSend: boolean;
var
pki: TPackInfo;
rPk: TPackInfo;
begin
result:=false;
pki:=pack;
pki.id:=pkId;
TcpClient.WriteBuffer(pki, pkSize);
try
TcpClient.ReadBuffer(rPk, pkSize);
except
exit;
end;
if rpk.id=pki.id then result:=true;
end;
begin
repeat until cfSend;
inc(pkId);
end;

procedure TfmSendFileExe.FormShow(Sender: TObject);
begin
UdpClient.Host:=dm.IPByUser(user);
udpClient.Active:=true;
TcpClient.Host:=dm.IPByUser(user);
postMessage(handle, CM_SELECTFILE, 0, 0);
end;

procedure TfmSendFileExe.wmClose(var msg: TMessage);
begin
if btnAct.Caption='取消(&C)' then
messageBox(handle, '请先按 取消 按钮通知对方，再关闭...', '提示', MB_ICONINFORMATION)
else
close;
end;

procedure TfmSendFileExe.cmSelectFile(var msg: TMessage);
begin
if btnSelectFile.Visible then
begin
application.ProcessMessages;
PickExe(nil);
end;
end;

constructor TfmSendFileExe.CreateExe(Auser, ip, Files, msg: String);
var
Wnd: THandle;
begin
Wnd:=findWindow('TfmSendFileExe', nil);
if wnd=0 then
inherited createExe(Auser, ip, Files, msg)
else
showWindow(wnd, SW_SHOWNORMAL);
end;

end.

//************************
unit ReceiveFile;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SendFile, CaptionGauges, StdCtrls, ComCtrls, myControls,
ExtCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,
IdSocketHandle, intList, IdTCPConnection, IdTCPClient, IdTCPServer,
IdAntiFreezeBase, IdAntiFreeze, commx, srToolButton, srListview;
type
TfmReceiveFile = class(TsrForm)
Udp: TIdUDPServer;
TcpClient: TIdTCPClient;
TcpSever: TIdTCPServer;
procedure btnActClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnSelectFileClick(Sender: TObject);
procedure UdpUDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TcpSeverExecute(AThread: TIdPeerThread);
procedure FileListDblClick(Sender: TObject);
private
{ Private declarations }
Dir: string;
ttRecByte: int64;
RecFileNo: integer;
FStream: TFileStream;
fpkCount: integer;
rfpkCount: integer;
pkId: integer;
recFbyte: integer;
pkInfo: TpackInfo;
pki: TpackInfo;
procedure SendPacket(pack: TPackInfo);
procedure save;
procedure FileRename;
function fileName(index: integer): string;
procedure cmUpdateState(var msg: TMessage); message CM_UPDATESTATE;
procedure wmClose(var msg: TMessage); message WM_CLOSE;
protected
massInfo : pPackInfo;
procedure SetDlgMsg(const Value: TDlgMsg); override;
procedure addFiles(Files: TStrings); override;
public
{ Public declarations }
end;

var
fmReceiveFile: TfmReceiveFile;

implementation

uses dmMain, FileCtrl, myfunctions, math, shellApi;

{$R *.dfm}

{ TfmReceiveFile }

procedure TfmReceiveFile.addFiles(Files: TStrings);
var
i: integer;
begin
for i:=0 to Files.Count-1 do
with Filelist.Items.add do
begin
caption:=Files;
SubItems.Add('未知');
SubItems.Add('');
SubItems.Add('');
end;
end;

procedure TfmReceiveFile.btnActClick(Sender: TObject);
var
pki: TpackInfo;
begin
if btnAct.Caption='接收(&A)' then
save
else
if btnAct.Caption='取消(&C)' then
begin
pki.DlgMsg:=Rec_cancel;
try
try
SendPacket(pki);
except
close;
end;
finally
pnMsg.Caption:=' 文件接收取消...';
btnAct.Caption:='关闭(&C)';
end;
end
else
if btnAct.Caption='关闭(&C)' then close;
end;

procedure TfmReceiveFile.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
if assigned(FStream) then FStream.Free;
inherited;
end;

procedure TfmReceiveFile.btnSelectFileClick(Sender: TObject);
var
pkInfo: TPackinfo;
begin
if btnSelectFile.Caption='拒收(&R)' then
begin
pkInfo.DlgMsg:=Rec_Rej;
SendPacket(pkInfo);
close;
end
else
ShellExecute(0, 'open', pchar(Dir), nil, nil, sw_show);
end;

procedure TfmReceiveFile.UdpUDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
begin
Adata.Read(pkInfo, pkSize);
if pkInfo.DlgMsg =File_data then
begin
// if (rfpkCount=pkInfo.pkNo) then
// begin
AData.Position:=pkSize;
FStream.Position:=pkInfo.FilePos;
FStream.CopyFrom(AData, pkInfo.Size);
inc(ttRecByte, pkInfo.Size);
pki.pkNo:=pkInfo.pkNo;
pki.cfReceive:=true;
Udp.SendBuffer(ABinding.PeerIP, ABinding.PeerPort, pki, pkSize);
inc(rfpkCount);
inc(recFbyte, pkInfo.Size);
postMessage(handle, CM_UPDATESTATE, 0, 0);
// end;
end;
end;

procedure TfmReceiveFile.save;
var
PkInfo: TPackInfo;
begin
if SelectDirectory('选择目录', '', Dir) then
begin
FileRename;
RecFileNo:=0;
pkInfo.DlgMsg:=Rec_StandBy;
pkInfo.fileNo:=0;
SendPacket(pkInfo);
//btnSelectFile.Visible:=false;
end;
end;

function TfmReceiveFile.fileName(index: integer): string;
begin
result:=FileList.Items[index].Caption;
end;

procedure TfmReceiveFile.FormCreate(Sender: TObject);
begin
inherited;
ttRecByte:=0;
pkId:=0;
TcpSever.Bindings.Clear;
TcpSever.Bindings.Add.Port:=7171;
TcpSever.Active:=true;
end;

procedure TfmReceiveFile.SetDlgMsg(const Value: TDlgMsg);
begin
if value = FDlgMsg then exit;
FDlgMsg := value;
case FDlgMsg of
Sender_Cancel:
begin
pnMsg.Caption:='对方取消了传送';
btnSelectFile.Visible:=false;
btnAct.Caption:='关闭(&C)';
showAndFlashWindow;
end;
RecAll_Complete:
begin
FreeAndNil(FStream);
pnMsg.Caption:='接收完毕...';
btnAct.Caption:='关闭(&C)';
btnSelectFile.Enabled:=true;
showAndFlashWindow;
end;
end;
end;

procedure TfmReceiveFile.SendPacket(pack: TPackInfo);
function cfSend: boolean;
var
pki: TPackInfo;
rPk: TPackInfo;
begin
result:=false;
pki:=pack;
pki.id:=pkId;
TcpClient.WriteBuffer(pki, pkSize);
try
TcpClient.ReadBuffer(rPk, pkSize);
except
exit;
end;
if rpk.id=pki.id then result:=true;
end;
begin
repeat until cfSend;
inc(pkId);
end;

procedure TfmReceiveFile.FormShow(Sender: TObject);
begin
Udp.Active:=true;
TcpClient.Host:=Host;
TcpClient.Connect;
showWindow(handle, SW_SHOWNORMAL);
end;

procedure TfmReceiveFile.TcpSeverExecute(AThread: TIdPeerThread);
var
pkInfo: TPackInfo;
spk: TpackInfo;
begin
AThread.Connection.ReadBuffer(pkInfo, pkSize);
AThread.Connection.WriteBuffer(pkInfo, pkSize);
DlgMsg:=pkInfo.DlgMsg;
case pkInfo.DlgMsg of
File_TotalSize :
begin
Gauge.MaxValue:=pkInfo.Size;
end;
File_begin :
begin
btnSelectFile.Enabled:=false;
btnAct.Caption:='取消(&C)';
btnSelectFile.Caption:='打开文件夹';
pnMsg.Caption:=' 文件接收进行中...';
FileList.Items[RecFileNo].SubItems[0]:=FileSizeToStr(pkInfo.Size);
if pkInfo.Size mod LEN = 0 then
fpkCount:=pkInfo.Size div LEN
else
fpkCount:=pkInfo.Size div LEN+1;
if FStream<>nil then FreeAndNil(FStream);
FStream:=TFileStream.Create(fileName(pkInfo.fileNo), fmCreate or fmOpenWrite);
FStream.Size:=pkInfo.Size;
FStream.Position:=0;
rfpkCount:=0;
RecFByte:=0;
FileList.Items[RecFileNo].Selected:=true;
spk.DlgMsg:=Rec_Acc;
spk.fileNo:=RecFileNo;
SendPacket(spk);
end;
File_Complete :
begin
if RecFileNo<FileList.Items.Count-1 then
begin
inc(RecFileNo);
spk.fileNo:=RecFileNo;
spk.DlgMsg:=Rec_StandBy;
SendPacket(spk);
end
else
begin
spk.DlgMsg:=RecAll_Complete;
sendPacket(spk);
DlgMsg:=RecAll_Complete;
end;
end;
end;
// moMsg.Lines.Add(dlgs[DlgMsg]);
end;

procedure TfmReceiveFile.cmUpdateState(var msg: TMessage);
var
pcDone: integer;
begin
Gauge.Progress:=ttRecByte;
pcDone:=100*rfpkCount div fpkCount;
if pcDone<>100*(rfpkCount-1) div fpkCount then
FileList.Items[RecFileNo].SubItems[1]:=inttostr(pcDone)+'%';
end;

procedure TfmReceiveFile.wmClose(var msg: TMessage);
begin
if btnAct.Caption='取消(&C)' then
messageBox(handle, '请先按 取消 按钮通知对方，再关闭...', '提示', MB_ICONINFORMATION)
else if btnAct.Caption='接收(&A)' then
messageBox(handle, '请先按 拒收 按钮通知对方，再关闭...', '提示', MB_ICONINFORMATION)
else close;
end;

procedure TfmReceiveFile.FileListDblClick(Sender: TObject);
var
FName: string;
begin
if (DlgMsg=RecAll_Complete) and (FileList.Selected<>nil) then
begin
Fname:=FileList.Selected.Caption;
ShellExecute(0, 'open', pchar(Fname), nil, nil, sw_show);
end;
end;

procedure TfmReceiveFile.FileRename;
var
FName: string;
i, j: integer;
ext: string;
fpart: string;
begin
for i:=0 to FileList.Items.Count-1 do
begin
FName:=FileList.Items.Caption;
if Dir[length(Dir)]<>'/' then Dir:=Dir+'/';
ext:=ExtractFileExt(FName);
Fpart:=copy(Fname, 1, length(Fname)-length(ext));
Fname:=Dir+Fname;
j:=1;
FileList.Items.Caption:=Fname;
while FileExists(Fname) do
begin
Fname:=Dir+Fpart+inttostr(j)+ext;
FileList.Items.Caption:=Fname;
inc(j);
end;
end;
end;

end.

不过好像有问题 这个程序传输时候有些程序在传输到最后的时候会卡住啊

我指的是chenybin的

xuxiaohan 能不能copy一份窗体与工程文件 这样我可以编译一下看看便于给分

为什么xuxiaohan的代码有3部分？

chenybin 你的代码只能传送一次啊 再次传送文件的时候就会出错！

那就只有自己调了，代码都有，跟踪一下就知道哪里的问题了

我就差重写了 我把所有在可能程序启动时候建立而在收取数据之后没有建立或清理的东西全加进去了 还是会在第2次传送时卡住 并且有些程序会在传送一半的时候卡住 麻烦你帮忙检查一下 我也可以学习学习

是在三各不同的单元， 其中一个是主单元， 另外两个 分别是接收， 发送单元， 其中的继承关系你看看就知道了。

这是我的 办公自动化系统的 一部分， 整个工程copy给你就很多了，你参考我的代码，自己写一个不就成了吗？

结贴给分吧 chenybin是从网上抄的并且有BUG 40分 嘿嘿 xuxiaohan是自己原创的 能不能用有待研究呵呵 不过本着支持原创的原则 60分！ 以后有时间再研究～

多人接受答案了。