netserver.pas

很不错的软件请使用

unit NetServer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,winsock, RXCtrls, Buttons, Registry, Menus;

type
  TGetComputerName = class(TForm)
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    RxLabel1: TRxLabel;
    RxLabel2: TRxLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Label1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Label2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  GetComputerName: TGetComputerName;

implementation

uses logos;

{$R *.dfm}

procedure TGetComputerName.FormCreate(Sender: TObject);
var
i : Integer;
ErrCode : Integer;
NetRes : Array[0..1023] of TNetResource;
EnumHandle : Thandle;
EnumEntries : Dword;
BufferSize : Dword;
begin
With NetRes[0] do begin
  dwScope :=RESOURCE_GLOBALNET;
  dwType :=RESOURCETYPE_ANY;
  dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
  dwUsage :=RESOURCEUSAGE_CONNECTABLE;
  lpLocalName :=NIL;
  lpRemoteName :=NIL;
  lpProvider :=NIL;
  end;
{ get net root }
ErrCode:=WNetOpenEnum(
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER,
@NetRes[0],
EnumHandle
);

If ErrCode=NO_ERROR then begin
  EnumEntries:=1;
  BufferSize:=SizeOf(NetRes);
  ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
  WNetCloseEnum(EnumHandle);
  ErrCode:=WNetOpenEnum(
  RESOURCE_GLOBALNET,
  RESOURCETYPE_ANY,
  RESOURCEUSAGE_CONNECTABLE,
  @NetRes[0],
  EnumHandle
  );
  EnumEntries:=1024;
  BufferSize:=SizeOf(NetRes);
  ErrCode:=WNetEnumResource(
  EnumHandle,
  EnumEntries,
  @NetRes,
  BufferSize
  );
  for i:=0 to 1023 do
    if NetRes[i].lpRemoteName='' then Exit
    else begin
    listbox1.Items.Add(Copy(NetRes[i].lpRemoteName,3,Length(NetRes[i].lpRemoteName)-2));
  end;
 end;
end;
procedure TGetComputerName.BitBtn2Click(Sender: TObject);
begin
close;
end;

procedure TGetComputerName.ListBox1Click(Sender: TObject);
begin
edit1.text:=listbox1.Items[Listbox1.ItemIndex];
end;

procedure TGetComputerName.FormShow(Sender: TObject);
var
Reg:TRegistry;
j, MaxWidth: integer;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
  if (Reg.OpenKey('\network\SqlServer',false))=False then
   begin
   Reg.CreateKey('\network\SqlServer');
   Reg.OpenKey('\network\SqlServer', True);
   Reg.WriteString('SqlServerName','未定义');
  end else
   begin
   Reg.OpenKey('\network\SqlServer', True);
   edit1.text:=Reg.ReadString('sqlservername');
   end;
 Reg.CloseKey;
 Reg.Free;
 bitbtn1.Enabled:=false;
 //给list加水平条
  MaxWidth := 0;
  for j := 0 to ListBox1.Items.Count - 1 do
  if MaxWidth<ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[j]) then
    MaxWidth:=ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[j]);
    SendMessage(ListBox1.Handle,LB_SETHORIZONTALEXTENT,MaxWidth+2,0); 
end;
procedure TGetComputerName.BitBtn1Click(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
 try
 Reg.RootKey:=HKEY_CURRENT_USER;
 Reg.OpenKey('\network\SqlServer', True);
 Reg.WriteString('SqlServerName',edit1.text);
 Reg.CloseKey;
 except
  begin
  MessageBox(Handle,'注册表错误导致程序终止！！','警告',MB_OK or MB_ICONSTOP);
  free;
  Application.Terminate;
  end;
  end;
 Reg.Free;
 bitbtn1.Enabled:=false;
 MessageBox(Handle,pchar('你已经成功地选定了['+edit1.text+']为服务器！'),'消息',MB_OK or MB_ICONinformation);
 exit;
end;

procedure TGetComputerName.Edit1Change(Sender: TObject);
begin
bitbtn1.Enabled:=true;
end;

procedure TGetComputerName.Label1Click(Sender: TObject);
var
Reg:TRegistry;
sqlservername:string;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
Reg.OpenKey('\network\SqlServer', True);
sqlservername:=Reg.ReadString('SqlServerName');
Reg.CloseKey;
Reg.Free;
MessageBox(Handle,pchar('当前SqlServer服务器名：'+#13+sqlservername+#13+'注册表信息存储地址：'+'HKEY_CURRENT_USER\network\SqlServer'+#13+'服务器名字符串：'+#13+'SqlServerName='+sqlservername+#13+#13+'通用程序服务器寻址'),'',MB_OK);
exit;
end;

procedure TGetComputerName.N1Click(Sender: TObject);
begin
label1click(sender);
end;

procedure TGetComputerName.Label2Click(Sender: TObject);
var
i : Integer; 
ErrCode : Integer; 
NetRes : Array[0..1023] of TNetResource; 
EnumHandle : Thandle; 
EnumEntries : Dword;
BufferSize : Dword;
begin
listbox1.Clear;
With NetRes[0] do begin
  dwScope :=RESOURCE_GLOBALNET;
  dwType :=RESOURCETYPE_ANY;
  dwDisplayType :=RESOURCEDISPLAYTYPE_DOMAIN;
  dwUsage :=RESOURCEUSAGE_CONNECTABLE;
  lpLocalName :=NIL;
  lpRemoteName :=NIL; 
  lpProvider :=NIL;
  end; 
{ get net root } 
ErrCode:=WNetOpenEnum( 
RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
RESOURCEUSAGE_CONTAINER, 
@NetRes[0],
EnumHandle
); 

If ErrCode=NO_ERROR then begin 
  EnumEntries:=1; 
  BufferSize:=SizeOf(NetRes);
  ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
  WNetCloseEnum(EnumHandle); 
  ErrCode:=WNetOpenEnum(
  RESOURCE_GLOBALNET,
  RESOURCETYPE_ANY,
  RESOURCEUSAGE_CONNECTABLE,
  @NetRes[0],
  EnumHandle
  );
  EnumEntries:=1024;
  BufferSize:=SizeOf(NetRes);
  ErrCode:=WNetEnumResource(
  EnumHandle,
  EnumEntries, 
  @NetRes, 
  BufferSize
  );
  for i:=0 to 1023 do
    if NetRes[i].lpRemoteName='' then Exit
    else begin
    listbox1.Items.Add(Copy(NetRes[i].lpRemoteName,3,Length(NetRes[i].lpRemoteName)-2));
  end; 
end;
end;

end.