downpicunt.pas

絮语2007视频聊天软件源程序.仅供参考

//------------------------------------------------------------------------------
//  简化了的文件传输 专门用于传输 图片
//------------------------------------------------------------------------------
unit downpicunt;

interface

uses
  Windows, SysUtils,Classes,Gauges, IdBaseComponent,IdComponent,
  IdUDPBase, IdUDPServer,IdSocketHandle, IdAntiFreezeBase,
  IdAntiFreeze,constunt,structureunt,extctrls,compress;

Type
   Tdownpic=class
    constructor Create;
    destructor  Destroy;override;
    private
      UDPServer: TIdUDPServer;
      AntiFreeze: TIdAntiFreeze;
//------------------------------------------------------------------------
      status_array:array of Byte;            //文件分块状态数组  0:none 1:request 2:complete
      cur_completecount,                     //当前文件完成数量.
      cur_filesize:integer;                  //当前文件的大小
      procedure UDPServerUDPRead(Sender: TObject; AData: TStream;ABinding: TIdSocketHandle);
      //--------------------------------------------------------------------------
      procedure sendmsgto(msg:string);
      procedure sendtoclient_fileinfor;
      procedure inceptserver_fileinfor(datstr:string);
      procedure rebuild_file_array;
      function getnextposition:integer;
      procedure send_reqeust_thread(id:integer);
      procedure startrequestsend_data;
      procedure startsendtoclient_data(infor:Tdatapack;datstr:string);
      procedure process_client_data(infor:Tdatapack;datstr:string);
      procedure initfiletran;
    public
      just_sending,
      succeedconnect,               //连接确认
      just_receiving:boolean;
      ownerhwnd:hwnd;
      sourcefile,                               //源文件
      sourcemd5,
      destfile,
      destmd5:string;                          //目的文件
      svrip,destip:string;
      svrport,destport:integer;
      procedure handshake(msgid:integer);
      procedure sendmsgtosvr(msg:string);
      procedure filetranstart;
      procedure filetranover;
    end;

implementation
uses shareunit;

//------------------------------------------------------------------------------
//  消息发送
//------------------------------------------------------------------------------
procedure Tdownpic.sendmsgto(msg:string);
begin
if succeedconnect then
udpserver.Binding.SendTo(destip,destport,msg[1],length(msg));
sleep(1);
end;

//------------------------------------------------------------------------------
// 简单命令交互
//------------------------------------------------------------------------------
procedure Tdownpic.handshake(msgid:integer);
begin
sendmsgto(makepacket(msgid,0,0));
end;

//------------------------------------------------------------------------------
// 与中转服务器进行协商
//------------------------------------------------------------------------------
procedure Tdownpic.sendmsgtosvr(msg:string);
begin
makeparamsex(msg,'language',locallanguage);
encompress(msg);//压缩
udpserver.Binding.SendTo(svrip,svrport,msg[1],length(msg));
sleep(1);
end;

//------------------------------------------------------------------------------
//  初始化组件
//------------------------------------------------------------------------------
procedure Tdownpic.initfiletran;
begin
udpserver.Bindings.clear;
udpserver.BufferSize:=65536;
udpserver.ThreadedEvent:=true;
with udpserver.Bindings.add do
  begin
  ip:='0.0.0.0';
  port:=0;
  end;
udpserver.Active:=true;
udpserver.Binding.UpdateBindingLocal;
udpserver.OnUDPRead:=UDPServerUDPRead;
end;

procedure Tdownpic.filetranstart;
begin
//开始请求文件传送...
just_receiving:=true;
handshake(xy_infor);
end;

//******************************************************************************
//为文件建立分块传输标志。文件不存就建立一个空白文件
//******************************************************************************
procedure Tdownpic.rebuild_file_array;
var arraycount:integer;
begin
status_array:=nil;
cur_completecount:=0;
arraycount:=cur_filesize div datalen;
if (cur_filesize mod datalen)>0 then inc(arraycount);
setlength(status_array,arraycount);
if (fileexists(destfile))or(cur_filesize=0) then
   begin
   handshake(xy_complete);
   postmessage(ownerhwnd,refresh_status,xy_downpic_complete,0);
   end else begin
   with tfilestream.Create(destfile,fmcreate) do free;
   startrequestsend_data;{2.开始请求传输文件内容}
   end;
end;
//******************************************************************************
//文件传交互过程
//------------------------------------------------------------------------------
{1.请求路径,文件总数,当前文件序号,当前文件名称,当前文件大小,文件MD5}
procedure Tdownpic.sendtoclient_fileinfor;
var msg:string;
begin
makeparamsex(msg,'curfilename',extractfilename(sourcefile));
makeparamsex(msg,'curfilesize',getfilesize(sourcefile));
makeparamsex(msg,'curfilemd5',sourcemd5);
sendmsgto(concat(makepacket(xy_context,0,0),msg));
end;

{1.请求路径,文件总数,当前文件序号,当前文件名称,当前文件大小
   下理收到的数据}
