计算机间文件传输源码，支持串口、MODEM、UDP方式，需要者请进! (0分)

计算机间文件传输实现原理及实践
最近在DFW上看到一些网友提出如何在两台计算机之间传输文件的问题，而且这个
问题也没有较好的答案，本人由于工作需要，开发了一个这样的程序，在此与大
家分享经验，希望能起到抛砖引玉的作用，同时向DFW上一些开放源码的朋友致敬！

一般来说在计算机间传输数据需要考虑下面三个方面的问题：

1. 流量控制
2. 差错控制
3. 协议实现

流量控制：
因为两台计算机处理能力可能不同，为了能稳定可靠的进行数据传输必须按照较慢计算
机的处理能力来处理数据

差错控制：
要保证数据帧能够按顺序、正确的到达对方，同时对方能根据数据帧内本身的数据对数据帧的正确性进行校对，目前校验方法很多，常用的有累加和、CRC等，本程序中为
了简便，采用累加和校验方式

协议实现：
通讯协议需要解决的问题是：这个协议能完成差错控制、可在不同的传输媒介上实现
同时不能使传输效率降低很多


//=====================================================================
//= 抽象传输媒介类(实际是现时需从该类继承)
//= 实际上传输媒介只要支持写入和读取功能就可以在其上传输数据
//= 下面为了统一UDP、MODEM、串口
//= 将传输媒介抽象为：
//= Open // UDP,MODEM,串口都需提供
//= Connect // Modem提供
//= DisConnect // Modem提供
//= Write // UDP,MODEM,串口都需提供
//= Close // UDP,MODEM,串口都需提供
//= 传输媒介必须提供两个事件
//= OnStatusChange // 指示传输媒介状态改变
//= OnPackAge // 指示传输媒介上出现一个数据包
//=====================================================================
Unit TransmitMedia;

interface

Uses Windows,Messages,Classes,Controls,MemCommand;

Const
MoveWindow: Integer = 5; // 滑动传口大小（定义成可变常量的原因是：不同的传输媒介需要不同的窗口大小
// 根据本人的经验，UDP方式窗口为5能达到最大传输能力,串口窗口
// 为48能达到最大传输能力，MODEM和串口一致）
PackageSize = 512; // 数据包大小
MaxPackAgeSize = PackageSize*2+8; // 数据包最大尺寸

MM_OPENED = 100; // 传输媒介打开后
MM_READ = 101; // 传输媒介有数据
MM_WRITE = 102; // 传输媒介可写入
MM_CTS = 103; // MODEM传输方式需采用RTS/CTS流量控制协议
MM_CONNECTED = 104; // 传输媒介已连接
MM_DISCONNECTED = 105; // 传输媒介已断开
MM_RING = 106; // 收到震铃信号
MM_ERROR = 107; // 传输媒介出现错误
MM_CLOSED = 108; // 传输媒介已关闭
MM_USER = 1000; // 自定义状态由此开始

Type
TTransmitMedia=(tmCOM,tmUDP,tmModem);

TMediaParam = Class(TPersistent)
Private
FMediaType: TTransmitMedia;
FLocalPort: Integer;
FRemotePort: Integer;
FRemoteHost: String;
FTelephoneNo: String;
FIP: String;
Published
Property MediaType: TTransmitMedia Read FMediaType Write FMediaType;
Property LocalPort: Integer Read FLocalPort Write FLocalPort;
Property RemotePort: Integer Read FRemotePort Write FRemotePort;
Property RemoteHost: String Read FRemoteHost Write FRemoteHost;
Property TelephoneNo: String Read FTelephoneNo Write FTelephoneNo;
Property IP: String Read FIP Write FIP;
End;

TOnStatusChange = Procedure (Sender: TObject; Status: DWord) of Object;
TOnPackAge = Procedure (Buffer: PChar; Size: Integer) of Object;

TTransmitChannel = Class(TWinControl) // 有的传输媒介需向窗口发送消息，故采用窗口类作为基类
Private
FMedia: TMediaParam;
FOnPackAge: TOnPackAge;
FOnChange: TOnStatusChange;
Protected
Procedure CreateParams(Var Params:TCreateParams); Override;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Function Open: Integer; Virtual; // 打开
Procedure Connect; Virtual; // 连接
Procedure DisConnect; Virtual; // 断开
Procedure Write(Buffer: PChar; Size: Integer); Virtual; // 写入
Procedure Close; Virtual; // 关闭
Published
Property Media: TMediaParam Read FMedia;
Property OnStatusChange: TOnStatusChange Read FOnChange Write FOnChange;
Property OnPackAge: TOnPackAge Read FOnPackAge Write FOnPackAge;
End;

implementation

Procedure TTransmitChannel.CreateParams(Var Params: TCreateParams); // 使窗口为顶层窗口，避免出现'Control has no parent'错误
Begin
Inherited;
With Params Do
Begin
Style:=WS_POPUP;
ExStyle:=0;
End;
End;

Constructor TTransmitChannel.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
FMedia:=TMediaParam.Create;
End;

Destructor TTransmitChannel.Destroy;
Begin
FMedia.Free;
Inherited Destroy;
End;

Function TTransmitChannel.Open: Integer;
Begin
Result:=0;
End;

Procedure TTransmitChannel.Close;
Begin
End;

Procedure TTransmitChannel.Connect;
Begin
End;

Procedure TTransmitChannel.DisConnect;
Begin
End;

Procedure TTransmitChannel.Write(Buffer: PChar; Size: Integer);
Begin
End;

end.

//===============================================================
//= 传输媒介实例(COM,MODEM方式)
//= 该实例继承自TTransmitChannel,重新实现了打开、关闭、写入命令
//===============================================================
unit Modem;

interface

Uses
Windows,Messages,Controls,Classes,MemCommand,SysUtils,TransmitMedia;

Const
WM_MODEMEVENT = WM_USER+1;
Type
TModemMonitor = Class(TThread)
Private
FDevice: THandle;
FWindow: HWND;
FMessage: Integer;
Public
Constructor Create(Device: THandle; Window: HWND; Message: Integer);
Procedure Execute; Override;
End;

TModemChannel = Class (TTransmitChannel)
Private
FSize: DWord;
ATCommand: Array [0..128] of Char;
Private
FRead: TOverLapped;
FWrite: TOverLapped;
FPackAge: PChar;
FPosition: Integer;
FFirst: PMemCommand;
Private
FMonitor: TModemMonitor;
FDevice: THandle;
FStatus: Integer;
Procedure ModemEvent(Var Msg: TMessage); Message WM_MODEMEVENT;
Protected
Procedure SearchPackAge;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Function Open: Integer; Override;
Procedure Close; Override;
Procedure Connect; Override;
Procedure DisConnect; Override;
Procedure Write(Buffer: PChar; Size: Integer); Override;
End;

implementation

Constructor TModemMonitor.Create(Device: THandle; Window: HWND; Message: Integer);
Begin
Inherited Create(True);
FDevice:=Device;
FWindow:=Window;
FMessage:=Message;
FreeOnTerminate:=True;
Resume;
End;

