Статьи на Delphi - Передача файла по 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
Гб. Все файлы были доставлены от сервера организации до клиента в локальной сети
без ошибок. Полный текст программы можно поглядеть в прилагаемых исходниках.
На этом все.
Удачи в этом интересном и развивающем мозг деле!
С Уважением!
Владимир.
Замечания и вопросы по статье отсылайте на
Исходный код и оригинал статьи: tcp-file-transfer.zip (543 Кб).
Дата: 24.05.2014, Автор: Владимир.