{*******************************************************} { } { 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) 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; 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; 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; 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; 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) 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.