opports.dpr

像windows的netstat一样查看本机开放端口的程序源码

program OpPorts;
{$APPTYPE CONSOLE}
{$R OpPorts.res}
uses Windows,WinSvc;
const
 DriverName='ReadMemDriver';
 DriverFileName='readmem.sys';
 IOCTL_READ_OBJ_INFO=$00222000;

 SystemProcessesAndThreadsInformation=5;
 SystemHandleInformation=16;
 ObjectNameInformation=1;
 ProcessBasicInformation=0;

 STATUS_INFO_LENGTH_MISMATCH=$C0000004;

 WINSOCK_VERSION=$0202;
 WSADESCRIPTION_LEN=256;
 WSASYS_STATUS_LEN=128;
 AF_INET=2;
 IPPROTO_TCP=6;
 IPPROTO_UDP=17;
 SOCK_STREAM=1;
 SOCK_DGRAM=2;
 SOCKET_ERROR=DWORD(-1);

type
 TWSAData=packed record
  Version,HighVersion:Word;
  Description:array[0..WSADESCRIPTION_LEN] of Char;
  SystemStatus:array[0..WSASYS_STATUS_LEN] of Char;
  MaxSockets,MaxUdpDg:Word;
  VendorInfo:PChar;
 end;
 PSockAddr=^TSockAddr;
 TSockAddr=packed record
  sin_family,sin_port:Word;
  sin_addr:Cardinal;
  sin_zero:array[0..7] of Char;
 end;

 PUnicodeString=^TUnicodeString;
 TUnicodeString=packed record
  Length,MaximumLength:Word;
  Buffer:Pointer;
 end;
 TAnsiString=packed record
  Length,MaximumLength:Word;
  Buffer:Pointer;
 end;

 TObjectInfo=packed record
  ObType,Alloc,Size,Res:Byte;
  Ptr1,Ptr2,Ptr3:Pointer;
  Flags:Cardinal;
 end;

 TRMDIn=record
  ObjAddr:Pointer;
 end;
 TRMDOut=record
  Info:TObjectInfo;
  Name:array[0..255] of Char;
 end;

 TVmCounters=packed record
  PeakVirtualSize,VirtualSize:Cardinal;
  PageFaultCount:ULONG;
  PeakWorkingSetSize,WorkingSetSize,QuotaPeakPagedPoolUsage,QuotaPagedPoolUsage,QuotaPeakNonPagedPoolUsage,QuotaNonPagedPoolUsage,PagefileUsage,PeakPagefileUsage:Cardinal;
 end;
 TIoCounters=packed record
  ReadOperationCount,WriteOperationCount,OtherOperationCount,ReadTransferCount,WriteTransferCount,OtherTransferCount:LARGE_INTEGER;
 end;
 TClientId=packed record
  UniqueProcess,UniqueThread:Cardinal;
 end;

 PObjectNameInformation=^TObjectNameInformation;
 TObjectNameInformation=packed record
  Name:TUnicodeString;
 end;
 PSystemHandleInformation=^TSystemHandleInformation;
 TSystemHandleInformation=packed record
  ProcessId:Cardinal;
  ObjectTypeNumber,Flags:Byte;
  Handle:Word;
  ObjectPtr:Pointer;
  GrantedAccess:Cardinal;
 end;
 PSystemHandleInformationEx=^TSystemHandleInformationEx;
 TSystemHandleInformationEx=packed record
  NumberOfEntries:Cardinal;
  Handles:array of TSystemHandleInformation;
 end;
 TSystemThreads=packed record
  KernelTime,UserTime,CreateTime:LARGE_INTEGER;
  WaitTime:Cardinal;
  StartAddress:Pointer;
  ClientId:TClientId;
  Priority,BasePriority,ContextSwitchCount,State,WaitReason:Cardinal;
 end;
 PSystemProcesses=^TSystemProcesses;
 TSystemProcesses=packed record
  NextEntryDelta,ThreadCount:Cardinal;
  Reserved1:array[0..5] of Cardinal;
  CreateTime,UserTime,KernelTime:LARGE_INTEGER;
  ProcessName:TUnicodeString;
  BasePriority,ProcessId,InheritedFromProcessId,HandleCount:Cardinal;
  Reserved2:array[0..1] of Cardinal;
  VmCounters:TVmCounters;
  IoCounters:TIoCounters;
  Threads:array of TSystemThreads;
 end;
 TTdiConnectionIn=packed record
  UserDataLength:Cardinal;
  UserData:Pointer;
  OptionsLength:Cardinal;
  Options:Pointer;
  RemoteAddressLength:Cardinal;
  RemoteAddress:Pointer;
 end;
 TTdiConnectionOut=packed record
  State,Event,TransmittedTsdus,ReceivedTsdus,TransmissionErrors,ReceiveErrors:Cardinal;
  Throughput,Delay:LARGE_INTEGER;
  SendBufferSize,ReceiveBufferSize,Unreliable:Cardinal;
  Unk1:array[0..5] of Cardinal;
  Unk2:Word;
 end;
 TProcessBasicInformation=packed record
  ExitStatus:Cardinal;
  PebBaseAddress:Pointer;
  AffinityMask,BasePriority,UniqueProcessId,InheritedFromUniqueProcessId:Cardinal;
 end;
 PMibUdpExRow=^TMibUdpExRow;
 TMibUdpExRow=packed record
  LocalAddr,LocalPort,ProcessId:Cardinal;
 end;
 PMibUdpExTable=^TMibUdpExTable;
 TMibUdpExTable=packed record
  NumEntries:Cardinal;
  Table:array of TMibUdpExRow;
 end;
 PMibTcpExRow=^TMibTcpExRow;
 TMibTcpExRow=packed record
  State,LocalAddr,LocalPort,RemoteAddr,RemotePort,ProcessId:Cardinal;
 end;
 PMibTcpExTable=^TMibTcpExTable;
 TMibTcpExTable=packed record
  NumEntries:Cardinal;
  Table:array of TMibTcpExRow;
 end;
 TResult=packed record
  Active:Boolean;
  Count:Integer;
  Objects:PSystemHandleInformation;
 end;

 TNtQuerySystemInformation=function(ASystemInformationClass:Cardinal;ASystemInformation:Pointer;ASystemInformationLength:Cardinal;AReturnLength:PCardinal):Cardinal; stdcall;
 TNtQueryObject=function(AObjectHandle:THandle;AObjectInformationClass:Cardinal;AObjectInformation:Pointer;AObjectInformationLength:Cardinal;AReturnLength:PCardinal):Cardinal; stdcall;
 TNtQueryInformationProcess=function(AProcessHandle:THandle;AProcessInformationClass:Cardinal;AProcessInformation:Pointer;AProcessInformationLength:Cardinal;AReturnLength:PCardinal):Cardinal; stdcall;
 TRtlUnicodeStringToAnsiString=function(ADestinationString:PAnsiString;ASourceString:PUnicodeString;AAllocateDestinationString:Boolean):Cardinal; stdcall;
 TRtlFreeAnsiString=function(AAnsiString:PAnsiString):Cardinal; stdcall;
 TWSAStartup=function(AVersionRequired:Word;var VWSData:TWSAData):Integer;stdcall;
 TWSACleanup=function:Integer;stdcall;
 TWSASocket=function(AFamily,AType,AProto:Integer;AProtocolInfo:Pointer;AGroup,AFlags:Cardinal):Integer;stdcall;
 Tbind=function(ASocket:Cardinal;AName:PSockAddr;ANameLen:Integer):Cardinal;stdcall;
 Tclosesocket=function(ASocket:Cardinal):Cardinal;stdcall;

 TAllocateAndGetTcpExTableFromStack=function(ATcpExTable:PMibTcpExTable;AOrder:Boolean;AHeap:THandle;AZero:Cardinal;AFlags:Cardinal):Cardinal;stdcall;
 TAllocateAndGetUdpExTableFromStack=function(AUdpExTable:PMibUdpExTable;AOrder:Boolean;AHeap:THandle;AZero:Cardinal;AFlags:Cardinal):Cardinal;stdcall;
