[OSIRIS]

ситуация следующая:
есть консольное приложение, после запуска надо в него предавать данные и считывать результат соответственно

перекопал много чего - рабочего примера так и не нашел

самое близкое - исходники redirect-a ( http://vovan-ve.fatal.ru/download/55 )
но там проблема с кодировкой

пробовал

компонент RusCod1 - не помогло

функции

Код:

function StrOemToAnsi(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  OemToAnsiBuff(@S[1], @Result[1], Length(S));
end;

//---------------------------------------------------------------
function StrAnsiToOem(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  AnsiToOemBuff(@S[1], @Result[1], Length(S));
end;

Админ: Пользуемся тегами для оформления кода!

тоже не спасают

PS:
Embarcadero® RAD Studio XE 2010
Windows 7 проф.

[poli-smen]

Сообщение от OSIRIS

функции

Код:

function StrOemToAnsi(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  OemToAnsiBuff(@S[1], @Result[1], Length(S));
end;

//---------------------------------------------------------------
function StrAnsiToOem(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  AnsiToOemBuff(@S[1], @Result[1], Length(S));
end;

тоже не спасают

Вот так должно работать:

Код:

function CharToOemCase(Value: AnsiString): AnsiString;
begin
  Result := Value;
  if Result <> '' then CharToOemBuffA(Pointer(Result), Pointer(Result), Length(Result));
end;

function OemToCharCase(Value: AnsiString): AnsiString;
begin
  Result := Value;
  if Result <> '' then OemToCharBuffA(Pointer(Result), Pointer(Result), Length(Result))
end;

Пример:

Код:

program Project1;

{$APPTYPE CONSOLE}

uses
  Windows;

function CharToOemCase(Value: AnsiString): AnsiString;
begin
  Result := Value;
  if Result <> '' then CharToOemBuffA(Pointer(Result), Pointer(Result), Length(Result));
end;

function OemToCharCase(Value: AnsiString): AnsiString;
begin
  Result := Value;
  if Result <> '' then OemToCharBuffA(Pointer(Result), Pointer(Result), Length(Result))
end;

begin
  Writeln(CharToOemCase('Проверка'));
  Readln;
end.

[Freeman]

Гадостью CharToOem лучше не пользоваться, она корежит символы псевдографики. Для современных версий Delphi правильным будет решение через встроенные преобразования UnicodeString:

Код:

type
  OEMString = type AnsiString(CP_OEMCP);
var
  S: OEMString;
  U: UnicodeString;
begin
  ReadLn(RedirOut, S);
  U := S;
  Memo1.Add(U);
end;

По идее, должно сработать и прямое присваивание, поскольку OEMString физически тоже UnicodeString:

Код:

begin
  ReadLn(RedirOut, S);
  Memo1.Add(S);
end;

[OSIRIS]

заработал вот такой код:

Код:

function StrAnsiToOem(const S: String): AnsiString;
begin
  SetLength(Result, Length(S)*2);
  AnsiToOemBuff(@S[1], @Result[1], Length(S)*2);
end;

function StrOemToAnsi(const S: String): AnsiString;
begin
  SetLength(Result, Length(S)*2);
  OemToAnsiBuff(@S[1], @Result[1], Length(S)*2);
end;

прием работает нормально, по крайней мере при старте ( запускается консольное приложение и выдает данные в подобающем виде)
однако при попытке отправить команду ничего не происходит, а при нажатии "end write" команда вроде отправляется - однако обрезается по ходу дела до 1 символа
исправленные исходники могу приложить или выложить какую либо часть кода

[Freeman]

Сообщение от OSIRIS

при нажатии "end write" команда вроде отправляется - однако обрезается по ходу дела до 1 символа

Аффтар, ты баран. Пользоваться Юникод-версией Delphi и городить какую-то кривую самопальщину вместо встроенного преобразования кодовых страниц -- надо быть альтернативно одаренным. Неужели нельзя справку почитать? Есть прекрасная функция SetCodePage. Передавай ей GetOEMCP, и будет тебе преобразование из кодовой страницы OEM.

[OSIRIS]

Сообщение от Freeman

Аффтар, ты баран. Пользоваться Юникод-версией Delphi и городить какую-то кривую самопальщину вместо встроенного преобразования кодовых страниц -- надо быть альтернативно одаренным. Неужели нельзя справку почитать? Есть прекрасная функция SetCodePage. Передавай ей GetOEMCP, и будет тебе преобразование из кодовой страницы OEM.

"setcodepage" надо будет запомнить, ранее не натыкался, вопрос же сейчас уже по больше части в другом - почему не идет отправка данных в консольное приложение, или же оно идет но не полностью?

к слову говоря:

Код:

procedure TForm1.btnWriteClick(Sender: TObject);
var s:string;
begin
    if zRedirect<>nil then begin
        s := edInput.Text+#13#10;
        if rgCharset.ItemIndex=1 then
            //CharToOem(@s[1],@s[1]);   //////////
            s:=StrAnsiToOem(s);
        zRedirect.WriteData(s);
        edInput.Text := '';
    end;
end;

procedure TRedirectThread.WriteData(Data: string);
var writen:Cardinal;
begin
    if (hWriteIn<>0) and (Length(Data)>0) then begin
        WriteFile(hWriteIn, Data[1], Length(Data), writen, nil);
    end;
end;

[Freeman]

По-нормальному должно быть как-то так:

Код:

procedure TForm1.btnWriteClick(Sender: TObject);
var
  s: string;
begin
  if zRedirect <> nil then
  begin
    s := edInput.Text + sLineBreak;
    if rgCharset.ItemIndex = 1 then
      SetCodePage(s, GetOEMCP, True);
    zRedirect.WriteData(s);
    edInput.Text := '';
  end;
end;

procedure TRedirectThread.WriteData(Data: RawByteString); // переопределил!
var
  Written: Cardinal;
begin
  if hWriteIn <> 0 then
    WriteFile(hWriteIn, Data[1], Length(Data) * StringElementSize(Data), Written, nil);
end;

[OSIRIS]

Сообщение от Freeman

По-нормальному должно быть как-то так:

Код:

procedure TForm1.btnWriteClick(Sender: TObject);
var
  s: string;
begin
  if zRedirect <> nil then
  begin
    s := edInput.Text + sLineBreak;
    if rgCharset.ItemIndex = 1 then
      SetCodePage(s, GetOEMCP, True);
    zRedirect.WriteData(s);
    edInput.Text := '';
  end;
end;

procedure TRedirectThread.WriteData(Data: RawByteString); // переопределил!
var
  Written: Cardinal;
begin
  if hWriteIn <> 0 then
    WriteFile(hWriteIn, Data[1], Length(Data) * StringElementSize(Data), Written, nil);
end;

строка

Код:

SetCodePage(s, GetOEMCP, True);

выдает ошибку

Код:

[DCC Error] Unit1.pas(199): E2033 Types of actual and formal var parameters must be identical

при описании

Код:

var
  s: RawByteStr;

запускается - но результат тот же, ( команда проходит неправильно), мб ошибка где то в отправке а не в кодировке?

[Freeman]

Сообщение от OSIRIS

запускается - но результат тот же, ( команда проходит неправильно)

Это очень странно.

Хорошо, попробуем вариант с метатипом, который уже предлагал:

Код:

type
  OEMString = type AnsiString(CP_OEMCP);

procedure TForm1.btnWriteClick(Sender: TObject);
var
  s: RawByteString;
begin
  if zRedirect <> nil then
  begin
    zRedirect.WriteData(edInput.Text + sLineBreak);
    edInput.Text := '';
  end;
end;

procedure TRedirectThread.WriteData(const Data: OEMString); // <-- вот тут
var
  Written: Cardinal;
begin
  if hWriteIn <> 0 then
    WriteFile(hWriteIn, Data[1], Length(Data) * StringElementSize(Data), Written, nil);
end;

[OSIRIS]

заработало, спасибо ))
а можно поподробнее про ansistring? если честно не знал что у него могут быть параметры.... получается параметром указывается в какой кодировке будет строка?

[Freeman]

Сообщение от OSIRIS

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

Для начала нужно уяснить, что тип UnicodeString -- метастрока, то есть общая структура, позволяющая хранить текстовые данные с разным физическим представлением символов. Кодировки на основе кодовых страниц и UTF-8 хранят символы в виде одного или нескольких байт, а UTF-16 -- в виде одного или двух слов, которые называют WideChar. Если не путаю, UnicodeString поддерживает также и UTF-32, в которой символы представлены двойными словами -- UCS4Char.

Особенность в том, что словные и двухсловные символы имеют лишь одно логическое представление -- UTF-16 и UTF-32 соответственно, а вот байтовые интерпретируются по-разному в зависимости от кодовой страницы. В Delphi это и реализовано: AnsiString является подтипом UnicodeString для байтовых символов, и ему можно задать кодовую страницу.