Форум программистов [Powered by Invision Power Board]

Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winsock;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

function ZwQuerySystemInformation(ASystemInformationClass: DWORD; ASystemInformation: Pointer;
  ASystemInformationLength: DWORD; AReturnLength: PCardinal): DWORD;
  stdcall; external 'ntdll.dll';

function ZwQueryObject(ObjectHandle, ObjectInformationClass: DWORD;
  ObjectInformation: Pointer; Length: DWORD; ReturnLength: PDWORD): DWORD;
  stdcall; external 'ntdll.dll';

const
  SYSTEM_HANDLE_INFORMATION = 16;

  STATUS_INFO_LENGTH_MISMATCH = $C0000004;
  STATUS_SUCCESS = $00000000;

  OB_TYPE_FILE_WIN2K = 26;
  OB_TYPE_FILE_WINXP = 28;

  OBJECT_NAME_INFORMATION = 1;

type
  TSYSTEM_HANDLE_INFORMATION = packed record
    ProcessId: DWORD;
    ObjectTypeNumber: Byte;
    Flags: Byte;
    Handle: Word;
    pObject: Pointer;
    GrantedAccess: DWORD;
  end;

  TSYSTEM_HANDLE_INFORMATION_EX = packed record
    NumberOfHandles: DWORD;
    Information: array [0..0] of TSYSTEM_HANDLE_INFORMATION;
  end;
  PSYSTEM_HANDLE_INFORMATION_EX = ^TSYSTEM_HANDLE_INFORMATION_EX;

  TUnicodeString = packed record
    Length: Word;
    MaximumLength: Word;
    Buffer: PWideChar;
  end;
  PUnicodeString = ^TUnicodeString;

implementation

{$R *.dfm}

function GetInfoTable(ATableType: DWORD; var ReturnLen: DWORD): Pointer;
var
  mSize: DWORD;
  mPtr: Pointer;
  St: DWORD;
  
begin
  Result := nil;
  mSize := $4000;

  repeat
    mPtr := VirtualAlloc(nil, mSize, MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
    if mPtr = nil then
      Exit;

    St := ZwQuerySystemInformation(ATableType, mPtr, mSize, nil);

    if St = STATUS_INFO_LENGTH_MISMATCH then
    begin
      VirtualFree(mPtr, 0, MEM_RELEASE);
      mSize := mSize * 2;
      ReturnLen := mSize;
    end;
  until St <> STATUS_INFO_LENGTH_MISMATCH;

  if St = STATUS_SUCCESS then
    Result := mPtr else
    VirtualFree(mPtr, 0, MEM_RELEASE);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Info: PSYSTEM_HANDLE_INFORMATION_EX;
  InfoSize, HandleNameLen, ObjectType, PID, hProcess, Loop, DstHandle, ReturnLen: DWORD;
  Version: TOSVersionInfo;
  HandleName: PUnicodeString;
  Filename: string;

  WSAData: TWSAData;

  r_sin: sockaddr_in;
  r_sin_len: Integer;

begin
  PID := StrToInt(Edit1.Text);
  hProcess := OpenProcess(PROCESS_DUP_HANDLE, False, PID);
  
  if hProcess = 0 then
  begin
    Memo1.Lines.Add('Process not accessible');
    Exit;
  end;

  Version.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(Version);

  if Version.dwMajorVersion <> 5 then
  begin
    Memo1.Lines.Add('Unsupported Windows version');
    Exit;
  end;

  case Version.dwBuildNumber of
    2195: ObjectType := OB_TYPE_FILE_WIN2K;
    2600: ObjectType := OB_TYPE_FILE_WINXP;
  end;

  HandleNameLen := SizeOf(WideChar) * MAX_PATH;
  HandleName := VirtualAlloc(nil, SizeOf(TUnicodeString) + HandleNameLen,
                             MEM_COMMIT or MEM_RESERVE, PAGE_READWRITE);
  if HandleName = nil then
    Exit;
  HandleName^.MaximumLength := HandleNameLen;

  Info := GetInfoTable(SYSTEM_HANDLE_INFORMATION, InfoSize);

  if Info = nil then
  begin
    Memo1.Lines.Add('Cannot obtain system handle list');
    Exit;
  end;

  WSAStartup($202, WSAData);

  for Loop := 0 to Info^.NumberOfHandles - 1 do
    if Info^.Information[Loop].ProcessId = PID then
      if Info^.Information[Loop].ObjectTypeNumber = ObjectType then
        if DuplicateHandle(hProcess, Info^.Information[Loop].Handle,
                           GetCurrentProcess, @DstHandle,
                           0, False, DUPLICATE_SAME_ACCESS) then
        begin
          ZwQueryObject(DstHandle, OBJECT_NAME_INFORMATION, HandleName,
                        HandleNameLen, @ReturnLen);
          FileName := WideCharToString(HandleName^.Buffer);
                      
          if Pos('\Device\Afd', Filename) > 0 then
          begin
            r_sin_len := SizeOf(r_sin);
            FillChar(r_sin, SizeOf(r_sin), 0);
               
            if getpeername(DstHandle, r_sin, r_sin_len) = 0 then
              Memo1.Lines.Add('Addr: ' + inet_ntoa(r_sin.sin_addr) + ', Port: ' + IntToStr(ntohs(r_sin.sin_port)));
          end;

          CloseHandle(DstHandle);
        end;

  WSACleanup;

  VirtualFree(HandleName, SizeOf(TUnicodeString) + HandleNameLen, MEM_RELEASE);
  VirtualFree(Info, InfoSize, MEM_RELEASE);

  CloseHandle(hProcess);
end;

end.