var
 I,J:Integer;
 HandleTableSize,ProcessInfoTableSize,Status,BytesRet:Cardinal;
 HandleTable:PSystemHandleInformationEx;
 ProcessInfoTable:PSystemProcesses;
 PHandleInfo,PObj:PSystemHandleInformation;
 HandleInfo,LastObj:TSystemHandleInformation;
 SockHandleType,Proto:Byte;
 ProcessHandle,DupHandle,DrvHandle:THandle;
 TdiConnIn:TTdiConnectionIn;
 TdiConnOut:TTdiConnectionOut;
 DriverBin,ResLn,Str1:string;
 Port:Word;
 IpHlpSupport:Boolean;
 TCPPortsTable:PMibTcpExTable;
 UDPPortsTable:PMibUdpExTable;
 TCPRow:PMibTcpExRow;
 UDPRow:PMibUdpExRow;
 SockObjInfoTCP,SockObjInfoUDP,ObjInfo:TObjectInfo;
 LocPID:Cardinal;
 ResultPorts:array[0..1,0..65535] of TResult;

 NtQuerySystemInformation:TNtQuerySystemInformation;
 NtQueryObject:TNtQueryObject;
 NtQueryInformationProcess:TNtQueryInformationProcess;
 RtlUnicodeStringToAnsiString:TRtlUnicodeStringToAnsiString;
 RtlFreeAnsiString:TRtlFreeAnsiString;
 WSAStartup:TWSAStartup;
 WSACleanup:TWSACleanup;
 WSASocket:TWSASocket;
 bind:Tbind;
 closesocket:Tclosesocket;
 AllocateAndGetTcpExTableFromStack:TAllocateAndGetTcpExTableFromStack;
 AllocateAndGetUdpExTableFromStack:TAllocateAndGetUdpExTableFromStack;