procedure Tdownpic.inceptserver_fileinfor(datstr:string);
var ext:string;
begin
destmd5:=getparamitem(datstr,'curfilemd5');
ext:=extractfileext(getparamitem(datstr,'curfilename'));
cur_filesize:=strtointdef(getparamitem(datstr,'curfilesize'),0);
destfile:=extractfilepath(application_name)+'images\'+destmd5+ext;
rebuild_file_array; //从文件生成 array 列表
end;


//******************************************************************************
//  定时器回调
//******************************************************************************
procedure TimerCallBack(Wnd: HWND; Msg, idEvent: UINT; dwTime: DWORD);stdcall; far; export;
begin
postmessage(Wnd,refresh_status,xy_downpic_outtime,idEvent);
end;

//设置定时器.
procedure Tdownpic.send_reqeust_thread(id:integer);
begin
   status_array[id]:=1;
   settimer(ownerhwnd,id,1500,@TimerCallBack);
   sendmsgto(makepacket(xy_detail,id,cur_completecount));
end;

//******************************************************************************
function Tdownpic.getnextposition:integer;
var i:integer;
begin
result:=-1;
for i:=cur_completecount to High(status_array) do
if status_array[i]=0 then
   begin
   result:=i;
   break;
   end;
end;

{2.开始请求传输文件内容}
procedure Tdownpic.startrequestsend_data;
var cur_position:integer;
begin
cur_position:=getnextposition;
if cur_position>=0 then
   send_reqeust_thread(cur_position);
end;

{2.开始请求传输文件内容
   处理请求}
procedure Tdownpic.startsendtoclient_data(infor:Tdatapack;datstr:string);
var m,n:integer;
    buf:string;
begin
n:=infor.curpos;
with tfilestream.Create(sourcefile,fmopenread or fmShareDenyNone) do
   try
   position:=n*datalen;
   m:=size-n*datalen;
   if m>datalen then m:=datalen;
   setlength(buf,m);
   readbuffer(buf[1],m);
   finally
   free;
   end;
sendmsgto(concat(makepacket(xy_data_detail,n,0),buf));
end;

{3.处理收到的数据 拼接文件}
procedure Tdownpic.process_client_data(infor:Tdatapack;datstr:string);
var n:integer;
begin
n:=infor.curpos;
killtimer(ownerhwnd,n);
if status_array[n]<2 then
   begin
   inc(cur_completecount);
   status_array[n]:=2;
   with tfilestream.Create(destfile,fmopenwrite or fmShareDenyNone) do
     try
     Position:=n*datalen;
     writebuffer(datstr[1],length(datstr));
     finally
     free;
     end;
   end;

if cur_completecount=high(status_array)+1 then
   begin
   handshake(xy_complete);
   postmessage(ownerhwnd,refresh_status,xy_downpic_complete,0);
   end;
end;

procedure Tdownpic.filetranover;
begin
if just_receiving then
   handshake(xy_cancel);
end;


//******************************************************************************
//接收端处理过程
//******************************************************************************
procedure Tdownpic.UDPServerUDPRead(Sender: TObject; AData: TStream;ABinding: TIdSocketHandle);
var datastr:string;
    tmpack:Tdatapack;
begin
try
adata.Seek(0,soFromBeginning);
setlength(datastr,adata.size-sizeof(Tdatapack));
adata.ReadBuffer(tmpack,sizeof(Tdatapack)); //取出msgid 和 position
adata.ReadBuffer(datastr[1],adata.size-sizeof(Tdatapack)); //取出 msgtext

case tmpack.msgid of
  xy_succeed_handshake:
     begin
     destip:=ABinding.PeerIP;
     destport:=ABinding.PeerPort;
     succeedconnect:=true;
     //连接已经确认...
     filetranstart;
     end;
     
  xy_infor:
     begin
     just_sending:=true;
     {1.请求路径,文件总数,当前文件序号,当前文件名称,当前文件大小
        返回给客户端 1}
     sendtoclient_fileinfor;
     end;

  xy_context:
     begin
     //收到文件相关信息..
     inceptserver_fileinfor(datastr);
     end;

  xy_detail:
     begin
     {2.开始请求传输文件内容
        返回给客户端}
     startsendtoclient_data(tmpack,datastr);
     end;

  xy_data_detail:
     begin
     //收到文件内容..
     startrequestsend_data;
     process_client_data(tmpack,datastr);
     end;

  xy_complete:
     begin
     just_sending:=false;
     end;

  xy_cancel:
     begin
     just_sending:=false;
     end;
     
  end;

except
logmemo.Add('Error:'+datastr);
end;
end;

//------------------------------------------------------------------------------
// 创建
//------------------------------------------------------------------------------
constructor Tdownpic.Create;
begin
UDPServer:=TIdUDPServer.Create(nil);
AntiFreeze:=TIdAntiFreeze.create(nil);
initfiletran;
end;

//------------------------------------------------------------------------------
// 释放
//------------------------------------------------------------------------------
destructor Tdownpic.Destroy;
begin
  status_array:=nil;
  UDPServer.Active:=false;
  UDPServer.free;
  AntiFreeze.free;
  inherited Destroy;
end;
end.