Запуск приложения Delphi с CGI и отправка результата в интерфейс - PullRequest
Новая
       68

Запуск приложения Delphi с CGI и отправка результата в интерфейс

0 голосов
/ 07 октября 2019

У меня есть исполняемый скрипт winCGI, возвращающий изображение. Я использую Intraweb в качестве сервера.

У меня есть пользовательский веб-сервер, созданный в Delphi, и я создаю функцию для запуска CGI и возврата изображения.

CGI от стороннего производителя иЯ не могу изменить твой код. У меня следующий код, возвращаемый из CGI при запросе изображения: 

'Content-type: image/gif'#$A'Access-Control-Allow-Origin: *'#$A#$A'GIF89a@'#1'@'#1#0#0#0'!ÿ'#$B'NETSCAPE2.0'#3#1'ÿÿ'#0'!ù'#4#0'!'#0#0#0','#0#0#0#0'@'#1'@'#1'‡'#0#0#0#1#1#1#2#2#2#3#3#3#4#4#4#5#5#5#6#6#6#7#7#7#8#8#8#9#9#9#$A#$A#$A#$B#$B#$B#$C#$C#$C#$D#$D#$D#$E#$E#$E#$F#$F#$F#$10#$10#$10#$11#$11#$11#$12#$12#$12#$13#$13#$13#$14#$14#$14#$15#$15#$15#$16#$16#$16#$17#$17#$17#$18#$18#$18#$19#........

Мне нужно отправить изображение в приложение внешнего интерфейса в браузере. 

<div>
 <img src="getImage(1)">
</div>

Здесь getImageФункция берет изображение с сервера, но не показывает, потому что я думаю, что формат, который я возвращаю изображение с сервера во внешний интерфейс, имеет что-то неправильно. Как можно исправить текст содержимого изображения на сервере, чтобы оно было допустимым изображением в интерфейсе? 

function RunCGIOutput(CommandLine: string; Stream:TStream;Folder: string = ''): string;
const
  CReadBuffer = 2400;
var
  saSecurity: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  suiStartup: TStartupInfo;
  piProcess: TProcessInformation;
  dRead: DWORD;
  Handle,WasOK:Boolean;
  Buffer: array[0..CReadBuffer] of AnsiChar;
  BytesRead: Cardinal;
  WorkingDirP,EnvBlock:PChar;

