如何实现象 oicq一样的文件传输!急急 !

我的email : [email protected] 谢谢!

我也要一份，收到后开贴200分感谢
[email protected]

接受部分unit receive;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ComCtrls;type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    SaveDialog1: TSaveDialog;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1Accept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;  TCon = record
    FileName : String;
    TotalSize : Integer;
    Status : Integer;
  end;  PCON = ^TCON;
  var
  Form1: TForm1;
  Rece_Size : integer;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
    Serversocket1.Active := true;
end;procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
   c : pcon;
begin
    c :=new(pcon);
    c.FileName := '';
    c.TotalSize :=  0 ;
    c.Status := 0;
    Socket.Data := c;
    Socket.SendText('已经连接,请输入UPLOAD FILENAME SIZE'#13#10);
end;procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var C : PCON;
    cmd:String;
    Buffer : pointer;
    nRetr : integer;
    fs : TFileStream;
const bufferSize =  1024 ;begin
    C:= Socket.Data ;
    case c.Status of
        0 :
        begin
               cmd := trim(Socket.ReceiveText) ;
               Memo1.Lines.Add('收到文件路径');               if  Pos('UPLOAD ',uppercase(cmd)) >  0 then
               begin
                    c.FileName := trim(Copy(cmd,Pos(' ',cmd)+1,Length(cmd)));
                    c.TotalSize := StrToInt(Copy(c.FileName,Pos(' ',c.FileName)+1,Length(c.FileName)));
                    c.FileName := trim(Copy(c.FileName,1,Pos(' ',c.FileName)));
                    c.Status := 1;
                    Socket.Data := C;
                    Socket.SendText('you can send File  !'#13#10);
               end;
            end;
        1 : begin
                memo1.Lines.Add('Star Receive File');
                GetMem(Buffer,BufferSize);
                nRetr := Socket.ReceiveBuf(Buffer^,BufferSize);                if not FIleExists('c:\'+c.FileName) then
                begin
                     fs :=TFileStream.Create('c:\'+c.FileName,fmCreate or fmShareDenyNone);
                     fs.Seek(0,soFromBeginning);
                end
                else
                begin
                     fs :=TFileStream.Create('c:\'+c.FileName,fmOpenWrite or fmShareDenyNone);
                     fs.Seek(0,soFromEnd);
                end;
                fs.WriteBuffer(Buffer^,nRetr);
                fs.Destroy;
                FreeMem(Buffer);
                Rece_Size := Rece_Size + nRetr;                if Rece_Size = c.TotalSize then
                begin
                   Socket.SendText('发送结束');
                   Memo1.Lines.Add('接收结束');
                end
                else
                   Socket.SendText('在发送');
                Form1.ProgressBar1.Position := Form1.ProgressBar1.Position + (nretr div 100);
            end;
    end;
end;procedure TForm1.ServerSocket1Accept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    Form1.Caption := '连接上';
end;procedure TForm1.Button1Click(Sender: TObject);
var
  Path : string;
begin
{
  SaveDialog1.FileName := '1.txt';
  if SaveDialog1.Execute then
  begin
    Form1.Caption := SaveDialog1.FileName;
//    Form1.Caption := ExtractFilePath(SaveDialog1.FileName);
  end else Form1.Caption := '12345';
}
    With SaveDialog1 do
    begin
    Filename := '1.txt';
    Execute;
    path := ExtractFileName(FileName);
    Form1.Caption := Path;
    end;
end;end.

unit send;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ComCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    ClientSocket1: TClientSocket;
    Edit1: TEdit;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Edit2: TEdit;
    Label2: TLabel;
    Button3: TButton;
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  Send_Size : integer;
  File_Lost : integer;implementation{$R *.dfm}function GetFileSize(const FileName: string):integer;
var f : TFileStream;
begin
    f := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
    Result :=f.Size;
    F.Free;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
    if ClientSocket1.Active then
       ClientSocket1.Active := False;
     ClientSocket1.Address := Edit1.Text;
     ClientSocket1.Port := 1024;
     ClientSocket1.Active := true;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
    with OpenDialog1 do
    begin
        Execute;
        if FileName <> '' then
        begin
            Edit2.Text := 'UPLOAD '+ ExtractFileName(FileName) +' '+Inttostr(GetFileSize(FileName));
            Label2.Caption := FileName;            Form1.Caption := Inttostr(GetFileSize(FileName));
            ClientSocket1.Socket.SendText(edit2.Text);
        end;
    end;
end;procedure TForm1.Button3Click(Sender: TObject);
var fs : TFileStream;
    Buf : pointer;
    Size : integer;
begin
    fs := TFileStream.Create(Label2.Caption ,fmOpenRead or fmShareDenyNone);    if Fs.Size > 1024 then
        Size := 1024
    else
        Size := fs.Size;    GetMem(Buf,Size);
    fs.Seek(0,soFromBeginning);
    fs.ReadBuffer(Buf^,Size);
    ClientSocket1.Socket.SendBuf(Buf^,Size);
    Send_Size := Size;
    fs.Destroy;
    FreeMem(Buf);
    //Form1.ProgressBar1.Position := Form1.ProgressBar1.Position + (Size div 100);
end;procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    Form1.Caption := '已经连接'+socket.RemoteAddress;
end;procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
    ErrorCode := 0;
    Form1.Caption := '错误';
end;procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
    ReceText : string;
    fs : TFileStream;
    Buf : pointer;
    Size : integer;
begin
    ReceText := Socket.ReceiveText;
    Memo1.Lines.Add(ReceText);
    if ReceText = '在发送' then
    begin
        fs := TFileStream.Create(Label2.Caption ,fmOpenRead or fmShareDenyNone);        File_Lost := Fs.Size - Send_Size;
        if File_Lost > 1024 then
            Size := 1024
        else
            Size := File_Lost;        GetMem(Buf,Size);
        fs.Seek(Send_Size,soFromBeginning);
        fs.ReadBuffer(Buf^,Size);
        Socket.SendBuf(Buf^,Size);
        fs.Destroy;
        FreeMem(Buf);
        Send_Size := Send_Size + Size;
        Form1.ProgressBar1.Position := Form1.ProgressBar1.Position + (Size div 100);
    end;
end;end.

上面程序分为两个部分，程序做的还不是很完整，我用的是tcp/ip传送的,用流方式发送文件，每次只发送1k的数据，可以根据自己实践调节发送的速度。
有什么问题，请联系我[email protected]

我也想要一份方件传输的例子！！
[email protected]

能给我也发一份吗？
[email protected]

调试易

如何实现象 oicq一样的文件传输!急急 !

解决方案 »

如何实现 象 oicq一样的文件 传输!急 急 !

解决方案 »

如何实现象 oicq一样的文件传输!急急 !