Procedure TModemMonitor.Execute;
Var
Mask: DWord;
OverLapped: TOverLapped;
Size: DWord;
Begin
if FDevice<>INVALID_HANDLE_VALUE Then
Begin
SetCommMask(FDevice,EV_CTS Or EV_RING Or EV_RLSD Or EV_RXCHAR Or EV_TXEMPTY Or EV_ERR);
OverLapped.hEvent:=CreateEvent(Nil,True,False,Nil);
While Not Terminated Do
Begin
WaitCommEvent(FDevice,Mask,@OverLapped);
GetOverLappedResult(FDevice,OverLapped,Size,True);
if Mask And EV_RXCHAR <> 0 Then
Begin
PostMessage(FWindow,FMessage,Mask,MM_READ);
End;
if Mask And EV_TXEMPTY <> 0 Then
Begin
PostMessage(FWindow,FMessage,Mask,MM_WRITE);
End;
if Mask And EV_CTS <> 0 Then
Begin
PostMessage(FWindow,FMessage,Mask,MM_CTS);
End;
if Mask And EV_RING <> 0 Then
Begin
PostMessage(FWindow,FMessage,Mask,MM_RING);
End;
if Mask And EV_RLSD <> 0 Then
Begin
GetCommModemStatus(FDevice,Size);
if Size And MS_RLSD_ON <> 0 Then
PostMessage(FWindow,FMessage,Mask,MM_CONNECTED)
Else
PostMessage(FWindow,FMessage,Mask,MM_DISCONNECTED);
End;
if Mask And EV_ERR <> 0 Then
Begin
PostMessage(FWindow,FMessage,Mask,MM_ERROR);
ClearCommError(FDevice,Mask,Nil);
End;
End;
End;
End;

Constructor TModemChannel.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);
FDevice:=INVALID_HANDLE_VALUE;
FillChar(FRead,Sizeof(TOverLapped),0);
FillChar(FWrite,Sizeof(TOverLapped),0);
GetMem(FPackAge,1024*128);
FPosition:=0;
MoveWindow:=48;
End;

Destructor TModemChannel.Destroy;
Begin
Close;
FreeMem(FPackAge,1024*128);
Inherited Destroy;
End;

Function TModemChannel.Open: Integer;
Const
fBinary = $00000001;
fOutxCtsFlow = $00000004;
Var
FDCB: DCB;
TimeOut: COMMTIMEOUTS;
Begin
Close;

FDevice:=CreateFile(PChar('//./COM'+IntToStr(Media.LocalPort)),Generic_Read Or Generic_Write,0,Nil,Open_Existing,File_Flag_OverLapped,0);
if FDevice=INVALID_HANDLE_VALUE Then
Begin
Result:=-1;
Exit;
End;

SetupComm(FDevice,1024*128,1024*128);

GetCommState(FDevice,FDCB);
FDCB.BaudRate:=CBR_115200;
FDCB.Parity:=NOPARITY;
FDCB.Stopbits:=ONESTOPBIT;
FDCB.Bytesize:=8;
if Media.MediaType=tmCOM Then FDCB.Flags:=fBinary
Else FDCB.Flags:=fBinary Or fOutxCtsFlow;
SetCommState(FDevice,FDCB);

FMonitor:=TModemMonitor.Create(FDevice,Handle,WM_MODEMEVENT);

if Media.MediaType=tmModem Then
Begin
FillChar(TimeOut,Sizeof(COMMTIMEOUTS),0);
TimeOut.WriteTotalTimeoutMultiplier:=30;
SetCommTimeOuts(FDevice,TimeOut);

EscapeCommFunction(FDevice,CLRDTR);
Sleep(80);
EscapeCommFunction(FDevice,SETDTR);

EscapeCommFunction(FDevice,SETRTS);
Sleep(80);

StrPCopy(ATCommand,'ATE0'+#13+#10);
WriteFile(FDevice,ATCommand,StrLen(ATCommand),FSize,@FWrite);
GetOverLappedResult(FDevice,FWrite,FSize,True);
Sleep(10);

StrPCopy(ATCommand,'ATQ0'+#13+#10);
WriteFile(FDevice,ATCommand,StrLen(ATCommand),FSize,@FWrite);
GetOverLappedResult(FDevice,FWrite,FSize,True);
Sleep(10);

{ StrPCopy(ATCommand,'ATS0=1'+#13+#10);
WriteFile(FDevice,ATCommand,StrLen(ATCommand),FSize,@FWrite);
GetOverLappedResult(FDevice,FWrite,FSize,True);
Sleep(10);}

StrPCopy(ATCommand,'ATS7=60'+#13+#10);
WriteFile(FDevice,ATCommand,StrLen(ATCommand),FSize,@FWrite);
GetOverLappedResult(FDevice,FWrite,FSize,True);
Sleep(10);

FillChar(TimeOut,Sizeof(COMMTIMEOUTS),0);
SetCommTimeOuts(FDevice,TimeOut);

if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_OPENED);
End
Else
Begin
FStatus:=MM_CONNECTED;
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_OPENED);
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_CONNECTED);
End;
Result:=0;
End;

Procedure TModemChannel.Close;
Begin
if FDevice=INVALID_HANDLE_VALUE Then Exit;

if FMonitor<>Nil Then
Begin
FMonitor.Terminate;
FMonitor:=Nil;
SetCommMask(FDevice,0);
EscapeCommFunction(FDevice,CLRDTR);
Sleep(60);
EscapeCommFunction(FDevice,SETDTR);
End;
if FDevice<>INVALID_HANDLE_VALUE Then
Begin
CloseHandle(FDevice);
FDevice:=INVALID_HANDLE_VALUE;
End;
End;

Procedure TModemChannel.Connect;
Begin
if FDevice=INVALID_HANDLE_VALUE Then Exit;

if Media.MediaType=tmModem Then
Begin
StrPCopy(ATCommand,'ATDT'+Media.TelephoneNo+#13+#10);
AddCommand(FFirst,ATCommand,StrLen(ATCommand));
PostMessage(Handle,WM_MODEMEVENT,0,MM_WRITE);
End;
End;

Procedure TModemChannel.DisConnect;
Begin
if FDevice=INVALID_HANDLE_VALUE Then Exit;

if Media.MediaType=tmModem Then
Begin
EscapeCommFunction(FDevice,CLRDTR);
Sleep(100);
EscapeCommFunction(FDevice,SETDTR);
End;
End;

Procedure TModemChannel.Write(Buffer: PChar; Size: Integer);
Begin
if FDevice=INVALID_HANDLE_VALUE Then Exit;

AddCommand(FFirst,Buffer,Size);
PostMessage(Handle,WM_MODEMEVENT,0,MM_WRITE);
End;

Procedure TModemChannel.SearchPackAge;
Var
N: Integer;
S,E: Integer;
Begin
S:=-1;
For N:=0 To FPosition-1 Do
Begin
if (FPackAge+N)^=#$55 Then S:=N
Else if (FPackAge+N)^=#$CC Then
Begin
E:=N;
if S<>-1 Then
Begin
if Assigned(OnPackAge) Then OnPackAge(FPackAge+S,E-S+1);
Move((FPackAge+E+1)^,FPackAge^,FPosition-E);
FPosition:=FPosition-E-1;
Break;
End;
End;
End;
End;

Procedure TModemChannel.ModemEvent(Var Msg: TMessage);
Var
State: ComStat;
Errors: DWord;
Begin
Case Msg.lParam of
MM_READ:
Begin
ClearCommError(FDevice,Errors,@State);
ReadFile(FDevice,(FPackAge+FPosition)^,State.cbInQue,Errors,@FRead);
if FStatus=MM_CONNECTED Then
Begin
FPosition:=FPosition+Integer(Errors);
SearchPackAge;
End;
End;
MM_WRITE:
Begin
if FFirst<>Nil Then
Begin
WriteFile(FDevice,FFirst^.Buffer^,FFirst^.Size,Errors,@FWrite);
DeleteTopCommand(FFirst);
End
End;
MM_CONNECTED:
Begin
PurgeComm(FDevice,PURGE_RXCLEAR);
FStatus:=MM_CONNECTED;
FPosition:=0;
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_CONNECTED);
End;
MM_DISCONNECTED:
Begin
FStatus:=MM_DISCONNECTED;
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_DISCONNECTED);
End;
MM_RING:
Begin
StrPCopy(ATCommand,'ATS0=1'+#13+#10);
WriteFile(FDevice,ATCommand,StrLen(ATCommand),FSize,@FWrite);
FStatus:=MM_RING;
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_RING);
End;
MM_CTS:
Begin
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_CTS);
End;
MM_ERROR:
Begin
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_ERROR);
End;
End;
End;

