Tutorial #5

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.Menus;

type
  TPalWinInfo = Record
    sTitle: String;
    hMainWin: Hwnd;
    hOutgoing: Hwnd;
    hIncoming: Hwnd;
    hNickList: Hwnd;
    bIsRoom: Boolean;
  End;

type
  TForm1 = class(TForm)
    lvWinInfo: TListView;
    btnRefresh: TButton;
    reIncoming: TRichEdit;
    btnGetAllText: TButton;
    PopupMenu1: TPopupMenu;
    GetTHISroomsText1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure GetTHISroomsText1Click(Sender: TObject);
    procedure btnGetAllTextClick(Sender: TObject);
  private
    { Private declarations }
    Procedure AddToListView(pWinInfo: TPalWinInfo);
    Procedure CleanUp;
    Function GetPalText(const HwndIncommingText: Hwnd): String;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  aPalWinInfo: Array of TPalWinInfo;

implementation

{$R *.dfm}

procedure TForm1.AddToListView(pWinInfo: TPalWinInfo);
var
  sRoomType: String;
begin

  case pWinInfo.bIsRoom of
    True:
      sRoomType := 'Room';
    False:
      sRoomType := 'Pm';
  end;

  with lvWinInfo.Items.Add do
  begin
    Caption := pWinInfo.sTitle;
    subItems.Add(IntToStr(pWinInfo.hMainWin));
    subItems.Add(IntToStr(pWinInfo.hIncoming));
    subItems.Add(IntToStr(pWinInfo.hOutgoing));
    subItems.Add(IntToStr(pWinInfo.hNickList));
    subItems.Add(sRoomType);
  end;
end;

function GetTitle(aHwnd: Hwnd): String;
begin
  SetLength(Result, 255);
  SetLength(Result, GetWindowText(aHwnd, Pchar(Result), 255));
end;

function GetClass(aHwnd: Hwnd): String;
begin
  SetLength(Result, 255);
  SetLength(Result, GetClassName(aHwnd, Pchar(Result), 255));
end;

Function EnumChildProc(aHwnd: Hwnd; Param: LParam): BOOL; stdcall;
begin
  Result := True;
  if IsWindowVisible(aHwnd) = True then
    case GetDlgCtrlId(aHwnd) of
      202:
        begin
          aPalWinInfo[Pred(Length(aPalWinInfo))].hIncoming := aHwnd;
          Result := False;
        end;
      203:
        begin
          aPalWinInfo[Pred(Length(aPalWinInfo))].hOutgoing := aHwnd;
        end;
      1789:
        begin
          aPalWinInfo[Pred(Length(aPalWinInfo))].hNickList := aHwnd;
          aPalWinInfo[Pred(Length(aPalWinInfo))].bIsRoom := True;
        end;
    end;
end;

function EnumWindowsProc(aHwnd: Hwnd; Param: LParam): BOOL; stdcall;
begin
  Result := True;
  if GetClass(aHwnd) = 'DlgGroupChat Window Class' then
  begin
    if aPalWinInfo <> nil then
      SetLength(aPalWinInfo, Length(aPalWinInfo) + 1)
    else
      SetLength(aPalWinInfo, 1);

    aPalWinInfo[Pred(Length(aPalWinInfo))].sTitle := GetTitle(aHwnd);
    aPalWinInfo[Pred(Length(aPalWinInfo))].hMainWin := aHwnd;

    EnumChildWindows(aHwnd, @EnumChildProc, 0);

  end;
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
var
  I: Integer;
begin
  CleanUp;
  EnumWindows(@EnumWindowsProc, 0);

  for I := Low(aPalWinInfo) to High(aPalWinInfo) do
    AddToListView(aPalWinInfo[I]);

end;

procedure TForm1.CleanUp;
begin
  if aPalWinInfo <> nil then
    aPalWinInfo := Nil;

  lvWinInfo.Clear;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  CleanUp;
end;

Function TForm1.GetPalText(const HwndIncommingText: Hwnd): String;
var
  iLineCount, iLineLength, iLineIndex: Integer;
  szBuffer: array of WideChar;
begin

  if isWindow(HwndIncommingText) = True then
  begin
    iLineCount := Sendmessage(HwndIncommingText, EM_GETLINECOUNT, 0, 0) - 2;
    iLineIndex := Sendmessage(HwndIncommingText, EM_LINEINDEX, iLineCount, 0);
    iLineLength := Sendmessage(HwndIncommingText, EM_LINELENGTH, iLineIndex, 0);

    if iLineLength = 0 then
    begin
      Result := 'Fail Line Length';
      Exit;
    end;

    SetLength(szBuffer, iLineLength);
    Word(szBuffer[0]) := iLineLength;
    Sendmessage(HwndIncommingText, EM_GETLINE, iLineCount, LParam(szBuffer));
    szBuffer[iLineLength] := #0;
    Result := PWidechar(szBuffer);

    szBuffer := Nil;
  end
  else
    Result := 'Fail Hwnd';
end;

procedure TForm1.GetTHISroomsText1Click(Sender: TObject);
begin
  reIncoming.Lines.Add(aPalWinInfo[lvWinInfo.Selected.Index].sTitle + ': ' +
    GetPalText(aPalWinInfo[lvWinInfo.Selected.Index].hIncoming));
end;

procedure TForm1.btnGetAllTextClick(Sender: TObject);
var
  I: Integer;
begin
  reIncoming.Clear;
  for I := 0 to Pred(lvWinInfo.Items.Count) do
    reIncoming.Lines.Add(aPalWinInfo[I].sTitle + ': ' +
      GetPalText(aPalWinInfo[I].hIncoming));
end;

end.