unit DTPClient;
interface
uses
CommClient, Classes;
const
DEFAULT_TTL = 86400*30*3; //缺省生存周期
DEFAULT_PATH= './Received_Files'; //指定目录无法创建时, 文件保存位置
type
//数据包头
TDTPPacket = packed record
Source : String; //源地址
Destination : String; //目标地址
Command : String; //命令码
Data : String; //数据
Context : String; //附加参数
FileName : String; //如果不为空表示还需要发送文件
Memo : String; //备注字段
end;
//数据包到达通知事件
TDTPDataEvent = procedure (Sender: TObject; aDTPPacket: TDTPPacket; out aAction: Integer) of object;
//数据传送客户端
TDTPClient = class(TCommClient)
private
FOnDTPData : TDTPDataEvent;
function ReadStringFromStream(aStream: TStream): String;
procedure WriteStringToStream(aStream: TStream; const aString: String);
protected
procedure setOnData(aValue: TOnDataEvent); override; //
procedure OnRecv(Sender: TObject; aData: TStream; const aSource: String; out aAction: Integer);
public
constructor Create(aOwner: TComponent); override;
function SendData(const aDTPPacket: TDTPPacket; aTTL: Integer=DEFAULT_TTL): Integer;
published
property OnDTPData: TDTPDataEvent read FOnDTPData write FOnDTPData;
end;
procedure Register;
implementation
uses
SysUtils, LogFiles, Windows;
procedure Register;
begin
RegisterComponents('Samples', [TDTPClient]);
end;
constructor TDTPClient.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
OnData := OnRecv;
end;
function TDTPClient.SendData(const aDTPPacket: TDTPPacket; aTTL: Integer=DEFAULT_TTL): Integer;
var
Stream : TMemoryStream;
aFile : TFileStream;
FileSize: Integer;
Packet : TDTPPacket;
begin
Result := -1;
Packet := aDTPPacket;
//文件不存在
if not FileExists(Packet.FileName) then Packet.FileName := '';
Stream := TMemoryStream.Create;
try
try
//将包头写入流中
Stream.Seek(0, soFromBeginning);
with Packet do
begin
// WriteStringToStream(Stream, Source); 源地址不发送, 自动添加
WriteStringToStream(Stream, Destination);
WriteStringToStream(Stream, Command);
WriteStringToStream(Stream, Data);
WriteStringToStream(Stream, Context);
WriteStringToStream(Stream, FileName);
WriteStringToStream(Stream, Memo);
end;
//如果需要发送文件, 将文件写入流中
if Trim(Packet.FileName) <> '' then
try
aFile := TFileStream.Create(Packet.FileName, fmOpenRead);
try
FileSize := aFile.Size;
aFile.Seek(0, soFromBeginning);
Stream.Write(FileSize, SizeOf(FileSize)); //将文件尺寸写入流中
Stream.CopyFrom(aFile, FileSize); //将文件内容写入流中
finally
aFile.Free;
end;
except
on E: Exception do
begin
TLogFile.WriteLn('读取需要发送的文件失败, 错误信息="%s"', [E.Message]);
end;
end;
//发送
Result := Send(Stream, aDTPPacket.Destination, aTTL);
except
//发送失败
on E: Exception do
begin
TLogFile.WriteLn('数据发送失败, 错误信息="%s"', [E.Message]);
end;
end;
finally
Stream.Free;
end;
end;
procedure TDTPClient.setOnData(aValue: TOnDataEvent);
begin
inherited setOnData(OnRecv);
end;
function TDTPClient.ReadStringFromStream(aStream: TStream): String;
var
Len : Integer;
Str : String;
begin
try
Str := '';
aStream.Read(Len, SizeOf(Len)); //从流中读入字符串长度
if Len > 0 then
begin
SetLength(Str, Len);
aStream.Read(Str[1], Len); //从流中读入字符串
end;
except
on E: Exception do
begin
Str := '';
end;
end;
Result := Str;
end;
procedure TDTPClient.WriteStringToStream(aStream: TStream; const aString: String);
var
Len : Integer;
begin
Len := Length(aString);
aStream.Write(Len, SizeOf(Len)); //向流中写字符串长度
if Len > 0 then aStream.Write(aString[1], Len); //向流中写字符串
end;
procedure TDTPClient.OnRecv(Sender: TObject; aData: TStream; const aSource: String; out aAction: Integer);
var
Stream : TFileStream;
DTPPacket : TDTPPacket;
FileSize : Integer;
FilePath : String;
FileName : String;
isInvalidPath : Boolean;
begin
//解析包头
aData.Seek(0, soFromBeginning);
with DTPPacket do
begin
// Source := ReadStringFromStream(aData);
Source := aSource; //源地址为实际发送方地址, 自动获取
Destination := ReadStringFromStream(aData);
Command := ReadStringFromStream(aData);
Data := ReadStringFromStream(aData);
Context := ReadStringFromStream(aData);
FileName := ReadStringFromStream(aData);
Memo := ReadStringFromStream(aData);
end;
//如果包中含有文件
FileName := DTPPacket.FileName;
if Trim(FileName) <> '' then
try
//确保目标路径存在
FileName := ExpandFileName(FileName);
isInvalidPath := GetDriveType(PChar(ExtractFileDrive(FileName)+':/')) in [0, 1, DRIVE_CDROM];
FilePath := ExtractFilePath(FileName);
if isInvalidPath or (not ForceDirectories(FilePath))then
begin
//目录创建失败, 文件保存在缺省文件接收目录
FilePath := IncludeTrailingPathDelimiter(DEFAULT_PATH);
ForceDirectories(FilePath);
FileName := FilePath + ExtractFileName(FileName);
DTPPacket.FileName := ExpandFileName(FileName);
end;
Stream := TFileStream.Create(FileName, fmCreate);
try
aData.Read(FileSize, SizeOf(FileSize));
if FileSize > 0 then Stream.CopyFrom(aData, FileSize);
finally
Stream.Free;
end;
except
//接受失败, 可能是磁盘满或磁盘数据损坏
on E: Exception do
begin
TLogFile.WriteLn('保存接收到的文件失败, 错误信息="%s"', [E.Message]);
end;
end;
try
if Assigned(FOnDTPData) then FOnDTPData(Sender, DTPPacket, aAction);
except
on E: Exception do
begin
TLogFile.WriteLn('DTP数据接收事件处理失败, 错误信息="%s"', [E.Message]);
end;
end;
end;
end.