procedure UninstallDriver; forward;
function DeleteFile(AFile:string):Boolean; forward;

procedure About;
begin
 WriteLn;
 WriteLn('Open Ports v1.2');
 WriteLn('programmed by Holy_Father && Ratter/29A');
 WriteLn('as a part of Hacker Defender rootkit - http://www.hxdef.org,');
 WriteLn('http://hxdef.net.ru, http://hxdef.czweb.org, http://rootkit.host.sk');
 WriteLn('Copyright (c) 2000,forever ExEwORx');
 WriteLn('birthday: 29.06.2003');
 WriteLn;
end;

procedure FatalError(AErrMsg:string;AUninstDrv:Boolean=False);
begin
 WriteLn(AErrMsg);
 if AUninstDrv then
 begin
  UninstallDriver;
  DeleteFile(DriverBin);
 end;
 Halt(1);
end;

function LoadAPI:Boolean;
var
 LHMod:THandle;
begin
 LHMod:=GetModuleHandle('ntdll.dll');
 NtQuerySystemInformation:=GetProcAddress(LHMod,'NtQuerySystemInformation');
 NtQueryObject:=GetProcAddress(LHMod,'NtQueryObject');
 NtQueryInformationProcess:=GetProcAddress(LHMod,'NtQueryInformationProcess');
 RtlUnicodeStringToAnsiString:=GetProcAddress(LHMod,'RtlUnicodeStringToAnsiString');
 RtlFreeAnsiString:=GetProcAddress(LHMod,'RtlFreeAnsiString');
 LHMod:=LoadLibrary('ws2_32.dll');
 WSAStartup:=GetProcAddress(LHMod,'WSAStartup');
 WSACleanup:=GetProcAddress(LHMod,'WSACleanup');
 WSASocket:=GetProcAddress(LHMod,'WSASocketA');
 bind:=GetProcAddress(LHMod,'bind');
 closesocket:=GetProcAddress(LHMod,'closesocket');
 Result:=not ((@NtQuerySystemInformation=nil) or (@NtQueryInformationProcess=nil)
           or (@NtQueryObject=nil) or (@RtlUnicodeStringToAnsiString=nil) or (@RtlFreeAnsiString=nil)
           or (@WSAStartup=nil) or (@WSACleanup=nil) or (@WSASocket=nil) or (@bind=nil)
           or (@closesocket=nil));

 LHMod:=LoadLibrary('iphlpapi.dll');
 IpHlpSupport:=not (LHMod=0);
 if IpHlpSupport then
 begin
  AllocateAndGetTcpExTableFromStack:=GetProcAddress(LHMod,'AllocateAndGetTcpExTableFromStack');
  AllocateAndGetUdpExTableFromStack:=GetProcAddress(LHMod,'AllocateAndGetUdpExTableFromStack');
  IpHlpSupport:=not ((@AllocateAndGetTcpExTableFromStack=nil) or (@AllocateAndGetUdpExTableFromStack=nil));
 end;
end;

function GetObjInfo(AHandleInfo:TSystemHandleInformation;var VName:string):TObjectInfo;
var
 LRMDIn:TRMDIn;
 LRMDOut:TRMDOut;
 LBytesRecvd:Cardinal;
begin
 ZeroMemory(@Result,SizeOf(Result));
 LRMDIn.ObjAddr:=AHandleInfo.ObjectPtr;
 if DeviceIoControl(DrvHandle,IOCTL_READ_OBJ_INFO,@LRMDIn,SizeOf(LRMDIn),@LRMDOut,SizeOf(LRMDOut),LBytesRecvd,nil) then
 begin
  VName:=LRMDOut.Name;
  Result:=LRMDOut.Info;
 end;
end;

function ntohs(APort:Word):Word; assembler;
asm
 xchg ah,al
end;

procedure GetHandleTableAndSocketType;
var
 LWSAData:TWSAData;
 LSockTCP,LSockUDP,LPID:Cardinal;
 LI,LCurCount:Integer;
 LPHandleInfo,LPHandleInfoCur:PSystemHandleInformation;
 LAddr:TSockAddr;
 LStr:string;
 LSockFoundTCP,LSockFoundUDP:Boolean;
 LSockInfo:TObjectInfo;
