Голосование

Какую версию Delphi Вы используете?

Delphi 4 и ниже
Delphi 5
Delphi 7
Delphi 2005
Delphi 2006
Delphi 2007
Delphi 2009
Delphi 2010



Посмотреть результаты
Другие опросы ...

 

Лента RSS, новости сайта Новости сайта
Лента RSS, новости форума Новости форума
  Bookmark and Share

Архив исходников

   
  Базы данных
  Графика & Мультимедиа
  Сети & Интернет
  Система
  Разное
   

Кнопки, Ссылки и Баннеры ...

 


Automatic translation


English German French Italian Spanish
Portuguese Greece Japan Chinese Korean


Ссылки и Баннеры


скрыть

 

Delphi Sources

Delphi Sources

СТАТЬИ

 

. : Передача файла по TCP : .

 

Приветствую всех!

  

Как то раз возникла задача отправки файла с гарантированной доставкой до пункта назначения. Значит нужно использовать протокол TCP. Но какой компонент выбрать? В интернете очень много споров по этому вопросу и надо признаться я потратил очень много времени пробуя один компонент за другим и не получая требуемых результатов. Возможно это связано с тем, что я отношусь к классу новичков или как говориться type lamak = class(newbie). К тому же на просторах паутины попросту нет вменяемых рабочих примеров. В большинстве форумов отсылают новичков к примерам, которые идут вместе с компонентами. С одной стороны это и правильно, ведь если просто брать и копировать код, тогда люди ничему не научатся, а с другой стороны хорошая статья помогла бы сохранить очень много времени начинающим в познании сетей.

   

В этой статье будет показан небольшой пример как можно отправить файл большого размера от клиента к серверу с использованием компонент TTCPClient и TTCPServer.

   

   

Механика работы программы такова, что сначала отправляется так называемый маркер, который извещает сервер о том, что именно сейчас будет отправлено: строка текста или же файл и затем уже отправляются данные.

Клиентская часть

   

Функция отправки строки

   

procedure TForm1.ButtonSendLineClick(Sender: TObject);
var
  bt : integer;
begin
if Trim(EditLine.Text) <> '' then
  begin
     EditLine.Text := Trim(Editline.Text);
     Display('|------------------------------');
     Display('| Send string ' + QuotedStr(EditLine.Text));

     try
       TcpClient1.Sendln(MARKER_LINE);
       bt := TcpClient1.Sendln(EditLine.Text);
       Display('| Send bytes: ' + QuotedStr(IntToStr(bt)));
       Display('| Send length: ' + IntToStr(length(EditLine.Text)));
       Display('+------------------------------');
     except
       on E: Exception do begin Display('# ' + E.Message); end;
     end;
  end;
end;

   

В ней отправляется строка с маркером
TcpClient1.Sendln(MARKER_LINE);

   

и затем отправляется сама строка
bt := TcpClient1.Sendln(EditLine.Text);

   

Функция отправки файла

   

procedure TForm1.SendFile(FileName: string);
const
  delim : string[1] = ':';
var
  buf : Pointer;
  nRead : Integer;
  markerstring : string;
