客户端:
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;