局域网内传文件或文件内容

来源:互联网 发布:音乐广告制作软件 编辑:程序博客网 时间:2024/06/06 07:02

      前一段时间由于工作需要写了一个局域网内传文件的小程序。后来在CSDN上也看到了有朋友在发这样的帖子。于是整理了一下,发表出来。希望能对需要的朋友有所帮助。我也是初学。也可能在高手们看来这样的程序太菜了。呵呵。由于这个程序本来就很简单,我只是作了封装而已。在此的目的只是想把代码发表出来。所以不会对基本的概念性的知识再作解释。
     在这个程序当中我用了四个控件。TIdTCPServer、TIdTCPClient、TIdAntiFreeze、TIdIcmpClien。这四个控件都已封装在TGetFileClass类当中。
      下面是基本的功能有:
       一、Ping 功能。
       二、读文件的内容。
       三、读取整个文件。(基实也就是copy 文件)。
以下TGetFileClass文件。
{***********************使用说明************************************************}
//服务端说明
{1.创建TGetFileClass对象的实例
 2.设置ServerPort
 3.调用ServerStart方法
 4.设置ReadFilePath和ReadFileName
 5.停止调用ServerStop方法}

//客户端说明
{1.创建TGetFileClass对象的实例
 2.设置Host
 3.设置ClientPort
 4.调用ClientConnect方法
 5.在向服务端发出请求之前先调用PingForUsesBefor方法来拼一下服务器在调用此方法之
   前要对PingBufferSize 和 PingReceiveTimeout 属性. 根据PINGSERVER属性来判断。
 6.设置读取文件的类型ReadFileType属性
 7.如果是读取文件内容则调用ClientGetFileInfo
 8.如果是传文件则请在调用ClientGetFileInfo之前先设置SaveFilePath属性
 9.断开调用ClientDisConnect方法}
{*******************************************************************************}


unit uGetFileClass;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdAntiFreezeBase, IdAntiFreeze,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,IdTCPServer,StrUtils,
  IdIcmpClient,DateUtils;