begin
if not FileExists(FileName) then Exit;
if TcpClient1.Connected then
  begin
     try
       FFileStream := TFileStream.Create(FileName, fmOpenRead);
       FFileStream.Position := 0;
       Progress(0, 0);
       try
         //отправка маркера "файл", его имени и размера
         //(можно тут же выслать хеш и прочее...)
         FileName := ExtractFileName(FileName);
         Display('|------------------------------');
        Display('| Send marker string ' + QuotedStr(MARKER_FILE + delim
                    + FileName + delim + IntToStr(FFileStream.Size)));
         TcpClient1.Sendln(MARKER_FILE);
         Display('| File name: ' + QuotedStr(FileName));
         TcpClient1.Sendln(FileName);
         Display('| File size: ' +
                    QuotedStr(IntToStr(FFilestream.Size)));
         TcpClient1.Sendln(IntToStr(FFilestream.Size));
         Display('| Sending...');
       except
         on E: Exception do begin Display('# ' + E.Message);
          AbortConnection; Exit; end;
       end;

       //посылка файла
       repeat
         try
           if TcpClient1.Connected then
             begin
               GetMem(buf, CONST_BUFSIZE);

               nRead := FFileStream.Read(buf^, CONST_BUFSIZE);
               if nRead > 0 then
                  begin
                    try
                      TcpClient1.SendBuf(buf^, nRead)
                    except
                      on E: Exception do begin Display('# '
                                                     + E.Message);
                      AbortConnection; Exit; end;
                    end;
                    Progress(FFileStream.Position, FFileStream.Size);
                  end;

               Application.ProcessMessages;
             end;
         finally
           FreeMem(buf, CONST_BUFSIZE);
         end;

       until nRead <= 0;

       Display('| File ' + QuotedStr(FileName) + ' sent');
       Display('+------------------------------');
     finally
       if FFileStream <> nil then begin FFileStream.Free;
       FFileStream := nil; end;
     end;
  end;
end;
 

Сначала отправляется маркер «файл»
TcpClient1.Sendln(MARKER_FILE);
 

Затем высылается имя файла и его размер
TcpClient1.Sendln(FileName);
TcpClient1.Sendln(IntToStr(FFilestream.Size));
 

И в цикле repeat .. until отправляется, непосредственно, сам файл.

   

Серверная часть

   

Основное событие TCPServer это onAccept и в нем я проводил обработку запросов клиента. Возможно, это и не корректно и надо было создавать потоки в событии OnGetThread, но по-другому у меня не получилось реализовать работу. Я использовал бесконечный цикл While True do для работы с клиентом. Код функции снабжен большим количеством комментариев.

   

procedure TForm1.TcpServer1Accept(Sender: TObject; ClientSocket:
    TCustomIpClient);
var
  rcvdline, fName : string;
  fSize : Int64;
  buf : pointer;
  readCount, nRead: integer;
begin
Display(' from ' + QuotedStr(ClientSocket.RemoteHost + ':'
 + ClientSocket.RemotePort));