end.

//===============================================================
//= 传输媒介实例(UDP方式)
//= 该实例继承自TTransmitChannel,重新实现了打开、关闭、写入命令
//===============================================================
unit TransmitUDP;

interface

Uses Windows,Messages,Controls,Classes,WinSock,TransmitMedia;

Const
WM_NETWORK = WM_USER+1;

Type
TUDPChannel = Class (TTransmitChannel)
Private
FDevice: TSocket;
Procedure UDPEvent(Var Msg: TMessage); Message WM_NETWORK;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Function Open: Integer; Override;
Procedure Close; Override;
Procedure Write(Buffer: PChar; Size: Integer); Override;
End;

implementation

Constructor TUDPChannel.Create(AOwner: TComponent);
Var
Data: WSAData;
Begin
Inherited Create(AOwner);
FDevice:=INVALID_SOCKET;
WSAStartup(MAKEWORD(1,1),Data);
MoveWindow:=5;
End;

Destructor TUDPChannel.Destroy;
Begin
if FDevice<>INVALID_SOCKET Then CloseSocket(FDevice);
WSACleanup;
Inherited Destroy;
End;

Function TUDPChannel.Open: Integer;
Var
Addr: SockAddr_in;
Begin
Result:=-1;
if FDevice<>INVALID_SOCKET Then CloseSocket(FDevice);

FDevice:=Socket(AF_INET,SOCK_DGRAM,IPPROTO_UDP);
if FDevice=INVALID_SOCKET Then Exit;

Addr.sin_family:=AF_INET;
Addr.sin_port:=htons(Media.LocalPort);
Addr.sin_addr.S_addr:=htonl(INADDR_ANY);

if Bind(FDevice,Addr,Sizeof(SockAddr_in))=SOCKET_ERROR Then
Begin
CloseSocket(FDevice);
FDevice:=INVALID_SOCKET;
Exit;
End;
WSAAsyncSelect(FDevice,Handle,WM_NETWORK,FD_READ);

if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_OPENED);
if Assigned(OnStatusChange) Then OnStatusChange(Self,MM_CONNECTED);
Result:=0;
End;

Procedure TUDPChannel.Close;
Begin
if FDevice<>INVALID_SOCKET Then CloseSocket(FDevice);
End;

Procedure TUDPChannel.Write(Buffer: PChar; Size: Integer);
Var
Addr: SockAddr_in;
Begin
Addr.sin_family:=AF_INET;
Addr.sin_port:=htons(Media.RemotePort);
Addr.sin_addr.S_addr:=inet_addr(PChar(Media.RemoteHost));
SendTo(FDevice,Buffer^,Size,0,Addr,Sizeof(SockAddr_in));
End;

