Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi Chat - Computer auflisten (https://www.delphipraxis.net/14128-chat-computer-auflisten.html)

-homer- 2. Jan 2004 18:55


Chat - Computer auflisten
 
hi,

wie kann ich alle Computer in einer ListBox auflisten, die sich gerade im Netztwerk befinden???

CReber 2. Jan 2004 20:12

Re: Chat - Computer auflisten
 
Code:

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

function CreateNetResourceList(ResourceType: DWord;
                              NetResource: PNetResource;
                              out Entries: DWord;
                              out List: PNetResourceArray): Boolean;
var
  EnumHandle: THandle;
  BufSize: DWord;
  Res: DWord;
begin
  Result := False;
  List := Nil;
  Entries := 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET,
                  ResourceType,
                  0,
                  NetResource,
                  EnumHandle) = NO_ERROR then begin
    try
      BufSize := $4000; // 16 kByte
      GetMem(List, BufSize);
      try
        repeat
          Entries := DWord(-1);
          FillChar(List^, BufSize, 0);
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
          if Res = ERROR_MORE_DATA then begin
            ReAllocMem(List, BufSize);
          end;
        until Res <> ERROR_MORE_DATA;

        Result := Res = NO_ERROR;
        if not Result then begin
          FreeMem(List);
          List := Nil;
          Entries := 0;
        end;
      except
        FreeMem(List);
        raise;
      end;
    finally
      WNetCloseEnum(EnumHandle);
    end;
  end;
end;

procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);

procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
    for i := 0 to Integer(Entries) - 1 do begin
      if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
        (NetResourceList[i].dwDisplayType = DisplayType) then begin
        List.AddObject(NetResourceList[i].lpRemoteName,
                      Pointer(NetResourceList[i].dwDisplayType));
      end;
      if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
        ScanLevel(@NetResourceList[i]);
    end;
  finally
    FreeMem(NetResourceList);
  end;
end;

begin
  ScanLevel(Nil);
end;
zum ausführen

Code:

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end;

-homer- 2. Jan 2004 20:28

Re: Chat - Computer auflisten
 
hi,
danke: Das war genau das was ich gesucht habe.

-homer- 2. Jan 2004 21:09

Zu früh gefreut
 
hi,
Mist hab mich zu früh gefreut. Den Code den h0nkib0nk mir geschrieben hat klappt bei mir nicht. Weiß nicht wieso. Da ich den meinen Code mal vorstellen mal vorstellen möchte, muss ich hier ein paar Erklärungen preis geben: Ich habe eine ListBox(ListBox1), die die vorhandenen Computernamen im Netzwerk auflistet; einen Button (Bsend): Zum senden einer Nachricht; Einen Button der den Namen des eigenen Pc anzeigt (Bname); Ein Memo-Feld zur Eingabe des Textes (text); 'Eanzahl' ist die Anzahl, der zu schickenden Nachrichten; Als letztes habe ich noch einen Button um den es hier geht: Brefresh. Dieser Button soll nun in der ListBox alle Computer anzeigen (wenn auf ihn geklickt wird)!!! Ich kann en Fehler in meinem Programm nicht finden, vielleicht kann es ja einer von euch.


Hier zu meinem Code:
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellApi, Spin, ExtCtrls;

type
  TEasyCMD = class(TForm)
    Bsend: TButton;
    Bname: TButton;
    Text: TMemo;
    Eanzahl: TSpinEdit;
    Brefresh: TButton;
    ListBox1: TListBox;
    procedure BsendClick(Sender: TObject);
    procedure BnameClick(Sender: TObject);
    procedure EanzahlChange(Sender: TObject);
    procedure BrefreshClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  EasyCMD: TEasyCMD;

implementation

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

function CreateNetResourceList(ResourceType: DWord;
                              NetResource: PNetResource;
                              out Entries: DWord;
                              out List: PNetResourceArray): Boolean;
var
  EnumHandle: THandle;
  BufSize: DWord;
  Res: DWord;
begin
  Result := False;
  List := Nil;
  Entries := 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET,
                  ResourceType,
                  0,
                  NetResource,
                  EnumHandle) = NO_ERROR then begin
    try
      BufSize := $4000; // 16 kByte
      GetMem(List, BufSize);
      try
        repeat
          Entries := DWord(-1);
          FillChar(List^, BufSize, 0);
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
          if Res = ERROR_MORE_DATA then begin
            ReAllocMem(List, BufSize);
          end;
        until Res <> ERROR_MORE_DATA;

        Result := Res = NO_ERROR;
        if not Result then begin
          FreeMem(List);
          List := Nil;
          Entries := 0;
        end;
      except
        FreeMem(List);
        raise;
      end;
    finally
      WNetCloseEnum(EnumHandle);
    end;
  end;
end;

procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);


procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
    for i := 0 to Integer(Entries) - 1 do begin
      if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
        (NetResourceList[i].dwDisplayType = DisplayType) then begin
        List.AddObject(NetResourceList[i].lpRemoteName,
                      Pointer(NetResourceList[i].dwDisplayType));
      end;
      if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
        ScanLevel(@NetResourceList[i]);
    end;
  finally
    FreeMem(NetResourceList);
  end;
end;

begin
  ScanLevel(Nil);
end;




{$R *.dfm}

procedure TEasyCMD.BsendClick(Sender: TObject);
var send: String;
    i: Integer;
begin
  for i := 1 to StrToInt(Eanzahl.text) do
  begin
    send := 'send ' + ListBox1.Items.Text + ' ' + text.text + '';
    ShellExecute(GetDesktopWindow, 'open', 'net.exe', PChar(send), nil, SW_HIDE);
  end;
end;

function GetComputerName: String;
var Buffer: Array[0..MAX_COMPUTERNAME_LENGTH + 1] of Char;
    size: DWord;
begin
  size := 1024;
  Windows.GetComputerName(Buffer, Size);
  Result := StrPas(Buffer);
end;

procedure TEasyCMD.BnameClick(Sender: TObject);
begin
  ShowMessage(GetComputerName)
end;

procedure TEasyCMD.EanzahlChange(Sender: TObject);
begin
  try
    if StrToInt(Eanzahl.Text) < 1 then
    begin
      Eanzahl.Text := '1';
    end;
  except
  begin
    ShowMessage('Sie müssen eine Zahl eingeben!!!');
    Eanzahl.Text := '1';
  end;
  end;
end;

procedure TEasyCMD.BrefreshClick(Sender: TObject);
begin
  ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end;

-homer-

gekmihesg 3. Jan 2004 12:51

Re: Chat - Computer auflisten
 
Liste der Anhänge anzeigen (Anzahl: 1)
also wenn ich des richtig seh schreibst du ein chatprogramm das auf allen computern im netz laufen soll oder? sowas hab ich auch gemacht und ich hab das mit dem computer anzeigen mit den indy udpkomponenten gelöst.
ich schick nen broadcast ins netz und die anderen programme antworten mir dann. so krieg ich wirklich nur die pcs auf denen das programm auch läuft.
funktioniert wunderbar ;)

mwiesbau 20. Dez 2004 12:11

Re: Chat - Computer auflisten
 
Hallo erstmal,

ich würde mal versuchen die Funktion zu deklarieren und zwar oben bei den procedures.


mfg


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:12 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