Network function is open

xiaoxiao2021-03-06  68

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.

转载请注明原文地址:https://www.9cbs.com/read-87298.html

New Post(0)