Enviar un mensaje a todas las conexiones activas

[DarkByte]

:s lo acabo de probar y a mí tampoco me funciona de esa manera

[•–[XII]–•]

DarkByte, si consigue la solución ruego que me la escriba en el foro o la responda a mi mail.

[*Emilio*]

Hola, te copio mi unit tal cual, si tienes problemas con ella, avisa y paso un proyectito completo a la sección Ejemplos.

Código Delphi [-]
unit UStrogoff;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ShellCtrls, Spin, ExtCtrls, TFlatHintUnit,
  Menus, Grids;

type
  TFormStrogoff = class(TForm)
    PageControl1: TPageControl;
    TsStrogoffMensaje: TTabSheet;
    TsHistorico: TTabSheet;
    Panel6: TPanel;
    Panel1: TPanel;
    Panel2: TPanel;
    ShellComboBox1: TShellComboBox;
    Panel3: TPanel;
    ShellListView1: TShellListView;
    Panel4: TPanel;
    Label4: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    edPC: TEdit;
    edRemitente: TEdit;
    edDestinatario: TEdit;
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    edMensaje: TEdit;
    FlatHint1: TFlatHint;
    PopupMenu1: TPopupMenu;
    IconoGrande: TMenuItem;
    IconosCanijos: TMenuItem;
    Lista: TMenuItem;
    N1: TMenuItem;
    Acercade1: TMenuItem;
    copyLabel: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure ShellListView1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edMensajeClick(Sender: TObject);
    procedure IconoGrandeClick(Sender: TObject);
    procedure IconosCanijosClick(Sender: TObject);
    procedure ListaClick(Sender: TObject);
    procedure Acercade1Click(Sender: TObject);
    procedure TsHistoricoShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    function GetComputerNetName: string;
  public
    { Public declarations }
  end;

var
  FormStrogoff: TFormStrogoff;

implementation

{$R *.dfm}

