【delphi开源代码栏目提醒】：以下是网学会员为您推荐的delphi开源代码-Frm_FileServer.pas，希望本篇文章对您学习有所帮助。

    unit Frm_FileServer;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ScktComp, StdCtrls, XPMan;
    
    
    const
       BufferSize=2048;
       CPort = 6656;
    
    type
      TDataFlag = Record
        FileName : String;
        FileSize : Integer;
        WorkFlag : Integer;
      end;
      PDataFlag = ^TDataFlag;
    
    type
      TFrmServerFile = class(TForm)
        SServer: TServerSocket;
        BtnStart: TButton;
        BtnStop: TButton;
        BtnClose: TButton;
        GBxStarus: TGroupBox;
        MmStatus: TMemo;
        BtnDisConne: TButton;
        procedure FormCreate(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure SServerAccept(Sender: TObject; Socket: TCustomWinSocket);
        procedure SServerClientConnect(Sender: TObject;
          Socket: TCustomWinSocket);
        procedure SServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
        procedure BtnStartClick(Sender: TObject);
        procedure BtnStopClick(Sender: TObject);
        procedure BtnDisConneClick(Sender: TObject);
        procedure BtnCloseClick(Sender: TObject);
      private
        MemoStream:TMemoryStream;
        Trancing:boolean;
        userhost:string;
        Procedure ConneRun;
        procedure StopConn;
        Procedure StartConn;
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      FrmServerFile: TFrmServerFile;
    
    implementation
    
    {$R *.dfm}
    Procedure TFrmServerFile.ConneRun;
    begin
      Trancing:=false;
      SServer.Port:=CPort;
      SServer.Active:=true;
      MemoStream.Clear;
      showmessage('服务器已经启动！');
    end;
    
    procedure TFrmServerFile.StopConn;
    begin
      MemoStream.clear;
      Trancing:=false;
      if SServer.Socket.ActiveConnections>0 then
      begin
        SServer.Socket.Connections[0].SendText('FileTransferStop');
        MmStatus.Lines.Add('当前任务停止！');
      end;
    end;
    
    Procedure TFrmServerFile.StartConn;
    begin
      if SServer.Socket.ActiveConnections>0 then
      begin
        Caption:='start';
        MemoStream.Clear;
        Trancing:=true;
        SServer.Socket.Connections[0].SendText('FiletransferWork');
        MmStatus.Lines.Add('准备好接受文件！');
      end;
    end;
    
    
    procedure TFrmServerFile.FormCreate(Sender: TObject);
    begin
      MemoStream:=TMemoryStream.Create;
      MemoStream.Position:=0;
      ConneRun;
    end;
    
    procedure TFrmServerFile.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
      SServer.Active:=False;
      SServer.Close;
    end;
    
    procedure TFrmServerFile.SServerAccept(Sender: TObject; Socket: TCustomWinSocket);
    begin
      mmStatus.Lines.Add('客户:'+Socket.RemoteHost+'连接成功！')
    end;
    
    procedure TFrmServerFile.SServerClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    var
      DataF:PDataFlag;
    begin
      DataF := New(pDataFlag);
      Dataf.FileName:='';
      Dataf.FileSize:=0;
      DataF.WorkFlag:=0;
      Socket.Data:=Dataf;
      socket.SendText('已经连接好，准备传输文件！'#13#10);
    //  socket.RemoteHost+' '
    end;
    
    
    
    procedure TFrmServerFile.SServerClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    var
      Buf:array[0..buffersize] of char;
      dataf:PDataFlag;
      NumberBytes:integer;
      cmd:string;
    begin
      dataf:=Socket.Data;
      Case dataf.WorkFlag of
      0:
        begin
          cmd := Trim(Socket.ReceiveText);
          if pos('SendFileinfo',cmd) > 0 then
          begin
            DataF.FileName:=Trim(Copy(CMD,pos(';',cmd)+1,Length(cmd)));
            Dataf.FileSize:=StrToInt(Copy(Dataf.FileName,pos(';',Dataf.FileName)+1,Length(dataf.FileName)));
            DataF.FileName:=Trim(copy(Dataf.FileName,0,pos(';',dataf.FileName)-1));
            Dataf.WorkFlag:=1;
            socket.Data:=Dataf;
            mmStatus.Lines.Add('文件名:'+dataf.FileName+'文件大小：'+inttostr(Dataf.FileSize));
            userhost :=Socket.RemoteHost;
          end;
        end;
      1:
         begin
           if Trancing then
           begin
             begin
               NumberBytes:= socket.ReceiveLength;
               socket.ReceiveBuf(buf,NumberBytes);
               MemoStream.Write(buf,numberBytes);
               if numberbytes >= BufferSize then
               begin
                  socket.SendText('FiletransferWork');
                  mmstatus.Lines.Add(inttostr(NumberBytes));
               end;
               if numberbytes < BufferSize then
               begin
                 socket.Sendtext('FileTransferStop');
                 MemoStream.Position:=0;
                 try
                   mmstatus.Lines.Add('来自：'+Socket.RemoteHost+ '的文件传送完毕！');
                   Trancing:=false;
                   Dataf.WorkFlag:=0;
                   socket.Data:=Dataf;
                   MemoStream.savetofile(DataF.filename);
                 except
                   showmessage('在保存文件时出现错误！');
                   exit;
                 end;
                 Memostream.clear;
               end;
             end;
           end;
         end;
       end;
    end;
    
    procedure TFrmServerFile.BtnStartClick(Sender: TObject);
    begin
      StartConn;
    end;
    
    procedure TFrmServerFile.BtnStopClick(Sender: TObject);
    begin
      stopconn;
    end;
    
    pr