unitserver.pas

Delphi67中利用UDP协议传送文件的例子

{本源码是自由程序，你可以把它用在任何地方，但不允许以任何形式把它单独用作商业用途。

本人是一个普通的打工仔，为了给朋友们献上更好的源码和控件，我需要你的支持，如果你认为本程序对你有帮助，希望你寄任意你愿意数额的RMB给我以资鼓励和支持，如果你认为不值，也希望你寄一张PostCard或者一封Email对我予以支持。

深圳市福田区联合广场41楼恒星威电子有限公司GPS部 艾真保  收
518026

mailto:[e-mail]

HomePage:
  http://www.aidelphi.com}
unit UnitServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,IdSocketHandle,
  IdAntiFreezeBase, IdAntiFreeze, Gauges;

type
  TFormServer = class(TForm)
    IdUDPServer1: TIdUDPServer;
    SaveDialog1: TSaveDialog;
    Gauge1: TGauge;
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;ABinding: TIdSocketHandle);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FileName:String;
    FileSize:Integer;
    Mem:TFileStream;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormServer: TFormServer;

implementation

{$R *.dfm}

procedure TFormServer.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
Var Str:String;
begin
  AData.Seek(0,0);
  SetLength(Str,AData.Size);
  AData.Read(Str[1],AData.Size);
  if Pos('Send file:File Name:',Str)>0 then
  begin
    Delete(Str,1,Length('Send file:File Name:'));
    FileName:=Str;
    Str:='Recived File Name OK!';
    ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
  end else if Pos('Send File:File Length:',Str)>0 then
  begin
    Delete(Str,1,Length('Send File:File Length:'));
    FileSize:=StrToIntDef(Str,0);
    SaveDialog1.FileName:=FileName;
    if SaveDialog1.Execute then
    begin
      FileName:=SaveDialog1.FileName;
      if FileExists(FileName) then
        DeleteFile(FileName);
      if Mem<>nil then
      begin
        Mem.Free;
        Mem:=nil;
      end;
      if not FileExists(FileName) then
        Mem:=TFileStream.Create(FileName,fmOpenReadWrite or fmCreate)
      else
        Mem:=TFileStream.Create(FileName,fmOpenReadWrite);
      Str:='Recived File Length OK!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
    end else
    begin
      Str:='Recived File Length Cancel!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
    end;
  end else if Pos('Send File:File End!',Str)>0 then
  begin
    if Mem<>nil then
    begin
      Mem.Free;
      Mem:=nil;
      Str:='Recived File OK!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
    end;
    FileName:='';
    FileSize:=0;
  end
  else
  begin
    if Mem<>nil then
    begin
      Mem.Seek(0,2);
      AData.Seek(0,0);
      Mem.CopyFrom(AData,AData.Size);
      Gauge1.Progress:=Round(Mem.Size/FileSize*100);
      Str:='Recived File Package OK!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
      Application.ProcessMessages;
    end;
  end;
end;

procedure TFormServer.FormCreate(Sender: TObject);
begin
  IdUDPServer1.Active:=True;
  FileName:='';
  FileSize:=0;
  Mem:=nil;
end;

procedure TFormServer.FormDestroy(Sender: TObject);
begin
  if Mem<>nil then
    Mem.Free;
end;

end.