Type
  //定义读取文件的方式(文件,文件内容)
  TReadFileType = (rtFile,rtFileInfo);

  TGetFileClass = class
  private
    FIdTCPServer: TIdTCPServer;   //服务器
    FIdTCPClient: TIdTCPClient;   //客户端
    FIdAntiFreeze: TIdAntiFreeze; //防止冻结(client)
    FIdIcmpClient: TIdIcmpClient; //Ping服务器

    FPingBufferSize : Integer ;    //PING的数据包的大小
    FPingReceiveTimeout : Integer ;//PING用时

    FHost : string;               //主机
    FClientPort : Integer;        //客户端口
    FServerPort : Integer;        //服务端口
    FSendData : string;           //发送数据
    FsCommand : string;           //命令
    FReadFileName : string;       //要读取的文件名
    FReadFilePath : string;       //要读取的文件路径

    FSaveFileName : String ;      //要保存的文件名(存放)
    FSaveFilePath : String ;      //要保存文件的路径

    FClientConnect : Boolean;     //客户端状态
    FServerStart : Boolean;       //服务端状态

    FClientResultInfo : string;   //客户端状态信息
    FServerResultInfo : string;   //服务端状态信息

    FFileInfo : TStrings;         //文件内容
    FReadFileType : TReadFileType ;       //读取文件的方式
  public
    procedure SetHost(const AHost : string) ;          //设置端口
    procedure SetClientPort(const APort : Integer);    //设置客户端口
    procedure SetServerPort(const APort : Integer);    //设置服务端口
    //要读取的
    procedure SetReadFileName(const AReadFileName : string);   //设置要读取的文件名
    procedure SetReadFilePath(const AReadFilePath : string);   //设置要读取的文件路径
    //要保存的
    procedure SetSaveFileName(const ASaveFilename : string) ;  //设置要保存的文件名
    procedure SetSaveFilePath(const ASaveFilePath : string) ;  //设置要保存的文件路径

    procedure SetReadFileType(const AReadFileType : TReadFileType); //设置读取文件的方式.

    procedure SetPingBufferSize(APingBufferSize : Integer);   //设置PING数据包的大小.
    procedure SetPingReceiveTimeout(APingReceiveTimeout : Integer);  //设置PING的用时。

    Function  GetClientResultInfo : string;            //返回客户端状态信息
    Function  GetServerResultInfo : string;            //返回服务端状态信息

    function ClientConnect : Integer;                  //客户端连接
    function ClientDisConnect : Integer;               //客户端断开
    function SendData(const AData : string ) : Integer;//发送数据
    function ClientGetFileInfo : Integer;              //向服务端请求文件

    Function ServerStart : Integer;                          //服务端启动
    Function ServerStop : Integer;                           //服务端停止
    procedure IdTCPServerConnect(AThread: TIdPeerThread);    //服务端连接
    procedure IdTCPServerExecute(AThread: TIdPeerThread);    //服务端执行
   
    //用PING控件测试服务器是否能联通.
    Function PingForUsesBefor : Boolean;

    //公布的属性。
    property Host : string read FHost write SetHost ;
    property ClientPort : Integer read FClientPort write SetClientPort ;
    property ServerPort : Integer read FServerPort write SetServerPort ;
    property ClientState : string read GetClientResultInfo ;  //客户端当前信息
    property ServerState : string read GetServerResultInfo ;  //服务端当前信息
    property FileInfo : TStrings read FFileInfo ;             //文件内容
    //需读取文件的路径和文件名.由用户指定.
    property ReadFilePath : String read FReadFilePath write  SetReadFilePath;
    property ReadFileName : String read FReadFileName write SetReadFileName;
    //保存文件的文件路径和文件名,由用户指定.
    property SaveFilePath : String read FSaveFilePath write SetSaveFilePath;
    property SaveFileName : String read FSaveFileName write SetSaveFileName;
    //读取文件的类型
    property ReadFileType : TReadFileType read FReadFileType write FReadFileType;
    //PING 服务的标示 TRUE 为通 FALSE 为不通
    property PingServer : Boolean read PingForUsesBefor;
    //拼值的数据包大小
    property PingBufferSize : Integer read FPingBufferSize  write SetPingBufferSize;
    //拼的时间
    property PingReceiveTimeout : Integer read FPingReceiveTimeout  write SetPingReceiveTimeout;

    constructor Create(Owner: TComponent);
    destructor Destroy ;override ;
  end;
implementation

{ TGetFileClass }

function TGetFileClass.ClientConnect: Integer;
begin
  Result := 0 ;
  if FIdTCPClient.Connected then FIdTCPClient.Disconnect;
  FIdTCPClient.Host := Host;
  FIdTCPClient.Port := ClientPort;
  with FIdTCPClient do
  begin
    Try
      Try
        Connect(50000);
        FClientResultInfo := ReadLn();
        FClientConnect := True;
      Except
        FClientResultInfo := '远程主机无响应!';
        FIdTCPClient.Disconnect;
        FClientConnect := False;
      end;
    Except
      FClientResultInfo := '无法建立到'+Host+'的连接!';
      Result := -1 ;
    end;
  end;
end;

function TGetFileClass.ClientDisConnect: Integer;
begin
  Result := 0 ;
  if FIdTCPClient.Connected then
  begin
    Try
      FIdTCPClient.WriteLn('QUIT');
    Finally
      FIdTCPClient.Disconnect;
      FClientConnect := False;
      FClientResultInfo := '同主机'+Host+'的连接已断开。';
    End;
  end;
end;

function TGetFileClass.ClientGetFileInfo: Integer;
var
  aFileSize,FileSize : Integer;
  Buff : array[0..1023] of Byte;
  ReadCount : Integer;
  FileInfoStream: TMemoryStream;
  FileStream : TFileStream;
  aFileName : string;