Procedure TUDPChannel.UDPEvent(Var Msg: TMessage);
Var
Size: Integer;
Addr: SockAddr_In;
RecvBuf: Array [0..MaxPackAgeSize-1] of Char;
Begin
Size:=Sizeof(SockAddr_in);
Size:=RecvFrom(FDevice,RecvBuf,MaxPackAgeSize,0,Addr,Size);
if Size<>SOCKET_ERROR Then
Begin
if (RecvBuf[0]=#$55) And (RecvBuf[Size-1]=#$CC) Then
Begin
if Assigned(OnPackAge) Then OnPackAge(@RecvBuf[0],Size);
End;
End;
End;

end.

//===============================================================================
//=
//= 命令缓存函数集（用于滑动窗口和其他一些用途）
//=
//===============================================================================
unit MemCommand;

interface

Type
TMemCommand = Packed Record // 命令缓存结构
Size: Integer; // 缓存大小
Buffer: Pointer; // 缓存指针
Prev: Pointer; // 上一个
Next: Pointer; // 下一个
End;
PMemCommand = ^TMemCommand;

Procedure DestroyCommand(Var First: PMemCommand);
Function GetCommandByIndex(First: PMemCommand; Index: Integer): PMemCommand;
Procedure DeleteCommand(Var Node: PMemCommand);
Procedure AddCommand(Var First: PMemCommand; Buffer: PChar; Size: Integer);
Procedure DeleteTopCommand(Var First: PMemCommand);
Function GetCommandCount(First: PMemCommand): Integer;

implementation

Procedure DestroyCommand(Var First: PMemCommand);
Var
P: PMemCommand;
Begin
if First=Nil Then Exit;

P:=First^.Next;
While P<>Nil Do
Begin
FreeMem(P^.Buffer,P^.Size);
if P^.Next<>Nil Then
Begin
P:=P^.Next;
FreeMem(P^.Prev,Sizeof(TMemCommand));
End
Else
Begin
FreeMem(P,Sizeof(TMemCommand));
Break;
End;
End;

FreeMem(First^.Buffer,First^.Size);
FreeMem(First,Sizeof(TMemCommand));
First:=Nil;
End;

Function GetCommandByIndex(First: PMemCommand; Index: Integer): PMemCommand;
Var
P: PMemCommand;
N: Integer;
Begin
N:=-1;
P:=First;
While P<>Nil Do
Begin
Inc(N);
if N=Index Then
Begin
Result:=P;
Exit;
End;
P:=P^.Next;
End;
Result:=Nil;
End;

Procedure DeleteCommand(Var Node: PMemCommand);
Begin
if Node=Nil Then Exit;

if Node^.Prev<>Nil Then PMemCommand(Node^.Prev)^.Next:=Node^.Next;
if Node^.Next<>Nil Then PMemCommand(Node^.Next)^.Prev:=Node^.Prev;

FreeMem(Node^.Buffer,Node^.Size);
FreeMem(Node,Sizeof(TMemCommand));

Node:=Nil;
End;

Procedure AddCommand(Var First: PMemCommand; Buffer: PChar; Size: Integer);
Var
P: PMemCommand;
Begin
if Size<=0 Then Exit;

if First=Nil Then
Begin
GetMem(First,Sizeof(TMemCommand));
First^.Size:=Size;
GetMem(First^.Buffer,Size);
Move(Buffer^,First^.Buffer^,Size);
First^.Next:=Nil;
First^.Prev:=Nil;
End
Else
Begin
P:=First;
While P^.Next<>Nil Do
Begin
P:=P^.Next;
End;
GetMem(P^.Next,Sizeof(TMemCommand));
PMemCommand(P^.Next)^.Prev:=P;
P:=P^.Next;
P^.Size:=Size;
GetMem(P^.Buffer,Size);
Move(Buffer^,P^.Buffer^,Size);
P^.Next:=Nil;
End;
End;

Procedure DeleteTopCommand(Var First: PMemCommand);
Begin
if First=Nil Then Exit;

if First^.Next<>Nil Then
Begin
FreeMem(First^.Buffer,First^.Size);
First:=First^.Next;
FreeMem(First^.Prev,Sizeof(TMemCommand));
First^.Prev:=Nil;
End
Else
Begin
FreeMem(First^.Buffer,First^.Size);
FreeMem(First,Sizeof(TMemCommand));
First:=Nil;
End;
End;

Function GetCommandCount(First: PMemCommand): Integer;
Var
P: PMemCommand;
Begin
if First=Nil Then
Begin
Result:=0;
Exit;
End;

P:=First;
Result:=1;
While P^.Next<>Nil Do
Begin
Inc(Result);
P:=P^.Next;
End;
End;

end.

//=========================================================================
//=
//= 协议实现主体
//=
//=========================================================================
Unit Transmit;

interface

Uses Windows,Messages,Classes,Controls,SysUtils,ExtCtrls,MemCommand,
MMSystem,TransmitMedia,Modem,TransmitUDP;

Const
RepeatTimes = 3; // 重传次数
TimeOutConst = 8; // 重传间隔
FileDivBlock = 800; // 在传输过程中输出多少次OnTransmiting和OnReciving,如果输出过多会影响传输速度

REQUEST_TRANSMIT_FILE = 1; // 通知对方，请求传输文件
TRANSMITING_FILE = 2; // 正在传输数据命令
TRANSMIT_FILE_COMPLETE = 3; // 传输完毕
RESPOND_MESSAGE = 4; // 响应命令

// 命令定义
Type
TRequestTransmitFile = Packed Record // 请求传输文件命令
Command: Byte; // 命令号，一般应用256个命令就足够了
Ident: Byte; // 数据包标示
Size: DWord; // 文件长度
Name: Array [0..63] of Char; // 文件名称（不包含路径）
End;
PRequestTransmitFile = ^TRequestTransmitFile;

TTransmitFile = Packed Record // 文件数据包
Command: Byte; // 命令号
Ident: Byte; // 数据报标示
PackageNo: DWord; // 该包数据在文件中的位置
Data: Array [0..PackageSize-1] of Char; // 数据
End;
PTransmitFile = ^TTransmitFile;

TRespond = Packed Record // 响应命令
Command: Byte; // 命令号
Ident: Byte; // 数据包标示
Request: Byte; // 所响应的命令号
Result: ShortInt; // 执行结果 0=正常 -1=错误
Param: Integer; // 返回参数
End;
PRespond = ^TRespond;

TGeneric = Packed Record // 通用命令结构
Command: Byte;
Ident: Byte;
End;
PCommand = ^TGeneric;

TimeStamp = Packed Record // 时间戳
Start: DWord; // 传输时间
Times: Integer; // 已重传次数
End;
PTimeStamp = ^TimeStamp;

// 状态定义
Type
TTransmitStatus = Packed Record // 传输状态
FileName: Array [0..MAX_PATH-1] of Char; // 正在传输文件名
FileSize: DWord; // 文件大小
StartTime: DWord; // 开始传输时间
EndTime: DWord; // 结束传输时间
End;

Type
TOnCommand = Procedure (Command: DWord; Buffer: PChar; Size: Integer; Var Result,Param: Integer) of Object;
TOnRecvPackAge = Procedure (Command: DWord; Buffer: PChar; Size: Integer) of Object;
TOnStart = Procedure (FileName: String; FileSize: DWord) of Object;
TOnTransmiting = Procedure (FileName: String; FileSize,Transmited: DWord; elapse: DWord) of Object;
TOnComplete = Procedure (FileName: String; FileSize: DWord; StartTime,EndTime: DWord) of Object;
TOnError = Procedure (Count: Integer) of Object;

TTransmit = Class (TWinControl)
Private
FStatus: TTransmitStatus;
FResend: PMemCommand;
FChannel: TTransmitChannel;
FIdent: Byte;
FTimer: TTimer;
FErrCount: Integer;
FProgress: Integer;
FOnError: TOnError;
FOnStartTransmit: TOnStart;
FOnTransmiting: TOnTransmiting;
FOnTransmited: TOnComplete;
FOnStartRecive: TOnStart;
FOnReciving: TOnTransmiting;
FOnRecived: TOnComplete;
FOnTimeOut: TNotifyEvent;
FOnPackAge: TOnRecvPackAge;
FOnCommand: TOnCommand;
Private
FBuffer: Array [0..MaxPackAgeSize-1] of Char;
FRecv: THandle;
FSend: THandle;
FExpect: DWord;
FPackage: DWord;
Private
Procedure InsertCommand(Var CmdList: PMemCommand; Buffer: PChar; Size: Integer);
Procedure DeleteResendCommand(Command,Ident: Byte);
Function AssemblePackAge(Dest,Source: PChar; Size: Integer): Integer;
Function DisAssemblePackage(Dest,Source: PChar; Size: Integer): Integer;
Procedure RecivePackAge(Buffer: PChar; Size: Integer);
Procedure Respond(Request: Byte; Result: ShortInt; Param: Integer; Ident: Byte);
Procedure TransmitNextFileBlock;
Procedure Timer(Sender: TObject);
Procedure ProcessPackAge(Buffer: PChar; Size: Integer);
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Function Open: Integer;
Procedure Close;
Procedure Connect;
Procedure Write(Command: DWord; Param: PChar; Size: Integer);
Procedure TransmitFile(FileName: String);
Published
Property Channel: TTransmitChannel Read FChannel Write FChannel;

Property OnStartTransmit: TOnStart Read FOnStartTransmit Write FOnStartTransmit;
Property OnTransmiting: TOnTransmiting Read FOnTransmiting Write FOnTransmiting;
Property OnTransmited: TOnComplete Read FOnTransmited Write FOnTransmited;

Property OnStartRecive: TOnStart Read FOnStartRecive Write FOnStartRecive;
Property OnReciving: TOnTransmiting Read FOnReciving Write FOnReciving;
Property OnRecived: TOnComplete Read FOnRecived Write FOnRecived;

Property OnTimeOut: TNotifyEvent Read FOnTimeOut Write FOnTimeOut;
Property OnPackAge: TOnRecvPackAge Read FOnPackAge Write FOnPackAge;
Property OnCommand: TOnCommand Read FOnCommand Write FOnCommand;

Property OnError: TOnError Read FOnError Write FOnError;
End;

implementation

Constructor TTransmit.Create(AOwner: TComponent);
Begin
Inherited Create(AOwner);

FChannel:=TUDPChannel.Create(Self);
FChannel.OnPackAge:=RecivePackage;

// 如要使用MODEM,COM
//FChannel:=TModemChannel.Create(Self);
//FChannel.OnPackAge:=RecivePackAge;

FRecv:=INVALID_HANDLE_VALUE;
FSend:=INVALID_HANDLE_VALUE;
FTimer:=TTimer.Create(Self);
FTimer.Interval:=TimeOutConst*1000;
FTimer.Enabled:=False;
FTimer.OnTimer:=Timer;

FResend:=Nil;
FErrCount:=0;
FIdent:=0;
End;

Destructor TTransmit.Destroy;
Begin
DestroyCommand(FReSend);
FChannel.Free;
Inherited Destroy;
End;

Procedure TTransmit.Timer(Sender: TObject); // 重传定时器，该定时器如果执行，都是一些要重传的数据
Var
P: PMemCommand;
Begin
FTimer.Enabled:=False;

if FReSend=Nil Then Exit;

P:=FReSend;
While P<>Nil Do
Begin
if PTimeStamp(P^.Buffer)^.Times<RepeatTimes Then // 如果重传次数小于最大重传次数
Begin
if PTimeStamp(P^.Buffer)^.Start+TimeOutConst*1000<timeGetTime Then // 判断是否到重传时间
Begin
FChannel.Write(FBuffer,AssemblePackAge(FBuffer,PChar(P^.Buffer)+Sizeof(TimeStamp),P^.Size-Sizeof(TimeStamp)));
Inc(PTimeStamp(P^.Buffer)^.Times);
PTimeStamp(P^.Buffer)^.Start:=timeGetTime;
Inc(FErrCount);
End;
End
Else
Begin
if P=FReSend Then FReSend:=Nil;

DeleteCommand(P);
if Assigned(FOnTimeOut) Then FOnTimeOut(Self); // 调用OnTimeOut方法
if FSend<>INVALID_HANDLE_VALUE Then // 关闭打开文件
Begin
CloseHandle(FSend);
FSend:=INVALID_HANDLE_VALUE;
End;
if FRecv<>INVALID_HANDLE_VALUE Then
Begin
CloseHandle(FSend);
FRecv:=INVALID_HANDLE_VALUE;
End;
Break;
End;
P:=P^.Next;
End;

if Assigned(FOnError) Then FOnError(FErrCount);

if FReSend<>Nil Then FTimer.Enabled:=True;
End;

Procedure TTransmit.InsertCommand(Var CmdList: PMemCommand; Buffer: PChar; Size: Integer);
Var
P: PChar;
Stamp: TimeStamp;
Begin
if PCommand(Buffer)^.Command<>RESPOND_MESSAGE Then // 如果是响应命令无需缓存
Begin
Stamp.Start:=timeGetTime; // 打上时间戳
Stamp.Times:=0;

PCommand(Buffer)^.Ident:=FIdent;
GetMem(P,Size+Sizeof(TimeStamp));
Move(Stamp,P^,Sizeof(TimeStamp));
Move(Buffer^,(P+Sizeof(TimeStamp))^,Size);
AddCommand(CmdList,P,Size+Sizeof(TimeStamp)); // 加入缓存
FreeMem(P,Size+Sizeof(TimeStamp));
Inc(FIdent);
FTimer.Enabled:=True;
End;
FChannel.Write(FBuffer,AssemblePackAge(FBuffer,Buffer,Size)); // 向传输媒介写入
End;

Procedure TTransmit.DeleteResendCommand(Command,Ident: Byte); // 删除特定的数据包
Var
P: PMemCommand;
Begin
if FReSend=Nil Then Exit;

P:=FReSend;
While P<>Nil Do
Begin
if (PCommand(PChar(P^.Buffer)+Sizeof(TimeStamp))^.Command=Command) And (PCommand(PChar(P^.Buffer)+Sizeof(TimeStamp))^.Ident=Ident) Then
Begin
if P=FReSend Then DeleteTopCommand(FReSend)
Else DeleteCommand(P);
Break;
End;
P:=P^.Next;
End;
End;

Function TTransmit.Open: Integer;
Begin
Result:=FChannel.Open;
End;

Procedure TTransmit.Connect;
Begin
FChannel.Connect;
End;

Procedure TTransmit.Close;
Begin
FChannel.Close;
End;

//===========================================================================
//= 关于数据组帧
//= 为了在流式传输媒体上传输数据，必须进行数据组帧，组帧的目的是能在一堆数据中
//= 找出数据帧的起始点，然后能将数据从这堆数据中分离出来，这里采用的是字符填充
//= 法，字符填充法的实现方法是： 选取某字符作为转义字符，如果数据帧内出现系统
//= 定义的特殊字符或转义字符本身，那就在该字符前插入转义字符并对特殊字符进行某
//= 种运算后的结果去替代特殊字符，这样接收方在碰到转义字符后将其从数据帧中去掉
//= 并对其后字符后进行相应的逆运算即可得到原始的数据帧。 关于这种方法的更多
//= 描述可找一些网络基础教程来看，我推荐一本由熊桂喜翻译的，大约30多块
//=
//= 校验方式
//= 本程序采用累加和校验方式，为了适应一些要求严格校验的场合，这里推荐一种16位
//= CRC校验方法
//= Const
//= CRCTableHi:Array [0..255] of Byte=($00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
//= $40, $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0,
//= $80, $41, $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01,
//= $C0, $80, $41, $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41,
//= $00, $C1, $81, $40, $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81,
//= $40, $01, $C0, $80, $41, $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0,
//= $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80, $41, $01,
//= $C0, $80, $41, $00, $C1, $81, $40, $01, $C0, $80, $41, $00, $C1, $81, $40,
//= $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
//= $40, $00, $C1, $81, $40, $01, $C0, $80, $41, $00, $C1, $81, $40, $01, $C0,
//= $80, $41, $01, $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01,
//= $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81, $40, $01, $C0, $80, $41,
//= $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80, $41, $00, $C1, $81,
//= $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81, $40, $01, $C0,
//= $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80, $41, $01,
//= $C0, $80, $41, $00, $C1, $81, $40, $00, $C1, $81, $40, $01, $C0, $80, $41,
//= $00, $C1, $81, $40, $01, $C0, $80, $41, $01, $C0, $80, $41, $00, $C1, $81,
//= $40);
//=
//= CRCTableLo:Array [0..255] of Byte=($00, $C0, $C1, $01, $C3, $03, $02, $C2, $C6, $06, $07, $C7, $05, $C5, $C4,
//= $04, $CC, $0C, $0D, $CD, $0F, $CF, $CE, $0E, $0A, $CA, $CB, $0B, $C9, $09,
//= $08, $C8, $D8, $18, $19, $D9, $1B, $DB, $DA, $1A, $1E, $DE, $DF, $1F, $DD,
//= $1D, $1C, $DC, $14, $D4, $D5, $15, $D7, $17, $16, $D6, $D2, $12, $13, $D3,
//= $11, $D1, $D0, $10, $F0, $30, $31, $F1, $33, $F3, $F2, $32, $36, $F6, $F7,
//= $37, $F5, $35, $34, $F4, $3C, $FC, $FD, $3D, $FF, $3F, $3E, $FE, $FA, $3A,
//= $3B, $FB, $39, $F9, $F8, $38, $28, $E8, $E9, $29, $EB, $2B, $2A, $EA, $EE,
//= $2E, $2F, $EF, $2D, $ED, $EC, $2C, $E4, $24, $25, $E5, $27, $E7, $E6, $26,
//= $22, $E2, $E3, $23, $E1, $21, $20, $E0, $A0, $60, $61, $A1, $63, $A3, $A2,
//= $62, $66, $A6, $A7, $67, $A5, $65, $64, $A4, $6C, $AC, $AD, $6D, $AF, $6F,
//= $6E, $AE, $AA, $6A, $6B, $AB, $69, $A9, $A8, $68, $78, $B8, $B9, $79, $BB,
//= $7B, $7A, $BA, $BE, $7E, $7F, $BF, $7D, $BD, $BC, $7C, $B4, $74, $75, $B5,
//= $77, $B7, $B6, $76, $72, $B2, $B3, $73, $B1, $71, $70, $B0, $50, $90, $91,
//= $51, $93, $53, $52, $92, $96, $56, $57, $97, $55, $95, $94, $54, $9C, $5C,
//= $5D, $9D, $5F, $9F, $9E, $5E, $5A, $9A, $9B, $5B, $99, $59, $58, $98, $88,
//= $48, $49, $89, $4B, $8B, $8A, $4A, $4E, $8E, $8F, $4F, $8D, $4D, $4C, $8C,
//= $44, $84, $85, $45, $87, $47, $46, $86, $82, $42, $43, $83, $41, $81, $80,
//= $40);
//= Function CreateCRCCode(BufferChar;Len:Integer):Word;
//= Var
//= Loop:Integer;
//= CRCHi,CRCLo:Byte;
//= Index:Word;
//= Begin
//= CRCHi:=$FF;
//= CRCLo:=$FF;
//= For Loop:=0 To Len-1 Do
//= Begin
//= Index:=Byte((Buffer+Loop)^) Xor CRCHi;
//= CRCHi:=CRCLo Xor CRCTableHi[Index];
//= CRCLo:=CRCTableLo[Index];
//= End;
//= Result:=(CRCHi Shl 8) Or CRCLo;
//= End;
//===========================================================================

Function TTransmit.AssemblePackAge(Dest,Source: PChar; Size: Integer): Integer; //数据组帧
Var
N: Integer;
C: Integer;
Check: Byte;
Begin
Dest^:=#$55;
C:=1;
Check:=0;
For N:=1 To Size Do
Begin
Case Byte(Source^) of
$55:
Begin
(Dest+C)^:=#$AA;
(Dest+C+1)^:=#$56;
Inc(C,2);
End;
$CC:
Begin
(Dest+C)^:=#$AA;
(Dest+C+1)^:=#$CD;
Inc(C,2);
End;
$AA:
Begin
(Dest+C)^:=#$AA;
(Dest+C+1)^:=#$AB;
Inc(C,2);
End;
Else
Begin
(Dest+C)^:=Source^;
Inc(C);
End;
End;
Check:=Check+Byte(Source^); // 累加和,如果传输错误率控制严格可采用16位CRC校验方式
Source:=Source+1;
if C >= MaxPackAgeSize-2 Then
Begin
Result:=-1;
Exit;
End;
End;
Case Check of
$55:
Begin
(Dest+C)^:=#$AA;
(Dest+C+1)^:=#$56;
Inc(C,2);
End;
$CC:
Begin
(Dest+C)^:=#$AA;
(Dest+C+1)^:=#$CD;
Inc(C,2);
End;
$AA:
Begin
(Dest+C)^:=#$AA;
(Dest+C+1)^:=#$AB;
Inc(C,2);
End;
Else
Begin
(Dest+C)^:=Char(Check);
Inc(C);
End;
End;
(Dest+C)^:=#$CC;
Result:=C+1;
End;

Function TTransmit.DisAssemblePackage(Dest,Source: PChar; Size: Integer): Integer; // 数据解包
Var
N,C: Integer;
Check: Byte;
Begin
Result:=-1;
if Size<=0 Then Exit;
if (Source^=#$55) And ((Source+Size-1)^=#$CC) Then
Begin
N:=1;
C:=0;
While N<Size-1 Do
Begin
if (Source+N)^=#$AA Then
Begin
(Dest+C)^:=Char(Byte((Source+N+1)^)-1);
Inc(C);
Inc(N);
End
Else
Begin
(Dest+C)^:=(Source+N)^;
Inc(C);
End;
Inc(N);
End;
Check:=0;
For N:=0 To C-2 Do
Begin
Check:=Check+Byte((Dest+N)^);
End;
if (C<>0) And (Check=Byte((Dest+C-1)^)) Then Result:=C-1;
End;
End;

Procedure TTransmit.RecivePackAge(Buffer: PChar; Size: Integer); // 挂接到传输媒介的OnPackAge上
Var
S: Integer;
Begin
S:=DisassemblePackAge(FBuffer,Buffer,Size);
if S<>-1 Then
Begin
ProcessPackAge(FBuffer,S);
End;
End;

Procedure TTransmit.ProcessPackAge(Buffer: PChar; Size: Integer); // 处理信息包
Var
WSize: DWord;
Result,Param: Integer;
Begin
Case PCommand(Buffer)^.Command of
TRANSMITING_FILE: // 正在传输文件
Begin
if FRecv=INVALID_HANDLE_VALUE Then Exit; // 如果开始没有收到过REQUEST_TRANSMIT_FILE，说明该包无效

if PTransmitFile(Buffer)^.PackageNo<>FExpect Then // 如果不是希望的数据包
Begin
Respond(TRANSMITING_FILE,-1,FExpect,PCommand(Buffer)^.Ident); // 通知对方希望收到哪个数据包
Exit;
End;

SetFilePointer(FRecv,FExpect*PackAgeSize,Nil,File_Begin); // 定位
WriteFile(FRecv,PTransmitFile(Buffer)^.Data,Size-(Sizeof(TTransmitFile)-PackAgeSize),WSize,Nil); // 写入文件
Inc(FExpect);
Respond(TRANSMITING_FILE,0,FExpect,PCommand(Buffer)^.Ident); // 通知对方已正确执行

if Assigned(FOnReciving) Then
Begin
if Integer((FExpect*PackAgeSize) Div (FStatus.FileSize Div FileDivBlock))>FProgress Then // 为了不让用户过程影响传输速率，
// 人为规定多长时间调用用户过程
Begin
FOnReciving(FStatus.FileName,FStatus.FileSize,FExpect*PackAgeSize,timeGetTime-FStatus.StartTime);
Inc(FProgress);
End;
End;
FTimer.Enabled:=False;
FTimer.Enabled:=True;
End;
REQUEST_TRANSMIT_FILE: // 对方请求传输文件
Begin
if FRecv<>INVALID_HANDLE_VALUE Then CloseHandle(FRecv);

FRecv:=CreateFile(PRequestTransmitFile(Buffer)^.Name,Generic_Write,File_Share_Read Or File_Share_Write,Nil,Create_Always,File_Attribute_Normal,0);
if FRecv=INVALID_HANDLE_VALUE Then
Begin
Respond(REQUEST_TRANSMIT_FILE,-1,0,PCommand(Buffer)^.Ident);
Exit;
End;

FExpect:=0;
FProgress:=0;

StrLCopy(FStatus.FileName,PRequestTransmitFile(Buffer)^.Name,MAX_PATH);
FStatus.FileSize:=PRequestTransmitFile(Buffer)^.Size;
FStatus.StartTime:=timeGetTime;
if Assigned(FOnStartRecive) Then FOnStartRecive(FStatus.FileName,FStatus.FileSize);
Respond(REQUEST_TRANSMIT_FILE,0,0,PCommand(Buffer)^.Ident);
FTimer.Enabled:=False;
FTimer.Enabled:=True;
End;
TRANSMIT_FILE_COMPLETE: // 对方通知文件传输完毕
Begin
if FRecv=INVALID_HANDLE_VALUE Then Exit;

CloseHandle(FRecv);
Respond(TRANSMIT_FILE_COMPLETE,0,0,PCommand(Buffer)^.Ident);
FRecv:=INVALID_HANDLE_VALUE;

if Assigned(FOnRecived) Then FOnRecived(FStatus.FileName,FStatus.FileSize,FStatus.StartTime,timeGetTime);
End;
RESPOND_MESSAGE: // 收到应答消息
Begin
if PRespond(Buffer)^.Result=0 Then // 如果执行结果正确,从重发队列中删除该数据包
Begin
DeleteReSendCommand(PRespond(Buffer)^.Request,PRespond(Buffer)^.Ident);
End;
Case PRespond(Buffer)^.Request of
REQUEST_TRANSMIT_FILE:
Begin
if PRespond(Buffer)^.Result=0 Then // 如果对方正确响应请求传输文件命令
Begin
FPackAge:=0;
FProgress:=0;
For WSize:=0 To MoveWindow-1 Do TransmitNextFileBlock;
if Assigned(FOnStartTransmit) Then FOnStartTransmit(FStatus.FileName,FStatus.FileSize);
End;
End;
TRANSMITING_FILE:
Begin
if PRespond(Buffer)^.Result=0 Then // 如果对方正确响应文件数据包
Begin
if Assigned(FOnTransmiting) Then
Begin
if (PRespond(Buffer)^.Param*PackAgeSize) Div (Integer(FStatus.FileSize) Div FileDivBlock)>FProgress Then
Begin
FOnTransmiting(FStatus.FileName,FStatus.FileSize,PRespond(Buffer)^.Param*PackAgeSize,timeGetTime-FStatus.StartTime);
Inc(FProgress);
End;
End;
if FSend<>INVALID_HANDLE_VALUE Then
Begin
if GetCommandCount(FReSend)<MoveWindow Then // 如果重发队列中数据包数目小于滑动窗口大小，填满
Begin
For WSize:=0 To MoveWindow-GetCommandCount(FReSend)-1 Do
Begin
TransmitNextFileBlock;
End;
End;
End;
End;
End;
TRANSMIT_FILE_COMPLETE: // 对方正确收到文件传输结束
Begin
if Assigned(FOnTransmited) Then FOnTransmited(FStatus.FileName,FStatus.FileSize,FStatus.StartTime,timeGetTime);
End;
End;
End;
Else // 如果是用户自己的消息，调用OnCommand方法，让用户自己判断正确与否
Begin
Result:=0;
Param:=0;
if Assigned(FOnCommand) Then FOnCommand(PCommand(Buffer)^.Command,Buffer+Sizeof(TGeneric),Size-Sizeof(TGeneric),Result,Param);
Respond(PCommand(Buffer)^.Command,Result,Param,PCommand(Buffer)^.Ident);
End;
End;
End;

Procedure TTransmit.Respond(Request: Byte; Result:ShortInt; Param: Integer; Ident: Byte);
Var
RespondCmd: TRespond;
Begin
RespondCmd.Command:=RESPOND_MESSAGE;
RespondCmd.Ident:=Ident;
RespondCmd.Request:=Request;
RespondCmd.Result:=Result;
RespondCmd.Param:=Param;
InsertCommand(FReSend,@RespondCmd,Sizeof(TRespond));
End;

Procedure TTransmit.TransmitNextFileBlock; // 传输下一文件块
Var
RSize: DWord;
Cmd: TTransmitFile;
Begin
if FSend<>INVALID_HANDLE_VALUE Then
Begin
Cmd.Command:=TRANSMITING_FILE;
Cmd.PackageNo:=FPackage;
ReadFile(FSend,Cmd.Data,PackAgeSize,RSize,Nil);
if RSize<>0 Then InsertCommand(FReSend,@Cmd,RSize+(Sizeof(TTransmitFile)-PackAgeSize))
Else
Begin
CloseHandle(FSend);
Cmd.Command:=TRANSMIT_FILE_COMPLETE;
InsertCommand(FReSend,@Cmd,Sizeof(TGeneric));
FSend:=INVALID_HANDLE_VALUE;
End;
Inc(FPackAge);
End;
End;

Procedure TTransmit.TransmitFile(FileName: String);
Var
Request: TRequestTransmitFile;
Begin
FSend:=CreateFile(PChar(FileName),Generic_Read,File_Share_Read Or File_Share_Write,Nil,Open_Existing,File_Attribute_Normal,0);
if FSend=INVALID_HANDLE_VALUE Then Exit;

StrPCopy(FStatus.FileName,FileName);
FStatus.StartTime:=timeGetTime;
FStatus.FileSize:=GetFileSize(FSend,Nil);
FErrCount:=0;

FillChar(Request,Sizeof(TRequestTransmitFile),0);
Request.Command:=REQUEST_TRANSMIT_FILE;
Request.Size:=FStatus.FileSize;
StrPCopy(Request.Name,ExtractFileName(FileName));
InsertCommand(FReSend,@Request,Sizeof(TRequestTransmitFile));
End;

Procedure TTransmit.Write(Command: DWord; Param: PChar; Size: Integer); // 用户接口,用户需按TGeneric定义的命令发送消息
Var
P: Pointer;
Begin
GetMem(P,Size+Sizeof(TGeneric));
PCommand(P)^.Command:=Command;
Move(Param^,(PChar(P)+Sizeof(TGeneric))^,Size);
InsertCommand(FReSend,P,Size+Sizeof(TGeneric));
FreeMem(P,Size+Sizeof(TGeneric));
End;

end.

上面的程序编制得不是非常好，有一些漏洞，希望能和有协议编程经验的朋友一起把这个专题讨论到无需再讨论，同时也为能帮助一些困
惑于此的朋友感到高兴

上面的程序经过调试在100M网络的环境上速度可达到2.5MByte/S左右，在10M网络上可达到650K左右, 还有该程序没有包含MODEM和串口的
实现方法，有兴趣的网友可自己实现，如果转载该文章，请注明出处，其中必须注明出自DFW，如果对程序作了修改，请与大家一起分享，
最后希望DFW能有更多的朋友共享自己的源码，能对更多的专题进行讨论

TK128 2002.12.30

收藏！
也向开源的各位致敬

UDP太麻烦，要自己控制流量，还不如用TCP，开线程，如果有别的机器也想你的
这个UDP端口里发数据，你就无法判断了，总之安全性不够，还有其他一些问题

To 无忌兄:
你的问题切中要害，如果有其他计算机向这个端口发送数据就会产生错误，目前这个
程序中的确存在这个问题，我对这个问题的解决思路是： 在一定时间内，程序只接收
某个IP和端口发来的数据，这需要完善UDP传输通道程序，还有设计这样的协议目的其实
不仅是为了使用UDP，而是要适应于其他媒介，如：MODEM,串口等流式传输设备，采用UDP
其实是为了简单而已

你可以显式调用connect来解决这个问题，这样就有一个唯一的UDP‘连接’了
对了，你可以看看TFTP协议和看TCP控制流量等一些代码，TFTP是用UDP传文件，
总之，做完善不容易呀，好好努力，我能帮你的一定帮你

谢谢无忌兄
我的目的是抛砖引玉，因为我觉得DFW上一些专题的讨论太少了，而且程度不够，所以希望
能为DFW尽自己的一分力，在此向DFW提议，一段时间是否能针对一些专题发起一些讨论，
这样才能提高整个DFW的水准

to TK128
你可以用，DELPHI7的INDY这组控件。
采用的是TCP协议，支持多线程，而且也可以监控流量。
如果你用得是DELPHI6,那么可以去http://www.nevrona.com/indy/下载一个。
下面是我写的部分代码：

SERVER

procedure TFrmUpdate.StartServerClick(Sender: TObject);
begin
with TCPServer do
begin
Active := False;
DefaultPort := StrToInt(EdPort.Text);
Active := True;
LogMemo.Lines.Add(DateTimeToStr(Now)+'　服务已经启动！(Port: '+EdPort.Text+')');
end;
end;

procedure TFrmUpdate.StopServerClick(Sender: TObject);
begin
with TCPServer do
begin
Active := False;
LogMemo.Lines.Add(DateTimeToStr(Now)+'　服务已经停止！');
end;
end;

procedure TFrmUpdate.TCPServerExecute(AThread: TIdPeerThread);
var
FileStream: TFileStream;
FileSize: Int64;
FileStr: String;
begin
with AThread.Connection do
begin
while Connected do
begin
FileStr := ReadLn;
if FileExists(ExtractFilePath(Application.ExeName)+FileStr) then
FileStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+FileStr,fmOpenRead)
else
begin
LogMemo.Lines.Add(DateTimeToStr(Now)+'　'+FileStr+'　没有找到！');
FileStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+'Error.dll',fmOpenRead);
end;