procedure TFormStrogoff.Button1Click(Sender: TObject);
   procedure EnviarMensaje( ServidorRemoto,Destinatario,Remitente,Mensaje : String);
   var
     sTemp    : string;
     Manejador: THandle;
     Cuantos  : DWord;
   begin
     sTemp := '\\'+ServidorRemoto+'\mailslot\messngr';

     Manejador := CreateFile( PChar(sTemp),GENERIC_WRITE,FILE_SHARE_READ,
                          NIL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

     If Manejador = INVALID_HANDLE_VALUE then
       raise Exception.create( 'Error abriendo el manejador');

     sTemp:=Remitente+#0+Destinatario+#0+Mensaje;
     try
       Cuantos := 0;
       If (NOT WriteFile(Manejador,Pchar(sTemp)^,Length(sTemp),Cuantos,NIL)) or
          (Cuantos <> Length(sTemp)) then
          raise Exception.create( 'Disculpe, podría decirme dónde encontrar la máquina '+edPC.Text);
     finally
       CloseHandle(Manejador);
     end;
   end;
var
Mensajito: Widestring;
 begin
    if ( UpperCase(edPC.Text) <> 'HUMICLIMAEST' ) and ( UpperCase(edPC.Text) <> 'WORKGROUP' ) and
       ( UpperCase(edPC.Text) <> 'GRUPO_TRABAJO' ) and ( UpperCase(edPC.Text) <> 'SAMPOL' ) then
    begin
      Sleep( SpinEdit1.Value * 1000 );
      //Mensajito := StringToWideChar(edMensaje.text, );
      EnviarMensaje( edPC.text,edDestinatario.text,
                  edRemitente.text,edMensaje.Text);

      // Seteamos el StringGrid del histórico
      StringGrid1.Rows[0].Add('PC Destino');
      StringGrid1.Rows[0].Add('Remitente');
      StringGrid1.Rows[0].Add('Destinatario');
      StringGrid1.Rows[0].Add('Mensaje');

      StringGrid1.Rows[StringGrid1.Tag].Add( edPC.text );
      StringGrid1.Rows[StringGrid1.Tag].Add( edRemitente.Text );
      StringGrid1.Rows[StringGrid1.Tag].Add( edDestinatario.Text );
      StringGrid1.Rows[StringGrid1.Tag].Add( edMensaje.Text );
      StringGrid1.RowCount      := StringGrid1.Tag+1;
      StringGrid1.Tag           := StringGrid1.RowCount;
      StringGrid1.ColWidths[3]  := TsHistorico.Width -160;
    end
    else showmessage('No está permitido enviar mensajes a todo el grupo');
 end;


function TFormStrogoff.GetComputerNetName: string;
var
  buffer: array[0..255] of char;
  size: dword;
begin
  size := 256;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;

procedure TFormStrogoff.ShellListView1Click(Sender: TObject);
begin
  if ( ShellListView1.Itemindex > -1 ) then
    edPC.Text := ShellListView1.Folders[ShellListView1.Itemindex].DisplayName;

  end;

procedure TFormStrogoff.FormCreate(Sender: TObject);
begin
        // Rellenamos el edit con el nombre de la máquina local.
        edRemitente.Text := GetComputerNetName;
end;


procedure TFormStrogoff.edMensajeClick(Sender: TObject);
begin
        if (edMensaje.Text = 'Mensaje') then edMensaje.Text :='';
end;

procedure TFormStrogoff.IconoGrandeClick(Sender: TObject);
begin
  ShellListView1.ViewStyle := vsIcon;
end;

procedure TFormStrogoff.IconosCanijosClick(Sender: TObject);
begin
  ShellListView1.ViewStyle := vsSmallIcon;
end;

procedure TFormStrogoff.ListaClick(Sender: TObject);
begin
  ShellListView1.ViewStyle := vsList;
end;

procedure TFormStrogoff.Acercade1Click(Sender: TObject);
begin
  copyLabel.Visible := not copyLabel.Visible;

end;

procedure TFormStrogoff.TsHistoricoShow(Sender: TObject);
begin
  // Al mostrar el TabSheet, alargamos la columa Mensaje del StringGrid
  // al ancho de la ventana.
  StringGrid1.ColWidths[3]  := TsHistorico.Width -330;
end;

procedure TFormStrogoff.FormResize(Sender: TObject);
begin
  StringGrid1.ColWidths[3]  := TsHistorico.Width -330;
end;

end.

[•–[XII]–•]

Muchas gracias Emilio:
He descargado los TFlatStyle de la sección de componentes. Al intentar compilarlos con
Delphi 7 me dice: [Fatal Error] TFlatRegister.pas(27): File not found: 'DsgnIntf.dcu'

[*Emilio*]

No es necesario que instales ningún componente, eso lo único que hace son los Hint más bonitos.

Quita la declaración y pasa de él. Por cierto, esto compila correctamente con Delphi 6 Enterprise sin ningún componente adicional, con Delphi 7 no lo he probado, pero no creo que tengas problema.

[•–[XII]–•]

Muchas gracias Emilio, me parece que más o menos voy comprendiendo cómo hacerlo. Si pudieses enviarme o postear adjunto el .dfm (o como sea la extension de la posicion visual de los componentes) le estaría muy agradecido, así podría ver las cosas poco a poco.

Reitero lo dicho: muchas gracias

[DarkByte]

Empezado por •–[XII]–•

enviarme o postear adjunto el .dfm

Sería postear para que los demás también puedan solucionar sus problemas, en este caso, el mío también xD

[•–[XII]–•]

Después de tres meses sigo sin poder conseguirlo...

Emilio, tu ejemplo creo que trata el mensaje como un archivo y lo deja en un recurso compartido...

He probado con Dispach pero no me funciona, ¿Alguna otra sugerencia?. Ya me conformo con que, por lo menos, me envíe el mensaje al que me envió la petición, o a uno cualquiera...

[DarkByte]

Asegurate de que has añadido IdTCPServer a las uses de tu unit. A mi me pasaba eso...