begin
  Result := 0 ;
  if FClientConnect then
  begin
    //发送命令
    FIdTCPClient.WriteLn('GetFile');
    //读取文件名
    aFileName := FIdTCPClient.ReadLn(#13#10, 100);
    if aFileName = '' then
      Exit;
    if FIdTCPClient.Connected then
    begin
      //返回确认文件传输标志
      FIdTCPClient.WriteLn;

      //开始读取文件长度,创建文件
      FIdTCPClient.ReadBuffer(aFileSize, 4);
      FileSize := aFileSize;

      //如果读取类型为文件内容
      if ReadFileType = rtFileInfo then
      begin
        FileInfoStream := TMemoryStream.Create;
        try
          //读取文件流
          repeat
            if FileSize - FileInfoStream.Size > SizeOf(Buff) then
              ReadCount := SizeOf(Buff)
            else
              ReadCount := FileSize - FileInfoStream.Size;

            FIdTCPClient.ReadBuffer(Buff, ReadCount);
            FileInfoStream.WriteBuffer(Buff, ReadCount);
            Application.ProcessMessages;
          until FileInfoStream.Size >= FileSize;

          FileInfoStream.Position := 0;   //定位流的指针位置从0开始读取数据.
          FFileInfo.Clear;
          FFileInfo.LoadFromStream(FileInfoStream);  //将文件的内容存放到FFILEINFO变量中。
        finally
          FileInfoStream.Free;
          FileInfoStream := nil;
        end;
      end
      else
      begin     //如果读取的类型是文件
        SaveFileName := aFileName;
        FileStream := TFileStream.Create(SaveFilePath+SaveFileName, fmCreate);
        try
          //读取文件流
          repeat
            if FileSize - FileStream.Size > SizeOf(Buff) then
              ReadCount := SizeOf(Buff)
            else
              ReadCount := FileSize - FileStream.Size;

            FIdTCPClient.ReadBuffer(Buff, ReadCount);
            FileStream.WriteBuffer(Buff, ReadCount);
            Application.ProcessMessages;
          until FileStream.Size >= FileSize;
        finally
          FileStream.Free;
          FileStream := nil;
        end;
      end;
    end;
  end;
end;

constructor TGetFileClass.Create(Owner: TComponent);
begin
  //在类的造构函数中创建服务器端和客户端组件.
  FIdTCPServer  := TIdTCPServer.Create(OWner);
  FIdTCPServer.OnConnect := IdTCPServerConnect;
  FIdTCPServer.OnExecute := IdTCPServerExecute;

  FIdTCPClient  := TIdTCPClient.Create(OWner);
  FIdAntiFreeze := TIdAntiFreeze.Create(OWner);

  FIdIcmpClient := TIdIcmpClient.Create(OWner);

  //创建存放文件内容的STRINGS变量。可以通过属性FILEINFO来读取文件的内容。
  FFileInfo := TStringList.Create;
end;

destructor TGetFileClass.Destroy;
begin
  //在析购函数中释放生成的对象。
  FIdTCPServer.Free;
  FIdTCPClient.Free;
  FIdAntiFreeze.Free;
  FFileInfo.Free;
  FIdIcmpClient.Free;
  inherited;
end;

function TGetFileClass.GetClientResultInfo: string;
begin
  //返回客户端当前的时实状态。可以通过ClientState属性来读取。
  Result := FClientResultInfo ;
end;

function TGetFileClass.GetServerResultInfo: string;
begin
  //返回服务器端当前的时实状态。可以通过ServerState属性来读取。
  Result := FServerResultInfo;
end;

procedure TGetFileClass.IdTCPServerConnect(AThread: TIdPeerThread);
begin
  FServerStart := True;
  AThread.Connection.WriteLn('欢迎连接到服务器!');
  FServerResultInfo := '来自主机 '+AThread.Connection.Socket.Binding.PeerIP+'的请求已被接受。';
end;

procedure TGetFileClass.IdTCPServerExecute(AThread: TIdPeerThread);
var
  Buf : array[0..1023] of Byte;
  ReadCount : Integer;
  aStream : TFileStream;
  aSize : Integer;
begin
  with AThread.Connection do
  begin
    FsCommand := ReadLn();
    if SameText(FsCommand,'QUIT') then
    begin
      FServerResultInfo := '断开同主机 '+AThread.Connection.Socket.Binding.PeerIP+'的连接!';
      DisConnect;
      FServerStart := False;
    end
    else if AnsiStartsText('Data',FsCommand) then
    begin
      FServerResultInfo := ReadLn();
      WriteLn('200:数据接收成功!');
    end
    else if SameText(FsCommand,'GetFile') then
    begin
       aStream := TFileStream.Create(ReadFilePath+ReadFilename,
                                          fmOpenRead or fmShareDenyWrite);
      try
        //发送文件名
        AThread.Connection.WriteLn(ReadFilename);
        //等待确认接收
        AThread.Connection.ReadLn(#13#10, 1000);
        //写文件长度和文件流
        aSize := aStream.Size;
        AThread.Connection.WriteBuffer(aSize,4);
        while aStream.Position < aStream.Size do
        begin
          if aStream.Size - aStream.Position >= SizeOf(Buf) then
            ReadCount := sizeOf(Buf)
          else
            ReadCount := aStream.Size - aStream.Position;

          aStream.ReadBuffer(Buf, ReadCount);
          AThread.Connection.WriteBuffer(Buf,ReadCount);
          Application.ProcessMessages;
        end;
      finally
        aStream.Free;
      end;
    end ;
  end;
end;

function TGetFileClass.SendData(const AData: string): Integer;
begin
  Result := 0 ;
  with FIdTCPClient do
  begin
    Try
      WriteLn('Data'+AData);
      FClientResultInfo := ReadLn();
    Except
      DisConnect;
      FClientConnect := False;
      FClientResultInfo := '同主机'+Host+'已断开。';
      Result := -1 ;
    End;
  end;
end;

function TGetFileClass.ServerStart: Integer;
begin
  Result := 0 ;
  Try
    FIdTCPServer.DefaultPort := ServerPort;
    FIdTCPServer.Active := True;
    FServerStart := True;
    FServerResultInfo := '服务器已成功启动!';
  Except
    Result := -1;
    FServerStart := False;
  End;
end;

function TGetFileClass.ServerStop: Integer;
begin
  Result := 0;
  Try
    FIdTCPServer.Active := False;
    FServerStart := False;
    FServerResultInfo := '服务器已关闭!';
  Except
    Result := -1 ;
  End;
end;

procedure TGetFileClass.SetClientPort(const APort: Integer);
begin                                  
  if APort <> FClientPort then
    FClientPort := APort;
end;

procedure TGetFileClass.SetReadFileName(const AReadFileName: string);
begin
  if AReadFileName <> FReadFileName then
    FReadFileName := AReadFileName;
end;

procedure TGetFileClass.SetReadFilePath(const AReadFilePath: string);
begin
  if AReadFilePath <> FReadFilePath then
    FReadFilePath := AReadFilePath;
end;

procedure TGetFileClass.SetHost(const AHost: string);
begin
  if AHost <> FHost then
    FHost := AHost;
end;

procedure TGetFileClass.SetSaveFileName(const ASaveFilename: string);
begin
  if ASaveFileName <> FSaveFileName then
    FSaveFileName := ASaveFileName;
end;

procedure TGetFileClass.SetSaveFilePath(const ASaveFilePath: string);
begin
  if ASaveFilePath <> FSaveFilePath then
    FSaveFilePath := ASaveFilePath ;                                   
end;

procedure TGetFileClass.SetServerPort(const APort: Integer);
begin
  if APort <> FServerPort then
    FServerPort := APort ;
end;

procedure TGetFileClass.SetReadFileType(
  const AReadFileType: TReadFileType);
begin
  if AReadFileType <> FReadFileType then
    FReadFileType := AReadFileType;
end;

Function TGetFileClass.PingForUsesBefor : Boolean;
var
  StartDate,EndDate,UseDate:Ttime;
  i : integer;
  temp,hm : word;
begin
  if PingBufferSize = 0 then PingBufferSize := 10000;
  if PingReceiveTimeout = 0 then PingreceiveTimeout := 5000;
 
  FIdIcmpClient.BufferSize := PingBufferSize ;
  FIdIcmpClient.ReceiveTimeout := PingReceiveTimeout;
  FIdIcmpClient.Host := Host;

  StartDate := now;

  for i := 0 to 1 do
  begin
    FIdIcmpClient.Ping;
  end;

  EndDate := Now;
  UseDate := StartDate - EndDate ;

  //取出秒数
  DecodeDateTime(UseDate,temp,temp,temp,temp,temp,hm,temp);
  if hm >=5 then
    result := False
  else
    Result := True;
end;

procedure TGetFileClass.SetPingBufferSize(APingBufferSize: Integer);
begin
  if APingBufferSize <> FPingBufferSize then
    FPingBufferSize := APingBufferSize;
end;

procedure TGetFileClass.SetPingReceiveTimeout(
  APingReceiveTimeout: Integer);
begin
  if APingReceiveTimeout <> FPingReceiveTimeout then
    FPingReceiveTimeout := APingReceiveTimeout;
end;

end.

服务器端调用方法:***********
var
    GetFileClass : TGetFileClass;
启动:
  GetFileClass.ServerPort := 6060;  //端口请自行更改。
  GetFileClass.ServerStart;              //启动服务器
  BtnStart.Enabled := false;
  BtnStop.Enabled := True;
  Btnclose.Enabled := false;
  LbLog.Items.Add(GetFileClass.ServerState);     //LbLog是一个TListBox~ServerState是服务当前的状态信息。
  GetFileClass.ReadFilePath := Extractfilepath(Application.ExeName);    //设置要读取文件的路径
  GetFileClass.ReadFileName := '1.txt';                                                  //设置要读取文件的名称 
*****************************
停止:
  GetFileClass.ServerStop;
  BtnStop.Enabled := FAlse;
  BtnStart.Enabled := True;
  BtnClose.Enabled := True;
  LbLog.Items.Add(GetFileClass.ServerState);
******************************************************************************************
客户端调用方法:
连接方法:
  GetFileClass.Host := EdtHost.Text;
  GetFileClass.ClientPort := 6060 ;                 //这个端口要和服务器一样才行。
  GetFileClass.ClientConnect;                        //连接服务器
  LbLog.Items.Add(GetFileClass.ClientState);
  BtnConnect.Enabled := False;
  BtnDisConnect.Enabled := True;
  BtnExit.Enabled := False;

向服务器发送消息:
  if GetFileClass.SendData('aaa') = -1 then
  begin
    Application.MessageBox('发送失败!','错误',MB_Ok);
  end;
  LbLog.Items.Add(GetFileClass.ClientState);

Ping服务器:
function PingServer: Boolean;
begin
  GetFileClass.PingBufferSize := 10000;
  GetFileClass.PingReceiveTimeout := 5000;
  Result := GetFileClass.PingForUsesBefor;        //Ping服务器.
end;

读取服务器上指定文件的内容或是整个文件:(主要是根据传入的参数来进行操作)
procedure GetFile(AReadFileType : TReadFileType) ;
begin
  if (not PingServer) then exit;
  //设置读取类型
  if AReadFileType = rtFileInfo then
  begin
    GetFileClass.ReadFileType := AReadFileType;
    //调用 GetFileclass类的ClientGetFileInfo 方法,向服务器发送指令.
    if GetFileClass.ClientGetFileInfo = -1 then exit;

    memo1.Clear;
    //获得的文件信息可由Getfileclass类的FileInfo 属性读取.
    memo1.Lines.AddStrings(GetFileClass.FileInfo);
    //清空.
    GetFileClass.FileInfo.Clear;
  end
  else
  begin
    GetFileClass.ReadFileType := AReadFileType;
    GetFileClass.SaveFilePath := 'F:/';//ExtractFilePath(Application.ExeName);
    if GetFileClass.ClientGetFileInfo = -1 then exit;
  end;

end;

断开服务器:
  GetFileClass.ClientDisConnect;      
  LbLog.Items.Add(GetFileClass.ClientState);
  self.BtnConnect.Enabled := True;
  self.BtnDisConnect.Enabled  := False;
  BtnExit.Enabled := True;
********************************************************************************************
 在Delphi7+Windows2000Server下运行成功。希望能对大家有所帮助。这个程序写的有点早了。请大家不要见笑。

 

原创粉丝点击