Select BLOG {======================================================================================= ============================= Dumps: Network Library Time: 2002/10/02: 1.0 === ============================================================================================================================================================================================================= =====================} Unit net; Interface Uses Sysutils, Windows, Dialogs, Winsock, Classes, COMOBJ, WININET; // Get the local LAN IP address Function GetLocalIp (var LocalIp: string): Boolean; // returns the machine name Function GetNameByIPAddr by Ip (IPAddr: string; var macName: string): Boolean; // get the network SQLServer list Function GetSQLServerList (var list: Tstringlist): Boolean; / / Get all network types of 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; // acquired network resource Function GetUserResource (IpAddr: string; var List: TStringList): Boolean; // mapped network drives Function NetAddConnection (NetPath: Pchar; PassWord: Pchar; LocalPath: pchar): Boolean; // Detects Network Status Function CHEC KNET (ipaddr: string): boolean; // Detects whether the machine login in the network function checkmacttachnet: boolean; / / Decision IP protocol Do not install this function Function isipinstalled: boolean;
/ / Test if the machine is online Function InternetConnected: boolean; importation {===================================== =========================================== No return value: No return value: success: true failed: false Note : Version: 1.0 2002/10/03 09:55:00 ==================================== =============================} function checkmacttachnet: Boolean; Begin Result: = false; if getSystemmetrics (SM_Network) <> 0 Result: = true; End; {======================================================================================================================================================================== ======================= Dump: Return to the local area network IP address parameter: None return value: True, and fill the localip failed: false Remarks: Version: 1.0 2002/10/02 21:05:00 ===================================== ===============================
} Function GetLocalip: 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; {======================================== ========================== Features: Return to machine name by IP: 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; 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; {============================================== ==================== Features: Return to the SQLServer list parameters: List: The list returns to the list: Success: True, and populate the List failed FALSE Remarks : Version: 1.0 2002/10/02 22:44:00 ===================================== =============================} function getsqlserverlist (var list: tstringlist): boolean; var i: integer; 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 sqlser: = null; serverlist: = null; end; 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 ========================================= ==================================} 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 the result: = false end; false end; finally wsacleanup; end; End; {============== ============================================================================================================================================================================================================= = Function: Return to the shared resource parameter in the network: ipaddr: Machine IP List: The list of the need to be filled back: success: true, and fill the list: false; Note: WNETOpenENUM Function Starts An EnuMerance of Network Resources or Existing Connections . WneetenumResource Function Started by the WNETOpenENUM Function. Version: 1.0 2002/10/03 07:30 2002/10/03 07:30:00 ====================== ===========================
================} Function getUserResource (Ipaddr: string; var list: tstringlist): boolean; type tnetResourceRay = ^ TNetResource; // Network type array VAR i: integer; buf : Pointer; TEMP: TNETRESOTARRAY; LPHENUM: THANDLE; NetResource: TNetResource; count, bufsize, res: dword; begin result: = false; list: = false; list.clear; 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, Resource_Nany, Resourceusage_Connectable, @ NetResource, lphenum); if res <> no_error kil thrue do; // Exit the network resources of the designated Workgroup Begin Count: = $ fffffff; // Unlimited resource number buffsize: = 8192; // Buffer size is set to 8K getmem (buf, bufsize); // Apply for memory, used to obtain a workgroup information // Get the network of the specified computer Resource Name RES: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE); if res = error_no_more_items the Break; // Resource lists IF (res <> no_error) THEN EXIT; // Execution failed TE MP: = TNETRESOURCEARRAY (BUF); for i: = 0 to count - 1 do begin // Get the name of the shared resource 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 <> no_ERROR THEN EXIT; // Execution Result: = True; FreeMem (BUF); end; {======================================= ===
======================= Features: Return to the working group parameters in the network: list: List returns to be filled: success: true, and fill List failed: false; 备; 备; Note: version: 1.0 2002/10/03 08:00:00 ============================ ==============================================} Function getGroupList (var list: tstringlist): boolean; Type TNetResourceArray = ^ 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 resources 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 (RAISE EXCEPTION (RES); // Perform failed // Get network type information in the entire network Count: = $ ffffffffff; // unlimited resource number buffsize: = 8192; // buffer size setting 8K getmem (buf, bufsize); // Apply for memory for obtaining the working group information res: = WneetenumResource (lphenum, count, pointer (buf), bufsize); // Resource list // Perform failed IF (res = erro R_NO_MORE_ITEMS) or (res <> no_ERROR) THEN EXIT; P: = TNetResourceRay (BUF); for i: = 0 to count - 1 do // Record information of each network type Begin NetworkTypelist.Add (p); Inc (P) End; res: = wnetcloseenum (lphenum); // Close a list of ife; for j: =
0 TO NETWORKTYPELIST.COUNT-1 DO // Lists all working group names in each network type Begin // list all the working group names in a network type NetResource: = TNetResource (NetWorktyPelist.Items [J] ^); / / Network Type Information // Gets the handle of a file resource for a network type, NetResource is network type information, lphenum is Return Handle Res: = WNETOPENENUM (Resource_GlobalNet, ResourceType_Disk, Resourceusage_Container, @ netResource, lphenum); if @ NetResource, lphenum); if @ NetResource, lphenum); if res <> NO_ERROR THEN BREAK; // Perform a failure while true do // Information of all working groups of a network type begin count: = $ fffffff; // unlimited number of resources buffsize: = 8192; // buffer size set to 8K getMem ( BUF, BUFSIZE); // Apply for memory, used to obtain file resource information of a network type, res: = WnertenumResource (lphenum, count, pointer (buf), bufsize); // Resource listing / / Execute 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.Add ( StrPas (p ^ .lpremotename)); // Get a name INC (P) of a working group; end; end; res: = WnetCloseenum (lphenum); // Close a list of ife <> no_ERror dam
==============================================} function getUsers (Groupname: 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.clear; Fillchar (NetResource, SizeOf (NetResource), 0); // Initialization Network hierarchical information NetResource.lpremotename: = @Groupname [1]; // Specify the Working Group Name NetResource.dwdisplayType: = ResourceDisplayType_server; // Type server (working group) NetResource.dwUsage: = RESOURCEUSAGE_CONTAINER; NetResource.dwScope: = RESOURCETYPE_DISK; // // get the information listed in the file resource network resource handle Res designated working groups: = WNetOpenEnum (RESOURCE_GLOBALNET, RESOURCETYPE_DISK, RESOURCEUSAGE_CONTAINER, @ NetResource, lphEnum ); If res <> NO_ERROR THEN EXIT; // Execute the WHILE TRUE DO // Review the network resource of the specified working group begin count: = $ fffffff; // unlimited resource number buffsize: = 8192; // Buffer size setting For 8k getmem (buf, bufsize); // application memory, used to obtain a working group 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 Fail Temp: = TNetResourceRay (buf); for i: = 0 to count - 1 Do // Replace the working group computer name begin // Get the computer name of the workgroup, 2 means delete "//", such as // wangfajun => wangfajun list.add (Temp ^ .lpremotename 2); inc (TEMP ); End; end; res: = wnetcloseenum (lphenum); // Close a list of ife; // execution failure Result: = true; freemem (buf); end; {=====
============================================================================================================================================================================================================= ========== Features: list all network types parameters: List: The list returns to be filled: True, and fill the list: false; Note: Version: 1.0 2002/103 08:54:00 ============================================== ====================} Function GetNetList (var list: tstringlist): boolean; type tnetResourceRay = ^ TNetResource; // Network type array VAR P: TNetResourceRray; 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 thr in; // Execution failed count: = $ fffffff; // unlimited number of resources BUFSIZE: = 8192; // Buffer size is set to 8K getmem (buf, bufsize); // Apply for memory, for Get Workgroup Information Res: = WneetenumResource (Lphenum, Count, Pointer (BUF), BUFSIZE); // Get Network Type Information // Resource Recumeration // Execution Fastening IF (Res = Error_NO_MORE_ITEMS) OR (RES <> NO_ERROR) THEN Exit; p: = TNetResourceRra {===================== =====================================================================================================================================================
===================== Function: Mapping network drive parameters: NetPath: Want to map the network path password: Access password LocalPath local path return value: success: True failed: false; Remarks: 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; {======= ============================================================================================================================================================================================================= ======== Features: Detect Network Status parameters: 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; ticmpsend Echo = 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 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: = 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 R Esult: = false; halt; end; // --------------------------------------- --------------------- Address: = inet_addr (pchar (ipaddr)); if (address = inaddr_none) Then Begin Phe: = gethostByname (Pchar (iPaddr)) Ife: = 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 dam = 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; end; {===== ============================================================================================================================================================================================================= ========== Features: Check if the computer is online parameters: no return value: success: true failed: false; Note: Uses Wininet version: 1.0 2002/10/07 13: 33: 00 == ========================================= ==================================================================================================================
