Chat - Computer auflisten

[-homer-]

hi,

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

[CReber]

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-]

hi,
danke: Das war genau das was ich gesucht habe.

[-homer-]

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]

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]

Hallo erstmal,

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


mfg