Передача файлов

[Lemo]

Ребята, с помощью каких компонентов в делфи можно передавать файлы!

Алгоритм:
Кнопка "Загрузить"=>диалоговое окно(выбираешь файл)=>ОК=>пошла передача файла!

Тонкости:
Что бы показывало какой процент отдан (возможно воспользоваться компонентом ProgressBar или Gauge) и сколько времени осталось до завершение передачи!
Жду ваших советов!

[uberchel]

Хм. А куда передавать то ???

[Lemo]

на другой копьютер
(пооидеи на другом компьтере должна быть эта же программа, с возможностью принимать и отдавать файлы) (не локальная сеть)!

[profi]

Делал когда-то подобную программу на Делфи, завтра приеду домой если найду скину. Напишите мне в ЛС свой почтовый ящик на всякий случай.

[uberchel]

Посмотри здесь :http://www.delphisources.ru/pages/fa...entsocket.html

[Lemo]

profi подогнал готовый пример:
Передача файлов происходи с помощью Компонетна TCP
Код клиента:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  StdCtrls;

type
  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    Button1: TButton;
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
var
  FileName: PChar;
  FileSize: Cardinal;
  FS: TFileStream;
begin
  GetMem(FileName, 256);
  try
    IdTCPClient1.ReadBuffer(FileName^, 256);
    IdTCPClient1.ReadBuffer(FileSize, SizeOf(FileSize));
    FS := TFileStream.Create(FileName, fmCreate); // тут создается файл, я его положил в каталог incoming
    try
      IdTCPClient1.ReadStream(FS, FileSize);
    finally
      FS.Free;
    end;
  finally
    FreeMem(FileName);
  end;
  ShowMessage('Принято');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
IdTCPClient1.Connect;
end;

end.

Код Сервера:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, sDialogs, StdCtrls,
  sButton;

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    sOpenDialog1: TsOpenDialog;
    sButton1: TsButton;
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure sButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var
  FileToSend: String;
  FileSize: Cardinal;
  p: Pointer;
begin
  FileToSend := sOpenDialog1.FileName;  // тут файл, который мы рассылаем любому попросившему.
  with TFileStream.Create(FileToSend, fmOpenRead) do
  try
    FileToSend := ExtractFileName(FileToSend) + #00;
    GetMem(p, 256);
    try
      CopyMemory(p, @FileToSend[1], Length(FileToSend));
      AThread.Connection.Socket.Send(p^, 256);
    finally
      FreeMem(p);
    end;
      FileSize := Size;
      AThread.Connection.Socket.Send(FileSize, SizeOf(FileSize));
      GetMem(p, Size);
    try
      ReadBuffer(p^, Size);
      AThread.Connection.Socket.Send(p^, Size);
    finally
      FreeMem(p);
    end;
  finally
    Free;
  end;
  AThread.Connection.Disconnect;
  ShowMessage('Послано');
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
sOpenDialog1.Execute;
end;
end.

Резльтат:


Проблема:
Когда я все делаю на 1 компе=> все работает (скриншет)
Но когда я с другом пытался передать файлы: выдавало ерор:



Как я передвал с другом файл:
друг скачал у меня клиент(екзешник), я на серве запустил, выбрал файл, говорю другу что бы нажал кнопку(принять файл) вылетает вышеуказаная ошибка!
Жду ваших советов!
Сам думаю что то с ип ?

[Lemo]

http://ipicture.ru/Gallery/Viewfull/20865736.html
забыл ссылку на ерор =)

[profi]

Все верно с ошибкой. Просто в свойстве Host компонента IdTCPClient1 нужно поставить IP адрес компьютера с которым нужно соединится.

[Lemo]

Terran подогнал исходник (+ в репе), а я его чуть переделал!
И кому интересно можете скачать...
Примечание:
Передавать с сервера можно только архивы (.rar).

Иходники:

Сервер

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, sSkinManager, sButton, Menus, CoolTrayIcon,
  sLabel;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ServerSocket1: TServerSocket;
    OpenDialog1: TOpenDialog;
    sSkinManager1: TsSkinManager;
    sButton1: TsButton;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    Hfpdt1: TMenuItem;
    N1: TMenuItem;
    sLabelFX1: TsLabelFX;

    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sButton1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Hfpdt1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
Var
fs: TFileStream;
Data: TMemoryStream;
Begin
if Socket.ReceiveText = 's' then
Begin
fs:=TFileStream.Create(Edit1.Text, fmOpenRead);
Try
fs.Position:= 0;
Socket.SendText('Size:'+IntToStr(fs.Size)+ #0);
Socket.SendStream(fs);
Finally
End;
End;
End;
procedure TForm1.sButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.Text:=OpenDialog1.FileName;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.Hfpdt1Click(Sender: TObject);
begin
Form1.show;
end;

End.

Клиент

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, sEdit, sSkinManager, sLabel, sButton, Menus,
  CoolTrayIcon;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    sLabelFX1: TsLabelFX;
    sSkinManager1: TsSkinManager;
    sEdit1: TsEdit;
    sButton1: TsButton;
    sButton2: TsButton;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure sButton1Click(Sender: TObject);
    procedure sButton2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    { Private declarations }
    fs: TFileStream;
    Reciving:Boolean;
    DataSize: integer;
      public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}




Procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
Begin
Socket.SendText('s');
End;
Procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
Var
s, sl: String;
Begin
s:= Socket.ReceiveText;
if Reciving then
Begin
fs.Write(s[1],length(s));
if fs.Size=DataSize then
Begin
fs.Free;
Reciving:=False;
Application.MessageBox('Поздравляю, Фаил принят', 'Внимание!!!');
End;
Exit;
End;
if copy(s, 1, 5)='Size:' then
Begin
sl:=copy(s, 6, Pos(#0, s)-6);
DataSize:=StrToInt(sl);
Delete(s, 1, Pos(#0, s));
Reciving:=True;
fs:=TFileStream.Create('OUTPUT.rar',fmCreate);
fs.Write(s[1], length(s));
End;
End;
procedure TForm1.sButton1Click(Sender: TObject);
begin
ClientSocket1.Address:=sEdit1.Text;
ClientSocket1.Active:=True;
end;

procedure TForm1.sButton2Click(Sender: TObject);
begin
ClientSocket1.Active:=False;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
form1.show;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
Application.Terminate;
end;

End.

Теперь вопросы:
Как можно передать файл, не подключаясь к инету, тойсть по локалке?
Пример:наша група сидит за машинами на паре програмирывания (подкл к инету отсутствует) и по-идее файл можно передать через сеть, а как?
2 приложения (нижевыложенные) идут через ип...

[Lemo]

У кого какие идеи?..