begin
 WSAStartup(WINSOCK_VERSION,LWSAData);
 for LI:=1 to 65535 do
 begin
  LSockTCP:=WSASocket(AF_INET,SOCK_STREAM,IPPROTO_TCP,nil,0,0);
  LAddr.sin_family:=AF_INET;
  LAddr.sin_port:=ntohs(LI);
  LAddr.sin_addr:=0;
  if bind(LSockTCP,@LAddr,SizeOf(LAddr))<>SOCKET_ERROR then Break;
  closesocket(LSockTCP);
 end;
 if LAddr.sin_port=65535 then FatalError('Unable to listen.',True);
 for LI:=1 to 65535 do
 begin
  LSockUDP:=WSASocket(AF_INET,SOCK_DGRAM,IPPROTO_UDP,nil,0,0);
  LAddr.sin_family:=AF_INET;
  LAddr.sin_port:=ntohs(LI);
  LAddr.sin_addr:=0;
  if bind(LSockUDP,@LAddr,SizeOf(LAddr))<>SOCKET_ERROR then Break;
  closesocket(LSockUDP);
 end;
 if LAddr.sin_port=65535 then FatalError('Unable to listen.',True);

 SockHandleType:=0;
 HandleTable:=nil;
 HandleTableSize:=$10000;

 while HandleTable=nil do
 begin
  HandleTable:=Pointer(LocalAlloc(LMEM_FIXED,HandleTableSize));
  Status:=NtQuerySystemInformation(SystemHandleInformation,HandleTable,HandleTableSize,nil);
  if Status=STATUS_INFO_LENGTH_MISMATCH then
  begin
   LocalFree(Cardinal(HandleTable));
   HandleTable:=nil;
   HandleTableSize:=2*HandleTableSize;
  end else if Status<>0 then FatalError('Unable to get system handle information table.',True);
 end;

 LPID:=GetCurrentProcessId;
 LPHandleInfoCur:=nil;
 LCurCount:=0;
 LPHandleInfo:=@HandleTable^.Handles;
 for LI:=0 to HandleTable^.NumberOfEntries-1 do
 begin
  if LPHandleInfo^.ProcessId=LPID then
  begin
   Inc(LCurCount);
   if LPHandleInfoCur=nil then LPHandleInfoCur:=LPHandleInfo;
   if LPHandleInfo^.Handle=LSockTCP then SockHandleType:=LPHandleInfo^.ObjectTypeNumber;
  end else if LCurCount>0 then Break;
  Inc(LPHandleInfo);
 end;

 LSockFoundTCP:=False;
 LSockFoundUDP:=False;
 for LI:=0 to LCurCount-1 do
 begin
  if LPHandleInfoCur^.ObjectTypeNumber=SockHandleType then
  begin
   LSockInfo:=GetObjInfo(LPHandleInfoCur^,LStr);
   if (LSockInfo.Flags=1) or (LSockInfo.Flags=2) then
    if not LSockFoundTCP and (LStr='Tcp') then
    begin
     SockObjInfoTCP:=LSockInfo;
     LSockFoundTCP:=True;
    end else
    if not LSockFoundUDP and (LStr='Udp') then
    begin
     SockObjInfoUDP:=LSockInfo;
     LSockFoundUDP:=True;
    end;
   if LSockFoundTCP and LSockFoundUDP then Break;
  end;
  Inc(LPHandleInfoCur);
 end;

 closesocket(LSockTCP);
 closesocket(LSockUDP);
 WSACleanup;
 FreeLibrary(GetModuleHandle('ws2_32.dll'));
 if SockHandleType=0 then FatalError('Unable to get socket handle type.',True);
 if not (LSockFoundTCP and LSockFoundUDP) then FatalError('Unable to get socket info.',True);
end;

function GetProcessNameByPID(APID:Cardinal):string;
var
 LPProcInfo:PSystemProcesses;
 LAnsiString:TAnsiString;
 LBuf:array[0..255] of Char;

begin
 if APID<>0 then
 begin
  Result:='';
  LPProcInfo:=ProcessInfoTable;
  while (LPProcInfo^.NextEntryDelta>0) and (LPProcInfo^.ProcessId<>APID) do
   LPProcInfo:=Pointer(Cardinal(LPProcInfo)+LPProcInfo^.NextEntryDelta);
  if LPProcInfo^.ProcessId=APID then
  begin
   RtlUnicodeStringToAnsiString(@LAnsiString,@LPProcInfo^.ProcessName,True);