try
FileSize := FileStream.Size;
WriteStream(FileStream,True,True,FileSize);
finally
fileStream.Free;
end;
end;
end;
end;

procedure TFrmUpdate.TCPServerConnect(AThread: TIdPeerThread);
begin
LogMemo.Lines.Add(InttoStr(AThread.ThreadID));
end;

CLIENT

procedure TFrmUpdate.TCPClientWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AWorkMode = wmRead then
begin
CurNum.Caption := IntToStr(AWorkCount);
ProgressBar1.Position := AWorkCount;
Update;
end;
end;

procedure TFrmUpdate.BeginUpdateClick(Sender: TObject);
var
FileStream: TFileStream;
i: Integer;
begin
if FuncObj.IniInfo['Update','EnUpdate']<>'True' then
begin
FuncObj.Prompt('升级功能被禁止！');
Exit;
end;

with TCPClient do
begin
Port := StrToInt(FuncObj.IniInfo['Update','Port']);

if FuncObj.IniInfo['Update','Host']='' then
Host := FuncObj.ServerIP
else
Host := FuncObj.IniInfo['Update','Host'];

if not Connected then
begin
try
Connect;
except
FuncObj.Prompt('升级服务没有开启！');
end;
end;

for i := 0 to FileListBox.Items.Count-1 do
begin
if FileListBox.Checked then
begin
FName.Caption := '';
FName.Update;
FileList.First;
while not FileList.Eof do
begin
if VartoStr(FileList.FieldValues['RightName'])=FileListBox.Items.Strings then
begin
FName.Caption := FileList.FieldValues['ModuleName'];
FName.Update;
Break;
end;
FileList.Next;
end;
WriteLn(FileList.FieldValues['ModuleName']+'.dll');