while True do
  begin
    // дойдя до этого места программа будет ждать данные от клиента
    rcvdline := ClientSocket.Receiveln;

    // пришли данные (в нашем случае 'маркер' команды)
    if (rcvdline <> '') and ClientSocket.Connected then
      begin
        Display('|------------------------------');
        Display('| Accepted marker: ' + QuotedStr(rcvdline));

        {* * * * *}  //прием текстовой строки
        if (rcvdline = MARKER_LINE) and ClientSocket.Connected then
          begin
            // сама строка, отправленная клиентом
            rcvdline := ClientSocket.Receiveln;
            if Trim(rcvdline) = '' then
              begin
                 Display('| Dead line...');
                 Display('+------------------------------');
                 Exit;
              end
            else Display('| Received line: ' + QuotedStr(rcvdline));
    Display('| Received bytes: ' + IntToStr(ClientSocket.BytesReceived
                                            - length(MARKER_LINE) - 2));
            Display('| Received length: ' + IntToStr(length(rcvdline)));
            Display('+------------------------------');
          end // конец приема строки

        {* * * * *}  //прием файла
        else if (rcvdline = MARKER_FILE) and ClientSocket.Connected then
          begin

            // клиентом отсылается 3 строки: Маркер,
            // имя файла и его размер,
            // поэтому вызываем в общей сложности 3 раза
            // 'ClientSocket.Receiveln'
            // (1 раз в цикле отлова маркера выше и 2 раза ниже)
            fName := ClientSocket.Receiveln;
            fSize := StrToInt64(ClientSocket.Receiveln);

            Display('| File name: ' + QuotedStr(fName));
            Display('| File size: ' + QuotedStr(IntToStr(fSize)));
            Display('| Receiving...');

            // создание потока для сохранения файла
            if FFileStream = nil then
               begin
                 try
                   FFileStream := TFileStream.Create(DestFolder +
                     fName, fmCreate);
                   FFileStream.Position := 0;
                   // установка прогрессбара в 0
                   Progress(0, 0);
                 except
                   on E: Exception do begin Display('#' + E.Message);
                     Exit; end;
                 end;
               end;

             repeat
                // таймаут для ожидания пакетов на случай
                // зависания клиента (можно и без него)
                if not ClientSocket.WaitForData(CONST_DATATIMEOUT) then
                  begin
                     AbortConnection(ClientSocket);
                     Exit;
                  end;

                // если оставшийся размер получаемого
                // файла больше размера буфера,
                // то считываем данные размером с наш буфер
                // иначе читается остаток файла

                // Например, размер буфера равен 4096, а до
                // конца файла осталось
                // считать только 500 байт, следовательно будет
                // считано только 500 байт,
                // вместо 4096
                readCount := Min(fSize - FFileStream.Position,
                    CONST_BUFSIZE);
                try
                  // выделение памяти под кусок файла
                  GetMem(buf, readCount);
                  try
                    // считывание из сокета части данных
                    // при этом НЕ ОБЯЗАТЕЛЬНО считается readCount байт
                    // может считаться и меньше поэтому...
                    nRead := ClientSocket.ReceiveBuf(buf^, readCount);
                  except
                    on E: Exception do begin Display('#' + E.Message);
                      AbortConnection(ClientSocket); Exit; end;
                  end;

                  // ...поэтому если что то считалось
                  if nRead > 0 then
                    begin
                       // пишем в файл ровно столько, сколько
                       // считалось (nRead),
                       // а не readCount
                       FFileStream.WriteBuffer(buf^, nRead);
                       // обновление прогрессбара
                       Progress(FFileStream.Position, fSize);
                    end;
                finally
                  // отпускаем буфера
                  FreeMem(buf, readCount);
                end;
             // чтение в цикле repeat -- until до тех пор,
             // пока позиция потока
             // FFileStream не достигнет конца файла fSize
             until FFileStream.Position = fSize;

             // если файл докачался...
             // (по сути выход из вышеупомянутого цикла
             // repeat - until и есть
             // факт докачки файла и эта проверка излишняя)
             if FFileStream.Position = fSize then
                 begin
                   FFileStream.Free; FFileStream := nil;
                   // любые действия после докачки файла:
                   // проверка контрольной суммы файла,
                   // перемещение файла куда-либо и т.д.
                   Display('| File ' + QuotedStr(fName) + ' received');
                   Display('+------------------------------');
                 end;
          end//конец приема файла

       {* * * * *} // иначе херня
        else
          begin
            AbortConnection(ClientSocket);
          end;

      end
    // если rcvdline = '' то значит, что клиент отключился
    // и можно выйти из цикла
    else
      begin
        Display(QuotedStr(ClientSocket.RemoteHost + ':'
                   + ClientSocket.RemotePort) + ' disconected.');
        break; //выход из цикла 'While True do'
      end;
  end;
end;

   

Были проведены тесты по пересылке файлов объемом 200 Кб, 120 Мб, 600 Мб и 2.5 Гб. Все файлы были доставлены от сервера организации до клиента в локальной сети без ошибок. Полный текст программы можно поглядеть в прилагаемых исходниках.
 

На этом все.
Удачи в этом интересном и развивающем мозг деле!

   

С Уважением!
Владимир.

  

Замечания и вопросы по статье отсылайте на Crusl@mail.ru.
 

Исходный код и оригинал статьи: tcp-file-transfer.zip (543 Кб).

Дата: 24.05.2014, Автор: Владимир.






Назад

   

 































































































































































































 

© 2004-2018 "DS"

Отправить письмо / Реклама


ВКонтакте   Facebook   Twitter