перенос сетевого приложения Delphi -> Lazarus

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

перенос сетевого приложения Delphi -> Lazarus

Сообщение sunjob » 20.04.2022 22:07:23

добрый день

пытаюсь перенести приложение !!! (приложение не мое) !!!

Код: Выделить всё
Delphi (неизвестная версия, но, видимо, не сильно старая)
Lazarus - 2.0.12/2.2.0
fpc - соотв. версиям Lazarus


приложение предназначено для тестирования "сетевых технологий" (отправка/прием)

в лоб конвертировать приложение не получилось
menu/Tools/Delpi Conversion

в ручном режиме создал проект, добавил компоненты на форму, перетащил код
1я часть/сервер работает (слушает порт, принимает запросы, выводит в TMemo)
2я часть/клиент уперлась в компонент THTTPClient. пытался заменить на "аналогичные", получал исключение

Код: Выделить всё
THTTPClient
-->
FPHTTPClient / use fphttpclient
IdHTTP       / Indy-10.6.2.0


идеи, пендили, помидоры... приветствуются :о)
спасибо

Код: Выделить всё
mClientLog            : TMemo;

procedure TForm1.btnGetClick(Sender: TObject);
var
  SS: TStringStream;
  HttpClient: THTTPClient;
begin
  SS := TStringStream.Create('', TEncoding.UTF8);
  try
    HttpClient := THTTPClient.Create();
    try
      HttpClient.Get(teURL.Text, SS);
      mClientLog.Lines.Add(SS.DataString);
    finally
      HttpClient.Free;
    end;
  finally
    SS.Free;
  end;
end;

function TForm1.PostRequest(const AURL: String; ASource: TStrings): TStream;
var
  SS: TStringStream;
  HttpClient: THTTPClient;
begin
  Result := TStringStream.Create('', TEncoding.UTF8);
  try
    HttpClient := THTTPClient.Create();
    try
      HttpClient.Post(AURL, ASource, Result);
    finally
      HttpClient.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
//
// пытался заменить на TFPHTTPClient - вызывает исключение
// -> exception - Invalid Protocol: ""
//
////////////////////////////////////////////////////////////////////////////////

function TForm1.PostRequest(const AURL: String; ASource: TStrings): TStream;
var
  SS: TStringStream;
  HttpClient: TFPHTTPClient; //
begin
Result := TStringStream.Create('', TEncoding.UTF8);
  try
    HttpClient := TFPHTTPClient.Create(nil);
    try
      HttpClient.Post(AURL, ASource); // -> exception - Invalid Protocol: ""
    finally
      HttpClient.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;
Последний раз редактировалось sunjob 21.04.2022 01:01:51, всего редактировалось 1 раз.
Аватара пользователя
sunjob
постоялец
 
Сообщения: 123
Зарегистрирован: 12.01.2011 15:19:54

Re: перенос сетевого приложения Delphi -> Lazarus

Сообщение Ichthyander » 20.04.2022 22:18:22

P.P.S. Последний приведенный фрагмент кода как минимум с процедурой TForm1.PostRequest явно неверный.
1) Во-первых, параметр ASource (TStrings) указывается параметром в процедуре POST, где он уже становится приемников ответа после запроса. В итоге он никак не используется.
2) Зачем-то создается экземпляр TStringStream и при этом с ним ничего не делается! Разве сама Lazarus IDE не выводило у Вас подсказку, что переменная ss никак не используется?
3) Result присваивается пустая строка и в итоге так и остается на выходе. Зачем??
4) В завершение генерится ошибка raise. Опять непонятно зачем и почему.
Тут надо мне подумать, что Вы хотели этим кодом сделать и переосмыслить

Добавлено спустя 22 минуты 17 секунд:
Подумав, чего Вы хотели получить я переработал эту функцию. Не проверял - проверьте сами. try except поставьте по необходимости. Еще один важный момент: я не рекомендую отдавать в качестве результата функции созданный экземпляр класса как в Вашем случае. Это некрасивое решение. Ну или обзовите функцию к примеру CreatePostRequestStream, к примеру. Но дело ваше. На фоне других ошибок это уже кажется мелочью. А новая функция вот:

Код: Выделить всё
function TForm1.PostRequest(const AURL: String; ASource: TStrings): TStream;
var
  HttpClient: TFPHTTPClient;
begin
  Result:=TStringStream.Create(EmptyStr);
  HttpClient := TFPHTTPClient.Create(nil);
  HttpClient.RequestBody:=TStringStream.Create(ASource.Text);
  try
    HttpClient.Post(AURL, Result);
  finally
    HttpClient.RequestBody.Free;
    HttpClient.Free;
  end;
end; 


Добавлено спустя 11 минут 45 секунд:
Понял зачем raise - добавил вариант с except, но все равно такой тип функции мне не нравится. Такое делают по-другому. Передают в качеств параметра фукнцию, а не передают как результат функции с созданием экземпляра внутри
Код: Выделить всё
function TForm1.PostRequest(const AURL: String; ASource: TStrings): TStream;
var
  HttpClient: TFPHTTPClient;
begin
  Result:=TStringStream.Create(EmptyStr);
  HttpClient := TFPHTTPClient.Create(nil);
  HttpClient.RequestBody:=TStringStream.Create(ASource.Text);
  try
    try
      HttpClient.Post(AURL, Result);
    finally
      HttpClient.RequestBody.Free;
      HttpClient.Free;
    end;
  except
    Result.Free;
    raise
  end;
end;
Аватара пользователя
Ichthyander
энтузиаст
 
Сообщения: 668
Зарегистрирован: 04.04.2007 08:32:43
Откуда: Астрахань

Re: перенос сетевого приложения Delphi -> Lazarus

Сообщение sunjob » 21.04.2022 01:03:21

что Вы хотели этим кодом сделать

мне бы самому понять ... :о)
!!! (приложение не мое) !!!
(добавил для понимания ситуации)
+
На фоне других ошибок

говорите, не стесняйтесь :о)

п.с. спасибо, доберусь до железки, посмотрю...

Добавлено спустя 10 минут 37 секунд:
та-же ошибка

зю
по поводу "потока", он далее так используется :о)
Код: Выделить всё
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.btnPostClick(Sender : TObject);
////////////////////////////////////////////////////////////////////////////////
var
  ResponceStream: TStream;
begin
ResponceStream := PostRequest(teURL.Text, mPostParams.Lines);
try
  mClientLog.Lines.LoadFromStream(ResponceStream);
finally
  ResponceStream.Free;
end;
end;
//////////////////////////////////////////////////////////////////////////////// 


хотите, я выложу полный проект? надеюсь, автор будет не против.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Аватара пользователя
sunjob
постоялец
 
Сообщения: 123
Зарегистрирован: 12.01.2011 15:19:54

Re: перенос сетевого приложения Delphi -> Lazarus

Сообщение Vadim » 21.04.2022 06:41:41

sunjob
Судя по тексту ошибки (по косвенным данным ;-) ) у Вас там где-то ожидалось "http" или "https", однако было не найдено. Попробуйте выяснить этот момент в коде.
Vadim
долгожитель
 
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: перенос сетевого приложения Delphi -> Lazarus

Сообщение Ichthyander » 22.04.2022 05:19:05

sunjob писал(а):хотите, я выложу полный проект? надеюсь, автор будет не против.

Ориентируйтесь на лицензионное соглашение автора: явное или неявное )
Vadim правильно сказал. Складывается ощущение, что Вы может просто забыли указать протокол в URL запроса. То есть, к примеру, указали в URL "freepascal.ru" вместо "http://freepascal.ru" или "https://sample.com/"
Аватара пользователя
Ichthyander
энтузиаст
 
Сообщения: 668
Зарегистрирован: 04.04.2007 08:32:43
Откуда: Астрахань

Re: перенос сетевого приложения Delphi -> Lazarus

Сообщение sunjob » 26.04.2022 10:56:43

спасибо всем за пендили, вроде как "лед сдвинулся"... :о)
пока дальше добивать этот модуль времени нет, если дошлепаю, отпишиусь :о)
Аватара пользователя
sunjob
постоялец
 
Сообщения: 123
Зарегистрирован: 12.01.2011 15:19:54


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 32

Рейтинг@Mail.ru