AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Delphi pipes(read+write) zu mehr als einer Konsolenanwendung

pipes(read+write) zu mehr als einer Konsolenanwendung

Ein Thema von Icyclemort · begonnen am 6. Mai 2006 · letzter Beitrag vom 8. Mai 2006
Antwort Antwort
Icyclemort

Registriert seit: 3. Mai 2006
3 Beiträge
 
#1

pipes(read+write) zu mehr als einer Konsolenanwendung

  Alt 6. Mai 2006, 22:33
Hi all!

Ich habe in letzter Zeit eine "Redirect Console unit" (hier irgendwo gefunden, auch wenn ich es jetzt gerade nicht wieder sehe) in einem Programm von mir, welches mit Konsolenanwendung per Textbefehlen kommunizieren muss, benutzt.
In der ursprünglichen Verwendung (GUI--Konsole) funktioniert das auch prima...

Hier der wesentliche Quellcode als Referenz:

Delphi-Quellcode:
unit RedirectConsole;

interface

const
  CRLF=#13#10;

var
  RC_SendBuf: string;
  RC_End: Boolean;
  RC_ExitCode: Cardinal;

procedure RC_Run(Command: string);
procedure RC_LineIn(s: string);
var RC_LineOut: procedure(s: string);

implementation

uses Windows, Forms;

procedure RC_LineIn(s: string);
begin
  RC_SendBuf:=RC_SendBuf+s+CRLF;
end; // RC_LineIn;

function IsWinNT: Boolean;
var osv: tOSVERSIONINFO;
begin
  osv.dwOSVersionInfoSize:=sizeof(osv);
  GetVersionEx(osv);
  result:=osv.dwPlatformID=VER_PLATFORM_WIN32_NT;
end; // IsWinNT

