filetranunt.pas

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

begin
try
adata.Seek(0,soFromBeginning);
setlength(datastr,adata.size-sizeof(Tdatapack));
adata.ReadBuffer(tmpack,sizeof(Tdatapack)); //取出msgid 和 curpos,compos
adata.ReadBuffer(datastr[1],adata.size-sizeof(Tdatapack)); //取出 msgtext

case tmpack.msgid of
  xy_succeed_handshake:
     begin //连接已经确认...
     if autoaccept_file then
        begin
        okbtn.Enabled:=false;
        start_time:=time;
        just_trans_files:=true;
        handshake(xy_infor);
        end;
     end;
     
  xy_context:
     begin
     //收到文件相关信息..
     inceptserver_fileinfor(datastr);
     {2.开始请求传输文件内容}
     startrequestsend_data;
     end;

  xy_data_detail:
     begin
     trans_status_label.caption:='正在接收...';
     //收到文件内容..
     startrequestsend_data;
     process_client_data(tmpack,datastr);
     end;

  xy_complete:
     begin
     filetran_complete:=true;
     just_trans_files:=false;
     postmessage(handle,refresh_status,xy_filetran_complete,0);
     end;

  xy_cancel:
     begin
     just_trans_files:=false;
     postmessage(handle,refresh_status,xy_cancel,0);
     postmessage(handle,refresh_status,xy_filetran_complete,0);
     end;
     
  end;

except

end;
end;

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

//消息处理过程..
procedure Tfiletranfrm.process_custom_message(var msg:tmessage);
begin
case msg.WParam of
  xy_form_close:close;
  xy_cancel:udpcore.showmsgfrm('对方取消了文件传输!');
  xy_refuseing:udpcore.showmsgfrm('对方拒绝接收文件!');
  xy_filetran_complete:close;
  xy_filetran_outtime:
     sendmsgto(makepacket(xy_detail,msg.LParam,cur_completecount));
  end;
end;

//******************************************************************************
//为文件建立分块传输标志。文件不存就建立一个空白文件
//******************************************************************************
procedure Tfiletranfrm.rebuild_file_array;
var arraycount,curcount,i: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(cur_filename) then
  begin
  curcount:=getfilesize(cur_filename) div datalen;
  if curcount>0 then
    begin
    cur_completecount:=curcount;
    for i:=1 to curcount do
      status_array[i-1]:=2;
    end;

  end else with tfilestream.Create(cur_filename,fmcreate) do free;
end;

//******************************************************************************
function Tfiletranfrm.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;

//******************************************************************************

//******************************************************************************
//文件传交互过程
//------------------------------------------------------------------------------
{1.请求路径,文件总数,当前文件序号,当前文件名称,当前文件大小,文件MD5}
procedure Tfiletranfrm.sendtoclient_fileinfor;
var msg:string;
begin
inc(filelist_position);
if filelist.count>=filelist_position then
  begin
  cur_completecount:=0;
  cur_filename:=source_path+filelist.strings[filelist_position-1];
  cur_filesize:=getfilesize(cur_filename);

  maxbar.MaxValue:=filelist.count;
  maxbar.Progress:=filelist_position;
  minbar.MaxValue:=cur_filesize;
  minbar.Progress:=0;

  makeparamsex(msg,'filescount',filelist.count);
  makeparamsex(msg,'filespositoin',filelist_position);
  makeparamsex(msg,'curfilename',filelist.strings[filelist_position-1]);
  makeparamsex(msg,'curfilesize',cur_filesize);
  
  sendmsgto(concat(makepacket(xy_context,0,0),msg));
  end else begin //文件列表已经传送完成..
  filetran_complete:=true;
  handshake(xy_complete);
  just_trans_files:=false;
  postmessage(handle,refresh_status,xy_filetran_complete,0);
  end;
end;

{1.请求路径,文件总数,当前文件序号,当前文件名称,当前文件大小
   下理收到的数据}
procedure Tfiletranfrm.inceptserver_fileinfor(datstr:string);
begin
maxbar.MaxValue:=strtointdef(getparamitem(datstr,'filescount'),0);
maxbar.Progress:=strtointdef(getparamitem(datstr,'filespositoin'),0);
minbar.MaxValue:=strtointdef(getparamitem(datstr,'curfilesize'),0);
minbar.Progress:=0;
cur_filesize:=strtointdef(getparamitem(datstr,'curfilesize'),0);
cur_filename:=dest_path+getparamitem(datstr,'curfilename');
createdirectorys(extractfilepath(cur_filename));

if fileexists(cur_filename) then
   begin
   if cur_filesize=getfilesize(cur_filename) then
      begin
      handshake(xy_infor);//请求下一个文件..
      end else begin   //如果文件不同.将现在文件改名.
      if file_supervention then              
         begin
         if (cur_filesize<getfilesize(cur_filename))or
            (getfilesize(cur_filename) mod datalen>0)then
               renamefile(cur_filename,cur_filename+'.bak'); //文件不同改名
         end else deletefile(cur_filename);
      rebuild_file_array;   //从文件生成 array 列表
      end;
   end else if cur_filesize=0 then
   begin
   handshake(xy_infor);//请求下一个文件..
   end else rebuild_file_array; //从文件生成 array 列表
end;

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

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

{2.开始请求传输文件内容
   处理请求}
procedure Tfiletranfrm.startsendtoclient_data(infor:Tdatapack;datstr:string);
var m,n:integer;
    buf:string;
begin
n:=infor.curpos;
with tfilestream.Create(cur_filename,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));
cur_completecount:=infor.compos;
inc(total_trans_packet,length(buf));
refresh_trans_infor;
end;

{3.处理收到的数据 拼接文件}
procedure Tfiletranfrm.process_client_data(infor:Tdatapack;datstr:string);
var n:integer;
begin
n:=infor.curpos;
killtimer(handle,n);
if status_array[n]<2 then
   begin
   inc(cur_completecount);
   status_array[n]:=2;
   inc(total_trans_packet,length(datstr));
   refresh_trans_infor;
   with tfilestream.Create(cur_filename,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 handshake(xy_infor);  //请求下一个文件
end;


//******************************************************************************
procedure Tfiletranfrm.refresh_trans_infor;
var td:tdatetime;h,m,s,sc:word;
    k:longword;
begin
td:=time-start_time;
Label4.caption:=timetostr(td);
decodetime(td,h,m,s,sc);
k:=h*3600+m*60+s;
if k>0 then
  begin
  minbar.Progress:=cur_completecount*datalen;
  statusbar1.Panels.Items[1].Text:=extractfilename(cur_filename);
  statusbar1.Panels.Items[2].Text:=inttostr((total_trans_packet div 1024) div k)+'KB/秒';
  end;
end;


procedure Tfiletranfrm.FormPaint(Sender: TObject);
begin
udpcore.formonpaint(self);
end;

end.