求internet上点对点传输文件的源码

Question

使用阻塞模式下,internet上点对点传输图片,分为客户端,服务端 要求不丢数据包
贴出源码或者发到

Answer 1

socket传文件的例子，葵花宝典上的unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls;type
  TCon = record
    FileName : String;
    TotalSize : Integer;
    Status : Integer;
  end;  PCON = ^TCON;  TForm1 = class(TForm)
    SS: TServerSocket;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure SSClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Unit2;{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
begin
    SS.Port := 9000;
    SS.Active := True;
end;procedure TForm1.SSClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var c : pcon;
begin    c :=new(pcon);
    c.FileName := '';
    c.TotalSize :=  0 ;
    c.Status := 0;
    Socket.Data := c;
    Socket.SendText('已经连接,请输入UPLOAD FILENAME SIZE'#13#10);end;procedure TForm1.SSClientRead(Sender: TObject; Socket: TCustomWinSocket);
var C : PCON;
    cmd:String;
    Buffer : pointer;
    nRetr : integer;
    fs : TFileStream;
const bufferSize =  1024 ;begin
    C:= Socket.Data ;
    case c.Status of
        0 :
        begin
               cmd := trim(Socket.ReceiveText) ;               if  Pos('UPLOAD ',uppercase(cmd)) >  0 then
               begin
                    c.FileName := trim(Copy(cmd,Pos(' ',cmd)+1,Length(cmd)));
                    c.TotalSize := StrToInt(Copy(c.FileName,Pos(' ',c.FileName)+1,Length(c.FileName)));
                    c.FileName := trim(Copy(c.FileName,1,Pos(' ',c.FileName)));
                    c.Status := 1;
                    Socket.Data := C;
                    Socket.SendText('you can send File  !'#13#10);
               end;
            end;
        1 : begin
                GetMem(Buffer,BufferSize);
                nRetr := Socket.ReceiveBuf(Buffer^,BufferSize);                if not FIleExists('c:\'+c.FileName) then
                begin
                     fs :=TFileStream.Create('c:\'+c.FileName,fmCreate or fmShareDenyNone);
                     fs.Seek(0,soFromBeginning);
                end
                else
                begin
                     fs :=TFileStream.Create('c:\'+c.FileName,fmOpenWrite or fmShareDenyNone);
                     fs.Seek(0,soFromEnd);
                end;                fs.WriteBuffer(Buffer^,nRetr);                fs.Destroy;
                FreeMem(Buffer);
            end;
    end;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
    Form2.Show;
end;end. 
 --------------------------------------------------------------------------------
来自：唐晓锋 时间：99-11-30 01:17:19 ID:162654 
unit Unit2;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ScktComp;type
  TForm2 = class(TForm)
    CS: TClientSocket;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    SendCommand: TButton;
    Label1: TLabel;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure SendCommandClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CSRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form2: TForm2;implementation{$R *.DFM}
function GetFileSize(const FileName: string):integer;
var f : TFileStream;
begin
    f := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
    Result :=f.Size;
    F.Free;
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
    with OpenDialog1 do
    begin
        Execute;
        if FileName <> '' then
        begin
            Edit1.Text := 'UPLOAD '+ ExtractFileName(FileName) +' '+Inttostr(GetFileSize(FileName));
            Label1.Caption := FileName;
            cs.Socket.SendText(edit1.Text);
        end;
    end;
end;procedure TForm2.Button2Click(Sender: TObject);
begin
    CS.Active := True;end;procedure TForm2.SendCommandClick(Sender: TObject);
var fs : TFileStream;
    Buf : pointer;begin
    //CS.Socket.SendText(Edit1.Text+#13#10);
    //Memo1.Lines.Add();
    fs := TFileStream.Create(Label1.Caption ,fmOpenRead or fmShareDenyNone);    GetMem(Buf,fs.Size);
    fs.Seek(0,soFromBeginning);    fs.ReadBuffer(Buf^,fs.Size);    memo1.Lines.Add('has send : '+inttostr(Cs.Socket.SendBuf(Buf^,fs.Size)));end;procedure TForm2.Button3Click(Sender: TObject);
begin
    cs.Close;
end;procedure TForm2.CSRead(Sender: TObject; Socket: TCustomWinSocket);
begin   Memo1.Lines.add(socket.receiveText);end;end.

Answer 2

unit SERVERS;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,IniFiles, ScktComp, Psock, NMSTRM, ComCtrls, ExtCtrls, StdCtrls;type
   TForm1 = class(TForm)
    NMStrmServ1: TNMStrmServ;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Label2: TLabel;
    procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
      strm: TStream);
    procedure NMStrmServ1ClientContact(Sender: TObject);
    procedure NMStrmServ1Status(Sender: TComponent; Status: String);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  PORTSTR,COmmstr:STRING;
  myinifile:Tinifile;
 Count : Integer;
implementation{$R *.dfm}procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
  strm: TStream);
var
myfstream:tfilestream;
begin
myfstream:=tfilestream.create('log\'+FormatdateTime('yyyymmddhhnnss',Now)+'.txt',fmcreate);
try
myfstream.CopyFrom(strm,strm.size);
finally
myfstream.Free;
end;
end;procedure TForm1.NMStrmServ1ClientContact(Sender: TObject);
begin
nmstrmserv1.ReportLevel:=status_basic;
nmstrmserv1.TimeOut:=90000;
statusbar1.SimpleText:='客户端连接';
end;procedure TForm1.NMStrmServ1Status(Sender: TComponent; Status: String);
begin
if statusbar1<>nil then
  statusbar1.SimpleText:=status;
end;procedure TForm1.FormCreate(Sender: TObject);
var filename:string;
begin
  filename:=ExtractFilePath(paramstr(0))+'CONFIG.INI';
  myinifile:=TInifile.Create(filename);
  PORTSTR:=myinifile.readstring('host','port',PORTSTR);
  NMStrmServ1.port:=strtoint(PORTSTR);
end;end.
*******************************************************************
unit CLIENTS;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp,IniFiles, DB, ADODB, ExtCtrls, Grids, DBGrids,
  Psock, NMSTRM, ComCtrls;type
   Tclientm = class(TForm)
    Button1: TButton;
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    Button2: TButton;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Label3: TLabel;
    NMStrm1: TNMStrm;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ADOConnection1AfterConnect(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure DbgridToTxt(source:Tobject);
    procedure NMStrm1MessageSent(Sender: TObject);
    procedure NMStrm1Connect(Sender: TObject);
    procedure NMStrm1Disconnect(Sender: TObject);
    procedure NMStrm1HostResolved(Sender: TComponent);
    procedure NMStrm1Status(Sender: TComponent; Status: String);
    procedure NMStrm1PacketSent(Sender: TObject);
    procedure NMStrm1InvalidHost(var Handled: Boolean);
    procedure NMStrm1ConnectionFailed(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
   
  public
    { Public declarations }
  end;var
  clientm: Tclientm;
  CONNSTR,HOSTSTR,PORTSTR,timestr,commstr:STRING;
  myinifile:Tinifile;
implementation{$R *.dfm}
procedure Tclientm.FormCreate(Sender: TObject);
var filename:string;
begin
  filename:=ExtractFilePath(paramstr(0))+'CONFIG.INI';
  myinifile:=TInifile.Create(filename);
  CONNSTR:=myinifile.readstring('db','DB_source',CONNSTR);
  HOSTSTR:=myinifile.readstring('host','address',HOSTSTR);
  PORTSTR:=myinifile.readstring('host','port',PORTSTR);
  commstr:=myinifile.readstring('db','commtext',commSTR);
  timeSTR:=myinifile.readstring('time','time',timeSTR);
  Adoconnection1.ConnectionString:=CONNSTR;
  Adoconnection1.connected:=true;
  Adodataset1.commandtext:=commstr;
  adodataset1.Connection:=Adoconnection1;
  Adodataset1.Active:=true;
  NMStrm1.Host := HOSTSTR;
  //label1.caption := formatdatetime('hhnnss',time);
  label2.caption := timestr;
end;procedure Tclientm.ADOConnection1AfterConnect(Sender: TObject);
begin
StatusBar1.SimpleText:='数据连接状况:正常';
end;procedure Tclientm.Button1Click(Sender: TObject);
var
filename:string;
MyFStream: TFileStream;
begin
  filename:=ExtractFilePath(paramstr(0))+'CONFIG.INI';
  myinifile:=TInifile.Create(filename);
  CONNSTR:=myinifile.readstring('db','DB_source',CONNSTR);
  HOSTSTR:=myinifile.readstring('host','address',HOSTSTR);
  PORTSTR:=myinifile.readstring('host','port',PORTSTR);
  MyFStream := TFileStream.Create(label3.caption, fmOpenRead);
    try
      NMStrm1.PostIt(MyFStream);
    finally
      MyFStream.Free;
    end;
end;
procedure Tclientm.Button2Click(Sender: TObject);
begin
 DbgridToTxt(dbgrid1);end;
procedure Tclientm.DbgridToTxt(source:Tobject);
var
  filename:Textfile;
  Dataset:Tdataset;
  valuestr,tempstr:string;
  counter:integer;
begin
  if (source is Tdbgrid)then
    Dataset:=Tdbgrid(source).DataSource.DataSet
    else
      Dataset:=TDataset(source);
  if ((Dataset.IsEmpty)or(not Dataset.Active))then
    exit else
    begin
      Dataset.DisableControls;
      Dataset.First;
        begin
          assignfile(filename,'log\'+FormatdateTime('yyyymmddhhnnss',Now)+'.txt');
          rewrite(filename);
          while not Dataset.Eof do
            begin
              valuestr:='';
              for counter:=0 to Dataset.FieldCount-1 do
              begin
                tempstr:=Dataset.Fields[counter].Text;
                valuestr:=valuestr+char(9)+tempstr;
              end;
              valuestr:=trim(valuestr);
              writeln(filename,valuestr);
              Dataset.Next;
            end;
              closefile(filename);
          end;
              Dataset.EnableControls;
              label3.caption:='log\'+FormatdateTime('yyyymmddhhnnss',Now)+'.txt'
    end;
end;procedure Tclientm.NMStrm1MessageSent(Sender: TObject);
begin
showmessage('传送开始');
end;procedure Tclientm.NMStrm1Connect(Sender: TObject);
begin
  StatusBar1.SimpleText := 'Connected';
end;procedure Tclientm.NMStrm1Disconnect(Sender: TObject);
begin
  If StatusBar1 <> nil then
    StatusBar1.SimpleText := '传送结束';
end;procedure Tclientm.NMStrm1HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText := 'Host Resolved';
end;procedure Tclientm.NMStrm1Status(Sender: TComponent; Status: String);
begin
  If StatusBar1 <> nil then
    StatusBar1.SimpleText := status;
end;procedure Tclientm.NMStrm1PacketSent(Sender: TObject);
begin
StatusBar1.SimpleText := IntToStr(NMStrm1.BytesSent)+' of '+IntToStr(NMStrm1.BytesTotal)+' sent';
end;procedure Tclientm.NMStrm1InvalidHost(var Handled: Boolean);
var
  TmpStr: String;
begin
  If InputQuery('Invalid Host!', 'Specify a new host:', TmpStr) then
  Begin
    NMStrm1.Host := TmpStr;
    Handled := TRUE;
  End;
end;procedure Tclientm.NMStrm1ConnectionFailed(Sender: TObject);
begin
ShowMessage('连接失败');
end;procedure Tclientm.Timer1Timer(Sender: TObject);
begin
  label1.Caption:=formatdatetime('hhnnss',time);
  if label1.caption = label2.caption then
  begin
  DbgridToTxt(dbgrid1);
  Button1Click(Sender);
  end;
end;end.

Answer 3

这个里面有数据库，只是因为原稿中需要将数据库文件传成TXT或是XML，如果你不要数据库，有些部分可以不看呀？
这个例子采用了NMStrmServ，很方便的。我认为比使用WINSOCKET做文件传输要快的多。

Answer 4

emule就是开放代码的盗版专家

Answer 5

如果想要稳当一点的就可认相对应的MAC地址...因为这是全球唯一的..所以比较难假冒..当然..还是可以假冒的..不过一般人做不到这一点...