try
FileStream := TFileStream.Create(ExtractFilePath(Application.ExeName)+FileList.FieldValues['ModuleName']+'.dll',fmCreate);
ReadStream(FileStream,-1,False);
finally
FileStream.Free;
end;
end;
end;
FuncObj.Prompt('升级正常完成！');
Close;
end;
end;

procedure TFrmUpdate.TCPClientWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
TolNum.Caption := InttoStr(StrToInt(TolNum.Caption)+StrToInt(CurNum.Caption));
end;

由于是从程序出截取的部分代码，所以可能有不相关的垃圾。[]
希望对你有用。

上面的代码发送数据部分太简单，考虑的不太全面

谢谢cola:
制定这个协议的时候我主要目的是为了进行远程维护，所以这个协议是和ZModem协议比较
的，因为我手头没有ZModem协议的资料，所以自己设计了这个协议，这个协议有个天生的缺
陷，就是没有考虑多网状传送模式，既多对多的模式，但在单点模式时这个协议能工作得很
好，同时这个程序因为主要介绍一些Delphi编程概念和协议设计概念因此都采用最基本的函
数没有使用任何控件，就像MemCommand单元一样，仅使用GetMem和FreeMem，同时采用数据
结构中的链表方式来解决滑动窗口的问题，这个程序主要要突出的是怎么用一些最基本的
元素来构建程序

to 张无忌：
谢谢提醒，望赐教。

WriteStream函数最好自己该写，提高稳定性

gz

学习

好！

顶

同意张无忌

up

有没有调用的demo？

学习