. : Передача файла по 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;

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;

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;

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

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

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

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

Назад