LINUX.ORG.RU
Форум — Development  

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

 , , ,


0

1

добрый день

пытаюсь перенести приложение

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 (всего исправлений: 1)

А от местной публики вы чего хотите то? Чтобы они за вас прочитали документацию и разобрались в коде? Будем считать эти вопросы первым пендалем.

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

abcq ★★
()
Последнее исправление: abcq (всего исправлений: 1)

HttpClient.Post(AURL, ASource); // -> exception - Invalid Protocol: «»

В TFPHTTPClient.Post второй параметр это поток куда будет записываться ответ.

Вот так работает: 

function PostRequest(const aUrl: String; aSource: TStream): TStringStream;
var
  HttpClient: TFPHTTPClient;
begin
  Result := TStringStream.Create('', TEncoding.UTF8);
  try
    HttpClient := TFPHTTPClient.Create(nil);
    HttpClient.RequestBody := aSource;
    try
      HttpClient.Post(aUrl, Result);
    finally
      HttpClient.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Source: TStringStream = nil;
  Response: TStringStream = nil;
begin
  try
    Source := TStringStream.Create('Preved!');
    Response := PostRequest('http://httpbin.org/post', Source);
    ShowMessage(Response.DataString);
  finally
    Response.Free;
    Source.Free;
  end;
end;

No ★
()
Ответ на: комментарий от No

наверное, надо было сразу вызывающий код добавить (используется TMemo.Lines / TStrings) 

procedure TForm1.btnPostClick(Sender: TObject);
var
  ResponceStream: TStream;
begin
  //
  // teURL      : TEdit - http://192.168.0.250/api/cmd
  // mPostParams: TMemo - содержит ключи-значения
  //
  ResponceStream := PostRequest(teURL.Text, mPostParams.Lines);
  try
    mClientLog.Lines.LoadFromStream(ResponceStream);
  finally
    ResponceStream.Free;
  end;
end;
спасибо громеное :о) доберусь до железа, потестирую

sunjob ★★★★
() автор топика
Последнее исправление: sunjob (всего исправлений: 1)
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development