Network function is open
Zsy_Good (as long as it is unswerving, then it will succeed)
{================================================================================================================================================================================================================ =========================
Finance: Network Library
Time: 2002/10/02
Version: 1.0
Note: There is no matter what you do, copywriting is sorted out some network functions for everyone.
I hope everyone can continue to add
============================================================================================================================================================================================================= ========================}
Unit Net;
Interface
Uses
Sysutils
, Windows
Dialogs
, Winsock
, Classes
, Comobj
Wininet;
/ / Get the local area network IP address
Function Getlocalip (Var localip: string): boolean;
// Return to the machine via IP
Function GetNameByipaddr (Ipaddr: String; Var MacName: String): Boolean;
/ / Get list of SQLServer in the network
Function GetsqlserverList (var list: tstringlist): boolean;
/ / Get all network types in the network
Function GetNetList (var list: tstringlist): boolean;
/ / Get the working group in the network
Function getGroupList (var list: tstringlist): boolean;
/ / Get all your computers in the working group
Function GetUsers (Groupname: string; var list: tstringlist): boolean;
/ / Get resources in the network
Function GetUserResource (iPaddr: string; var list: tstringlist): boolean;
// Map network drive
Function NetaddConnection (NetPath: Pchar; Password: Pchar; LocalPath: pchar): Boolean;
// Detect network status
Function checknet (ipaddr: string): boolean;
/ / Test whether the machine login network
Function Checkmacttach: Boolean;
/ / Deconstimate whether there is any problem with the IP protocol installed
Function isipinstalled: boolean; // Test if the machine is online
Function InternetConnected: boolean;
IMPLEMENTATION
{================================================================================================================================================================================================================ ================
Function: Detect whether the machine login network
Parameter: None
Return Value: Success: TRUE Failure: False
Note:
Version:
1.0 2002/10/03 09:55:00
============================================================================================================================================================================================================= ================}
Function Checkmacttach: Boolean;
Begin
Result: = FALSE;
IF getSystemmetrics (SM_Network) <> 0 THEN
RESULT: = true;
END;
{================================================================================================================================================================================================================ ================
Function: Return to the local area network IP address
Parameter: None
Return Value: Success: True, and fill the localip failed: False
Note:
Version:
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 dam;
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;
{================================================================================================================================================================================================================ ================
Function: Return to the machine by IP
Parameter:
Ipaddr: I want to get the name of the IP
Return Value: Success: The machine name failed: ''
Note:
INET_ADDR Function Converts A String Containing An Internet
Protocol dotted address INTO AN IN_ADDR.
Version:
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 dam
MacName: = strpas (hostent ^ .h_name);
RESULT: = true;
Finally
WSACLEANUP;
END;
END;
{================================================================================================================================================================================================================ ================
Function: Return to the list of SQLServer in the network
Parameter:
List: List that needs to be filled
Return Value: Success: True, and populate List failed FALSE
Note:
Version:
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;
{================================================================================================================================================================================================================ ================ Dominable: Declaration IP protocol is installed
Parameter: None
Return Value: Success: True Failure: False;
Note: There is still a problem with this function.
Version:
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;
{================================================================================================================================================================================================================ ================
Function: Returns a shared resource in the network
Parameter:
Ipaddr: Machine IP
List: List that needs to be filled
Return Value: Success: True, and fill the list failed: false;
Note:
WNETOPENENUM FUNCTION STARTS An EnuMeration Of Network
Resources or esting connections.
WneetenumResource Function Continues a network-resource
ENUMERATION Started by The WnetopENUM Function.
Version:
1.0 2002/10/03 07:30:00
============================================================================================================================================================================================================= ===============} Function GetUserResource (Ipaddr: string; var list: tstringlist): boolean;
Type
TNetResourceArray = ^ TNetResource; // Number of network types
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; // Pack IP address information
Fillchar (NetResource, Sizeof (NetResource), 0); // Initialization Network Hierarchy Information
NetResource.lpremotename: = @ipaddr [1]; // Specify the computer name
/ / Get the network resource handle of the specified computer
Res: = WNETOPENENUM (Resource_GlobalNet, ResourceType_any,
Resourceusage_Connectable, @ NetResource, Lphenum;
If res <> no_error thr; // execution failed
While true do // lists the network resources of the designated workgroup
Begin
Count: = $ fffffff; // Number of unlimited resources
BUFSIZE: = 8192; // Buffer size Set to 8K
GetMem (buf, bufsize); // Apply for memory to obtain workgroup information
/ / Get the network resource name of the specified computer
Res: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE
if res = error_no_more_items the Break; // Resource list
IF (res <> no_error) THEN EXIT; / / Execution Failure
Temp: = TNetResourceArray (BUF);
For i: = 0 to count - 1 do
Begin
/ / Get the shared resource name in the specified computer, 2 means delete "/",
//, such as / 192.168.0.1 => 192.168.0.1
List.add (temp ^ .lpremotename 2);
Inc (TEMP);
END;
END;
Res: = WnetCloseenum (lphenum); // Close a list
If res <> no_error thr; // execution failed
RESULT: = TRUE;
FreeMem (buf);
END;
{================================================================================================================================================================================================================ ================ Function: Return to the working group in the network
Parameter:
List: List that needs to be filled
Return Value: Success: True, and fill the list failed: false;
Note:
Version:
1.0 2002/10/03 08:00:00
============================================================================================================================================================================================================= ================}
Function getGroupList (var list: tstringlist): boolean;
Type
TNetResourceArray = ^ TNetResource; // Number of network types
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;
/ / Get the handle of the file resource in the entire network, lphenum is the return handle
Res: = WNETOPENUM (Resource_GlobalNet, ResourceType_Disk,
Resourceusage_Container, NIL, LPHENUM;
if res <> NO_ERROR THEN EXIT; // Raise Exception (RES); // Execution Failure
/ / Get Network Type Information in the entire network
Count: = $ fffffff; // Number of unlimited resources
BUFSIZE: = 8192; // Buffer size Set to 8K
GetMem (buf, bufsize); // Apply for memory to obtain workgroup information
Res: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE
// Resource listing / / Execution failed
IF (RES = Error_NO_MORE_ITEMS) or (res <> NO_ERROR).
P: = TNetResourceArray (BUF);
For i: = 0 to count - 1 DO // Record information of each network type
Begin
NetworkTypelist.Add (p);
INC (P);
END;
Res: = wnetcloseenum (lphenum); // Turns a list of ife; no_ERROR THEN EXIT;
For j: = 0 to networktypelist.count-1 do // list all the workgroup names in each network type
Begin // lists all the working group names in a network type
NetResource: = TNetResource (NetWorktyPelist.Items [J] ^); // Network Type Information
/ / Get the handle of a file resource of a network type, NetResource is network type information, and lphenum is the backhand
Res: = WNETOPENUM (Resource_GlobalNet, ResourceType_Disk,
Resourceusage_container, @ netResource, lphenum;
If res <> no_error dam; // execution failed
While true do // lists information about all working groups of a network type
Begin
Count: = $ fffffff; // Number of unlimited resources
BUFSIZE: = 8192; // Buffer size Set to 8K
GetMem (buf, bufsize); // Apply for memory to obtain workgroup information
// Get a file resource information of a network type,
Res: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE
// Resource listing / / Execution failed
IF (res = error_no_more_items) or (res <> NO_ERROR) THEN BREAK;
P: = TNetResourceArray (BUF);
For i: = 0 to count - 1 do // list information from each working group
Begin
List.add (StrPas (p ^ .lpremotename); // get the name of a workgroup
INC (P);
END;
END;
Res: = WnetCloseenum (lphenum); // Close a list
If res <> no_error dam; // execution failed
END;
RESULT: = TRUE;
FreeMem (buf);
NetworkTypelist.destroy;
END;
{================================================================================================================================================================================================================ ================
Function: list all the computers in the working group
Parameter:
List: List that needs to be filled
Return Value: Success: True, and fill the list failed: false;
Note:
Version:
1.0 2002/10/03 08:00:00
============================================================================================================================================================================================================= ================} function getusers (Groupname: string; var list: tstringlist): boolean
Type
TNetResourceArray = ^ TNetResource; // Number of network types
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); // Initialization Network Hierarchy Information
NetResource.lpremotename: = @Groupname [1]; // Specify the name of the workgroup
NetResource.dwdisplayType: = ResourceDisplayType_server; // Type Server (Workgroup)
NetResource.dwusage: = Resourceusage_Container;
NetResource.dwscope: = resourcetype_disk; // list file resource information
/ / Get the network resource handle of the specified workgroup
Res: = WNETOPENUM (Resource_GlobalNet, ResourceType_Disk,
Resourceusage_container, @ netResource, lphenum;
If res <> no_error thr; // execution failed
While true do // lists the network resources of the designated workgroup
Begin
Count: = $ fffffff; // Number of unlimited resources
BUFSIZE: = 8192; // Buffer size Set to 8K
GetMem (buf, bufsize); // Apply for memory to obtain workgroup information
// Get the computer name
Res: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE
if res = error_no_more_items the Break; // Resource list
IF (res <> no_error) THEN EXIT; / / Execution Failure
Temp: = TNetResourceArray (BUF);
For i: = 0 to count - 1 do // list the computer name of the working group
Begin
/ / Get the computer name of the working group, 2 means delete "/", such as / wangfajun => wangfajun
List.add (temp ^ .lpremotename 2);
Inc (TEMP);
END;
END;
Res: = WnetCloseenum (lphenum); // Close a list
If res <> no_error thr; // Execute the failure Result: = true;
FreeMem (buf);
END;
{================================================================================================================================================================================================================ ================
Function: list all network types
Parameter:
List: List that needs to be filled
Return Value: Success: True, and fill the list failed: false;
Note:
Version:
1.0 2002/10/03 08:54:00
============================================================================================================================================================================================================= ================}
Function GetNetList (var list: tstringlist): boolean;
Type
TNetResourceArray = ^ TNetResource; // Number of network types
VAR
P: TNetResourceArray;
BUF: POINTER;
i: smallint;
Lphenum: thandle;
NetResource: TNETRESOURCE;
Count, BufSize, Res: DWORD
Begin
Result: = FALSE;
List.clear;
Res: = WNETOPENUM (Resource_GlobalNet, ResourceType_Disk,
Resourceusage_Container, NIL, LPHENUM;
If res <> no_error thr; // execution failed
Count: = $ fffffff; // Number of unlimited resources
BUFSIZE: = 8192; // Buffer size Set to 8K
GetMem (buf, bufsize); // Apply for memory to obtain workgroup information
Res: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE); // Get Network Type Information
// Resource listing / / Execution failed
IF (RES = Error_NO_MORE_ITEMS) or (res <> NO_ERROR).
P: = TNetResourceArray (BUF);
For i: = 0 to count - 1 DO // Record information of each network type
Begin
List.add (p ^ .lpremotename);
INC (P);
END;
Res: = WnetCloseenum (lphenum); // Close a list
If res <> no_error thr; // Execute the failure Result: = true;
FreeMem (BUF); // Release memory
END;
{================================================================================================================================================================================================================ ================
Function: Mapping Network Drive
Parameter:
Netpath: Want to map the network path
Password: Access password
LocalPath local path
Return Value: Success: True Failure: False;
Note:
Version:
1.0 2002/10/03 09:24:00
============================================================================================================================================================================================================= ================}
Function NetAddConnection (NetPath: pchar; Password: Pchar
; LocalPath: pchar): boolean;
VAR
Res: dWord;
Begin
Result: = FALSE;
Res: = WnetdConnection (NetPath, Password, LocalPath);
IF RES <> NO_ERROR THEN EXIT;
RESULT: = true;
END;
{================================================================================================================================================================================================================ ================
Function: Detecting Network Status
Parameter:
IPaddr: IP address or name of the host on the network is tested, it is recommended to use IP
Return Value: Success: True Failure: False;
Note:
Version:
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 buffopt: 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: = loading (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 the beginning
Result: = FALSE;
Halt;
END;
ELSE BEGIN
Result: = FALSE;
Halt;
END;
/ / -------------------------------------------------------------------------------------------- ----------------
Address: = inet_addr (pchar (ipaddr));
IF (address = incaddr_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 the result: = false;
END;
IF address = incaddr_none kil
Begin
Result: = FALSE;
END;
// Get Some Data Buffer Space and Put Something In The Packet To sendbuffersize: = 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.
END;
{================================================================================================================================================================================================================ ================
Function: Detect whether the computer is online
Parameter: None
Return Value: Success: True Failure: False;
备 Note: Uses Wininet
Version:
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 .. // 's LOCAL SYSTEM'S MODEM IS Bu.
Internet_connection_modem_busy = 8;
VAR
DWCONNECTIONTYPES: DWORD;
Begin
DWCONNECTIONTYPES: = Internet_connection_modem internet_connection_lan
Internet_Connection_Proxy;
Result: = InternetGetConnectedState (@dwconnectiontypes, 0);
END;
// Turn off the network connection
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;
NetsessionNum: 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;
Lionle: Thandle;
Begin
Result: = FALSE;
Try
{Load DLL}
LibHandle: = loadingLibrary ('svrapi.dll');
Try
{If the load failed, libHandle = 0.}
IF libhandle = 0 THEN
Raise Exception.create ('Can't load SVRAPI.dll');
{DLL load is successful, get the connection to the DLL output function and then call}
@NetSessionNum: = getProcaddress (libhandle, 'netsessionenum');
@NetSessionDel: = getProcaddress (LibHandle, 'NetSessionDel');
IF (@NetSessionNum = NIL) or (@ netsession_del = nil) THEN
RaiselastWin32error {Connection function failed}
Else
Begin
DWNetret: = NetsessionNum (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 (librandle); // unload the dll.
END;
Except
END;
END;
End.
// Error message constant
Unit head;
Interface
Const
C_ERR_GETLOCALIP = 'Get local IP failed';
C_ERR_GETNAMEBYIPADDR = 'Gets the host name failed';
C_ERR_GETSQLSERVERLIST = 'Gets the SQLServer server failed';
C_ERR_GETUSERRESOURCE = 'Get a shared capital failure';
C_ERR_GETGROUPLIST = 'Get all working group failed';
C_ERR_GETGROUSERS = 'Get all computers in the working group';
C_ERR_GETNETLIST = 'Get all network type failed';
C_ERR_CHECKNET = 'network is not on';
C_ERR_CHECKATTACHNET = 'None Log in Network';
C_ERR_INTERNETCONNECTED = 'No Internet';
C_txt_checknetsuccess = 'network is unblocked;
C_txt_checkattachnetsuccess = 'Loggedited in Network';
C_txt_internetconnected = 'Internetped';
IMPLEMENTATION
End.