| Unit net; Interface
Uses
Sysutils
, Windows
, Dialogs
, Winsock
, Classes
, Comobj
, Wininet; // Obtain the local lan ip Address
Function getlocalip (VAR localip: string): Boolean;
// Return the machine name through IP Address
Function getnamebyipaddr (ipaddr: string; var macname: string): Boolean;
// Obtain the list in the Network
Function getsqlserverlist (VAR list: tstringlist): Boolean;
// Obtain all network types in the Network
Function getnetlist (VAR list: tstringlist): Boolean;
// Obtain the workgroup in the Network
Function getgrouplist (VAR list: tstringlist): Boolean;
// Obtain all computers in the workgroup
Function getusers (groupname: string; var list: tstringlist): Boolean;
// Obtain resources in the Network
Function getuserresource (ipaddr: string; var list: tstringlist): Boolean;
// Map the network drive
Function netaddconnection (netpath: pchar; Password: pchar; localpath: pchar): Boolean;
// Check the network status
Function checknet (ipaddr: string): Boolean;
// Check whether the machine is logged on to the network
Function checkmacattachnet: Boolean; // Check whether the IP protocol has a problem with this function.
Function isipinstalled: Boolean;
// Check whether the machine is connected to the Internet
Function internetconnected: Boolean;
Implementation {===================================================== ======================================
Function: checks whether the machine is logged on to the network.
Parameter count: None
Returned value: Successful: True failed: false
Secondary note:
Version:
1.0 2002/10/03 09:55:00
========================================================== ===============================}
Function checkmacattachnet: Boolean;
Begin
Result: = false;
If getsystemmetrics (sm_network) <> 0 then
Result: = true;
End; {===================================================== ======================================
Function: return the local area network IP address.
Parameter count: None
Returned value: Success: True, and filling localip failed: false
Secondary note:
Version:
1.0 21:05:00
========================================================== ===============================}
Function getlocalip (VAR localip: string): Boolean;
VaR
Hostent: phostent;
IP: string;
ADDR: pchar;
Buffer: array [0 .. 63] of char;
Ginitdata: twsadata;
Begin
Result: = false;
Try
Wsastartup (2, ginitdata );
Gethostname (buffer, sizeof (buffer ));
Hostent: = gethostbyname (buffer );
If hostent = nil then exit;
ADDR: = hostent ^. h_addr_list ^;
IP: = format ('% d. % d', [byte (ADDR [0]),
Byte (ADDR [1]), byte (ADDR [2]), byte (ADDR [3]);
Localip: = IP;
Result: = true;
Finally
Wsacleanup;
End;
End; {===================================================== ======================================
Function: return the machine name through IP Address
Parameters:
Ipaddr: IP address to get the name
Returned value: Success: Machine name failed :''
Secondary note:
Inet_addr function converts a string containing an Internet
Protocol dotted address into an in_addr.
Version:
1.0 22:09:00
========================================================== ===============================}
Function getnamebyipaddr (ipaddr: string; var macname: string): Boolean;
VaR
Sockaddrin: tsockaddrin;
Hostent: phostent;
Wsadata: twsadata;
Begin
Result: = false;
If ipaddr = ''then exit;
Try
Wsastartup (2, wsadata );
Sockaddrin. sin_addr.s_addr: = inet_addr (pchar (ipaddr ));
Hostent: = gethostbyaddr (@ sockaddrin. sin_addr.s_addr, 4, af_inet );
If hostent <> nil then
Macname: = strpas (hostent ^. h_name );
Result: = true;
Finally
Wsacleanup;
End;
End; {===================================================== ======================================
Function: Return to the list on the network.
Parameters:
List: list to be filled
Returned value: Success: True, and filling list failed: false
Secondary note:
Version:
1.0 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; {===================================================== ======================================
Function: determines whether the IP protocol is installed.
Parameter count: None
Returned value: Success: true failure: false;
Note: This function is still faulty.
Version:
1.0 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 shared resources from the network.
Parameters:
Ipaddr: IP address of the machine
List: list to be filled
Returned value: Success: True, and filling the list failed: false;
Secondary 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. Clear;
If copy (ipaddr, 0, 2) <> '// 'then
Ipaddr: = '//' + ipaddr; // fill in the IP address information
Fillchar (netresource, sizeof (netresource), 0); // initialize network level information
Netresource. lpremotename: = @ ipaddr [1]; // specify the computer name
// Obtain the network resource handle of the specified computer
Res: = wnetopenenum (resource_globalnet, resourcetype_any,
Resourceusage_connectable, @ netresource, lphenum );
If res <> no_error then exit; // execution failed
While true do // list network resources of a specified workgroup
Begin
Count: = $ ffffffff; // unlimited number of resources
Bufsize: = 8192; // set the buffer size to 8 K.
Getmem (BUF, bufsize); // apply for memory, used to obtain the workgroup Information
// Obtain the Network Resource Name of the specified computer
Res: = wnetenumresource (lphenum, Count, pointer (BUF), bufsize );
If res = error_no_more_items then break; // The resource list is complete.
If (RES <> no_error) Then exit; // execution failed
Temp: = tnetresourcearray (BUF );
For I: = 0 to count-1 do
Begin
// Obtain the name of the shared resource on the specified computer. + 2 indicates deleting "//",
// For example, // 192.168.0.1 => 192.168.0.1
List. Add (temp ^. lpremotename + 2 );
INC (temp );
End;
End;
Res: = wnetcloseenum (lphenum); // close the listing once.
If res <> no_error then exit; // execution failed
Result: = true;
Freemem (BUF );
End; {===================================================== ======================================
Function: Return to the Working Group in the network.
Parameters:
List: list to be filled
Returned value: Success: True, and filling the list failed: false;
Secondary 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;
// Obtain the file resource handle of the entire network. lphenum is the return name handle.
Res: = wnetopenenum (resource_globalnet, resourcetype_disk,
Resourceusage_container, nil, lphenum );
If res <> no_error then exit; // raise exception (RES); // execution failed
// Obtain the network type information of the entire network
Count: = $ ffffffff; // unlimited number of resources
Bufsize: = 8192; // set the buffer size to 8 K.
Getmem (BUF, bufsize); // apply for memory, used to obtain the workgroup Information
Res: = wnetenumresource (lphenum, Count, pointer (BUF), bufsize );
// Resource list complete // execution failed
If (RES = error_no_more_items) or (RES <> no_error) Then exit;
P: = tnetresourcearray (BUF );
For I: = 0 to count-1 do // records information of each network type
Begin
Networktypelist. Add (P );
INC (P );
End;
Res: = wnetcloseenum (lphenum); // close the listing once.
If res <> no_error then exit;
For J: = 0 to networktypelist. Count-1 do // list all workgroup names in each network type
Begin // list all workgroup names in a network type
Netresource: = tnetresource (networktypelist. items [J] ^); // network type information
// Obtain the handle of a file resource of a network type. netresource indicates the network type, and lphenum indicates the return name.
Res: = wnetopenenum (resource_globalnet, resourcetype_disk,
Resourceusage_container, @ netresource, lphenum );
If res <> no_error then break; // execution failed
While true do // lists information about all working groups of a network type
Begin
Count: = $ ffffffff; // unlimited number of resources
Bufsize: = 8192; // set the buffer size to 8 K.
Getmem (BUF, bufsize); // apply for memory, used to obtain the workgroup Information
// Obtain the file resource information of a network type,
Res: = wnetenumresource (lphenum, Count, pointer (BUF), bufsize );
// Resource list complete // 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 of each working group
Begin
List. Add (strpas (P ^. lpremotename); // obtain the name of a workgroup.
INC (P );
End;
End;
Res: = wnetcloseenum (lphenum); // close the listing once.
If res <> no_error then break; // execution failed
End;
Result: = true;
Freemem (BUF );
Networktypelist. Destroy;
End; {===================================================== ======================================
Function: Lists All computers in a working group.
Parameters:
List: list to be filled
Returned value: Success: True, and filling the list failed: false;
Secondary note:
Version:
1.0 2002/10/03 08:00:00
========================================================== ===============================}
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); // initialize network level information
Netresource. lpremotename: = @ groupname [1]; // specify the workgroup name
Netresource. dwdisplaytype: = resourcedisplaytype_server; // type: Server (workgroup)
Netresource. dwusage: = resourceusage_container;
Netresource. dwscope: = resourcetype_disk; // lists file resource information.
// Obtain the network resource handle of the specified workgroup
Res: = wnetopenenum (resource_globalnet, resourcetype_disk,
Resourceusage_container, @ netresource, lphenum );
If res <> no_error then exit; // execution failed
While true do // list network resources of a specified workgroup
Begin
Count: = $ ffffffff; // unlimited number of resources
Bufsize: = 8192; // set the buffer size to 8 K.
Getmem (BUF, bufsize); // apply for memory, used to obtain the workgroup Information
// Obtain the computer name
Res: = wnetenumresource (lphenum, Count, pointer (BUF), bufsize );
If res = error_no_more_items then break; // The resource list is complete.
If (RES <> no_error) Then exit; // execution failed
Temp: = tnetresourcearray (BUF );
For I: = 0 to count-1 do // lists the names of the workgroup computers
Begin
// Obtain the computer name of the Working Group. + 2 indicates deleting "//", for example, // wangfajun => wangfajun
List. Add (temp ^. lpremotename + 2 );
INC (temp );
End;
End;
Res: = wnetcloseenum (lphenum); // close the listing once.
If res <> no_error then exit; // execution failed
Result: = true;
Freemem (BUF );
End; {===================================================== ======================================
Function: lists all network types.
Parameters:
List: list to be filled
Returned value: Success: True, and filling the list failed: false;
Secondary note:
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: = $ ffffffff; // unlimited number of resources
Bufsize: = 8192; // set the buffer size to 8 K.
Getmem (BUF, bufsize); // apply for memory, used to obtain the workgroup Information
Res: = wnetenumresource (lphenum, Count, pointer (BUF), bufsize); // obtain network type information
// Resource list complete // execution failed
If (RES = error_no_more_items) or (RES <> no_error) Then exit;
P: = tnetresourcearra {===================================================== ======================================
Ing network drive
Parameters:
Netpath: network path to be mapped
Password: Access Password
Localpath local path
Returned value: Success: true failure: false;
Secondary 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: = wnetaddconnection (netpath, password, localpath );
If res <> no_error then exit;
Result: = true;
End; {===================================================== ======================================
Function: detects the network status.
Parameters:
Ipaddr: IP address or name of the host on the tested network. IP address is recommended.
Returned value: Success: true failure: false;
Secondary 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 Buffer
Ipopt: tipoptioninformation; // IP options for packet to send
Const
Icmpdll = 'ICMP. dll ';
VaR
Hicmplib: hmodule;
Icmpcreatefile: ticmpcreatefile;
Icmpclosehandle: ticmpclosehandle;
Icmpsendecho: ticmpsendecho;
Hicmp: thandle; // handle for the ICMP CILS
Begin
// Initialise Winsock
Result: = true;
If wsastartup (2, wsadata) <> 0 then begin
Result: = false;
Halt;
End;
// Register the ICMP. dll stuff
Hicmplib: = loadlibrary (icmpdll );
If hicmplib <> null then begin
@ Icmpcreatefile: = getprocaddress (hicmplib, 'icmpcreatefile ');
@ Icmpclosehandle: = getprocaddress (hicmplib, 'icmpclosehandle ');
@ Icmpsendecho: = getprocaddress (hicmplib, 'icmpsendemocho ');
If (@ icmpcreatefile = nil) or (@ icmpclosehandle = nil) or (@ icmpsendecho = nil) then begin
Result: = false;
Halt;
End;
Hicmp: = icmpcreatefile;
If hicmp = invalid_handle_value then begin
Result: = false;
Halt;
End;
End else begin
Result: = false;
Halt;
End;
//------------------------------------------------------------
Address: = inet_addr (pchar (ipaddr ));
If (address = inaddr_none) then begin
PHE: = gethostbyname (pchar (ipaddr ));
If Phe = nil then result: = false
Else begin
Address: = longint (plongint (PHE ^. h_addr_list ^ );
Hostname: = Phe ^. h_name;
Hostip: = strpas (inet_ntoa (tinaddr (Address )));
End;
End
Else begin
PHE: = gethostbyaddr (@ address, 4, pf_inet );
If Phe = nil then result: = false;
End; If address = inaddr_none then
Begin
Result: = false;
End;
// Get some data buffer space and put something in the packet to send
Buffersize: = sizeof (ticmpechoreply) + size;
Getmem (preqdata, size );
Getmem (pdata, size );
Getmem (pipe, buffersize );
Fillchar (preqdata ^, size, $ aa );
Pipe ^. Data: = pdata; // Finally send the packet
Fillchar (ipopt, sizeof (ipopt), 0 );
Ipopt. TTL: = 64;
Npkts: = icmpsendecho (hicmp, address, preqdata, size,
@ Ipopt, pipe, buffersize, timeout );
If npkts = 0 then result: = false; // Free those Buffers
Freemem (PIPE); freemem (pdata); freemem (preqdata ); //--------------------------------------------------------------
Icmpclosehandle (hicmp );
Freelibrary (hicmplib );
// Free Winsock
If wsacleanup <> 0 then result: = false;
End; {===================================================== ======================================
Skill: Check whether the computer is surfing the internet
Parameter count: None
Returned 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.
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; Interface
Const
C_err_getlocalip = 'failed to get the local IP address ';
C_err_getnamebyipaddr = 'failed to get the host name ';
C_err_getsqlserverlist = 'failed to retrieve sqlserver server ';
C_err_getuserresource = 'failed to get shared resource ';
C_err_getgrouplist = 'failed to retrieve all workgroups ';
C_err_getgroupusers = 'failed to retrieve all computers in the workgroup ';
C_err_getnetlist = 'failed to retrieve all network type ';
C_err_checknet = 'network barri ';
C_err_checkattachnet = 'network not logged in ';
C_err_internetconnected = 'no Internet access '; C_txt_checknetsuccess = 'smooth network ';
C_txt_checkattachnetsuccess = 'logged on to network ';
C_txt_internetconnected = 'Internet access '; Implementation End. |
