|
发送端:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ScktComp, StdCtrls, ComCtrls, ExtCtrls, ToolWin; type TForm1 = class(TForm) ClientSocket1: TClientSocket; OpenDialog1: TOpenDialog; ToolBar1: TToolBar; ConnectBtn: TToolButton; OpenBtn: TToolButton; StatusBar1: TStatusBar; Panel1: TPanel; Label1: TLabel; RichEdit1: TRichEdit; Label2: TLabel; function GetFileSize(const FileName:string):integer; procedure GetFileReady(); Procedure SendFilePart(); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure ConnectBtnClick(Sender: TObject); procedure OpenBtnClick(Sender: TObject); procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Disconnect(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; implementation const BufSize=4096; var LeftSize:Longint; Stream:TMemoryStream; {$R *.dfm} function TForm1.GetFileSize(const FileName:string):integer; var f:TFileStream; begin f:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone); Result:=f.Size; f.Free; end; procedure TForm1.GetFileReady(); begin Richedit1.Lines.Add(datetimetostr(now())+'==>>开始读取文件'+label2.Caption); stream.Clear; stream.LoadFromFile(label2.Caption); stream.Position:=0; leftsize:=stream.Size; caption:=inttostr(leftsize); end; Procedure TForm1.SendFilePart(); var sendsize:longint; Buf:array[0..Bufsize - 1] of char; begin if stream.Size=0 then GetFileReady(); if LeftSize>=Bufsize then Sendsize:=Bufsize else sendsize:=Leftsize; Stream.ReadBuffer(Buf,Sendsize); Leftsize:=leftsize - sendsize; if leftsize=0 then begin stream.Clear; Richedit1.Lines.Add(DateTimetostr(now())+'==>>'+'文件传送完毕!'); end; try Clientsocket1.Socket.SendBuf(buf,sendsize); except Caption:='发送错误!'; stream.Clear; end; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin Clientsocket1.Active:=false; clientsocket1.Close; end; procedure TForm1.FormCreate(Sender: TObject); begin stream:=Tmemorystream.Create; end; procedure TForm1.ConnectBtnClick(Sender: TObject); var Remotehost:string; begin Remotehost:=inputbox('建立连接','请输入对方机器的IP地址或名称:',''); if trim(remotehost)<>'' then begin if not clientsocket1.Active then clientsocket1.Active:=true; clientsocket1.Port:=6768; clientsocket1.Host:=remotehost; try clientsocket1.Active:=true; Richedit1.Lines.Add(datetimetostr(now())+'==>>正在连接文件传送服务器'); except showmessage('连接失败!'); end; end; end; procedure TForm1.OpenBtnClick(Sender: TObject); var tmpstr:string; begin with opendialog1 do begin Execute; if FileName<>'' then begin tmpstr:='FILESEND '+extractFileName(FileName)+' '+inttostr(GetFilesize(FileName)); label2.Caption:=fileName; Clientsocket1.Socket.SendText(tmpstr); Richedit1.Lines.Add(datetimetostr(now())+'==>>'+label2.Caption+'准备传送!'); end; end; end; procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); begin Richedit1.Lines.Add(datetimetostr(now())+'==>>连接文件传送服务器成功!'); // showmessage('连接成功!'); end; procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket); begin stream.Clear; end; procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin errorcode:=0; stream.Clear; end; procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); var rstr:string; begin rstr:=socket.ReceiveText; if rstr='filetransferwork' then begin caption:='do send screen'; sendFilePart(); end; if rstr='filetransferstop' then begin stream.Clear; stream.SetSize(0); end; Richedit1.Lines.Add(datetimetostr(now())+'==>>'+rstr); end; end. |
|
文件传输发送端
|
|