Enviar un mensaje a todas las conexiones activas

[•–[XII]–•]

Más fácil: La que me venía con Delphi 7 Enterprise

[jachguate]

Pues yo recien compile el Demo del server de chat sin problemas...

revisá que incluyas en tu clausula uses la unidad IdTCPServer; aunque si has agregado en tiempo de diseño el componente, delphi debiera incluirla automáticamente.

Hasta luego.

[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.