{================================================================================================================================================================================================================ =================================02: 1.0 ========================================================================================================================================================================================================================================================= ============================================================================================================================================================================================================= ================} 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 machine name Function GetNameByipaddr (iPaddr: string; var MacName: String): boolean; // Get the network SQLServer list Function GetSqlServerList (VAR List: TStringList): boolean; // Get all network types in the network Function GetNetList (VAR List: tstringlist): boolean; // Gets the Working Group in the Network Function GetGroupList (Var List: Tstringlist): Boolean; / / Get all computers in the workgroup (Groupname: string; var list: tstringlist): boolean; // Get the resources in the network Function GetUserResource (iPaddr: string; var list: tstringlist): boolean; // Mapping network drive Function NetaddConnection (NetPath: PCHAR; PASSWORD: PCHAR; LOCALPATH: PCHAR): Boolean; // Detects Network Status Function Checknet (ipaddr: string): Boolean; // Detecting the machine login network Function CheckmacttachNet: Boolean;
/ / Decision IP protocol Do not install this function Function isipinstalled: boolean; // Detect the machine to internet FUNCTION InternetConnected: boolean; importation {==================== ================================================================================================================================================================================================== 功能: Detecting machine Whether to log in to network parameters: No return value: success: True Failure: False Note: Version: 1.0 2002/10/03 09:55:00 ==================== ======================================================} function checkmacttachnet: Boolean; begin result: = false; if getSystemmetrics (SM_NETWORK) <> 0 THEN Result: = true;
{================================================================================================================================================================================================================ ================ Features: Return to this machine's LAN IP address parameter: No 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: = 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;
{================================================================================================================================================================================================================ ================ Dump: IPAddr: IPADDR: IP Return value to get the name: Success: 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. ;
{================================================================================================================================================================================================================ ================ Features: Return to the network SQLServer list parameters: list: List that needs to be filled Return: Success: True, and fill the list False Remarks: Version: 1.0 2002/10/02 22:44:00 ======================================== ================================================================================================================================ 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;
{================================================================================================================================================================================================================ ================ Dump: Did you install the IP protocol: No return value: success: true failed: false; Remark: This function is also a problem version: 1.0 2002 / 10/02 21:05:00 ========================================= ============================================ , WSDATA) = 0 THEN Begin Protoent: = getProtobyname ('ip'); if protoent = nil the result: = false end; false end; finally wsacleanup; end; End; {============== ============================================================================================================================================================================================================= = Function: Return to the shared resource parameters in the network: ipaddr: Machine IP List: List returns to be filled: success: true, and fill the list: false;
Note: WNetOpenEnum function starts an enumeration of network resources or existing connections WNetEnumResource function continues a network-resource enumeration started by the WNetOpenEnum function Version: 1.0 2002/10/03 07:30:00 ========= ============================================================================================================================================================================================================= ======} Function GetUserResource (IpAddr: string; var List: TStringList): Boolean; type TNetResourceArray = ^ TNetResource; // network type array var i: Integer; Buf: Pointer; Temp: TNetResourceArray; lphEnum: THandle NetResource: TNetResource; Count, BufSize, Res: DWORD; Begin Result: = false; list: ipaddr, ipaddr, 0,2) <> '//' Then iPaddr: = '//' ipaddr; / / Fill IP Address Information FillChar (NetResource, SizeOf (NetResource), 0); // Initialization Network Hierarchical Information NetResource.lpRemotename: = @ipaddr [1]; // Specify 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, // Extrolmed the network of the designated workgroup Resource Begin Count: = $ fffffff; // Unlimited Source Number BUFSIZE: = 8192; // Buffer Size Set to 8k getMem (BUF, BUFSIZE); // Apply for memory, used to obtain workgroup information // Get specified computer Network Resource Name Res: = WnerteumResource (Lphenum, Count, Pointer (BUF), BUFSIZE); if Res = Error_NO_MORE_ITEMS THEN BREAK; // Resource lists IF (res <> no_error) THEN EXIT; // Execution failed TEMP: = TNetResourceArray (buf); for i: =
0 to count - 1 Do Begin // Get the shared resource name in the specified computer, 2 means delete "//", //, //192.168.0.1 => 192.168.0.1 list.add (Temp ^ .lpremotename 2 ); INC; end; end; res: = wnetcloseenum (lphenum); // Close a list of ife; // execution failure Result: = true; freemem (buf);
{================================================================================================================================================================================================================ ================ Features: Return to the working group parameters in the network: List: The list of lists that need to be filled: True, and fill the list failure: false; : Version: 1.0 2002/10/03 08:00:00 ==================================== =======================================} Function getGroupList (var list: tstringlist): boolean; type tnetResourceRay = ^ TNetResource; // network type array 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 Return Handle Res: = WNETOPENENUM (Resource_GlobalNet, ResourceTyPE_Disk, Resourceusage_Container, nil, lphenum); if res <> NO_ERROR THEN EXIT; // raise Exception (RES); // Perform failed // Get the network type information in the entire network Count: = $ fffffff; // unlimited resources BUFSIZE: = 8192; // Buffer size Set to 8K getMem (buf, bufsize) ; // Apply for memory for obtaining the working group information res: = WnertenumResource (lphenum, count, pointer (buf), bufsize); // resource list // Perform a failure if (res = error_no_more_items) or (res <> no_error) THEN EXIT; P: = TNetResourceRay (buf); for i: =
0 to count - 1 DO // Record the information of each network type begin networktypelist.add (p); inc (p); end; res: = wnetcloseenum (lphenum); // Close a list of ife ife <> no_ERROR THEN EXIT; For j: = 0 to networktypelist.count-1 do // list all the workgroup names in each network type begin // list all the working group names in a network type NetResource: = TNetResource (NetWorktyPelist.Items [J] ^); // Network type information // Get the handle of the file resource of a network type, NetResource is network type information, lphenum is returned to the list RES: = WNETOPENENUM (Resource_GlobalNet, ResourceTyPE_Disk, Resourceusage_Container, @ netResource, lphenum); if RES <> NO_ERROR THEN BREAK; // Perform a failure while true true do // Information of all working groups of a network type begin count: = $ fffffff; // unlimited resource number buffsize: = 8192; // Buffer size setting For 8K getmem (buf, bufsize); // application of memory, used to obtain file resource information for working group information //, res: = WnertenumResource (lphenum, count, pointer (buf), bufsize; // Resource listing // Performs failed IF (res = error_no_more_items) or (res <> no_error) the Break; P: = TNetResourceRay (buf); for i: = 0 to count - 1 do // list information of each working group Begin List.a DD (StrPas (P ^ .LpRemotename); // Take the name INC (P) of a workgroup; end; end; res: = WnetCloseenum (lphenum); // Close a list of ife ife <> no_ERROR THEN BREAK; / Execute failure end; result: = true; freemem (buf); networktypelist.destroy;
{================================================================================================================================================================================================================ ================ Dump: List: List: The list returns: success: True, and fill the list: false; Note: Version: 1.0 2002/10/03 08:00:00 ================================== ================================} function getusers (Groupname: string; var list: tstringlist): boolean; type tnetResourceRay = ^ TNetResource; // network type array var I: integer; buf: Pointer; Temp: TnetResourceRay; lphenum: thandle; netresource: tnetResource; count, bufsize, res: dword; begin result: = false; list; rest; fillchar (FillCha) NetResource, SizeOf (NetResource), 0); // Initialization Network hierarchical information NetResource.lpremotename: = @Groupname [1]; // Specify the workgroup name NetResource.dwdisplayType: = ResourceDisplayTyPE_Server; // Type Server (Working Group) NetResource .dwUsage: = RESOURCEUSAGE_CONTAINER; NetResource.dwScope: = RESOURCETYPE_DISK; // // include file information resource handle to access network resources specified Res working group: = WNetOpenEnum (RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @ NetResource, lphEnum); if Res <> NO_ERR Or life, // Exit the network resources of the designated workgroup, begin count: = $ fffffff; // unlimited resource number buffsize: = 8192; // Buffer size is set to 8K getMem (buf, Buffsize; // Apply for memory,
Used to get a workgroup information // Get computer name res: = WneetenumResource (lphenum, count, pointer (buf), bufsize); if res = error_no_more_items the break; // Resource lists IF (res <> no_ERROR) THEN EXIT; // Execute the failure Temp: = TNetResourceRay (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 of ife <> no_ERROR THEN EXIT; // Execution Failed Result: = true; FreeMem (BUF);
{================================================================================================================================================================================================================ ================ Features: list all network types: List: The list returns to the list: True, and fill the list: false; Remarks: Version: 1.0 2002/10/03 08:54:00 ======================================== ==========================} function getnetList (var list: tstringlist): boolean; type tnetResourceArray = ^ TNetResource; // Network type array 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; / / Execution failed count: = $ fffffffff; // unlimited number of resources BUFSIZE: = 8192; // Buffer size set to 8K getMem (buf, bufsize); / / Apply for memory, used to obtain Working Group Information Res: = WnertenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE) RES <> NO_ERROR) THEN EXIT; P: = TNetResourcecearra
{================================================================================================================================================================================================================ ================ Features: Mapping network drive parameters: NetPath: Want to map network path password: Access Password localpath local path return value: success: True failed: false; Note: Version: 1.0 2002/10/03 09:24:00 ==================================== ==============================} function NetaddConnection (NetPath: Pchar; Password: pchar; localpath: pchar): boolean; RES: DWORD; Begin Result: = false; res: = wnetdConnection (NetPath, Password, localpath); if res <> NO_ERROR THEN EXIT; RESULT: = True;
{================================================================================================================================================================================================================ ================ Dump: Ipaddr: IPAddr: IP address or name is tested on the network, it is recommended to use IP return value: Success: True Failure: False : Remarks: Version: 1.0 2002/10/03 09:40:00 ================================== =========================================} Function checknet (ipaddr: string): boolean; type pipoption; TipoptionInformation; TipoptionInformation Packed record ttl: Byte; // type of service (usload) flags: byte; // ip header flags (us) 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 Buff Options: Tipoption; // 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; 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 sendconst IcmpDLL = 'icmp.dll'; var hICMPlib: hModule; IcmpCreateFile : TIcmpCreateFile; IcmpCloseHandle: TIcmpCloseHandle; IcmpSendEcho: TIcmpSendEcho; hICMP: THandle; // Handle for the ICMP Callsbegin // 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: = getProc Address (hICMPlib, 'IcmpCloseHandle'); @IcmpSendEcho: = GetProcAddress (hICMPlib, 'IcmpSendEcho'); if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then begin Result: = False; HACT; END; HICMP: = ICMPCREATEFILE; if HiCMP = INVALID_HANDLE_VALUE INVALID_HANDLE_VALUE THEN BEGIN 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 TEN Result: = false else begin address: = longint (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 = 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, $ A); 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); Free Winsock IF WSACLANUP <> 0 THEN Result: = false;
{================================================================================================================================================================================================================ ================ Fenergy: Detect the computer to internet parameters: no return value: success: true failed: false; Note: Uses Wininet version: 1.0 2002/10/07 13 : 33:00 ======================================================================================================================================= ===================} Function InternetConnected: boolean; const // local system uses a mod_mode 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; end;
/ ******************************************** * Error message constant unit HEAD;
interfaceconst C_Err_GetLocalIp = 'get local ip fail'; C_Err_GetNameByIpAddr = 'Get names fail'; C_Err_GetSQLServerList = 'get SQLServer server failed'; C_Err_GetUserResource = 'acquire shared resources fail'; C_Err_GetGroupList = 'Get all the working group failed'; C_Err_GetGroupUsers = ' working group on all the computers fail '; C_Err_GetNetList =' Get all network types fail '; C_Err_CheckNet =' network nowhere '; C_Err_CheckAttachNet =' not signed network '; C_Err_InternetConnected =' no access'; C_Txt_CheckNetSuccess = 'network flow'; C_Txt_CheckAttachNetSuccess = 'Loggedited in the network'; c_txt_internetconnected = 'Internet version'; Implementation
End.