begin
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := true;
  saSecurity.lpSecurityDescriptor := nil;
  EnvBlock := BuildEnvBlock(True);
  if Folder <> '' then WorkingDirP := PChar(Folder)
  else WorkingDirP := nil;
  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
      FillChar(suiStartup, SizeOf(TStartupInfo), #0);
      suiStartup.cb := SizeOf(TStartupInfo);
      suiStartup.hStdInput := hRead;
      suiStartup.hStdOutput := hWrite;
      suiStartup.hStdError := hWrite;
      suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      suiStartup.wShowWindow := SW_HIDE;
      Handle:=CreateProcess(nil, PChar(CommandLine), @saSecurity, @saSecurity, true, CREATE_UNICODE_ENVIRONMENT, EnvBlock, WorkingDirP, suiStartup,
        piProcess);

    CloseHandle(hWrite);
    if Handle then
      try
        repeat
              WasOK := ReadFile(hRead, Buffer, CReadBuffer, BytesRead, nil) and (BytesRead>0);
              if WasOK then
                Stream.WriteBuffer(Buffer, BytesRead);
        until not WasOK;
        WaitForSingleObject(piProcess.hProcess, INFINITE);
      finally
        CloseHandle(piProcess.hThread);
        CloseHandle(piProcess.hProcess);
      end;
  finally
    CloseHandle(hRead);
    StrDispose(EnvBlock);
  end;
end;


//Run CGI, take image and send to browser
function TContentImaqge.Execute(aRequest: THttpRequest; aReply: THttpReply;
  const aPathname: string; aSession: TIWApplication;
  aParams: TStrings): boolean;
var
  s,wresult,saida,LocalDoc:string;
  i:integer;
  Stream:TMemoryStream;
begin
    Result:=True;
    LocalDoc:=TIWAppInfo.GetAppPath + 'wwwroot\cgi-bin\newweb\dgate.exe';
    Stream:=TMemoryStream.Create;
    saida:=RunCGIOutput(LocalDoc,Stream,TIWAppInfo.GetAppPath + 'wwwroot\cgi-bin\newweb\');
    Stream.Position:=0;
    saida:=ReadStringFromStream(Stream, -1, IndyTextEncoding_OSDefault);
    with aReply do
     begin
       ResetReplyType;
       Code := 200;
       ContentType := MIME_GIF; // MIME_HTML;
       SendStream(Stream);
    end;
end;

1 Ответ

1 голос
/ 09 октября 2019

Ваш CGI модуль генерирует необработанный HTTP-ответ , который должен передаваться как есть вашим обработчиком содержимого IW. Ответное сообщение состоит из:

  1. Строка состояния
  2. Строки заголовка HTTP
  3. Пустая строка, разделяющая заголовки и тело
  4. Тело (фактические данные изображенияв вашем случае)

Кажется, что IntraWeb THTTPReply не дает вам контроля над необработанным HTTP-ответом. Он предоставляет специальный интерфейс для отдельной манипуляции со статусом, заголовками и телом. Вот почему вам необходимо предварительно обработать поток, возвращаемый из CGI, и разделить заголовки на части по пустой строке. Затем вы можете передать их через THTTPReply. Возможно, вы также захотите внести в белый список только некоторые заголовки и игнорировать остальные.

В своем фрагменте кода вы используете ReadStringFromStream, что бессмысленно, так как вы все равно отбрасываете возвращаемое значение. Он перемещает позицию Stream в конец потока, но это не имеет значения, потому что aReply.SendStream(Stream) отправляет весь контент потока с начала.

Другой момент заключается в том, что вы используете IndyTextEncoding_OSDefaultв качестве последнего параметра для ReadStringFromStream, что, вероятно, неверно, поскольку заголовок HTTP закодирован в ASCII и, следовательно, вы должны использовать IndyTextEncoding_ASCII.

Вместо этого попробуйте этот код: 

function TContentImaqge.Execute(aRequest: THttpRequest; aReply: THttpReply;
  const aPathname: string; aSession: TIWApplication;
  aParams: TStrings): Boolean;
var
  CGIOutput, ContentStream: TMemoryStream;
  LocalDoc, Line: string;
  CharPos: Integer;
begin
  Result := True;
  CGIOutput := TMemoryStream.Create;
  try
    LocalDoc := TIWAppInfo.GetAppPath + 'wwwroot\cgi-bin\newweb\dgate.exe';
    RunCGIOutput(LocalDoc, CGIOutput, TIWAppInfo.GetAppPath + 'wwwroot\cgi-bin\newweb\');

    if ReadLnFromStream(CGIOutput, Line, -1, IndyTextEncoding_ASCII) then
    begin
      { process status line }
      CharPos := Pos(' ', Line);
      if CharPos > 0 then
      begin
        aReply.Code := StrToInt(Copy(Line, CharPos + 1, 3));
        CharPos := Pos(' ', Line, CharPos);
        if CharPos > 0 then
          aReply.CodeText := Copy(Line, CharPos + 1);
      end;

      { process headers (copy headers as they are) }
      while ReadLnFromStream(CGIOutput, Line, -1, IndyTextEncoding_ASCII) and (Line <> '') do
        aReply.Headers.Add(Line);

      { at this point CGIOutput.Position is at the beginning of body, so let's just copy
        the content to a separate memory stream }
      ContentStream := TMemoryStream.Create;
      try
        ContentStream.CopyFrom(CGIOutput, CGIOutput.Size - CGIOutput.Position);
      except
        ContentStream.Free;
        raise;
      end;
      aReply.SendStream(ContentStream);
    end
    else
    begin
      aReply.Code := 500;
      aReply.CodeText := RSHTTPInternalServerError;
      aReply.WriteString('CGI module returned malformed response.');
    end;
  finally
    CGIOutput.Free;
  end;
end;

Также обратите внимание, что вложенный вывод CGI не содержит строку состояния и начинается прямо с заголовков (Content-type: ...). Если это то, что вы получаете от CGI, вам следует обновить код для обработки такого случая.

...