{*******************************************************}{ }{ 陈新光 }{ }{ 版权所有 (C) 2008 }{ }{*******************************************************}//传输文件的服务器端//这个程序在服务器端要一直开着，否则客户端连接不了服务器 unit uServer; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent, IdTCPServer, ComCtrls,uImpTxt; type TFormServer = class(TForm) IdTCPServer1: TIdTCPServer; Button1: TButton; StatusBar1: TStatusBar; procedure IdTCPServer1Execute(AThread: TIdPeerThread); procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); private { Private declarations } public { Public declarations } end; var FormServer: TFormServer; const FFileName='d:/1.txt'; //参数有待放进INI文件中 FPort=9925; implementation {$R *.dfm} procedure TFormServer.IdTCPServer1Execute(AThread: TIdPeerThread);var AFileStream: TFileStream;begin with AThread.Connection do begin AFileStream := TFileStream.Create(FFileName, fmCreate); //建立文件流准备接收 try ReadStream(AFileStream, -1, true); //读入全部直到结束connect Application.ProcessMessages; finally AFileStream.Free; //释放文件流 end; //将接收到的文本文件写入数据库中，待加功能 end;end; procedure TFormServer.Button1Click(Sender: TObject);begin IdTCPServer1.DefaultPort := FPort; //端口 if not IdTCPServer1.Active then try IdTCPServer1.Active := True; StatusBar1.SimpleText:='服务器启动成功'; except StatusBar1.SimpleText:='服务器启动失败'; end;end; procedure TFormServer.FormClose(Sender: TObject; var Action: TCloseAction);begin IdTCPServer1.Active:=False;end; procedure TFormServer.FormShow(Sender: TObject);begin Button1Click(nil);end; end. {*******************************************************}{ }{ 陈新光 }{ }{ 版权所有 (C) 2008 }{ }{*******************************************************}//传输文件的客户端，使用多线程封装 unit uClient; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ComCtrls,uThread; type TFormClient = class(TForm) Button1: TButton; IdTCPClient1: TIdTCPClient; StatusBar1: TStatusBar; procedure Button1Click(Sender: TObject); private { Private declarations } procedure SendMSG; public { Public declarations } end; var FormClient: TFormClient; const FFileName='c:/1.txt'; //参数有待放进INI文件中 FPort=9925; FHost='127.0.0.1'; implementation {$R *.dfm} procedure TFormClient.Button1Click(Sender: TObject);var FT:TFunThread;begin FT:=TFunThread.Create(SendMSG);end; procedure TFormClient.SendMSG;var AFileStream:TFileStream;begin try IdTCPClient1.Host := FHost; //连接主机 IdTCPClient1.Port := FPort; //端口 IdTCPClient1.Connect; //连接 except StatusBar1.SimpleText:='连接服务器失败或者对方已经中断传输'; Exit; end; AFileStream := TFileStream.Create(FFileName, fmOpenRead);//建立文件流 try IdTCPClient1.OpenWriteBuffer; //准备发送缓冲 IdTCPClient1.WriteStream(AFileStream, true, false, AFileStream.Size);//参数二发送全部数据，参数三不发送大小，参数四发送的大小为文件流大小 IdTCPClient1.CloseWriteBuffer; //结束发送缓冲 StatusBar1.SimpleText:='短信发送成功'; except StatusBar1.SimpleText:='短信发送失败'; end; IdTCPClient1.Disconnect;end; end.