procedure SplitLines(s: string);
var t: string;
begin
  while pos(#$A, s)<>0 do begin
    t:=copy(s, 1, pos(#$A, s)-1);
    RC_LineOut(t);
    delete(s, 1, pos(#$A, s));
  end;
  if length(s)>0 then RC_LineOut(s);
end; // SplitLines

procedure RC_Run(Command: string);
const bufsize=1024; // 1KByte buffer
var
  buf: array [0..bufsize-1] of char;
  si: tSTARTUPINFO;
  sa: tSECURITYATTRIBUTES;
  sd: tSECURITYDESCRIPTOR;
  pi: tPROCESSINFORMATION;
  newstdin, newstdout, read_stdout, write_stdin: tHandle;
  bread, avail: dword;
begin
  // Configuraciones de seguridad para WinNT
  if IsWinNT then begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, false);
    sa.lpSecurityDescriptor:=@sd;
  end else sa.lpSecurityDescriptor:=nil;
  // Creamos Pipe A
  if not CreatePipe(newstdin, write_stdin, @sa, 0) then begin
    RC_LineOut('Error creating Pipe A');
    exit;
  end;
  // Creamos Pipe B
  if not CreatePipe(read_stdout, newstdout, @sa, 0) then begin
    RC_LineOut('Error creating Pipe B');
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
    exit;
  end;
  // Configuramos si
  GetStartupInfo(si);
  si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow:=SW_HIDE;
  si.hStdOutput:=newstdout;
  si.hStdError:=newstdout;
  si.hStdInput:=newstdin;
  // Creamos proceso
  if not CreateProcess(pchar(command), nil, nil, nil, true,
    CREATE_NEW_CONSOLE, nil, nil, si, pi) then begin
    RC_LineOut('Error creating process: '+command);
    CloseHandle(newstdin);
    CloseHandle(newstdout);
    CloseHandle(read_stdout);
    CloseHandle(write_stdin);
    exit;
  end;
  // Loop principal
  fillchar(buf, sizeof(buf), 0);
  RC_End:=false;
  RC_SendBuf:='';
  repeat
    // application.processmessages;
    Application.HandleMessage;
    GetExitCodeProcess(pi.hProcess, RC_ExitCode);
    if (RC_ExitCode<>STILL_ACTIVE) then RC_End:=True;
    PeekNamedPipe(read_stdout, @buf, bufsize, @bread, @avail, nil);
    // Comprobamos texto de salida
    if (bread<>0) then begin
      fillchar(buf, bufsize, 0);
      if (avail>bufsize) then
        while (bread>=bufsize) do begin
          ReadFile(read_stdout, buf, bufsize, bread, nil);
          SplitLines(buf);
          fillchar(buf, bufsize, 0);
        end
      else begin
        ReadFile(read_stdout, buf, bufsize, bread, nil);
        SplitLines(buf);
      end;
    end;
    // Comprobamos texto de entrada
    while (Length(RC_SendBuf)>0) do begin
      WriteFile(write_stdin, RC_SendBuf[1], 1, bread, nil);
      Delete(RC_SendBuf, 1, 1);
    end;
  until RC_End;
  // Cerramos las cosas
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(newstdin);
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
  CloseHandle(write_stdin);
end; // RC_Run

end.
Ich habe allerdings (die letzten Tage!!) ohne Erfolg versucht, das Ganze (auf verschiedene Varianten) auf 2 Konsolenanwendungen zu erweitern. (In der Art, dass meine GUI gleichzeitig mit 2 unterschiedlichen Konsolenanwendungen TextMessages austauscht)

Eigentlich müsste ich es nur schaffen, eine Art von "Multithreaded Pipe Server" (allerdings, situationsbedingt, mit anonymous pipes)

Aber ich werde von Programmabstürzen und Crashes der Konsolenanwendungen verfolgt. Ich habe es noch nie geschafft gleichzeitig mit beiden Anwendungen zu kommunizieren. Es bleibt immer mind. eine Konsolenanwendung stumm oder terminiert auf irgendeine Weise.

Hiermit gestehe ich meine Niederlage ein.

Ich hoffe nun, dass mir hier jemand einen Tip geben kann, wie ich auf irgendeine Art zwei stabile Verbindungen zu meinen Konsolenprogrammen bekommen...
(d.h. 2 mal jeweils 2(read/write) pipes zu meiner GUI)


Ich hoffe hier hat jemand mehr Durchblick als ich...



Danke im voraus,
Sebastian Leibnitz.

[edit=SirThornberry]Code-Tags durch Delphi-Tags ersetzt - Mfg, SirThornberry[/edit]
  Mit Zitat antworten Zitat
Icyclemort

Registriert seit: 3. Mai 2006
3 Beiträge
 
#2

Re: pipes(read+write) zu mehr als einer Konsolenanwendung

  Alt 8. Mai 2006, 14:14
Hat niemanand einen kleinen Tip?

Ich hab bis jetzt nur eine dämliche Notlösung gefunden.
Für jede Konsolenanwendung, die ich mit der GUI verbinden möchte, starte ich einen weiteren (!) Prozess, der jeweils dann per pipes mit "seiner" Konsolenanwendung kommuniziert.
Zw. diesen Prozessen und der GUI kommuniziere ich dann mit WM_Copydata.

Allerdings ist das verdammt umständlich und es kommend dadurch zwei oder mehr Prozesse dazu... Auch kann es sich dabei nicht um schlanke Konsolenanwendungen handeln, da ich für PostMessage(,WM_Copydada,,,) ja ein Window-Handle benötige...
Also keine finale Lösung des Problems, ich kann ja nicht den ganzen Rechner für so ein Problem mit Prozessen zumüllen.

Also, ich hoffe, dass hier noch jemand einen Ratschlag für mich hat.


Freundliche Grüße,
Sebastian Leibnizt.
  Mit Zitat antworten Zitat
Icyclemort

Registriert seit: 3. Mai 2006
3 Beiträge
 
#3

Re: pipes(read+write) zu mehr als einer Konsolenanwendung

  Alt 8. Mai 2006, 20:01
So, ich habe das Problem selbst gefunden und behoben. (ursprünglich wurde ein Teil von [sa: tSECURITYATTRIBUTES] nicht gesetzt (vererbare handles), was hier zu Problemen führte.

Da ich den ursprünglichen Code kräfig aufgebohrt habe (nun unbeschränkt viele Threads mit voller Duplex-Verbindung zu den jeweiligen Konsolenanwendungen mit anonymen pipes), dachte ich mir, ich kann ja mal den Rest der Welt daran teilhaben lassen:




Zuerst die unit, die zum Zugriff auf die Funktionen der Threads dient. (der unbedarfte Anwender braucht sich nur mit dieser einen Konstante und den 3 folgenden Prozeduren zu beschäfigen):

Delphi-Quellcode:
unit AnonymousPipeChannels;

interface

uses
  AnonymousPipeThreads, Classes;

const
  MAX_NUMBER_OF_CHANNELS = 4; // Maximale Anzahl an Kanälen/zu startenden
                                      // Konsolenanwendungen einstellen


  procedure RunProcess(xyz: string; channel : integer); // Startet Anwendung XYZ auf dem angegeben Kanal

  procedure LineToSend(msg: string; channel : integer); // Sendet eine Nachricht an die Anwendunge, die
                                                          // auf dem angegebenen Kanal "lauscht"

  procedure LineReceived(msg: string; channel : integer); // Hier kommen Nachrichten von den Anwendunge an...
                                                          // Was damit passiert ist natürlich Eure Sache



var
  AnonymousPipeThread: array[1..MAX_NUMBER_OF_CHANNELS] of TAnonymousPipeThread;




implementation


procedure RunProcess(xyz: string; channel : integer);
begin
  AnonymousPipeThread[channel] := TAnonymousPipeThread.Create(true);
  AnonymousPipeThread[channel].Priority := tpLower; // Priorität könnte man hier ändern

  AnonymousPipeThread[channel].FileToRun := xyz;
  AnonymousPipeThread[channel].Channel := channel;
  AnonymousPipeThread[channel].LineOut:= LineReceived; // hier wird die Ausgabe-Prozedur festgelegt
                                                        // Man kann also für jeden Thread/Kanal/Anwendung
                                                        // eine andere Prozedur zur Ausgabe benutzen.

  AnonymousPipeThread[channel].Resume;
end;


procedure LineToSend(msg: string; channel : integer);
begin
  AnonymousPipeThread[channel].LineIn(msg);
end;


procedure LineReceived(msg: string; channel : integer);
begin
        // Hier muss die Eingabe der Konsolenanwendung (auf dem jeweiligen channel)
        // verarbeitet werden...
end;

end.



Es folgt das eigentlich Wesentliche:
Delphi-Quellcode:
unit AnonymousPipeThreads;

interface

uses
  Classes, Windows, Sysutils;

const
  CRLF=#13#10;
  bufsize=1024; // 1KByte buffer

type
  TAnonymousPipeThread = class(TThread)
  private
    Sendbuffer : string;
    FChannel : Integer;
    FFileToRun : string;
    procedure SetChannel(Value: Integer);
    procedure SetFileToRun(Value: string);
  protected
    procedure Execute; override;
    procedure SplitLines(s: string);
    function IsWinNT: Boolean;
  public
    LineOut: procedure(s: string; channel : integer); // Variable setzen um die Ausgaben der gestarteten
                                                       // Anwendungen auf eine (oder auch verschiedene)
                                                       // Prozedur(en) der mit der folgenden Syntax
                                                       // (AusgabeDerEngine; EngineIdentifier)
                                                       // umzuleiten.

    property Channel : Integer write SetChannel; // > id um mehrere gestarte Prozesse und deren
                                                       // Ausgaben zu unterscheiden...

    property FileToRun : string write SetFileToRun; // > diser Eigenschaft wird entnommen welche
                                                       // Anwendung der Thread starten soll
                                                       // (z.B. 'C:\Windows\System32\cmd.exe' )

    procedure LineIn (s: string); // Mit dem Aufruf dieser Prozedur sendet der Thread
                                                       // den String an die gestarte Konsolenanwendung
  end;




implementation



procedure TAnonymousPipeThread.Execute;
var
  newstdin, newstdout, read_stdout, write_stdin: tHandle;

  buf: array [0..bufsize-1] of char;

  si: tSTARTUPINFO;
  sa: tSECURITYATTRIBUTES;
  sd: tSECURITYDESCRIPTOR;
  pi: tPROCESSINFORMATION;

  bread, avail: dword;

  ProcessExitCode: Cardinal;
  LoopEnd: Boolean;
begin
  // Konfigurieren der Sicherheits-Attribute
  If IsWinNT then begin
    InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(@sd, true, nil, false);
    sa.lpSecurityDescriptor:=@sd;
    sa.bInheritHandle:=true; //hier war der urspr. Fehler
  end else sa.lpSecurityDescriptor:=nil;
  // 1. Pipe erstellen
  If not CreatePipe(newstdin, write_stdin, @sa, 1024) then begin
    LineOut('Error creating first pipe', FChannel);
    exit;
  end;
  // 2. Pipe erstellen
  If not CreatePipe(read_stdout, newstdout, @sa, 1024) then begin
    LineOut('Error creating second pipe', FChannel);
    CloseHandle(newstdin);
    CloseHandle(write_stdin);
    exit;
  end;
  // StartupInfo für den zu startenden Prozess konfigurieren...
  GetStartupInfo(si);
  si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow:=SW_HIDE;
  si.hStdOutput:=newstdout;
  si.hStdError:=newstdout;
  si.hStdInput:=newstdin;


  // Prozess (Konsolenanwendung) starten...
  If not CreateProcess(pchar(FFileToRun), nil, nil, nil, true, CREATE_NEW_CONSOLE, nil, pChar(ExtractFilePath(FFileToRun)), si, pi)
   then begin
    LineOut('Error creating process: '+ FFileToRun, FChannel);
    CloseHandle(newstdin);
    CloseHandle(newstdout);
    CloseHandle(read_stdout);
    CloseHandle(write_stdin);
    exit;
  end;
  // Loop (infinite till process quits)
  fillchar(buf, sizeof(buf), 0);
  LoopEnd:=false;
  Sendbuffer:='';
  Repeat
    Sleep(1);
    GetExitCodeProcess(pi.hProcess, ProcessExitCode);
    If (ProcessExitCode<>STILL_ACTIVE) then LoopEnd:=True;
    PeekNamedPipe(read_stdout, @buf, bufsize, @bread, @avail, nil);
    // eingehende Nachrichten
    If (bread<>0) then begin
      fillchar(buf, bufsize, 0);
      If (avail>bufsize) then
        While (bread>=bufsize) do begin
          ReadFile(read_stdout, buf, bufsize, bread, nil);
          SplitLines(buf);
          fillchar(buf, bufsize, 0);
        end
      else begin
        ReadFile(read_stdout, buf, bufsize, bread, nil);
        SplitLines(buf);
      end;
    end;
    // ausgehende Nachrichten
    While (Length(Sendbuffer)>0) do begin
      WriteFile(write_stdin, Sendbuffer[1], 1, bread, nil);
      Delete(Sendbuffer, 1, 1);
    end;
  until LoopEnd;
  // Aufräumarbeiten...
  CloseHandle(pi.hThread);
  CloseHandle(pi.hProcess);
  CloseHandle(newstdin);
  CloseHandle(newstdout);
  CloseHandle(read_stdout);
  CloseHandle(write_stdin);
end;


procedure TAnonymousPipeThread.SplitLines(s: string);
var t: string;
begin
  While pos(#$A, s)<>0 do begin
    t:=copy(s, 1, pos(#$A, s)-1);
    LineOut(t, FChannel); // Ausgabe (von der Konsolenanwendung)
    delete(s, 1, pos(#$A, s));
  end;
  If length(s)>0 then LineOut(s, FChannel);
end;


procedure TAnonymousPipeThread.LineIn(s: string);
begin
  Sendbuffer:=Sendbuffer+s+CRLF; // Eingabe (an die Konsolenanwendung)
end;


procedure TAnonymousPipeThread.SetChannel(Value: Integer);
begin
  FChannel:=Value;
end;


procedure TAnonymousPipeThread.SetFileToRun(Value: string);
begin
  FFileToRun:=Value;
end;


function TAnonymousPipeThread.IsWinNT: Boolean;
var osv: tOSVERSIONINFO;
begin
  osv.dwOSVersionInfoSize:=sizeof(osv);
  GetVersionEx(osv);
  result:=osv.dwPlatformID=VER_PLATFORM_WIN32_NT;
end;

end.


Ich wünsche viel Spaß damit, mir hat es jedenfalls viel zu viel Mühe bereitet....




mfg,
Sebastian Leibnitz.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz