Междупрограмна комуникация

Чудя се, как мога да обменям данни с друго приложение. Но не чрез интерфейси или други подобни от високо ниво. Нещо като стартиране на програма с ShellExecute, подаване на някакви параметри през командния ред и изчакване на нейното завършване и връщане на резултат. Точно резултата е проблема - как програма може да върне на стартиращото приложение някакъв низ, число или какъв да е резултат от изпълнението си? Може, разбира се, да пише във файл, но това не ме устройва. Има ли друг начин?

Ми не знам, едно време правих подобни неща с DDE pipe-ове, а сега си мисля за Sockets.... а може и да съм много далеч от правилния подход :)

-------------
Special killer double trouble triple extra nicotine monster!

е чрез mail slot-ове
Ето ти и един пример (от Delphi 3000)

--------------------------------------------------------------------------

How can two applications communicate with each other if they are running on different machines?  

Answer:





unit Chris;



interface





uses  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

  Forms, Dialogs, StdCtrls, ExtCtrls, Menus, IniFiles, Buttons, ComCtrls,

  Spin, Registry, FileCtrl, ShellAPI, WinSvc;



// -----------------------------------------------------------------------

// First of all the Type-Definitions



Type

  TChMailSlot = class

    LastError: String;

    function CreateLocalServer(MailSlotName: String): Boolean;

    function CreateRemoteServer(Server, MailSlotName: String): Boolean;

    function CreateLocalClient(MailSlotName: String): Boolean;

    function CreateRemoteClient(Server, MailSlotName: String): Boolean;

    function ReadMail : String;

    function WriteMail(Text: String) : Boolean;

    procedure CloseServer;

    procedure CloseClient;

  private

    { Private declarations }

    FMailslotServer : THandle;

    FMailslotClient : THandle;

  public

    { Public declarations }

  end;



Var ChMailSlot : TChMailSlot;





implementation





{ -----------------------------------------------------------------------------}

{ --------------------   Begin of TChMailSlot-Declarations   ----------------- }

{ -----------------------------------------------------------------------------}



function TChMailSlot.CreateLocalServer(MailSlotName: String): Boolean;

const cERRNOCREATE   = 'The Mailslot %s could not be created';

      cSUCCESSCREATE = 'The Mailslotserver %s has been created';

begin

  LastError:= '';

  FMailslotServer := CreateMailslot(PChar('\\.\mailslot\'+MailSlotName), 0, 0, nil);

  if FMailslotServer = Invalid_Handle_Value then begin

    Result:= False;

    LastError:= Format(cERRNOCREATE, [MailSlotName]);

  end else begin

    Result:= True;

    LastError:= Format(cSUCCESSCREATE, [MailSlotName]);

  end;

end;



function TChMailSlot.CreateRemoteServer(Server, MailSlotName: String): Boolean;

const cERRNOCREATE   = 'The Mailslot %s could not be created';

      cSUCCESSCREATE = 'The Mailslotserver %s has been created';

begin

  LastError:= '';

  FMailslotServer := CreateMailslot(PChar('\\'+Server+'\mailslot\'+MailSlotName), 0, 0, nil);

  if FMailslotServer = Invalid_Handle_Value then begin

    Result:= False;

    LastError:= Format(cERRNOCREATE, [MailSlotName]);

  end else begin

    Result:= True;

    LastError:= Format(cSUCCESSCREATE, [MailSlotName]);

  end;

end;



function TChMailSlot.CreateLocalClient(MailSlotName: String): Boolean;

Const cERRNOOPEN     = 'The Mailslot %s could not be opened.';

      cSUCCESSCREATE = 'The Mailslotclient %s could be created';

begin

  FMailslotClient := CreateFile(PChar('\\.\mailslot\'+MailSlotName), Generic_Write, File_Share_Read,

                          nil, Open_Existing, File_Attribute_Normal, 0);

  if FMailslotClient = INVALID_HANDLE_VALUE then begin

    Result:= False;

    LastError:= Format(cERRNOOPEN, [MailSlotName]);

  end else begin

    Result:= True;

    LastError:= Format(cSUCCESSCREATE, [MailSlotName]);

  end;

end;



function TChMailSlot.CreateRemoteClient(Server, MailSlotName: String): Boolean;

Const cERRNOOPEN     = 'The Mailslot %s could not be opened.';

      cSUCCESSCREATE = 'The Mailslotclient %s was be created successfully';

begin

  FMailslotClient := CreateFile(PChar('\\'+Server+'\mailslot\'+MailSlotName), Generic_Write, File_Share_Read,

                          nil, Open_Existing, File_Attribute_Normal, 0);

  if FMailslotClient = INVALID_HANDLE_VALUE then begin

    Result:= False;

    LastError:= Format(cERRNOOPEN, [MailSlotName]);

  end else begin

    Result:= True;

    LastError:= Format(cSUCCESSCREATE, [MailSlotName]);

  end;

end;



function TChMailSlot.ReadMail : String;

const cERRNOINFO     = 'Reading Mailslot information not possible.';

      cERRNOREAD     = 'It was not possible to read the information from the Mailslot.';

Var  iMsgSize : DWord;

     iRead    : DWord;

     sMsg     : String;

begin

  Result:= '';

  LastError:= '';

  if not GetMailslotInfo(FMailslotServer, nil, iMsgSize, nil, nil) then

  begin

    LastError:= cERRNOINFO;

  end;

  if iMsgSize <> MAILSLOT_NO_MESSAGE then

    begin

      SetLength(sMsg, iMsgSize);

      if not ReadFile(FMailslotServer, sMsg[1], iMsgSize, iRead, nil) then

        begin

          LastError:=cERRNOREAD;

        end;

      Result:= sMsg;

    end;

end;



function TChMailSlot.WriteMail(Text: String) : Boolean;

const cERRNOWRITE = 'It was not possible to send the information to the Mailslot.';

var

  iBytes : DWord;

  sMsg   : String;

begin

  sMsg := Text;

  LastError:= cERRNOWRITE;

  Try

    WriteFile(FMailslotClient, sMsg[1], Length(sMsg), iBytes, nil);

    Result:= True;

    LastError:='';

  except

    LastError:= cERRNOWRITE;

    Result:= False;

  end;

end;





procedure TChMailSlot.CloseServer;

begin

  CloseHandle(FMailslotServer);

end;



procedure TChMailSlot.CloseClient;

begin

  CloseHandle(FMailslotClient);

end;



begin  { ----------------  Initialisation of the Unit ---------------- }



ChMailSlot:= TChMailSlot.Create;

END.





{ -----------------------------------------------------------------------------}

{ ---------------------- End of TChMailSlot-Declarations --------------------- }

{ -----------------------------------------------------------------------------}











{ And now a simple client-programm using the Mailslot definitions above defined in the unit Chris }



unit MainClient;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls,Chris;



type

  TForm1 = class(TForm)

    Label1: TLabel;

    Label2: TLabel;

    Messages: TEdit;

    Text: TEdit;

    Button1: TButton;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private-Deklarationen }

  public

    { Public-Deklarationen }

  end;



var

  Form1: TForm1;



implementation



{$R *.DFM}



procedure TForm1.FormCreate(Sender: TObject);

begin

  ChMailSlot.CreateLocalClient('TestMailSlot');

  Messages.Text:= ChMailSlot.LastError;

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  ChMailSlot.CloseClient;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

  If not ChMailSlot.WriteMail(Text.Text) then begin

    MessageBeep(0);

  end;

  Messages.Text:= ChMailSlot.LastError;

  Text.SelectAll;

end;



end.









{ And the corresponding server-programm using the Mailslot definitions above defined in the unit Chris }





unit Main;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls,Chris, ExtCtrls;



type

  TForm1 = class(TForm)

    Messages: TEdit;

    Label1: TLabel;

    Text: TEdit;

    Label2: TLabel;

    Button1: TButton;

    Timer1: TTimer;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

  private

    { Private-Deklarationen }

  public

    { Public-Deklarationen }

  end;



var

  Form1: TForm1;



implementation



{$R *.DFM}



procedure TForm1.FormCreate(Sender: TObject);

begin

  ChMailSlot.CreateLocalServer('TestMailSlot');

  Messages.Text:= ChMailSlot.LastError;

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  ChMailSlot.CloseServer;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

  Text.Text:=ChMailSlot.ReadMail;

  Messages.Text:= ChMailSlot.LastError;

end;



procedure TForm1.Timer1Timer(Sender: TObject);

Var Mail: String;

begin

  Mail:= ChMailSlot.ReadMail;

  If Mail <> '' then begin

    Text.Text:= Mail;

    Messages.Text:= ChMailSlot.LastError;

  end;

end;



end.

---
Е т'ва е живот!

A pipe is a section of shared memory that processes use for communication. The process that creates a pipe is the pipe server. A process that connects to a pipe is a pipe client. One process writes information to the pipe, then the other process reads the information from the pipe. (MSDN)
Answer:


WHAT PIPES ARE
==============

Pipes are used by independent processes to communicate with each other. For every pipe there must be a server that creates and manages the pipe and one or more clients that use the pipe to interchange messages between each other.

Pipes can be used for communication of processes residing on the same computer as well as processes residing on different machines within a network.

WHEN CAN YOU USE PIPES
======================

Basically all Windows NT 3.51 and up, as well as Win95 and up support named pipes. You will use named pipes only to transfer information between applications within a network, or similar. I would not use them for use within a single application or when the SendMessage/PostMessage routines will suffice.

Named Pipes will ensure the data transport between to processes - therefore you will use them when data transport is essential. Mailslots, similar to named pipes, will nmot ensure data transport between processes, are, however much more efficient.

BLOCKING AND NON-BLOCKING MODES
===============================

Pipes can be created supporting blocking and non-blocking modes. This is essential for three routines: ReadFile, WriteFile, and ConnectNamedPipe. These routines will not return during blocking-mode until data are read/sent. MS recommends the use of the blocking-mode.

THEORIE OF THIS SAMPLE
======================

Your Pipe-Server will create a named pipe and wait for clients to access the pipe in order to send data. Once a Pipe-Client sends data, the Pipe-Server will open the Pipe to the Client, process the data, send the "answer", and closes the Pipe to the Client.

The server will close the pipe after every message processed.

NOTE
====

This is a simple sample for the use of Pipes only, as samples are hard to find anyway. I am working on a more complex one, this may, however take quite some time - depending on my spare time. :)

THE UNIT UPIPES.PAS
===================

In this sample, the Pipe-Server will reverse the data send by the Pipe-Client as Response. No Range Checking is done!

unit uPipes;

interface

uses
Classes, Windows;

const
cShutDownMsg = 'shutdown pipe ';
cPipeFormat = '\\%s\pipe\%s';

type
RPIPEMessage = record
Size: DWORD;
Kind: Byte;
Count: DWORD;
Data: array[0..8095] of Char;
end;

TPipeServer = class(TThread)
private
FHandle: THandle;
FPipeName: String;

protected
public
constructor CreatePipeServer(aServer, aPipe: String; StartServer: Boolean);
destructor Destroy; override;

procedure StartUpServer;
procedure ShutDownServer;
procedure Execute; override;
end;

TPipeClient = class
private
FPipeName: String;
function ProcessMsg(aMsg: RPIPEMessage): RPIPEMessage;
protected
public
constructor Create(aServer, aPipe: String);

function SendString(aStr: String): String;
end;

implementation

uses
SysUtils;

procedure CalcMsgSize(var Msg: RPIPEMessage);
begin
Msg.Size :=
SizeOf(Msg.Size) +
SizeOf(Msg.Kind) +
SizeOf(Msg.Count) +
Msg.Count +
3;
end;

{ TPipeServer }

constructor TPipeServer.CreatePipeServer(
aServer, aPipe: String; StartServer: Boolean
);
begin
if aServer = '' then
FPipeName := Format(cPipeFormat, ['.', aPipe])
else
FPipeName := Format(cPipeFormat, [aServer, aPipe]);
// clear server handle
FHandle := INVALID_HANDLE_VALUE;
if StartServer then
StartUpServer;
// create the class
Create(not StartServer);
end;

destructor TPipeServer.Destroy;
begin
if FHandle <> INVALID_HANDLE_VALUE then
// must shut down the server first
ShutDownServer;
inherited Destroy;
end;

procedure TPipeServer.Execute;
var
I, Written: Cardinal;
InMsg, OutMsg: RPIPEMessage;
begin
while not Terminated do
begin
if FHandle = INVALID_HANDLE_VALUE then
begin
// suspend thread for 250 milliseconds and try again
Sleep(250);
end else begin
if ConnectNamedPipe(FHandle, nil) then
try
// read data from pipe
InMsg.Size := SizeOf(InMsg);
ReadFile(FHandle, InMsg, InMsg.Size, InMsg.Size, nil);
if
(InMsg.Kind = 0) and
(StrPas(InMsg.Data) = cShutDownMsg + FPipeName)
then
begin
// process shut down
OutMsg.Kind := 0;
OutMsg.Count := 3;
OutMsg.Data := 'OK'#0;
Terminate;
end else begin
// data send to pipe should be processed here
OutMsg := InMsg;
// we'll just reverse the data sent, byte-by-byte
for I := 0 to Pred(InMsg.Count) do
OutMsg.Data[Pred(InMsg.Count) - I] := InMsg.Data( i ); // tuk smeni () s []
end;
CalcMsgSize(OutMsg);
WriteFile(FHandle, OutMsg, OutMsg.Size, Written, nil);
finally
DisconnectNamedPipe(FHandle);
end;
end;
end;
end;

procedure TPipeServer.ShutDownServer;
var
BytesRead: Cardinal;
OutMsg, InMsg: RPIPEMessage;
ShutDownMsg: String;
begin
if FHandle <> INVALID_HANDLE_VALUE then
begin
// server still has pipe opened
OutMsg.Size := SizeOf(OutMsg);
// prepare shut down message
with InMsg do
begin
Kind := 0;
ShutDownMsg := cShutDownMsg + FPipeName;
Count := Succ(Length(ShutDownMsg));
StrPCopy(Data, ShutDownMsg);
end;
CalcMsgSize(InMsg);
// send shut down message
CallNamedPipe(
PChar(FPipeName), @InMsg, InMsg.Size, @OutMsg, OutMsg.Size, BytesRead, 100
);
// close pipe on server
CloseHandle(FHandle);
// clear handle
FHandle := INVALID_HANDLE_VALUE;
end;
end;

procedure TPipeServer.StartUpServer;
begin
// check whether pipe does exist
if WaitNamedPipe(PChar(FPipeName), 100 {ms}) then
raise Exception.Create('Requested PIPE exists already.');
// create the pipe
FHandle := CreateNamedPipe(
PChar(FPipeName), PIPE_ACCESS_DUPLEX,
PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_WAIT,
PIPE_UNLIMITED_INSTANCES, SizeOf(RPIPEMessage), SizeOf(RPIPEMessage),
NMPWAIT_USE_DEFAULT_WAIT, nil
);
// check if pipe was created
if FHandle = INVALID_HANDLE_VALUE then
raise Exception.Create('Could not create PIPE.');
end;

{ TPipeClient }

constructor TPipeClient.Create(aServer, aPipe: String);
begin
inherited Create;
if aServer = '' then
FPipeName := Format(cPipeFormat, ['.', aPipe])
else
FPipeName := Format(cPipeFormat, [aServer, aPipe]);
end;

function TPipeClient.ProcessMsg(aMsg: RPIPEMessage): RPIPEMessage;
begin
CalcMsgSize(aMsg);
Result.Size := SizeOf(Result);
if WaitNamedPipe(PChar(FPipeName), 10) then
if not CallNamedPipe(
PChar(FPipeName), @aMsg, aMsg.Size, @Result, Result.Size, Result.Size, 500
) then
raise Exception.Create('PIPE did not respond.')
else
else
raise Exception.Create('PIPE does not exist.');
end;

function TPipeClient.SendString(aStr: String): String;
var
Msg: RPIPEMessage;
begin
// prepare outgoing message
Msg.Kind := 1;
Msg.Count := Length(aStr);
StrPCopy(Msg.Data, aStr);
// send message
Msg := ProcessMsg(Msg);
// return data send from server
Result := Copy(Msg.Data, 1, Msg.Count);
end;

end.


A SAMPLE USING UPIPES.PAS
=========================

Create a new application and add the unit uPipes.pas to the uses clause.
Add the following Controls to the Main Form


Checkbox: (Name: chkRunServer; Caption: Run Server)

Edit: (Name: edtServer)

Edit: (Name:edtTextToSend)

Button: (Name: btnSend)

Edit: (Name: edtResponse)



Add the private variable:

FServer: TPipeServer;

For the OnClick Event of the chkRunServer add the following code:

procedure TForm1.chkRunServerClick(Sender: TObject);
begin
if chkRunServer.Checked then
try
FServer := TPipeServer.CreatePipeServer('', 'testit', True);
except
on E: Exception do
begin
ShowMessage(E.Message);
chkRunServer.Checked := False;
end;
end else begin
FServer.Destroy;
end;
end;

For the OnClick Event of the btnSend add the following code:

procedure TForm1.btnSendClick(Sender: TObject);
begin
with TPipeClient.Create(edtServer.Text, 'testit') do
try
edtResponse.Text := SendString(edtTextToSend.Text);
finally
Free;
end;
end;

за подобни комуникации, но реализирани и работещи и за Kylix - сподели ги ;-))) - че в момента събирам информация - дали да се насоча към Линукс платформата, а това(комуникацията) е нещо което живо ме интересува.

---
Е т'ва е живот!

да затвори вратата... че забравих кой беше :Р
(шегувам се но доста дълъг ми се видя този пример)

Shto li sichki sha migrirame na posix .... kakto i da e neshtata tam(kakto i tuk) mogat da se organizirat prez konzolata(standartniq whod izhod) samo deto za posix towa e neshto normalno dokato za windows e "izwratenost" btw pod linux shared memory e nalichan taka che ne se ochertawat seriozni problemi s interprocesnata komunikaciq (IPC: [линк] )

------------------------------
I got a COMPILER, and I'm not afraid to use it!

Едно време (при добрия, стар DOS) програмите връщаха код за грешка, напр:

begin
...
Halt(5);
end.

Това се използваше най-вече при batch processing (.bat файловете), където имаше и една програмка, (наречена choice.com в DOS 6) и служеща за изграждане на менюта в .bat файл. Стойността на кода се връщаше в променливата ERRORLEVEL, но дали това все още работи и как може да се прочете в Delphi приложение аз незнам. Ако някой го е правил, нека да каже.

Mixy

Halt F1

Unit

System

Category

flow control routines

procedure Halt [ ( Exitcode: Integer) ];

Description

Halt performs an abnormal termination of a program and returns to the operating system. To perform a normal termination of Delphi VCL non-console application, call Application.Terminate. Exitcode is an optional expression that specifies an exit code for the program.

Тука един пич се е постарал да направи кратък обзор:

[линк]

чети и дишай по-леко

Contains the application's exit code.

Unit

System

Category

backward compatibility routines

Delphi syntax:

var ExitCode: Integer = 0;

Description

In Delphi code, the ExitCode variable contains the application's exit code. An exit procedure can learn the cause of termination by examining ExitCode. If the program terminates normally, ExitCode is zero. If the program terminates due to a call to Halt, ExitCode contains the value passed to Halt. If the program terminates due to a runtime error, ExitCode contains the error code.

On Windows, setting the ExitCode variable to a value other than 0 in the initialization section of a unit will make loading of a DLL fail (DllMain will return false). You can also set ExitCode in code called from DllProc or DllProcEx to signal failure of loading.
On Linux, although the ExitCode variable is accessible from shared object code, its value does not affect the loader of the shared object. Thus, using ExitCode in a shared object has no effect.

------------------------------
I got a COMPILER, and I'm not afraid to use it!

Да де, ма кой да чете хелпа ...

Баси, за 6 м. мнооо' съм затъпял

Mixy

...
- Отличниците, Иванчо

цитата е от вица за Иванчо, баща му и хубавите мацки

Nqma da se plashish - shtom te izpisaha jiv zdraw i cql drugoto sha sa opraj

------------------------------
I got a COMPILER, and I'm not afraid to use it!

Zdr,Misho,
Spored men naj dobroto ne6to za taq rabota koqto izka6 da naprawish e da izpolzwa6 CORBA.Za6to CORBA? Zashtoto towa e standart koyto e baziran na OOP
mnogo dobre proektiran a ot tuk sledwa che i po lesno se pishat programitе.

10x на всички :)

Файла, който постна Печения е доста интересен. Заинтригува ме обмена на данни със съобшения - лесен за реализация и достатъчно гъвкав. Сега обаче се чудя, как да разбера, че извиканото приложение е затворено? Разбира се, то може да изпрати съответното съобщение по канала, но ще стане кофти ако забие или ако изгърми с грешка. А ShellExecute просто го пуска и продължава нататък. Ако пък ShellExecute чакаше до завършване на подпроцеса, нямаще да има начин за комуникация - главния процес ще е блокиран. Какво ще ме посъветвате?

погледни CreateProcess / WaitForSingleObject (май така се казваше).
пускаш втори процес, пускащото приложение си работи - WaitFor... е точно за да разбереш че втория процес е свършил, измил си го е и се е прибрал.

--------------------------------------
Започва Път от моят праг...