HanDs
管理员

[Delphi文章] Tcp/IP上传文件(分块上传,带进度条显示) 





学习中请遵循国家相关法律法规,黑客不作恶。没有网络安全就没有国家安全

本站需要登陆后才能查看

//////////////////////////////////////////客户端////////////////////////////////////////////

//CurFilePath:客户端路径

//CurFileName:客户端文件名

 

Function TFrmLogin.Act_UpFiles(CurFilePath,CurFileName:String):Boolean;
var
  RecevFileName:string;
  iFileHandle:integer;
  iFileLen,cnt:integer;
  buf:array[0..4096] of byte;
begin
  Result:=False;
  IdTCPClientSend.Host:=serverip;

  Try
    IdTCPClientSend.Connect;
  except
    MessageBox(Handle,'服务端没开启','提示',MB_OK);
    Exit;
  end;

  if IdTCPClientSend.Connected then
    IdTCPClientSend.Disconnect;
  
   with IdTCPClientSend do
   begin
      Connect;//连接到服务器
      Try

        RecevFileName:=CurFilePath+CurFileName;
        
        if FileExists(RecevFileName) then
        begin
          Try
            WriteLn(RecevFileName);  //发送文件名

            iFileHandle:=FileOpen(RecevFileName,fmOpenRead); //得到此文件大小
            iFileLen:=FileSeek(iFileHandle,0,2);

            FileSeek(iFileHandle,0,0);
            WriteInteger(iFileLen,True);////hjh 20071009


            FrmProgress.Show;
            FrmProgress.PB1.Position:=0;
            FrmProgress.PB1.Max :=  iFileLen div 100 ;
           
            while iFileLen >0 do
            begin
              if IFileLen > 4096 then
              begin
                cnt:=FileRead(iFileHandle,buf,4096);
                WriteBuffer(buf,cnt,True);/////hjh20071009
                iFileLen:=iFileLen-cnt;
                FrmProgress.Label1.Caption:='正在上传:'+RecevFileName;
                FrmProgress.PB1.Position:= FrmProgress.PB1.Position +(4096 div 100) ;

                Application.ProcessMessages;
              end
              else
              begin
                cnt:=FileRead(iFileHandle,buf,iFileLen);
                WriteBuffer(buf,cnt,True);/////hjh20071009
                iFileLen:=iFileLen-cnt;
              end;
            end;
            Result:=True;
          Finally
            FrmProgress.Close;
            FileClose(iFileHandle);
          end;
        end
        else
        begin
          WriteLn('文件不存在');
          Result:=False;
        end;
      Finally
        Disconnect;//断开连接
      end;
   end;
end;

 

/////////////////////////////////////////服务端/////////////////////////////////////////

 

IdTCPServerSave.Active:=True;

 

procedure IdTCPServerSaveExecute(AThread: TIdPeerThread);

var
 GetString,RecevFileName,FilePath:string;
 rbyte:array[0..4096] of byte;
 sFile:TFileStream;
 iFileSize:integer;
begin
  if not AThread.Terminated and AThread.Connection.Connected then  //注意这里
  begin
    with   AThread.Connection   do
    begin
      try
        FilePath:=ExtractFilePath(ParamStr(0))+'附件\';  //服务器路径

        RecevFileName:=ReadLn;//从客户端获得文件名

        if RecevFileName <>'文件不存在' then
        begin
          iFileSize:=AThread.Connection.ReadInteger(True);
          Try
            sFile:=TFileStream.Create(FilePath+ExtractFIleName(RecevFileName),fmCreate);

            While iFileSize > 4096 do
            begin
              AThread.Connection.ReadBuffer(rbyte,4096);
              sFile.Write(rByte,4096);
              inc(iFileSize,-4096);
            end;

 

            if iFileSize > 0 then
              AThread.Connection.ReadBuffer(rbyte,iFileSize);

 

            sFile.Write(rByte,iFileSize);
          Finally
             sFile.Free;
          end;
        end;

      finally
        Disconnect;//断开连接
      end;
    end;
  end;

end;


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
Tcp/IP 上传文件 ( 分块上传 带进度条显示 )
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复