From: mloeffler@teletrade.com (Michael J. Loeffler)
I started messing around with a utility like this, just for fun. I never finished it. I know it did work at the time. You might be able to use some of the code as a base point. Don't know if you feel like poring through the details, but hope it helps.
{
Network resource utility. Similar in function to NetWork-
Neighborhood.
Michael J. Loeffler
1997.01.31
}
unit netres_main_unit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
ComCtrls, StdCtrls, Buttons, Menus, ExtCtrls;
type
TfrmMain = class(TForm)
tvResources: TTreeView;
btnOK: TBitBtn;
btnClose: TBitBtn;
Label1: TLabel;
barBottom: TStatusBar;
popResources: TPopupMenu;
mniExpandAll: TMenuItem;
mniCollapseAll: TMenuItem;
mniSaveToFile: TMenuItem;
mniLoadFromFile: TMenuItem;
grpListType: TRadioGroup;
grpResourceType: TRadioGroup;
dlgOpen: TOpenDialog;
dlgSave: TSaveDialog;
procedure FormCreate(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mniExpandAllClick(Sender: TObject);
procedure mniCollapseAllClick(Sender: TObject);
procedure mniSaveToFileClick(Sender: TObject);
procedure mniLoadFromFileClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
private
ListType, ResourceType: DWORD;
procedure ShowHint(Sender: TObject);
procedure DoEnumeration;
procedure DoEnumerationContainer(NetResContainer: TNetResource);
procedure AddContainer(NetRes: TNetResource);
procedure AddShare(TopContainerIndex: Integer; NetRes:
TNetResource);
procedure AddShareString(TopContainerIndex: Integer; ItemName:
String);
procedure AddConnection(NetRes: TNetResource);
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
procedure TfrmMain.ShowHint(Sender: TObject);
begin
barBottom.Panels.Items[0].Text:=Application.Hint;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
Application.OnHint:=ShowHint;
barBottom.Panels.Items[0].Text:='';
end;
procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
Close;
end;
{
Enumerate through all network resources:
}
procedure TfrmMain.DoEnumeration;
var
NetRes: Array[0..2] of TNetResource;
Loop: Integer;
r, hEnum, EntryCount, NetResLen: DWORD;
begin
case grpListType.ItemIndex of
{ Connected resources: }
1: ListType:=RESOURCE_CONNECTED;
{ Persistent resources: }
2: ListType:=RESOURCE_REMEMBERED;
{ Global: }
else ListType:=RESOURCE_GLOBALNET;
end;
case grpResourceType.ItemIndex of
{ Disk resources: }
1: ResourceType:=RESOURCETYPE_DISK;
{ Print resources: }
2: ResourceType:=RESOURCETYPE_PRINT;
{ All: }
else ResourceType:=RESOURCETYPE_ANY;
end;
Screen.Cursor:=crHourGlass;
try
{ Delete any old items in the tree view: }
for Loop:=tvResources.Items.Count-1 downto 0 do
tvResources.Items[Loop].Delete;
except
end;
{ Start enumeration: }
r:=WNetOpenEnum(ListType,ResourceType,0,nil,hEnum);
if r<>NO_ERROR then
begin
if r=ERROR_EXTENDED_ERROR then
MessageDlg('Unable to Enumerate the Network.'+#13+
'A network-specific error occurred.',mtError,[mbOK],0)
else
MessageDlg('Unable to Enumerate the Network.',
mtError,[mbOK],0);
Exit;
end;
try
{ We got a valid enumeration handle; walk the resources: }
while (1=1) do
begin
EntryCount:=1;
NetResLen:=SizeOf(NetRes);
r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);
case r of
0: begin
{ It's a container, iterate it: }
if NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER then
DoEnumerationContainer(NetRes[0])
else
{ Persistent and connected resources show up here: }
if ListType in [RESOURCE_REMEMBERED,RESOURCE_CONNECTED]
then
AddConnection(NetRes[0]);
end;
{ Done: }
ERROR_NO_MORE_ITEMS: Break;
{ Other error: }
else begin
MessageDlg('Error Walking Resources.',mtError,[mbOK],0);
Break;
end;
end;
end;
finally
Screen.Cursor:=crDefault;
{ Close enumeration handle: }
WNetCloseEnum(hEnum);
end;
end;
{
Enumerate through the specified container:
This function is usually recursively called.
}
procedure TfrmMain.DoEnumerationContainer(NetResContainer:
TNetResource);
var
NetRes: Array[0..10] of TNetResource;
TopContainerIndex: Integer;
r, hEnum, EntryCount, NetResLen: DWORD;
begin
{ Add container name to tree view: }
AddContainer(NetResContainer);
{ Keep track of this item as current root: }
TopContainerIndex:=tvResources.Items.Count-1;
{ Start enumeration: }
if ListType=RESOURCE_GLOBALNET then
{ Enumerating global net: }
r:=WNetOpenEnum(ListType,ResourceType,RESOURCEUSAGE_CONTAINER,
@NetResContainer,hEnum)
else
{ Enumerating connections or persistent (won't normally get here):
}
r:=WNetOpenEnum(ListType,ResourceType,RESOURCEUSAGE_CONTAINER,
nil,hEnum);
{ Couldn't enumerate through this container; just make a note
of it and continue on: }
if r<>NO_ERROR then
begin
AddShareString(TopContainerIndex,'<Couldn''t Enumerate Resources
(Error #'+
IntToStr(r)+'>');
WNetCloseEnum(hEnum);
Exit;
end;
{ We got a valid enumeration handle; walk the resources: }
while (1=1) do
begin
EntryCount:=1;
NetResLen:=SizeOf(NetRes);
r:=WNetEnumResource(hEnum,EntryCount,@NetRes,NetResLen);
case r of
0: begin
{ Yet another container to enumerate; call this function
recursively to handle it: }
if (NetRes[0].dwUsage=RESOURCEUSAGE_CONTAINER) or
(NetRes[0].dwUsage=10) then
DoEnumerationContainer(NetRes[0])
else
case NetRes[0].dwDisplayType of
{ Top level type: }
RESOURCEDISPLAYTYPE_GENERIC,
RESOURCEDISPLAYTYPE_DOMAIN,
RESOURCEDISPLAYTYPE_SERVER: AddContainer(NetRes[0]);
{ Share: }
RESOURCEDISPLAYTYPE_SHARE:
AddShare(TopContainerIndex,NetRes[0]);
end;
end;
ERROR_NO_MORE_ITEMS: Break;
else begin
MessageDlg('Error #'+IntToStr(r)+' Walking
Resources.',mtError,[mbOK],0);
Break;
end;
end;
end;
{ Close enumeration handle: }
WNetCloseEnum(hEnum);
end;
procedure TfrmMain.FormShow(Sender: TObject);
begin
DoEnumeration;
end;
{
Add item to tree view; indicate that it is a container:
}
procedure TfrmMain.AddContainer(NetRes: TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpRemoteName));
if Trim(String(NetRes.lpComment))<>'' then
begin
if ItemName<>'' then ItemName:=ItemName+' ';
ItemName:=ItemName+'('+String(NetRes.lpComment)+')';
end;
tvResources.Items.Add(tvResources.Selected,ItemName);
end;
{
Add child item to container denoted as current top:
}
procedure TfrmMain.AddShare(TopContainerIndex: Integer; NetRes:
TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpRemoteName));
if Trim(String(NetRes.lpComment))<>'' then
begin
if ItemName<>'' then ItemName:=ItemName+' ';
ItemName:=ItemName+'('+String(NetRes.lpComment)+')';
end;
tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;
{
Add child item to container denoted as current top;
this just adds a string for purposes such as being unable
to enumerate a container. That is, the container's shares
are not accessible to us.
}
procedure TfrmMain.AddShareString(TopContainerIndex: Integer;
ItemName: String);
begin
tvResources.Items.AddChild(tvResources.Items[TopContainerIndex],ItemName);
end;
{
Add a connection to the tree view.
Mostly used for persistent and currently connected
resources to be displayed.
}
procedure TfrmMain.AddConnection(NetRes: TNetResource);
var
ItemName: String;
begin
ItemName:=Trim(String(NetRes.lpLocalName));
if Trim(String(NetRes.lpRemoteName))<>'' then
begin
if ItemName<>'' then ItemName:=ItemName+' ';
ItemName:=ItemName+'-> '+Trim(String(NetRes.lpRemoteName));
end;
tvResources.Items.Add(tvResources.Selected,ItemName);
end;
{
Expand all containers in the tree view:
}
procedure TfrmMain.mniExpandAllClick(Sender: TObject);
begin
tvResources.FullExpand;
end;
{
Collapse all containers in the tree view:
}
procedure TfrmMain.mniCollapseAllClick(Sender: TObject);
begin
tvResources.FullCollapse;
end;
{
Allow saving of tree view to a file:
}
procedure TfrmMain.mniSaveToFileClick(Sender: TObject);
begin
if dlgSave.Execute then
tvResources.SaveToFile(dlgSave.FileName);
end;
{
Allow loading of tree view from a file:
}
procedure TfrmMain.mniLoadFromFileClick(Sender: TObject);
begin
if dlgOpen.Execute then
tvResources.LoadFromFile(dlgOpen.FileName);
end;
{
Rebrowse:
}
procedure TfrmMain.btnOKClick(Sender: TObject);
begin
DoEnumeration;
end;
end.
From: "Ryan Smith" <corsmith@ihc.com>
You can try this code. I've been using it on a Netware LAN for some time now with no problems. It depends on having the NWCALLS.DLL library already on the users machine; if users have a Netware connection, then they should already have that DLL.
unit GetLogin;
{This unit is a wrapper for several external functions in the NWCALLS.DLL}
{Adapted by Ray Buck from code written by Gregory Trubetskoy}
{The unit contains a function that returns the Netware User ID}
{and one that returns the user's full name.}
interface
uses
SysUtils, Messages, Dialogs;
function GetUserLogin: string;
function GetUserFullName( SomeUser: string): string;
implementation
type
NWTimeStamp = record
Year: byte;
Month: byte;
Day: byte;
Hour: byte;
Minute: byte;
Second: byte;
DayOfWeek: byte;
end;
{Netware API's - require NWCALLS.DLL}
function NWGetDefaultConnectionID(var Connection: word): word;
far; external 'NWCALLS';
function NWGetConnectionNumber(Connection: word; var ConnectionNumber:
word): word;
far; external 'NWCALLS';
function NWGetConnectionInformation(Connection: word;
ConnectionNumber: word;
ObjectName: pchar;
var ObjectType: word;
var ObjectID: word;
var LoginTime: NWTimeStamp):word;
far; external 'NWCALLS';
function NWReadPropertyValue(Connection: word;
ObjectName: pChar;
ObjectType: word;
PropertyName: pChar;
DataSetIndex: byte;
DataBuffer: pChar;
var More: byte;
var Flags: byte): word;
far; external 'NWCALLS';
{ end of Netware API stuff }
function GetUserLogin: string;
var
ConnectionID: word;
ConnectionNumber: word;
RC: word;
Name: array[0..50] of Char;
ObjectType: word;
ObjectID: word;
LoginTime: NWTimeStamp;
begin
RC := NWGetDefaultConnectionID(ConnectionID);
RC := NWGetConnectionNumber(ConnectionID, ConnectionNumber);
RC := NWGetConnectionInformation( ConnectionID,
ConnectionNumber,
Name,
ObjectType,
ObjectID,
LoginTime);
Result := StrPas(Name);
end;
function GetUserFullName( SomeUser: string): string;
{The real user name is a 'property' called 'IDENTIFICATON'.
You have to call NWReadPropertyValue passing it (among other things) your ConnectionID,
the name of the object (same as the login of the user who's full name you need)
and the name property you want to retrieve, in this case 'IDENTIFICATION'
(which translated from Novellish to English means 'Full Name').}
var
ConnectionID: word;
RC: word;
Name: array[0..50] of Char;
ObjectType: word;
PropName: array[0..14] of Char;
DataSetIndex: byte;
FullName: array[0..127] of Char;
More: byte;
Flags: byte;
begin
RC := NWGetDefaultConnectionID(ConnectionID);
ObjectType := 256; {user}
StrPCopy(PropName, 'IDENTIFICATION');
DataSetIndex := 1;
StrPCopy(Name, SomeUser);
RC := NWReadPropertyValue( ConnectionID,
Name,
ObjectType,
PropName,
DataSetIndex,
FullName,
More,
Flags);
if RC = 35324 then
MessageDlg('No user ' + SomeUser + ' exists on this server!',
mtError, [mbOK], 0);
Result := StrPas(FullName);
end;
end.This document explains how to create a 'Network' button that brings up a connection dialog and then sets a drive box to point to the new drive in Delphi. The code was created in Delphi 2, but doing it in Delphi 1 should be about the same procedure.
Create a command button named NetBtn, and a drive combo box named DriveBox. Then type this code in the OnClick event for the button:
procedure TStartForm.NetBtnClick(Sender: TObject);
var
OldDrives: TStringList;
i: Integer;
begin
OldDrives := TStringList.Create;
OldDrives.Assign(Drivebox.Items); // Remember old drive list
// Show the connection dialog
if WNetConnectionDialog(Handle, RESOURCETYPE_DISK) = NO_ERROR then begin
DriveBox.TextCase := tcLowerCase; // Refresh the drive list box
for i := 0 to DriveBox.Items.Count - 1 do begin
if Olddrives.IndexOf(Drivebox.Items[i]) = -1 then begin // Find new Drive letter
DriveBox.ItemIndex := i; // Updates the drive list box to new drive letter
DriveBox.Drive := DriveBox.Text[1]; // Cascades the update to connected directory lists, etc
end;
end;
DriveBox.SetFocus;
end;
OldDrives.Free;
end;
You must also add the WinProcs and WinTypes units to the uses clause of your unit.
The difficult part here is that the DriveComboBox lacks a refresh function. By setting the TextCase property, we force an update of the box.
Copyright © 1997 by Josef Garvi
Try WNetConnectionDialog. This function is already pre-wrapped in Windows.pas and is specifically designed to do exactly what you want it to do.
> How can I detect my own IP address in delphi 1?
function my_ip_address:longint;
const
bufsize=255;
var
buf: pointer;
RemoteHost : PHostEnt; (* No, don't free it! *)
begin
buf:=NIL;
try
getmem(buf,bufsize);
winsock.gethostname(buf,bufsize); (* this one maybe without domain *)
RemoteHost:=Winsock.GetHostByName(buf);
if RemoteHost=NIL then
my_ip_address:=winsock.htonl($07000001) (* 127.0.0.1 *)
else
my_ip_address:=longint(pointer(RemoteHost^.h_addr_list^)^);
finally
if buf<>NIL then freemem(buf,bufsize);
end;
result:=winsock.ntohl(result);
end;
You only need a winsock.dcu/winsock.pas as this one isn't included with D1; I have one together with my tcpip component pack (where I snipped out the above routine).