delphi udp文件传输

客户端：

unit UnitClient;

interface

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

type
  TFormClient = class(TForm)
    IdUDPClient1: TIdUDPClient;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Gauge1: TGauge;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormClient: TFormClient;

implementation

{$R *.dfm}

procedure TFormClient.Button1Click(Sender: TObject);
Var  ReceivedString:String;
  Mem:TFileStream;
  p:Array[0..1023] of byte;
  Posi,Len:Integer;
begin
  if OpenDialog1.Execute then
  begin
    IdUDPClient1.Host:=Edit1.Text;
    IdUDPClient1.Active:=True;
    IdUDPClient1.Send('Send file:File Name:'+OpenDialog1.FileName);
    ReceivedString := IdUDPClient1.ReceiveString();
    if UpperCase(ReceivedString)='RECIVED FILE NAME OK!' then
    begin
      Mem:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
      try
        Posi:=0;
        IdUDPClient1.Send('Send File:File Length:'+IntToStr(Mem.Size));
        ReceivedString := IdUDPClient1.ReceiveString();
        if UpperCase(ReceivedString)='RECIVED FILE LENGTH OK!' then
        begin
          While Posi<Mem.Size do//一次只发1024个字节,字节数不能太多,不过应该还可以增加一些.
          begin
            Len:=1024;
            if Mem.Size-Posi<1024 then
              Len:=Mem.Size-Posi;
            Mem.Read(p,Len);
            IdUDPClient1.SendBuffer(P,Len);
            Inc(Posi,Len);
            Gauge1.Progress:=Round(Posi/Mem.Size*100);
            ReceivedString := IdUDPClient1.ReceiveString();
            if UpperCase(ReceivedString)<>'RECIVED FILE PACKAGE OK!' then
              Break;
            Application.ProcessMessages;
          end;
          IdUDPClient1.Send('Send File:File End!');
        end else
          ShowMessage('Send file cancel!');
      finally
        Mem.Free;
      end;
    end;
  end;
end;

end.

服务器端

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.

 

 

 

 

procedure TGisMapForm.SetAllVidIconXY;
var i: Integer;
  X, Y: Integer;
begin
    for i := Low(VI) to High(VI) do
        if VI[i].Img.Visible then
        begin
            GetOffsetXY(VI[i].X, VI[i].Y, X, Y);
            VI[i].Img.Left := X;
            VI[i].Img.Top := Y;
            VI[i].Img.Repaint;
        end;
end;

procedure TGisMapForm.GetOffsetXY(X: Integer; Y: Integer; var OffSetX: integer; var OffSetY: Integer);
var
    ZM: Double; //缩放度
    VX, VY: Integer;
    OX, OY: Integer;
begin
    ZM := Map.Zoom;
    VX := Map.ViewX;
    VY := Map.ViewY;
    OX := Map.OffsetX;
    OY := Map.OffsetY;
    OffSetX := Round(X * ZM / 100 - VX + OX);
    OffSetY := Round(Y * ZM / 100 - VY + OY);
end;


procedure TGisMapForm.UnderGetOffsetXY(OffSetX: integer; OffSetY: Integer;var X: Integer;var  Y: Integer);
var
    ZM: Double; //缩放度
    VX, VY: Integer;
    OX, OY: Integer;
begin
    ZM := Map.Zoom;
    VX := Map.ViewX;
    VY := Map.ViewY;
    OX := Map.OffsetX;
    OY := Map.OffsetY;
    X:=Round((OffSetX+VX- OX)* 100 / ZM);
    Y:=Round((OffSetY+VY- OY)* 100 /ZM);
end;

转载于:https://www.cnblogs.com/MaxWoods/p/3822407.html