kjkim
/
BSOne.SFC
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
BSOne.SFC/Tocsg.Lib/VCL/Tocsg.Network.pas

2657 lines
73 KiB
Plaintext
Raw Blame History

{*******************************************************}
{ }
{ Tocsg.Network
{ }
{ Copyright (C) 2022 sunk }
{ }
{*******************************************************}
unit Tocsg.Network;
interface
uses
Winapi.Windows, System.Classes, System.SysUtils, Winapi.WinSock,
Tocsg.Obj, System.Generics.Collections, Winapi.IpTypes;
//------------- headers from Microsoft IPTYPES.H--------------------------------
const
REG_KEY_NAME_CUR = 'SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\%s\Connection';
REG_KEY_NAME_001 = 'SYSTEM\ControlSet001\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\%s\Connection';
REG_KEY_NAME_002 = 'SYSTEM\ControlSet002\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}\%s\Connection';
REG_KEY_DNS = 'SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\Interfaces\%s';
IP_NULL = '0.0.0.0';
MAC_NULL = '000000000000';
ANY_SIZE = 1;
MAX_ADAPTER_DESCRIPTION_LENGTH = 128; // arb.
MAX_ADAPTER_NAME_LENGTH = 256; // arb.
MAX_ADAPTER_ADDRESS_LENGTH = 8; // arb.
DEFAULT_MINIMUM_ENTITIES = 32; // arb.
MAX_HOSTNAME_LEN = 128; // arb.
MAX_DOMAIN_NAME_LEN = 128; // arb.
MAX_SCOPE_ID_LEN = 256; // arb.
// Node Types ( NETBIOS)
BROADCAST_NODETYPE = 1;
PEER_TO_PEER_NODETYPE = 2;
MIXED_NODETYPE = 4;
HYBRID_NODETYPE = 8;
NETBIOSTypes : array[0..8] of string[20] =
( 'UNKNOWN', 'BROADCAST', 'PEER_TO_PEER', '', 'MIXED', '', '', '', 'HYBRID'
);
// Adapter Types
IF_OTHER_ADAPTERTYPE = 0;
IF_ETHERNET_ADAPTERTYPE = 1;
IF_TOKEN_RING_ADAPTERTYPE = 2;
IF_FDDI_ADAPTERTYPE = 3;
IF_PPP_ADAPTERTYPE = 4;
IF_LOOPBACK_ADAPTERTYPE = 5;
IF_SLIP_ADAPTERTYPE = 6;
//
AdaptTypes : array[0..6] of string[10] =
( 'other', 'ethernet', 'tokenring', 'FDDI', 'PPP', 'loopback', 'SLIP' );
DLL_IPHLPAPI = 'iphlpapi.dll';
DLL_NETAPI32 = 'NetAPI32.dll';
TCP_TABLE_BASIC_LISTENER = 0;
TCP_TABLE_BASIC_CONNECTIONS = 1;
TCP_TABLE_BASIC_ALL = 2;
TCP_TABLE_OWNER_PID_LISTENER = 3;
TCP_TABLE_OWNER_PID_CONNECTIONS = 4;
TCP_TABLE_OWNER_PID_ALL = 5;
TCP_TABLE_OWNER_MODULE_LISTENER = 6;
TCP_TABLE_OWNER_MODULE_CONNECTIONS = 7;
TCP_TABLE_OWNER_MODULE_ALL = 8;
UDP_TABLE_BASIC = 0;
UDP_TABLE_OWNER_PID = 1;
UDP_TABLE_OWNER_MODULE = 2;
TCP_STATE_UNKNOWN = 0;
TCP_STATE_CLOSED = 1;
TCP_STATE_LISTEN = 2;
TCP_STATE_SENT = 3;
TCP_STATE_SYN_RECEIVED = 4;
TCP_STATE_ESTABLISHED = 5;
TCP_STATE_FIN_WAIT_1 = 6;
TCP_STATE_FIN_WAIT_2 = 7;
TCP_STATE_CLOSE_WAIT = 8;
TCP_STATE_CLOSING = 9;
TCP_STATE_LAST_ACK = 10;
TCP_STATE_TIME_WAIT = 11;
TCP_STATE_delete_TCB = 12;
STYPE_DISKTREE = 0;
STYPE_PRINTQ = 1;
STYPE_DEVICE = 2;
STYPE_IPC = 3;
STYPE_TEMPORARY = $40000000;
STYPE_SPECIAL = $80000000;
MIB_TCP_STATE: array[TCP_STATE_UNKNOWN..TCP_STATE_delete_TCB] of string =
('Unknown', 'CLOSED', 'LISTEN', 'SYN-SENT ','SYN-RECEIVED', 'ESTABLISHED', 'FIN-WAIT-1',
'FIN-WAIT-2', 'CLOSE-WAIT', 'CLOSING','LAST-ACK', 'TIME-WAIT', 'delete TCB');
//-------------from other MS header files---------------------------------------
MAX_INTERFACE_NAME_LEN = 256; { mrapi.h }
MAXLEN_PHYSADDR = 8; { iprtrmib.h }
MAXLEN_IFDESCR = 256; { --"--- }
//------IP address structures---------------------------------------------------
MIB_IF_TYPE_OTHER = 1; // Some other type of network interface. 기타 등등
MIB_IF_TYPE_ETHERNET = 6; // An Ethernet network interface. 이더넷(무선 포함)
IF_TYPE_ISO88025_TOKENRING = 9; // MIB_IF_TYPE_TOKENRING 토큰링
MIB_IF_TYPE_FDDI = 15; // 광
MIB_IF_TYPE_PPP = 23; // A PPP network interface. PPP
MIB_IF_TYPE_LOOPBACK = 24; // A software loopback network interface. 루프백 (localloop)
MIB_IF_TYPE_SLIP = 28; // An ATM network interface. SLIP
IF_TYPE_IEEE80211 = 71; // An IEEE 802.11 wireless network interface.
type
// 추가 17_1206 14:17:45 sunk
TCP_TABLE_CLASS = Integer;
UDP_TABLE_CLASS = Integer;
PMibTcpRowOwnerPid = ^TMibTcpRowOwnerPid;
TMibTcpRowOwnerPid = packed record
dwState,
dwLocalAddr,
dwLocalPort,
dwRemoteAddr,
dwRemotePort,
dwOwningPid: DWORD;
end;
PMIB_TCPTABLE_OWNER_PID = ^MIB_TCPTABLE_OWNER_PID;
MIB_TCPTABLE_OWNER_PID = packed record
dwNumEntries: DWORD;
table: array of TMibTcpRowOwnerPid;
// table: Array [0..ANY_SIZE - 1] of TMibTcpRowOwnerPid;
end;
PMibUdpRowOwnerPid = ^TMibUdpRowOwnerPid;
TMibUdpRowOwnerPid = packed record
dwLocalAddr,
dwLocalPort,
dwOwningPid: DWORD;
end;
PMIB_UDPTABLE_OWNER_PID = ^MIB_UDPTABLE_OWNER_PID;
MIB_UDPTABLE_OWNER_PID = packed record
dwNumEntries: DWORD;
table: Array [0..ANY_SIZE - 1] of TMibUdpRowOwnerPid;
end;
type
TMacAddress = array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;
type
PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
TIP_ADDRESS_STRING = array [0..15] of AnsiChar; // IP as xxx.xxx.xxx.xxx string
//
PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
TIP_ADDR_STRING = packed record // for use in linked lists
Next : PTIP_ADDR_STRING;
IpAddress : TIP_ADDRESS_STRING;
IpMask : TIP_ADDRESS_STRING;
Context : DWORD;
end;
PTMibIPNetRow = ^TMibIPNetRow;
TMibIPNetRow = packed record
dwIndex : DWord;
dwPhysAddrLen : DWord;
bPhysAddr : TMACAddress;
dwAddr : DWord;
dwType : DWord;
end;
PTMibIPAddrRow = ^TMibIPAddrRow;
TMibIPAddrRow = packed record
dwAddr : DWORD;
dwIndex : DWORD;
dwMask : DWORD;
dwBCastAddr : DWORD;
dwReasmSize : DWORD;
Unused1,
Unused2 : WORD;
end;
TMibIPAddrArray = array of TMIBIPAddrRow;
PTMibIPAddrTable = ^TMibIPAddrTable;
TMibIPAddrTable = packed record
dwNumEntries : DWORD;
Table : array[0..ANY_SIZE - 1] of TMibIPAddrRow;
end;
PTMibIPNetTable = ^TMibIPNetTable;
TMibIPNetTable = packed record
dwNumEntries : DWORD;
Table : array[0..ANY_SIZE - 1] of TMibIPNetRow;
end;
PTMibIPStats = ^TMibIPStats;
TMibIPStats = packed record
dwForwarding : DWORD;
dwDefaultTTL : DWORD;
dwInReceives : DWORD;
dwInHdrErrors : DWORD;
dwInAddrErrors : DWORD;
dwForwDatagrams : DWORD;
dwInUnknownProtos : DWORD;
dwInDiscards : DWORD;
dwInDelivers : DWORD;
dwOutRequests : DWORD;
dwRoutingDiscards : DWORD;
dwOutDiscards : DWORD;
dwOutNoRoutes : DWORD;
dwReasmTimeOut : DWORD;
dwReasmReqds : DWORD;
dwReasmOKs : DWORD;
dwReasmFails : DWORD;
dwFragOKs : DWORD;
dwFragFails : DWORD;
dwFragCreates : DWORD;
dwNumIf : DWORD;
dwNumAddr : DWORD;
dwNumRoutes : DWORD;
end;
PTMibIPForwardRow = ^TMibIPForwardRow;
TMibIPForwardRow = packed record
dwForwardDest : DWORD;
dwForwardMask : DWORD;
dwForwardPolicy : DWORD;
dwForwardNextHop : DWORD;
dwForwardIFIndex : DWORD;
dwForwardType : DWORD;
dwForwardProto : DWORD;
dwForwardAge : DWORD;
dwForwardNextHopAS : DWORD;
dwForwardMetric1 : DWORD;
dwForwardMetric2 : DWORD;
dwForwardMetric3 : DWORD;
dwForwardMetric4 : DWORD;
dwForwardMetric5 : DWORD;
end;
PTMibIPForwardTable = ^TMibIPForwardTable;
TMibIPForwardTable = packed record
dwNumEntries : DWORD;
Table : array[0..ANY_SIZE - 1] of TMibIPForwardRow;
end;
//----------------TCP STRUCTURES------------------------------------------------
PTMibTCPRow = ^TMibTCPRow;
TMibTCPRow = packed record
dwState : DWORD;
dwLocalAddr : DWORD;
dwLocalPort : DWORD;
dwRemoteAddr : DWORD;
dwRemotePort : DWORD;
end;
//
PTMibTCPTable = ^TMibTCPTable;
TMibTCPTable = packed record
dwNumEntries : DWORD;
Table : array[0..0] of TMibTCPRow;
end;
//
PTMibTCPStats = ^TMibTCPStats;
TMibTCPStats = packed record
dwRTOAlgorithm : DWORD;
dwRTOMin : DWORD;
dwRTOMax : DWORD;
dwMaxConn : DWORD;
dwActiveOpens : DWORD;
dwPassiveOpens : DWORD;
dwAttemptFails : DWORD;
dwEstabResets : DWORD;
dwCurrEstab : DWORD;
dwInSegs : DWORD;
dwOutSegs : DWORD;
dwRetransSegs : DWORD;
dwInErrs : DWORD;
dwOutRsts : DWORD;
dwNumConns : DWORD;
end;
//---------UDP STRUCTURES-------------------------------------------------------
PTMibUDPRow = ^TMibUDPRow;
TMibUDPRow = packed record
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
end;
//
PTMibUDPTable = ^TMIBUDPTable;
TMIBUDPTable = packed record
dwNumEntries : DWORD;
UDPTable : array[0..ANY_SIZE - 1] of TMibUDPRow;
end;
//
PTMibUdpStats = ^TMIBUdpStats;
TMIBUdpStats = packed record
dwInDatagrams : DWORD;
dwNoPorts : DWORD;
dwInErrors : DWORD;
dwOutDatagrams : DWORD;
dwNumAddrs : DWORD;
end;
//------ADAPTER INFO STRUCTURES-------------------------------------------------
type
// Winapi.IpTypes.pas에서 PIP_ADAPTER_INFO 로 대체 20_1016 12:3843 sunk
// 기존에 사용하던 아래 구조체는 64비트 환경에서 포인터 밀린다.
PTIP_ADAPTER_INFO = PIP_ADAPTER_INFO;
TIP_ADAPTER_INFO = IP_ADAPTER_INFO;
// TTIME_T = array[1..325] of byte; // hack! MS time.h missing!
// PTIP_ADAPTER_INFO = ^TIP_ADAPTER_INFO;
// TIP_ADAPTER_INFO = packed record
// Next : PTIP_ADAPTER_INFO;
// ComboIndex : DWORD;
// AdapterName : array[1..MAX_ADAPTER_NAME_LENGTH + 4] of AnsiChar;
// Description : array[1..MAX_ADAPTER_DESCRIPTION_LENGTH + 4] of AnsiChar;
// AddressLength : UINT;
// Address : array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;
// Index : DWORD;
// aType : UINT;
// DHCPEnabled : UINT;
// CurrentIPAddress : PTIP_ADDR_STRING;
// IPAddressList : TIP_ADDR_STRING;
// GatewayList : TIP_ADDR_STRING;
// DHCPServer : TIP_ADDR_STRING;
// HaveWINS : BOOL;
// PrimaryWINSServer : TIP_ADDR_STRING;
// SecondaryWINSServer : TIP_ADDR_STRING;
// LeaseObtained : TTIME_T; //??
// LeaseExpires : TTIME_T; //??
// end;
//----------Fixed Info STRUCTURES---------------------------------------------
PTFixedInfo = ^TFixedInfo;
TFixedInfo = packed record
HostName : array[0..MAX_HOSTNAME_LEN + 4] of char;
DomainName : array[0..MAX_DOMAIN_NAME_LEN + 4] of char;
CurrentDNSServer : PTIP_ADDR_STRING;
DNSServerList : TIP_ADDR_STRING;
NodeType : UINT;
ScopeID : array[0..MAX_SCOPE_ID_LEN + 4] of char;
EnableRouting : UINT;
EnableProxy : UINT;
EnableDNS : UINT;
end;
//--------ICMP-STRUCTURES------------------------------------------------------
PTMibICMPStats = ^TMibICMPStats;
TMibICMPStats = packed record
dwMsgs : DWORD;
dwErrors : DWORD;
dwDestUnreachs : DWORD;
dwTimeEcxcds : DWORD;
dwParmProbs : DWORD;
dwSrcQuenchs : DWORD;
dwRedirects : DWORD;
dwEchos : DWORD;
dwEchoReps : DWORD;
dwTimeStamps : DWORD;
dwTimeStampReps : DWORD;
dwAddrMasks : DWORD;
dwAddrReps : DWORD;
end;
PTMibICMPInfo = ^TMibICMPInfo;
TMibICMPInfo = packed record
InStats : TMibICMPStats;
OutStats : TMibICMPStats;
end;
IPINFO = Record
Ttl : Char; // Time To Live
Tos : Char; // Type Of Service
IPFlags : Char; // IP flags
OptSize : Char; // Size of options data
Options : pChar; // Options data buffer
end;
ICMPECHO = Record
Source : ULONG; // Source address
Status : ULONG; // IP status
RTTime : ULONG; // Round trip time in milliseconds
DataSize : SHORT ; // Reply data size
Reserved : SHORT ; // Unknown
pData : Pchar; // Reply data buffer
ipInfo : IPINFO; // Reply options
end;
//----------INTERFACE STRUCTURES-------------------------------------------------
PTMibIfRow = ^TMibIfRow;
TMibIfRow = packed record
wszName : array[1..MAX_INTERFACE_NAME_LEN] of WCHAR;
dwIndex : DWORD;
dwType : DWORD;
dwMTU : DWORD;
dwSpeed : DWORD;
dwPhysAddrLen : DWORD;
bPhysAddr : array[1..MAXLEN_PHYSADDR] of byte;
dwAdminStatus : DWORD;
dwOperStatus : DWORD;
dwLastChange : DWORD;
dwInOctets : DWORD;
dwInUcastPkts : DWORD;
dwInNUCastPkts : DWORD;
dwInDiscards : DWORD;
dwInErrors : DWORD;
dwInUnknownProtos : DWORD;
dwOutOctets : DWORD;
dwOutUCastPkts : DWORD;
dwOutNUCastPkts : DWORD;
dwOutDiscards : DWORD;
dwOutErrors : DWORD;
dwOutQLen : DWORD;
dwDescrLen : DWORD;
bDescr : array[1..MAXLEN_IFDESCR] of char; //byte;
end;
TMIBIfArray = array of TMIBIFRow;
//
PTMibIfTable = ^TMIBIfTable;
TMibIfTable = packed record
dwNumEntries : DWORD;
Table : array[0..ANY_SIZE - 1] of TMibIfRow;
end;
//------------------imports from IPHLPAPI.DLL-----------------------------------
PRouteEnt = ^TRouteEnt;
TRouteEnt = record
sDestIp: String;
Info: TMibIPForwardRow;
end;
TRouteEntList = class(TList<PRouteEnt>)
protected
procedure Notify(const Item: PRouteEnt; Action: TCollectionNotification); override;
public
function GetEntByDestIp(sDestIp: String): PRouteEnt;
end;
SHARE_INFO_1 = record
shi1_netname : PWideChar;
shi1_type : DWORD;
shi1_remark : PWideChar;
end;
PSHARE_INFO_1 = ^SHARE_INFO_1;
SHARE_INFO_2 = record
shi2_netname : PWideChar;
shi2_type : DWORD;
shi2_remark : PWideChar;
shi2_permissions : DWORD;
shi2_max_uses : DWORD;
shi2_current_uses: DWORD;
shi2_path : PWideChar;
shi2_passwd : PWideChar;
end;
PSHARE_INFO_2 = ^SHARE_INFO_2;
NET_API_STATUS = DWORD;
TGetAdaptersInfo = function(pAdapterInfo: PTIP_ADAPTER_INFO; pOutBufLen: PULONG): DWORD; stdcall;
TGetExtendedTcpTable = function(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWORD; stdcall;
TGetExtendedUdpTable = function(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: UDP_TABLE_CLASS; Reserved: ULONG): DWORD; stdcall;
TGetIpForwardTable = function(pIPForwardTable: PTMibIPForwardTable; pdwSize: PULONG; bOrder: BOOL): DWORD; stdCall;
TDeleteIpForwardEntry = function(pEnt: PTMibIPForwardRow): DWORD; stdCall;
TNetShareEnum = function(ServerName: PWideChar; Level: DWORD; var BufPtr: Pointer;
PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD;
var ResumeHandle : DWORD): NET_API_STATUS; stdcall;
TNetApiBufferFree = function(Buffer : Pointer): NET_API_STATUS; stdcall;
function GetAdaptersInfo(pAdapterInfo: PTIP_ADAPTER_INFO; pOutBufLen: PULONG): DWORD;
function GetExtendedTcpTable(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWORD;
function GetExtendedUdpTable(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: UDP_TABLE_CLASS; Reserved: ULONG): DWORD;
//function GetNetworkParams(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetTcpTable(pTCPTable: PTMibTCPTable; pDWSize: PDWORD; bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetTcpStatistics(pStats: PTMibTCPStats): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetUdpTable(pUdpTable: PTMibUDPTable; pDWSize: PDWORD; bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetUdpStatistics(pStats: PTMibUdpStats): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetIpStatistics(pStats: PTMibIPStats): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetIpNetTable(pIpNetTable: PTMibIPNetTable; pdwSize: PULONG; bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
//function GetIpAddrTable(pIpAddrTable: PTMibIPAddrTable; pdwSize: PULONG; bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';
function GetIpForwardTable(pIPForwardTable: PTMibIPForwardTable; pdwSize: PULONG; bOrder: BOOL): DWORD;
function DeleteIpForwardEntry(pEnt: PTMibIPForwardRow): DWORD;
//function GetIcmpStatistics(pStats: PTMibICMPInfo): DWORD; stdCall; external 'IPHLPAPI.DLL';
//function GetRTTAndHopCount(DestIPAddress: DWORD; HopCount: PULONG; MaxHops: ULONG; RTT: PULONG): BOOL; stdCall; external 'IPHLPAPI.DLL';
//function GetIfTable(pIfTable: PTMibIfTable; pdwSize: PULONG; bOrder: boolean): DWORD; stdCall; external 'IPHLPAPI.DLL';
//function GetIfEntry(pIfRow: PTMibIfRow): DWORD; stdCall; external 'IPHLPAPI.DLL';
//function GetBestInterface(pIfRow: in_addr; pnBestIndex: PDWORD): DWORD; stdCall; external 'IPHLPAPI.DLL';
function NetShareEnum(ServerName: PWideChar; Level: DWORD; var BufPtr: Pointer;
PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD;
var ResumeHandle : DWORD): NET_API_STATUS;
function NetApiBufferFree(Buffer : Pointer): NET_API_STATUS;
//function IcmpCreateFile: THandle; stdcall; external 'icmp.dll';
//function IcmpCloseHandle(icmpHandle: THandle): boolean; stdcall; external 'icmp.dll';
//function IcmpSendEcho(IcmpHandle: THandle; DestinationAddress: LongInt;
// RequestData: Pointer; RequestSize: Smallint;
// RequestOptions: pointer; ReplyBuffer: Pointer;
// ReplySize: DWORD; Timeout: DWORD): DWORD;
// stdcall; external 'icmp.dll';
function GetCurrentHostName: String;
function IPToDWORD(sIp: String) : Dword;
function DWORDToIP(IPDWord: DWORD; bBig: Boolean = true) : String;
function IncIP(sIp: String; nInc: Integer = 1): String;
function IsValidIP(const sIp: String; bIgrIpNull: Boolean = true; bIncIPv6: Boolean = false): Boolean;
function IsValidIPEx(const sIp: String): Boolean;
function IsValidIpRange(sIpRange: String): Boolean;
function IsIncludeIP(const sIpEx, sIp: String): Boolean;
function GetHostIP: String;
function GetHostIPsFromDomain(sDomain: AnsiString; sDm: AnsiString = ','): AnsiString;
function GetIPAddrsToList(lstIP: TStrings): Integer;
function GetIPAddrsToListEx(lstIP: TStrings): Integer;
function GetIPAddrsToCommaStr: String;
function GetIPAddrsToCommaStrEx: String;
function GetMACAddrToList(aMacList: TStrings): Boolean;
function GetMACAddrToCommaStr: String;
function GetMACAddr: String;
function GetMACAddrUsing: String;
function ExtractIPPort(sSrcIPort: String; var sIp: String; var nPort: Integer): Boolean;
function GetNetDrives(aDrives: TStrings): Integer;
function NetDriveToRemoteAddr(sNDrv: String): String;
function IsNetDrive(cLetter: Char): Boolean;
function GetNicEnable(sDesc: String): Boolean;
function SetNicEnable(sDesc: String; bVal: Boolean): Integer;
function SetNicEnableByIndex(nIdx: Integer; bVal: Boolean): Boolean;
function GetNetAdapterTypeToStr(dwType: DWORD): String;
function IsConnectedWIFI(aInterfaceGuid: TGUID): Boolean;
function DisconnectWIFI(aInterfaceGuid: TGUID): Boolean;
function GetRouteTables(aList: TRouteEntList): Integer;
function GetPublicIP: string;
function RemoveEveryoneFromShare(const sShareName: string): Boolean;
type
// dwType
// 1 = MIB_IF_TYPE_OTHER (다른 유형의 네트워크 인터페이스. Some other type of network interface.)
// 6 = MIB_IF_TYPE_ETHERNET (이더넷 네트워크 인터페이스. An Ethernet network interface.)
// 9 = IF_TYPE_ISO88025_TOKENRING (MIB_IF_TYPE_TOKENRING)
// 23 = MIB_IF_TYPE_PPP (PPP 네트워크 인터페이스. A PPP network interface.)
// 24 = B_IF_TYPE_LOOPBACK (소프트웨어 루프백 네트워크 인터페이스. A software loopback network interface.)
// 28 = MIB_IF_TYPE_SLIP (ATM 네트워크 인터페이스. An ATM network interface.)
// 71 = IF_TYPE_IEEE80211 (IEEE 802.11 무선 네트워크 인터페이스. An IEEE 802.11 wireless network interface.)
PNetAdapterEnt = ^TNetAdapterEnt;
TNetAdapterEnt = record
sName,
sDesc,
sMacAddr,
sIpAddrs,
// sCurIpAddr,
sGatewayIps,
sDHCPServer,
sPriWINSServer,
sSecWINSServer: AnsiString;
bDHCP,
bHaveWINS: Boolean;
dwComboIdx,
dwIndex,
dwType: DWORD;
end;
TNetAdapterEntList = TList<PNetAdapterEnt>;
TNetAdapterInfo = class(TTgObject)
private
AdapterList_: TNetAdapterEntList;
procedure OnAdapterNotify(Sender: TObject; const Item: PNetAdapterEnt;
Action: TCollectionNotification);
function GetByIndex(nIndex: Integer): PNetAdapterEnt;
public
Constructor Create;
Destructor Destroy; override;
procedure UpdateNetAdapterInfo;
function Count: Integer;
property Items[nIndex: Integer]: PNetAdapterEnt read GetByIndex; default;
end;
PWLanEnt = ^TWLanEnt;
TWLanEnt = record
sName,
sBssid,
sProfile: String;
nQuality: Integer;
dwAlgo1,
dwAlgo2: DWORD;
bSecurety: Boolean;
InterfaceGuid: TGUID;
end;
TWLanEntList = TList<PWLanEnt>;
TWlanInfo = class(TTgObject)
private
WLanEntList_: TWLanEntList;
procedure OnWlanEntNotify(Sender: TObject; const Item: PWLanEnt;
Action: TCollectionNotification);
function GetByIndex(nIndex: Integer): PWLanEnt;
public
Constructor Create;
Destructor Destroy; override;
procedure UpdateWlanInfo;
function Count: Integer;
function GetWlanEntByName(sName: String): PWLanEnt;
property Items[nIndex: Integer]: PWLanEnt read GetByIndex; default;
end;
PTcpInfoEnt = ^TTcpInfoEnt;
TTcpInfoEnt = record
sLocalIpAddr,
sRemoteIpAddr: String;
nLocalPort,
nRemotePort: Integer;
dwPid,
dwStatus: DWORD;
end;
TTcpInfoEntList = TList<PTcpInfoEnt>;
TTcpTableInfo = class(TTgObject)
private
TcpEnts_: TTcpInfoEntList;
procedure OnTcpInfoEntNotify(Sender: TObject; const Item: PTcpInfoEnt;
Action: TCollectionNotification);
function GetByIndex(nIndex: Integer): PTcpInfoEnt;
public
Constructor Create;
Destructor Destroy; override;
procedure UpdateTcpTableInfo;
function Count: Integer;
procedure Delete(nIndex: Integer);
property Items[nIndex: Integer]: PTcpInfoEnt read GetByIndex; default;
end;
PUdpInfoEnt = ^TUdpInfoEnt;
TUdpInfoEnt = record
sLocalIpAddr: String;
nLocalPort: Integer;
dwPid: DWORD;
end;
TUdpInfoEntList = TList<PUdpInfoEnt>;
TUdpTableInfo = class(TTgObject)
private
UdpEnts_: TUdpInfoEntList;
procedure OnUdpInfoEntNotify(Sender: TObject; const Item: PUdpInfoEnt;
Action: TCollectionNotification);
function GetByIndex(nIndex: Integer): PUdpInfoEnt;
public
Constructor Create;
Destructor Destroy; override;
procedure UpdateUdpTableInfo;
function Count: Integer;
procedure Delete(nIndex: Integer);
property Items[nIndex: Integer]: PUdpInfoEnt read GetByIndex; default;
end;
PShdFldEnt = ^TShdFldEnt;
TShdFldEnt = record
sName,
sPath: String;
end;
TSharedFolder = class(TList<PShdFldEnt>)
protected
sSvrName_: String;
procedure Notify(const Item: PShdFldEnt; Action: TCollectionNotification); override;
public
Constructor Create(bUpdate: Boolean = false; sServerName: String = ''; bIgrSpecial: Boolean = false);
procedure UpdateShdFldList(bIgrSpecial: Boolean = false);
function ExistsSharedFolder(sPath: String): Boolean;
end;
implementation
uses
Tocsg.Safe, Tocsg.Strings, Tocsg.Path, Tocsg.Exception, Tocsg.Driver,
Tocsg.Convert, EM.nduWlanAPI, Tocsg.Trace, Tocsg.WMI, Tocsg.WinInfo,
System.Net.HttpClient, EM.nduWlanTypes, Winapi.AclAPI, Winapi.AccCtrl;
resourcestring
RS_NetOther = '기타';
RS_NetEthernet = '이더넷';
RS_NetTokenring = '토큰링';
RS_NetFDDI = '광';
RS_NetLoop = '루프백 (localloop)';
var
_hIpHlpApi: THandle = 0;
_fnGetAdaptersInfo: TGetAdaptersInfo = nil;
_fnGetExtendedTcpTable: TGetExtendedTcpTable = nil;
_fnGetExtendedUdpTable: TGetExtendedUdpTable = nil;
_fnGetIpForwardTable: TGetIpForwardTable = nil;
_fnDeleteIpForwardEntry: TDeleteIpForwardEntry = nil;
_hNetApi32: THandle = 0;
_fnNetShareEnum: TNetShareEnum = nil;
_fnNetApiBufferFree: TNetApiBufferFree = nil;
function InitIpHlpApiModule: Boolean;
begin
if _hIpHlpApi = 0 then
begin
_hIpHlpApi := GetModuleHandle(DLL_IPHLPAPI);
// 추가 22_0107 10:45:42 sunk
if _hIpHlpApi = 0 then
_hIpHlpApi := LoadLibrary(DLL_IPHLPAPI);
if _hIpHlpApi <> 0 then
begin
@_fnGetAdaptersInfo := GetProcAddress(_hIpHlpApi, 'GetAdaptersInfo');
@_fnGetExtendedTcpTable := GetProcAddress(_hIpHlpApi, 'GetExtendedTcpTable');
@_fnGetExtendedUdpTable := GetProcAddress(_hIpHlpApi, 'GetExtendedUdpTable');
@_fnGetIpForwardTable := GetProcAddress(_hIpHlpApi, 'GetIpForwardTable');
@_fnDeleteIpForwardEntry := GetProcAddress(_hIpHlpApi, 'DeleteIpForwardEntry');
end;
end;
Result := _hIpHlpApi <> 0;
end;
function InitNetApi32Module: Boolean;
begin
if _hNetApi32 = 0 then
begin
_hNetApi32 := GetModuleHandle(DLL_NETAPI32);
if _hNetApi32 = 0 then
_hNetApi32 := LoadLibrary(DLL_NETAPI32);
if _hNetApi32 <> 0 then
begin
@_fnNetShareEnum := GetProcAddress(_hNetApi32, 'NetShareEnum');
@_fnNetApiBufferFree := GetProcAddress(_hNetApi32, 'NetApiBufferFree');
end;
end;
Result := _hNetApi32 <> 0;
end;
function GetAdaptersInfo(pAdapterInfo: PTIP_ADAPTER_INFO; pOutBufLen: PULONG): DWORD;
begin
if InitIpHlpApiModule and Assigned(_fnGetAdaptersInfo) then
Result := _fnGetAdaptersInfo(pAdapterInfo, pOutBufLen)
else
Result := ERROR_INVALID_FUNCTION;
end;
function GetExtendedTcpTable(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWORD;
begin
if InitIpHlpApiModule and Assigned(_fnGetExtendedTcpTable) then
Result := _fnGetExtendedTcpTable(pTcpTable, dwSize, bOrder, lAf, TableClass, Reserved)
else
Result := ERROR_INVALID_FUNCTION;
end;
function GetExtendedUdpTable(pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL;
lAf: ULONG; TableClass: UDP_TABLE_CLASS; Reserved: ULONG): DWORD;
begin
if InitIpHlpApiModule and Assigned(_fnGetExtendedUdpTable) then
Result := _fnGetExtendedUdpTable(pTcpTable, dwSize, bOrder, lAf, TableClass, Reserved)
else
Result := ERROR_INVALID_FUNCTION;
end;
function GetIpForwardTable(pIPForwardTable: PTMibIPForwardTable; pdwSize: PULONG; bOrder: BOOL): DWORD;
begin
if InitIpHlpApiModule and Assigned(_fnGetIpForwardTable) then
Result := _fnGetIpForwardTable(pIPForwardTable, pdwSize, bOrder)
else
Result := ERROR_INVALID_FUNCTION;
end;
function DeleteIpForwardEntry(pEnt: PTMibIPForwardRow): DWORD;
begin
if InitIpHlpApiModule and Assigned(_fnDeleteIpForwardEntry) then
Result := _fnDeleteIpForwardEntry(pEnt)
else
Result := ERROR_INVALID_FUNCTION;
end;
function NetShareEnum(ServerName: PWideChar; Level: DWORD; var BufPtr: Pointer;
PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD;
var ResumeHandle : DWORD): NET_API_STATUS;
begin
if InitNetApi32Module and Assigned(_fnNetShareEnum) then
Result := _fnNetShareEnum(ServerName, Level, BufPtr, PrefMaxLen, EntriesRead,
TotalEntries, ResumeHandle)
else
Result := ERROR_INVALID_FUNCTION;
end;
function NetApiBufferFree(Buffer : Pointer): NET_API_STATUS;
begin
if InitNetApi32Module and Assigned(_fnNetApiBufferFree) then
Result := _fnNetApiBufferFree(Buffer)
else
Result := ERROR_INVALID_FUNCTION;
end;
function GetCurrentHostName: String;
var
wVersionRequested : WORD;
wsaData: TWSAData;
sHostName: array[0..128] of AnsiChar;
begin
ZeroMemory(@sHostName, SizeOf(sHostName));
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
GetHostName(@sHostName, 128);
Result := sHostName;
WSACleanup;
end;
function IPToDWORD(sIp: String) : Dword;
var
SL : TStringList;
i : integer;
begin
Result := 0;
try
SL := TStringList.Create;
{replace points with commas}
for i := 1 to Length(sIp) do
if sIp[i] = '.' then
sIp[i] := ',';
{put in stringlist to split into separate strings}
SL.CommaText := sIp;
Result := 0;
{make a value from the individual parts}
with SL do
for i := 0 to Count - 1 do
Result := (Result * $100) + StrToInt(Strings[i]);
except
on E: Exception do
begin
ETgException.TraceException(E, 'Fail .. IPToDWORD()');
Result := 0;
end;
end;
end;
function DWORDToIP(IPDWord: DWORD; bBig: Boolean = true) : String;
begin
if bBig then
begin
Result := Format('%d.%d.%d.%d', [(IPDWord div $1000000),
(IPDWord div $10000) mod $100,
(IPDWord div $100) mod $100,
IPDWord mod $100]);
end else begin
Result := Format('%d.%d.%d.%d', [IPDWord mod $100,
(IPDWord div $100) mod $100,
(IPDWord div $10000) mod $100,
(IPDWord div $1000000)]);
end;
end;
function IncIP(sIp: String; nInc: Integer = 1): String;
begin
Result := DWORDToIP(IPToDWord(sIp) + nInc)
end;
function IsValidIP(const sIp: String; bIgrIpNull: Boolean = true; bIncIPv6: Boolean = false): Boolean;
var
StrList: TStringList;
str: String;
nNum: Integer;
begin
Result := false;
if (sIp = '') or (bIgrIpNull and (sIp = IP_NULL)) then
exit;
if Pos('.', sIp) > 0 then
begin
// ipv4
Guard(StrList, TStringList.Create);
SplitString(sIp, '.', StrList);
if StrList.Count <> 4 then
exit;
for str in StrList do
begin
nNum := StrToIntDef(str, -1);
if (nNum < 0) or (nNum > 255) then
exit;
end;
end else begin
if not bIncIPv6 then
exit;
// ipv6
Guard(StrList, TStringList.Create);
SplitString(sIp, ':', StrList);
if StrList.Count <> 8 then
exit;
// todo : 자세히 체크
end;
Result := true;
end;
function IsValidIPEx(const sIp: String): Boolean;
var
lstStr: TStringList;
str: AnsiString;
nNum: Integer;
begin
Result := false;
if sIp = '*' then
begin
Result := true;
exit;
end;
Guard(lstStr, TStringList.Create);
lstStr.CommaText := StringReplace(sIp, '.', ',', [rfReplaceAll]);
if lstStr.Count > 4 then
exit;
if (lstStr.Count = 1) and (lstStr[0] <> '*') then
exit;
if (lstStr.Count < 4) and (lstStr[lstStr.Count-1] <> '*') then
exit;
for str in lstStr do
begin
if str = '*' then
continue;
nNum := StrToIntDef(str, -1);
if (nNum < 0) or (nNum > 255) then
exit;
end;
Result := true;
end;
// 아이피 범위 문법인지 확인 22_1011 14:00:30 kku
// 10.0.0.1-127.0.0.1
function IsValidIpRange(sIpRange: String): Boolean;
var
n: Integer;
sEnd: String;
begin
Result := false;
n := Pos('-', sIpRange);
if n > 0 then
begin
sEnd := Copy(sIpRange, n + 1, Length(sIpRange) - n);
Delete(sIpRange, n, Length(sIpRange) - n + 1);
Result := IsValidIP(sIpRange, false) and IsValidIP(sEnd) and
(IPToDWORD(sIpRange) < IPToDWORD(sEnd));
end;
end;
function IsIncludeIP(const sIpEx, sIp: String): Boolean;
var
lstSrcStr,
lstDecStr: TStringList;
i, nCheckCnt: Integer;
begin
Result := false;
if (sIpEx = '*') or (sIp = '*') then
begin
Result := true;
exit;
end;
Guard(lstSrcStr, TStringList.Create);
lstSrcStr.CommaText := StringReplace(sIpEx, '.', ',', [rfReplaceAll]);
Guard(lstDecStr, TStringList.Create);
lstDecStr.CommaText := StringReplace(sIp, '.', ',', [rfReplaceAll]);
if lstSrcStr.Count < lstDecStr.Count then
nCheckCnt := lstSrcStr.Count
else
nCheckCnt := lstDecStr.Count;
if (nCheckCnt > 0) and (nCheckCnt < 5) then
begin
for i := 0 to nCheckCnt - 1 do
begin
if (lstSrcStr[i] = '*') or (lstDecStr[i] = '*') then
continue;
if lstSrcStr[i] <> lstDecStr[i] then
exit;
end;
Result := true;
end;
end;
function ConvSsidToStr(aSrc: array of Byte; nSize: Integer): String;
var
i: Integer;
begin
if nSize = 0 then
begin
Result := '000000000000';
exit;
end else
Result := '';
for i := 0 to nSize - 1 do
Result := Result + IntToHex(aSrc[i], 2);
end;
function ConvMACAddrToStr(MacAddress: TMacAddress; nSize: Integer): String;
var
i: Integer;
begin
if nSize = 0 then
begin
Result := '000000000000';
exit;
end else
Result := '';
for i := 1 to nSize do
Result := Result + IntToHex(MacAddress[i], 2);
end;
function GetHostIP: String;
var
wVersionRequested : WORD;
wsaData: TWSAData;
sHostName: array[0..127] of AnsiChar;
pHEnt: PHostEnt;
p: PAnsiChar;
sIp,
sPath: String;
ss: TStringStream;
IPList: TStringList;
i: Integer;
begin
try
Result := '';
ZeroMemory(@sHostName, SizeOf(sHostName));
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
try
GetHostName(@sHostName, 128);
pHEnt := GetHostByName(@sHostName);
if pHEnt <> nil then
begin
p := inet_ntoa(PInAddr(pHEnt^.h_addr_list^)^);
Result := AnsiString(p);
end;
finally
WSACleanup;
end;
// 가끔 127.0.0.1 로 잡히는 알수없는 상황이 발생한다...
// 그래서 아래처럼 보완
if Result = '127.0.0.1' then
begin
Guard(IPList, TStringList.Create);
if GetIPAddrsToList(IPList) > 0 then
begin
for i := 0 to IPList.Count - 1 do
begin
if IPList[i] <> Result then
begin
Result := IPList[i];
exit;
end;
end;
end;
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetHostIP()');
end;
end;
function GetHostIPsFromDomain(sDomain: AnsiString; sDm: AnsiString = ','): AnsiString;
var
wVersionRequested : WORD;
wsaData: TWSAData;
pHEnt: PHostEnt;
pNext: PPAnsiChar;
sIp: PAnsiChar;
begin
try
Result := '';
wVersionRequested := MAKEWORD(1, 1);
// wVersionRequested := MAKEWORD(2, 2);
WSAStartup(wVersionRequested, wsaData);
try
pHEnt := GetHostByName(PAnsiChar(sDomain));
if pHEnt <> nil then
begin
pNext := PPAnsiChar(pHEnt^.h_addr_list);
while pNext^ <> nil do
begin
sIp := inet_ntoa(PInAddr(pNext^)^);
SumStringA(Result, sIp, sDm);
Inc(pNext);
end;
end;
finally
WSACleanup;
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetHostIPsFromDomain()');
end;
end;
function GetIPAddrsToList(lstIP: TStrings): Integer;
var
dwError,
dwBufLen: DWORD;
pAdapterInfo,
pAdapterWalk: PTIP_ADAPTER_INFO;
pIpAddr: PTIP_ADDR_STRING;
sIp: String;
begin
Result := 0;
dwBufLen := SizeOf(TIP_ADAPTER_INFO);
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
try
// 오버플러우일 경우 메모리 다시 할당해줘서 시도해주자 09_0706
if dwError = ERROR_BUFFER_OVERFLOW then
begin
FreeMem(pAdapterInfo, SizeOf(TIP_ADAPTER_INFO));
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
end;
if dwError = NO_ERROR then
begin
pAdapterWalk := pAdapterInfo;
while pAdapterWalk <> nil do
with pAdapterWalk^ do
begin
pIpAddr := @IPAddressList;
while pIpAddr <> nil do
begin
sIp := pIpAddr.IpAddress;
if sIp <> '0.0.0.0' then
lstIP.Add(sIp);
pIpAddr := pIpAddr.Next;
end;
pAdapterWalk := Next;
end;
end;
finally
FreeMem(pAdapterInfo, dwBufLen);
end;
Result := lstIP.Count;
end;
function GetIPAddrsToListEx(lstIP: TStrings): Integer;
var
dwError,
dwBufLen: DWORD;
pAdapterInfo,
pAdapterWalk: PTIP_ADAPTER_INFO;
pIpAddr: PTIP_ADDR_STRING;
sIp: AnsiString;
begin
Result := 0;
lstIP.Clear;
try
dwBufLen := SizeOf(TIP_ADAPTER_INFO);
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
try
// 오버플러우일 경우 메모리 다시 할당해줘서 시도해주자 09_0706
if dwError = ERROR_BUFFER_OVERFLOW then
begin
FreeMem(pAdapterInfo, SizeOf(TIP_ADAPTER_INFO));
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
end;
if dwError = NO_ERROR then
begin
pAdapterWalk := pAdapterInfo;
while pAdapterWalk <> nil do
with pAdapterWalk^ do
begin
pIpAddr := @IPAddressList;
while pIpAddr <> nil do
begin
sIp := pIpAddr.IpAddress;
if (sIp <> '') and (sIp <> IP_NULL) then
begin
// VPN, 무선 식별 추가 19_1205 15:41:18 sunk
// case aType of
case Type_ of
MIB_IF_TYPE_PPP : sIp := 'VPN:' + sIp; // 23 : VPN
IF_TYPE_IEEE80211 : sIp := 'WLS:' + sIp; // 71 : Wireless
end;
lstIP.Add(sIp);
end;
pIpAddr := pIpAddr.Next;
end;
pAdapterWalk := Next;
end;
end;
finally
FreeMem(pAdapterInfo, dwBufLen);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetIPAddrsToListEx(), Step=%d');
end;
Result := lstIP.Count;
end;
function GetIPAddrsToCommaStr: String;
var
StrList: TStringList;
begin
Guard(StrList, TStringList.Create);
if GetIPAddrsToList(StrList) > 0 then
Result := StrList.CommaText
else
Result := '';
end;
function GetIPAddrsToCommaStrEx: String;
var
StrList: TStringList;
begin
Guard(StrList, TStringList.Create);
if GetIPAddrsToListEx(StrList) > 0 then
Result := StrList.CommaText
else
Result := '';
end;
function GetMACAddrToList(aMacList: TStrings): Boolean;
var
dwError,
dwBufLen: DWORD;
pAdapterInfo,
pAdapterWalk: PTIP_ADAPTER_INFO;
begin
Result := false;
aMacList.Clear;
try
dwBufLen := SizeOf(TIP_ADAPTER_INFO);
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
try
// 오버플러우일 경우 메모리 다시 할당해줘서 시도해주자 09_0706
if dwError = ERROR_BUFFER_OVERFLOW then
begin
FreeMem(pAdapterInfo, SizeOf(TIP_ADAPTER_INFO));
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
end;
if dwError = NO_ERROR then
begin
pAdapterWalk := pAdapterInfo;
while pAdapterWalk <> nil do
with pAdapterWalk^ do
begin
if AddressLength > 0 then
aMacList.Add(ConvMACAddrToStr(TMacAddress(Address), AddressLength));
pAdapterWalk := Next;
end;
Result := aMacList.Count > 0;
end;
finally
FreeMem(pAdapterInfo, dwBufLen);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetMACAddrToList()');
end;
end;
function GetMACAddrToCommaStr: String;
var
lstMac: TStringList;
begin
Result := '';
Guard(lstMac, TStringList.Create);
if GetMACAddrToList(lstMac) then
Result := lstMac.CommaText;
end;
function GetMACAddr: String;
var
UuidCreateFunc: function (var guid: TGUID): HResult; stdcall;
hLib: THandle;
GUID: TGUID;
WinVer: TOSVersionInfo;
i: Integer;
begin
Result := '';
try
WinVer.dwOSVersionInfoSize := SizeOf(WinVer);
GetVersionEx(WinVer);
hLib := LoadLibrary('RPCRT4.DLL');
try
if WinVer.dwMajorVersion >= 5 then {Windows 2000 }
@UuidCreateFunc := GetProcAddress(hLib, 'UuidCreateSequential')
else
@UuidCreateFunc := GetProcAddress(hLib, 'UuidCreate') ;
UuidCreateFunc(GUID);
for i := 2 to 7 do
Result := Result + IntToHex(GUID.D4[i], 2);
finally
FreeLibrary(hLib);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetMACAddr()');
end;
end;
function GetMACAddrUsing: String;
var
dwError,
dwBufLen : DWORD;
pAdapterWalk,
pAdapterInfo : PTIP_ADAPTER_INFO;
sIp : AnsiString;
begin
Result := '';
try
sIp := GetHostIP;
if sIp = '' then
exit;
dwBufLen := SizeOf(TIP_ADAPTER_INFO);
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
try
// 오버플러우일 경우 메모리 다시 할당해줘서 시도해주자 09_0706
if dwError = ERROR_BUFFER_OVERFLOW then
begin
FreeMem(pAdapterInfo, SizeOf(TIP_ADAPTER_INFO));
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
end;
if dwError = NO_ERROR then
begin
pAdapterWalk := pAdapterInfo;
while pAdapterWalk <> nil do
begin
with pAdapterWalk^ do
begin
if (AddressLength > 0) and
(AnsiString(IPAddressList.IpAddress.S) = sIp) then
begin
Result := ConvMACAddrToStr(TMacAddress(Address), AddressLength);
exit;
end;
pAdapterWalk := Next;
end
end;
end;
finally
FreeMem(pAdapterInfo, dwBufLen);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetMACAddrUsing()');
end;
end;
function ExtractIPPort(sSrcIPort: String; var sIp: String; var nPort: Integer): Boolean;
var
nPos: Integer;
begin
Result := false;
sIp := '';
nPort := 0;
nPos := Pos(':', sSrcIPort);
if nPos > 0 then
begin
sIp := sSrcIPort;
nPort := StrToIntDef(Copy(sIp, nPos + 1, Length(sIp) - nPos), 0);
Delete(sIp, nPos, Length(sIp) - nPos + 1);
Result := IsValidIP(sIp);
if not Result then
begin
sIp := '';
nPort := 0;
end;
end;
end;
function GetNetDrives(aDrives: TStrings): Integer;
const
NET_BUFSIZE = 16384;
var
hEnum: THandle;
dwResult,
dwEntries,
dwBufSize: DWORD;
pBuf,
pDriveRes: PNetResource;
i: Integer;
begin
Result := 0;
aDrives.Clear;
hEnum := 0;
dwResult := WNetOpenEnum(RESOURCE_REMEMBERED, RESOURCETYPE_DISK, 0, nil, hEnum);
if dwResult = NO_ERROR then
begin
dwEntries := $FFFFFFFF;
dwBufSize := NET_BUFSIZE;
Guard(pBuf, AllocMem(dwBufSize));
try
repeat
dwResult := WNetEnumResource(hEnum, dwEntries, pBuf, dwBufSize);
case dwResult of
NO_ERROR :
begin
pDriveRes := pBuf;
for i := 0 to dwEntries - 1 do
try
if pDriveRes.lpLocalName <> '' then
begin
aDrives.Add(UpperCase(pDriveRes.lpLocalName));
Inc(Result);
end;
finally
Inc(pDriveRes);
end;
end;
ERROR_NO_MORE_ITEMS : ;
else break;
end;
until dwResult = ERROR_NO_MORE_ITEMS;
finally
WNetCloseEnum(hEnum);
end;
end;
end;
function NetDriveToRemoteAddr(sNDrv: String): String;
const
NET_BUFSIZE = 16384;
var
hEnum: THandle;
dwResult,
dwEntries,
dwBufSize: DWORD;
pBuf,
pDriveRes: PNetResource;
i: Integer;
begin
Result := '';
if sNDrv = '' then
exit;
sNDrv := UpperCase(sNDrv);
hEnum := 0;
dwResult := WNetOpenEnum(RESOURCE_REMEMBERED, RESOURCETYPE_DISK, 0, nil, hEnum);
if dwResult = NO_ERROR then
begin
dwEntries := $FFFFFFFF;
dwBufSize := NET_BUFSIZE;
Guard(pBuf, AllocMem(dwBufSize));
try
repeat
dwResult := WNetEnumResource(hEnum, dwEntries, pBuf, dwBufSize);
case dwResult of
NO_ERROR :
begin
pDriveRes := pBuf;
for i := 0 to dwEntries - 1 do
try
if (pDriveRes.lpLocalName <> '') and
(UpperCase(pDriveRes.lpLocalName)[1] = sNDrv[1]) then
begin
Result := pDriveRes.lpRemoteName;
exit;
end;
finally
Inc(pDriveRes);
end;
end;
ERROR_NO_MORE_ITEMS : ;
else break;
end;
until dwResult = ERROR_NO_MORE_ITEMS;
finally
WNetCloseEnum(hEnum);
end;
end;
end;
function IsNetDrive(cLetter: Char): Boolean;
var
NetDriveList: TStringList;
begin
cLetter := UpCase(cLetter);
Guard(NetDriveList, TStringList.Create);
Result := GetNetDrives(NetDriveList) > 0;
if Result then
Result := NetDriveList.IndexOf(Format('%s:', [cLetter])) <> -1;
end;
function GetNicEnable(sDesc: String): Boolean;
var
hDev: HDEVINFO;
sdd: TSPDevInfoData;
i: Integer;
dwBufSize,
dwStatus, dwProblem,
dwPropertyRegDataType: DWORD;
pBuf: Pointer;
begin
Result := false;
try
hDev := SetupDiGetClassDevs(@GUID_DEVCLASS_NET, nil, 0, DIGCF_PRESENT);
if hDev = INVALID_HANDLE_VALUE then
exit;
pBuf := nil;
try
ZeroMemory(@sdd, SizeOf(sdd));
sdd.cbSize := SizeOf(sdd);
i := 0;
while SetupDiEnumDeviceInfo(hDev, i, sdd) do
begin
dwBufSize := 0;
if pBuf <> nil then
begin
FreeMem(pBuf);
pBuf := nil;
end;
while not SetupDiGetDeviceRegistryProperty(hDev, sdd,
SPDRP_DEVICEDESC, dwPropertyRegDataType, pBuf, dwBufSize, dwBufSize) do
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
if pBuf <> nil then
FreeMem(pBuf);
pBuf := AllocMem(dwBufSize);
end else break;
end;
if pBuf <> nil then
begin
if CompareText(sDesc, String(PChar(pBuf))) = 0 then
begin
dwStatus := 0;
dwProblem := 0;
if CM_Get_DevNode_Status(dwStatus, dwProblem, sdd.DevInst, 0) = CR_SUCCESS then
Result := not (((dwStatus and DN_HAS_PROBLEM) = 0) and (dwProblem = CM_PROB_DISABLED));
exit;
end;
end;
Inc(i);
end;
finally
SetupDiDestroyDeviceInfoList(hDev);
if pBuf <> nil then
FreeMem(pBuf);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. SetNicEnable()');
end;
end;
function SetNicEnable(sDesc: String; bVal: Boolean): Integer;
var
hDev: HDEVINFO;
sdd: TSPDevInfoData;
i: Integer;
dwBufSize,
dwStatus, dwProblem,
dwPropertyRegDataType: DWORD;
pBuf: Pointer;
begin
Result := -1;
try
hDev := SetupDiGetClassDevs(@GUID_DEVCLASS_NET, nil, 0, DIGCF_PRESENT);
if hDev = INVALID_HANDLE_VALUE then
exit;
pBuf := nil;
try
ZeroMemory(@sdd, SizeOf(sdd));
sdd.cbSize := SizeOf(sdd);
i := 0;
while SetupDiEnumDeviceInfo(hDev, i, sdd) do
begin
dwBufSize := 0;
if pBuf <> nil then
begin
FreeMem(pBuf);
pBuf := nil;
end;
while not SetupDiGetDeviceRegistryProperty(hDev, sdd,
SPDRP_FRIENDLYNAME, dwPropertyRegDataType, pBuf, dwBufSize, dwBufSize) do
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
if pBuf <> nil then
FreeMem(pBuf);
pBuf := AllocMem(dwBufSize);
end else break;
end;
if pBuf <> nil then
begin
if CompareText(sDesc, String(PChar(pBuf))) = 0 then
begin
dwStatus := 0;
dwProblem := 0;
if CM_Get_DevNode_Status(dwStatus, dwProblem, sdd.DevInst, 0) = CR_SUCCESS then
begin
// var bDisabled: Boolean := (((dwStatus and DN_HAS_PROBLEM) = 0) and (dwProblem = CM_PROB_DISABLED));
// if bVal = bDisabled then
begin
var PropChangeParams: TSPPropChangeParams;
ZeroMemory(@PropChangeParams, SizeOf(PropChangeParams));
PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
PropChangeParams.Scope := DICS_FLAG_GLOBAL;
PropChangeParams.StateChange := BooleanToInt(bVal, DICS_ENABLE, DICS_DISABLE);
if SetupDiSetClassInstallParams(hDev, @sdd, PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams)) then
begin
// 64bit OS 에서는 64bit 프로그램 에서만 실행 가능하다 22_0621 13:59:21 kku
if SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDev, @sdd) then
Result := i;
end;
end;
end;
exit;
end;
end;
Inc(i);
end;
finally
SetupDiDestroyDeviceInfoList(hDev);
if pBuf <> nil then
FreeMem(pBuf);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. SetNicEnable()');
end;
end;
function SetNicEnableByIndex(nIdx: Integer; bVal: Boolean): Boolean;
var
hDev: HDEVINFO;
sdd: TSPDevInfoData;
dwBufSize,
dwStatus, dwProblem,
dwPropertyRegDataType: DWORD;
pBuf: Pointer;
begin
Result := false;
try
hDev := SetupDiGetClassDevs(@GUID_DEVCLASS_NET, nil, 0, DIGCF_PRESENT);
if hDev = INVALID_HANDLE_VALUE then
exit;
pBuf := nil;
try
ZeroMemory(@sdd, SizeOf(sdd));
sdd.cbSize := SizeOf(sdd);
if SetupDiEnumDeviceInfo(hDev, nIdx, sdd) then
begin
dwBufSize := 0;
if pBuf <> nil then
begin
FreeMem(pBuf);
pBuf := nil;
end;
while not SetupDiGetDeviceRegistryProperty(hDev, sdd,
SPDRP_FRIENDLYNAME, dwPropertyRegDataType, pBuf, dwBufSize, dwBufSize) do
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
if pBuf <> nil then
FreeMem(pBuf);
pBuf := AllocMem(dwBufSize);
end else break;
end;
if pBuf <> nil then
begin
dwStatus := 0;
dwProblem := 0;
if CM_Get_DevNode_Status(dwStatus, dwProblem, sdd.DevInst, 0) = CR_SUCCESS then
begin
var PropChangeParams: TSPPropChangeParams;
ZeroMemory(@PropChangeParams, SizeOf(PropChangeParams));
PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
PropChangeParams.Scope := DICS_FLAG_GLOBAL;
PropChangeParams.StateChange := BooleanToInt(bVal, DICS_ENABLE, DICS_DISABLE);
if SetupDiSetClassInstallParams(hDev, @sdd, PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams)) then
begin
// 64bit OS 에서는 64bit 프로그램 에서만 실행 가능하다 22_0621 13:59:21 kku
Result := SetupDiCallClassInstaller(DIF_PROPERTYCHANGE, hDev, @sdd);
end;
end;
end;
end;
finally
SetupDiDestroyDeviceInfoList(hDev);
if pBuf <> nil then
FreeMem(pBuf);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. SetNicEnable()');
end;
end;
{ TNetAdapterInfo }
Constructor TNetAdapterInfo.Create;
begin
Inherited Create;
AdapterList_ := TNetAdapterEntList.Create;
AdapterList_.OnNotify := OnAdapterNotify;
UpdateNetAdapterInfo;
end;
Destructor TNetAdapterInfo.Destroy;
begin
FreeAndNil(AdapterList_);
Inherited;
end;
procedure TNetAdapterInfo.OnAdapterNotify(Sender: TObject; const Item: PNetAdapterEnt;
Action: TCollectionNotification);
begin
case Action of
cnAdded: ;
cnRemoved: Dispose(Item);
cnExtracted: ;
end;
end;
function TNetAdapterInfo.GetByIndex(nIndex: Integer): PNetAdapterEnt;
begin
if (nIndex > -1) and (nIndex < AdapterList_.Count) then
Result := AdapterList_[nIndex]
else
Result := nil;
end;
procedure TNetAdapterInfo.UpdateNetAdapterInfo;
function GetIpAddrs(pIpAddr: PTIP_ADDR_STRING): String;
begin
Result := '';
while pIpAddr <> nil do
begin
SumString(Result, pIpAddr.IpAddress, ',');
pIpAddr := pIpAddr.Next;
end;
end;
var
dwError,
dwBufLen: DWORD;
pAdapterInfo,
pAdapterWalk: PTIP_ADAPTER_INFO;
pEnt: PNetAdapterEnt;
begin
AdapterList_.Clear;
dwBufLen := SizeOf(TIP_ADAPTER_INFO);
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
try
// 오버플러우일 경우 메모리 다시 할당해줘서 시도해주자 09_0706
if dwError = ERROR_BUFFER_OVERFLOW then
begin
FreeMem(pAdapterInfo, SizeOf(TIP_ADAPTER_INFO));
pAdapterInfo := AllocMem(dwBufLen);
dwError := GetAdaptersInfo(pAdapterInfo, @dwBufLen);
end;
if dwError = NO_ERROR then
begin
pAdapterWalk := pAdapterInfo;
while pAdapterWalk <> nil do
begin
New(pEnt);
ZeroMemory(pEnt, SizeOf(TNetAdapterEnt));
with pAdapterWalk^ do
begin
pEnt.sName := AdapterName;
pEnt.sDesc := Description;
if AddressLength > 0 then
pEnt.sMacAddr := UpperCase(ConvMACAddrToStr(TMacAddress(Address), AddressLength));
// pEnt.sCurIpAddr := GetIpAddrs(CurrentIPAddress);
pEnt.sIpAddrs := GetIpAddrs(@IPAddressList);
pEnt.sGatewayIps := GetIpAddrs(@GatewayList);
pEnt.sDHCPServer := GetIpAddrs(@DHCPServer);
pEnt.sPriWINSServer := GetIpAddrs(@PrimaryWINSServer);
pEnt.sSecWINSServer := GetIpAddrs(@SecondaryWINSServer);
pEnt.bDHCP := DHCPEnabled <> 0;
pEnt.bHaveWINS := HaveWINS;
pEnt.dwComboIdx := ComboIndex;
pEnt.dwIndex := Index;
// pEnt.dwType := aType;
pEnt.dwType := Type_;
pAdapterWalk := Next;
end;
AdapterList_.Add(pEnt);
end;
end;
finally
FreeMem(pAdapterInfo, dwBufLen);
end;
end;
function TNetAdapterInfo.Count: Integer;
begin
Result := AdapterList_.Count;
end;
{ TWlanInfo }
Constructor TWlanInfo.Create;
begin
Inherited Create;
WLanEntList_ := TWLanEntList.Create;
WLanEntList_.OnNotify := OnWlanEntNotify;
UpdateWlanInfo;
end;
Destructor TWlanInfo.Destroy;
begin
FreeAndNil(WLanEntList_);
Inherited;
end;
procedure TWlanInfo.OnWlanEntNotify(Sender: TObject; const Item: PWLanEnt;
Action: TCollectionNotification);
begin
if Action = cnRemoved then
Dispose(Item);
end;
procedure TWlanInfo.UpdateWlanInfo;
const
WLAN_AVAILABLE_NETWORK_INCLUDE_ALL_ADHOC_PROFILES = $00000001;
var
hClient: THandle;
dwVersion, dwResult: DWORD;
pInterface: Pndu_WLAN_INTERFACE_INFO_LIST;
i, j, c: Integer;
pAvNetList: Pndu_WLAN_AVAILABLE_NETWORK_LIST;
pBssList: Pndu_WLAN_BSS_LIST;
// pInterfaceGuid: PGUID;
InfcInfo: Tndu_WLAN_INTERFACE_INFO;
sBssid: String;
// sInterface: String;
pInfo: PWLanEnt;
begin
try
WLanEntList_.Clear;
hClient := 0;
pInterface := nil;
dwResult := WlanOpenHandle(NDU_WLAN_API_VERSION, nil, @dwVersion, @hClient);
try
if dwResult <> ERROR_SUCCESS then
begin
_Trace(Format('Error Open Client %d', [dwResult]));
exit;
end;
dwResult := WlanEnumInterfaces(hClient, nil, @pInterface);
if dwResult <> ERROR_SUCCESS then
begin
_Trace('Error Enum Interfaces ' + IntToStr(dwResult));
Exit;
end;
if pInterface.dwNumberOfItems = 0 then
exit;
for i := 0 to pInterface.dwNumberOfItems - 1 do
begin
InfcInfo := pInterface.InterfaceInfo[i];
// sInterface := pInterface.InterfaceInfo[i].strInterfaceDescription;
// pInterfaceGuid := @pInterface.InterfaceInfo[pInterface.dwIndex].InterfaceGuid;
dwResult := WlanGetAvailableNetworkList(hClient, @InfcInfo.InterfaceGuid, // pInterfaceGuid,
WLAN_AVAILABLE_NETWORK_INCLUDE_ALL_ADHOC_PROFILES, nil, pAvNetList);
if dwResult <> ERROR_SUCCESS then
begin
_Trace('Error WlanGetAvailableNetworkList, Idx=%d, Error=%d', [i, dwResult], 1);
continue;
end;
if pAvNetList.dwNumberOfItems = 0 then
continue;
for j := 0 to pAvNetList.dwNumberOfItems - 1 do
Begin
if j > High(pAvNetList.Network) then
break;
New(pInfo);
pInfo.sName := InfcInfo.strInterfaceDescription; // sInterface;
pInfo.sProfile := pAvNetList.Network[j].strProfileName;
pInfo.sBssid := '';
pInfo.nQuality := pAvNetList.Network[j].wlanSignalQuality;
pInfo.dwAlgo1 := pAvNetList.Network[j].dot11DefaultAuthAlgorithm;
pInfo.dwAlgo2 := pAvNetList.Network[j].dot11DefaultCipherAlgorithm;
pInfo.bSecurety := pAvNetList.Network[j].bSecurityEnabled;
pInfo.InterfaceGuid := InfcInfo.InterfaceGuid; // pInterfaceGuid^;
// 아래 bssid 가져오기 잘되는데 일단 막아놓음 25_0715 15:17:45 kku
// cmd : netsh wlan show interfaces
(*
pBssList := nil;
if WlanGetNetworkBssList(hClient, @pInterface.InterfaceInfo[i].InterfaceGuid,
{@pAvNetList.Network[j].dot11Ssid}nil, dot11_BSS_type_infrastructure,
true, nil, @pBssList) = ERROR_SUCCESS then
begin
if pBssList.dwNumberOfItems > 0 then
begin
for c := 0 to High(pBssList.wlanBssEntries) do
begin
with pBssList.wlanBssEntries[c] do
sBssid := Format('%.2x:%.2x:%.2x:%.2x:%.2x:%.2x',
[dot11Bssid[0], dot11Bssid[1], dot11Bssid[2],
dot11Bssid[3], dot11Bssid[4], dot11Bssid[5]]);
SumString(pInfo.sBssid, sBssid, ',');
end;
end;
if pBssList <> nil then
WlanFreeMemory(pBssList);
end;
*)
WLanEntList_.Add(pInfo);
End;
end;
finally
if pInterface <> nil then
WlanFreeMemory(pInterface);
if hClient <> 0 then
WlanCloseHandle(hClient, nil);
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Error .. UpdateWlanInfo()');
end;
end;
function TWlanInfo.GetByIndex(nIndex: Integer): PWLanEnt;
begin
if (nIndex > -1) and (nIndex < WLanEntList_.Count) then
Result := WLanEntList_[nIndex]
else
Result := nil;
end;
function TWlanInfo.Count: Integer;
begin
Result := WLanEntList_.Count;
end;
function TWlanInfo.GetWlanEntByName(sName: String): PWLanEnt;
var
i: Integer;
begin
Result := nil;
try
for i := 0 to WLanEntList_.Count - 1 do
if CompareText(WLanEntList_[i].sName, sName) = 0 then
begin
Result := WLanEntList_[i];
exit;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Error .. GetWlanEntByName()');
end;
end;
{ TTcpTableInfo }
Constructor TTcpTableInfo.Create;
begin
Inherited Create;
TcpEnts_ := TTcpInfoEntList.Create;
TcpEnts_.OnNotify := OnTcpInfoEntNotify;
end;
Destructor TTcpTableInfo.Destroy;
begin
FreeAndNil(TcpEnts_);
Inherited;
end;
procedure TTcpTableInfo.OnTcpInfoEntNotify(Sender: TObject; const
Item: PTcpInfoEnt; Action: TCollectionNotification);
begin
case Action of
cnAdded: ;
cnRemoved: Dispose(Item);
cnExtracted: ;
end;
end;
procedure TTcpTableInfo.UpdateTcpTableInfo;
var
dwResult,
dtTableSize: DWORD;
i: Integer;
IpAddress: in_addr;
pTcpTable: PMIB_TCPTABLE_OWNER_PID;
pEnt: PTcpInfoEnt;
begin
TcpEnts_.Clear;
dtTableSize := 0;
dwResult := GetExtendedTcpTable(nil, @dtTableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0);
if dwResult <> ERROR_INSUFFICIENT_BUFFER then
exit;
Guard(pTcpTable, AllocMem(dtTableSize));
if GetExtendedTcpTable(pTcpTable, @dtTableSize, true, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
for i := 0 to pTcpTable.dwNumEntries - 1 do
begin
New(pEnt);
IpAddress.s_addr := pTcpTable.Table[i].dwLocalAddr;
pEnt.sLocalIpAddr := string(inet_ntoa(IpAddress));
IpAddress.s_addr := pTcpTable.Table[i].dwRemoteAddr;
pEnt.sRemoteIpAddr := string(inet_ntoa(IpAddress));
pEnt.nLocalPort := ntohs(pTcpTable.Table[i].dwLocalPort);
pEnt.nRemotePort := ntohs(pTcpTable.Table[i].dwRemotePort);
pEnt.dwPid := pTcpTable.Table[i].dwOwningPid;
pEnt.dwStatus := pTcpTable.Table[i].dwState;
TcpEnts_.Add(pEnt);
end;
end;
function TTcpTableInfo.Count: Integer;
begin
Result := TcpEnts_.Count;
end;
procedure TTcpTableInfo.Delete(nIndex: Integer);
begin
if (nIndex > -1) and (nIndex < TcpEnts_.Count) then
TcpEnts_.Delete(nIndex);
end;
function TTcpTableInfo.GetByIndex(nIndex: Integer): PTcpInfoEnt;
begin
if (nIndex > -1) and (nIndex < TcpEnts_.Count) then
Result := TcpEnts_[nIndex]
else
Result := nil;
end;
{ TUdpTableInfo }
Constructor TUdpTableInfo.Create;
begin
Inherited Create;
UdpEnts_ := TUdpInfoEntList.Create;
UdpEnts_.OnNotify := OnUdpInfoEntNotify;
end;
Destructor TUdpTableInfo.Destroy;
begin
FreeAndNil(UdpEnts_);
Inherited;
end;
procedure TUdpTableInfo.OnUdpInfoEntNotify(Sender: TObject; const Item: PUdpInfoEnt;
Action: TCollectionNotification);
begin
case Action of
cnAdded: ;
cnRemoved: Dispose(Item);
cnExtracted: ;
end;
end;
procedure TUdpTableInfo.UpdateUdpTableInfo;
var
dwResult,
dtTableSize: DWORD;
i: Integer;
IpAddress: in_addr;
pUdpTable: PMIB_UDPTABLE_OWNER_PID;
pEnt: PUdpInfoEnt;
begin
UdpEnts_.Clear;
dtTableSize := 0;
dwResult := GetExtendedUdpTable(nil, @dtTableSize, False, AF_INET, UDP_TABLE_OWNER_PID, 0);
if dwResult <> ERROR_INSUFFICIENT_BUFFER then
exit;
Guard(pUdpTable, AllocMem(dtTableSize));
if GetExtendedUdpTable(pUdpTable, @dtTableSize, true, AF_INET, UDP_TABLE_OWNER_PID, 0) = NO_ERROR then
for i := 0 to pUdpTable.dwNumEntries - 1 do
begin
New(pEnt);
IpAddress.s_addr := pUdpTable.Table[i].dwLocalAddr;
pEnt.sLocalIpAddr := string(inet_ntoa(IpAddress));
pEnt.nLocalPort := ntohs(pUdpTable.Table[i].dwLocalPort);
pEnt.dwPid := pUdpTable.Table[i].dwOwningPid;
UdpEnts_.Add(pEnt);
end;
end;
function TUdpTableInfo.Count: Integer;
begin
Result := UdpEnts_.Count;
end;
procedure TUdpTableInfo.Delete(nIndex: Integer);
begin
if (nIndex > -1) and (nIndex < UdpEnts_.Count) then
UdpEnts_.Delete(nIndex);
end;
function TUdpTableInfo.GetByIndex(nIndex: Integer): PUdpInfoEnt;
begin
if (nIndex > -1) and (nIndex < UdpEnts_.Count) then
Result := UdpEnts_[nIndex]
else
Result := nil;
end;
{ TSharedFolder }
Constructor TSharedFolder.Create(bUpdate: Boolean = false; sServerName: String = ''; bIgrSpecial: Boolean = false);
begin
Inherited Create;
sSvrName_ := sServerName;
if sSvrName_ = '' then
sSvrName_ := GetComName;
if bUpdate then
UpdateShdFldList(bIgrSpecial);
end;
procedure TSharedFolder.Notify(const Item: PShdFldEnt; Action: TCollectionNotification);
begin
if Action = cnRemoved then
Dispose(Item);
end;
procedure TSharedFolder.UpdateShdFldList(bIgrSpecial: Boolean = false);
const
MAX_PREFERRED_LENGTH = -1;
NERR_SUCCESS = 0;
var
EntriesRead,
TotalEntries,
ResHandle: DWORD;
ShareInfo2, P: PSHARE_INFO_2;
dwStatus: NET_API_STATUS;
i: Integer;
pEnt: PShdFldEnt;
begin
try
Clear;
{
// WMI 사용하면 메모리 릭이 발생해서 뺌. 22_1221 15:18:10 kku
if WMI_GetInformationEx('', WMI_ROOT_OBJECT, '', '', 'Win32_Share', wmiResults, nVerCnt) then
begin
for i := 0 to nVerCnt - 1 do
begin
New(pEnt);
pEnt.sName := WMI_GetPropertyData(wmiResults, 'Name', i);
pEnt.sPath := WMI_GetPropertyData(wmiResults, 'Path', i);
Add(pEnt);
end;
end;
}
ResHandle := 0;
dwStatus := NetShareEnum(PChar(sSvrName_), 2, Pointer(ShareInfo2),
DWORD(MAX_PREFERRED_LENGTH),
EntriesRead, TotalEntries, ResHandle);
try
if dwStatus <> NERR_SUCCESS then
exit;
P := ShareInfo2;
for i := 0 to TotalEntries - 1 do
begin
if bIgrSpecial then
begin
if (CompareText(P.shi2_netname, 'ADMIN$') = 0) or
(CompareText(P.shi2_netname, 'IPC$') = 0) or
(CompareText(P.shi2_netname, 'PRINT$') = 0) then
begin
Inc(P);
continue;
end;
end;
New(pEnt);
pEnt.sName := P.shi2_netname;
pEnt.sPath := P.shi2_path;
Add(pEnt);
Inc(P);
end;
finally
NetApiBufferFree(ShareInfo2);
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. UpdateShdFldList()');
end;
end;
function TSharedFolder.ExistsSharedFolder(sPath: String): Boolean;
var
i: Integer;
begin
Result := false;
for i := 0 to Count - 1 do
begin
if CompareText(Items[i].sPath, sPath) = 0 then
begin
Result := true;
exit;
end;
end;
end;
{ TRouteEntList }
procedure TRouteEntList.Notify(const Item: PRouteEnt; Action: TCollectionNotification);
begin
if Action = cnRemoved then
Dispose(Item);
end;
function TRouteEntList.GetEntByDestIp(sDestIp: String): PRouteEnt;
var
i: Integer;
begin
Result := nil;
try
for i := 0 to Count - 1 do
begin
if Items[i].sDestIp = sDestIp then
begin
Result := Items[i];
exit;
end;
end;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. GetEntByDestIp()');
end;
end;
{ Functions }
function GetNetAdapterTypeToStr(dwType: DWORD): String;
begin
case dwType of
MIB_IF_TYPE_OTHER : Result := RS_NetOther;
MIB_IF_TYPE_ETHERNET : Result := RS_NetEthernet;
IF_TYPE_ISO88025_TOKENRING : Result := RS_NetTokenring;
MIB_IF_TYPE_FDDI : Result := RS_NetFDDI;
MIB_IF_TYPE_PPP : Result := 'PPP';
MIB_IF_TYPE_LOOPBACK : Result := RS_NetLoop;
MIB_IF_TYPE_SLIP : Result := 'SLIP';
IF_TYPE_IEEE80211 : Result := 'IEEE 802.11 (Wireless)';
else Result := Format('Unknown (%d)', [dwType]);
end;
end;
function IsConnectedWIFI(aInterfaceGuid: TGUID): Boolean;
var
hClient: THandle;
dwVersion,
dwResult, dwSize: DWORD;
pConnInfo: Pndu_WLAN_CONNECTION_ATTRIBUTES;
begin
Result := false;
try
hClient := 0;
pConnInfo := nil;
dwResult := WlanOpenHandle(NDU_WLAN_API_VERSION, nil, @dwVersion, @hClient);
try
if dwResult <> ERROR_SUCCESS then
begin
TTgTrace.T(Format('Error Open Client %d', [dwResult]));
exit;
end;
dwSize := 0;
dwResult := WlanQueryInterface(
hClient,
@aInterfaceGuid,
wlan_intf_opcode_current_connection,
nil,
@dwSize,
@pConnInfo,
nil
);
if dwResult = ERROR_SUCCESS then
Result := pConnInfo.isState = wlan_interface_state_connected;
finally
if pConnInfo <> nil then
WlanFreeMemory(pConnInfo);
if hClient <> 0 then
WlanCloseHandle(hClient, nil);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. IsConnectedWIFI()');
end;
end;
function DisconnectWIFI(aInterfaceGuid: TGUID): Boolean;
var
hClient: THandle;
dwVersion, dwResult: DWORD;
begin
Result := false;
try
hClient := 0;
dwResult := WlanOpenHandle(NDU_WLAN_API_VERSION, nil, @dwVersion, @hClient);
try
if dwResult <> ERROR_SUCCESS then
begin
TTgTrace.T(Format('Error Open Client %d', [dwResult]));
exit;
end;
Result := WlanDisconnect(hClient, @aInterfaceGuid, nil) = ERROR_SUCCESS;
finally
if hClient <> 0 then
WlanCloseHandle(hClient, nil);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. DisconnectWIFI()');
end;
end;
function GetRouteTables(aList: TRouteEntList): Integer;
var
pTable: PTMibIPForwardTable;
dwSize: DWORD;
i: Integer;
pRow: PTMibIPForwardRow;
pEnt: PRouteEnt;
begin
Result := 0;
try
aList.Clear;
pTable := nil;
dwSize := 0;
if GetIpForwardTable(pTable, @dwSize, FALSE) <> ERROR_INSUFFICIENT_BUFFER then
exit;
pTable := AllocMem(dwSize);
try
if GetIpForwardTable(pTable, @dwSize, FALSE) <> NO_ERROR then
exit;
if pTable.dwNumEntries = 0 then
exit;
for i := 0 to pTable.dwNumEntries - 1 do
begin
pRow := PTMibIPForwardRow(LONGLONG(@pTable.Table[0]) + (i * SizeOf(TMibIPForwardRow)));
New(pEnt);
ZeroMemory(pEnt, SizeOf(TRouteEnt));
pEnt.sDestIp := DWORDToIP(pRow.dwForwardDest, false);
pEnt.Info := pRow^;
aList.Add(pEnt);
end;
Result := aList.Count;
finally
FreeMem(pTable);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetRouteTables()');
end;
end;
function GetPublicIP: string;
var
HttpClient: THTTPClient;
Response: IHTTPResponse;
begin
Result := '';
try
Guard(HttpClient, THTTPClient.Create);
Response := HttpClient.Get('http://api.ipify.org');
Result := Response.ContentAsString();
if (Result <> '') and not IsValidIP(Result) then
Result := '';
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetPublicIP()');
end;
end;
function RemoveEveryoneFromShare(const sShareName: string): Boolean;
const
ACCESS_ALLOWED_ACE_TYPE = 0;
ACCESS_DENIED_ACE_TYPE = 1;
SYSTEM_AUDIT_ACE_TYPE = 2;
SYSTEM_ALARM_ACE_TYPE = 3;
// ACL Revision
ACL_REVISION = 2;
ACL_REVISION_DS = 4;
type
PACE_HEADER = ^ACE_HEADER;
ACE_HEADER = packed record
AceType: Byte;
AceFlags: Byte;
AceSize: Word;
end;
PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;
ACCESS_ALLOWED_ACE = packed record
Header: ACE_HEADER;
Mask: ACCESS_MASK;
SidStart: DWORD; // 실제 SID가 여기부터 시작
end;
PACCESS_DENIED_ACE = ^ACCESS_DENIED_ACE;
ACCESS_DENIED_ACE = packed record
Header: ACE_HEADER;
Mask: ACCESS_MASK;
SidStart: DWORD;
end;
var
pSD: PSECURITY_DESCRIPTOR;
pDACL: PACL;
pNewDACL: PACL;
eaCount, i: DWORD;
aceHeader: PACE_HEADER;
sidEveryone: PSID;
dwAceSize: DWORD;
pAceSID: PSID;
aceAccessMask: ACCESS_MASK;
dwRes: DWORD;
begin
Result := false;
try
pSD := nil;
// 1. 공유의 보안 정보 가져오기
dwRes := GetNamedSecurityInfo(
PChar('\\localhost\' + sShareName),
SE_LMSHARE,
DACL_SECURITY_INFORMATION,
nil, nil,
@pDACL,
nil,
pSD
);
if dwRes <> ERROR_SUCCESS then
begin
TTgTrace.T('GetNamedSecurityInfo failed: %d', [dwRes]);
exit;
end;
try
// 2. Everyone SID 생성
if not ConvertStringSidToSid('S-1-1-0', sidEveryone) then
begin
TTgTrace.T('Failed to create Everyone SID');
exit;
end;
// 3. 새 DACL 생성 (기존 DACL 크기 그대로 확보)
GetAclInformation(pDACL, @eaCount, SizeOf(eaCount), AclSizeInformation);
pNewDACL := AllocMem(1024); // 충분한 크기 확보
InitializeAcl(pNewDACL^, 1024, ACL_REVISION);
// 4. 기존 ACE들 순회하면서 Everyone 아닌 것만 복사
i := 0;
while GetAce(pDACL, i, Pointer(aceHeader)) do
begin
Inc(i);
// ACE SID 가져오기
case aceHeader.AceType of
ACCESS_ALLOWED_ACE_TYPE:
begin
aceAccessMask := PACCESS_ALLOWED_ACE(aceHeader)^.Mask;
pAceSID := @PACCESS_ALLOWED_ACE(aceHeader)^.SidStart;
end;
ACCESS_DENIED_ACE_TYPE:
begin
aceAccessMask := PACCESS_DENIED_ACE(aceHeader)^.Mask;
pAceSID := @PACCESS_DENIED_ACE(aceHeader)^.SidStart;
end;
else
Continue; // 다른 ACE 타입은 패스
end;
// Everyone과 같으면 건너뜀
if EqualSid(sidEveryone, pAceSID) then
Continue;
// 새 DACL에 추가
AddAccessAllowedAceEx(
pNewDACL^,
ACL_REVISION,
0,
aceAccessMask,
pAceSID
);
end;
// 5. 수정된 DACL을 다시 설정
dwRes := SetNamedSecurityInfo(
PChar('\\localhost\' + sShareName),
SE_LMSHARE,
DACL_SECURITY_INFORMATION,
nil, nil,
pNewDACL,
nil
);
Result := dwRes = ERROR_SUCCESS;
finally
if pSD <> nil then
LocalFree(HLOCAL(pSD));
if sidEveryone <> nil then
LocalFree(HLOCAL(sidEveryone));
if pNewDACL <> nil then
FreeMem(pNewDACL);
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. RemoveEveryoneFromShare()');
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink