[Delphi] Paltalk Class

Heres the place all related to Programming in Delphi

[Delphi] Paltalk Class

Postby Departure » Sat Sep 27, 2014 7:18 am

here is some coding I have been working, its not completely finished but its still very functional, feel free to use it in your projects, The only condition is that if you improve the code you send me the improvements. This way it can only get better, sharing is the way of the future... and the future is now.

Code: Select all
{ ============================================================================
  * Unit  : clsPaltalk                                                       *
  * Author: Departure                                                        *
  * Date  : 14/07/2013                                                       *
  ============================================================================ }
unit clsPaltalk;

interface

uses
  Windows, Classes, System.SysUtils,
  System.Generics.Collections, ComCtrls, commctrl, Messages, StrUtils, Dialogs;

{ TPalWindow Class, Holds Info for each Paltalk Window Handle }
Type
  TPalWindow = Class
  Private
    FsTitle: String;
    FhMain: Hwnd;
    FhIncoming: Hwnd;
    FhOutgoing: Hwnd;
    FhNickList: Hwnd;
    FbIsRoom: Boolean;
  Public
    // ================= Property's ================= //
    Property MainTitle: String read FsTitle;
    Property MainHwnd: Hwnd read FhMain;
    Property IncomingTextHwnd: Hwnd read FhIncoming;
    Property OutgoingTextHwnd: Hwnd read FhOutgoing;
    Property NickListHwnd: Hwnd read FhNickList;
    Property IsRoom: Boolean read FbIsRoom;
    // ============ Functions & Procedures =========== //
    Function GetText: String;
    Function MainHwndToString: String;
    Function IncomingTextHwndToString: String;
    Function OutgoingTextHwndToString: String;
    Function NickListHwndToString: String;
    Procedure SendText(aMsg: AnsiString);
    Procedure SendPalRTF(aRichEdit: TRichedit);
    Procedure GetNickList(AList: TStringList);
    // ============== Create / Destroy =============== //
    Constructor Create;
    Destructor Destroy; Override;
  End;

  { TPaltalkList Class, Holds A List of TPalWindows
    Calls EnumWindows and adds each TPalWindow to it's Self }
Type
  TPaltalkList = Class(TObjectList<TPalWindow>)
  Private
    // ============ Functions & Procedures =========== //
    Function GetWindowTitle(Hwnd: Hwnd): string;
    Function GetWindowClass(Hwnd: Hwnd): string;
    Procedure GetWindows;
  Public
    // ============== Create / Destroy =============== //
    Constructor Create;
    Destructor Destroy; Override;
    Procedure UpdateList;
  End;

Type
  PalCmd = (REMOVE_HANDS = 32995, REMOVE_MICS = 32996, GIVE_MICS = 32997,
    ADMIN_CONSOLE = 32998, BOUNCE = 32947, REDDOT = 32946, LOWER_HAND = 32950,
    VOICE_ACTIVATED = 33344, PUSH_TALK = 33343, LOCK_MIC = 33340,
    FREEZE_TEXT = 210, ROOM_IGNORE = 33003, ROOM_START_PM = 32901,
    ROOM_ADD_USER = 32898, ROOM_BLOCK_USER = 33381, INVIT_USERS = 32989,
    INSERT_NICK = 33379, EXIT_ROOM = 32849);

implementation

{ TPalWindow }

constructor TPalWindow.Create;
begin
  inherited;
  Self.FsTitle := '';
  Self.FhMain := 0;
  Self.FhIncoming := 0;
  Self.FhOutgoing := 0;
  Self.FhNickList := 0;
  Self.FbIsRoom := False;
end;

Destructor TPalWindow.Destroy;
begin
  inherited;
end;

procedure TPalWindow.GetNickList(AList: TStringList);
Var
  iCount, i: integer;
  lvItem: LV_ITEM;
  plvRemoteItem: ^LV_ITEM;
  pszItemText: PChar;
  pszRemoteItemText: PChar;
  nReadWritten: SIZE_T;
  ProcessHND: THandle;
  PID: DWORD;
  stResult: string;
const
  ITEM_BUFFER: integer = $4000;

begin
  pszItemText := #0;
  pszRemoteItemText := #0;
  plvRemoteItem := @lvItem;

  if NickListHwnd = 0 then
    exit;
  GetWindowThreadProcessId(NickListHwnd, @PID);
  ProcessHND := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
    PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION, False, PID);
  try
    pszItemText := AllocMem(ITEM_BUFFER);
    FillMemory(addr(lvItem), sizeof(LV_ITEM), 0);
    plvRemoteItem := VirtualAllocEx(ProcessHND, nil, sizeof(LV_ITEM),
      MEM_COMMIT, PAGE_READWRITE);
    pszRemoteItemText := VirtualAllocEx(ProcessHND, nil, ITEM_BUFFER,
      MEM_COMMIT, PAGE_READWRITE);

    iCount := sendmessage(NickListHwnd, LVM_GETITEMCOUNT, 0, 0);
    dec(iCount);
    lvItem.cchTextMax := ITEM_BUFFER;
    lvItem.iSubItem := 0;
    lvItem.pszText := pszRemoteItemText;
    stResult := '';
    for i := 0 to iCount do
    begin
      if (not WriteProcessMemory(ProcessHND, plvRemoteItem, addr(lvItem),
        sizeof(LV_ITEM), nReadWritten)) then
        showmessage(inttostr(getLastError));
      sendmessage(NickListHwnd, LVM_GETITEMTEXT, WPARAM(i),
        LPARAM(plvRemoteItem));
      if (not ReadProcessMemory(ProcessHND, pszRemoteItemText, pszItemText,
        ITEM_BUFFER, nReadWritten)) then
        showmessage(inttostr(getLastError));
      stResult := stResult + strpas(pszItemText);
      AList.Append(pszItemText);
    end;
  finally
    FreeMem(pszItemText);
    VirtualFreeEx(ProcessHND, pszRemoteItemText, 0, MEM_RELEASE);
    VirtualFreeEx(ProcessHND, plvRemoteItem, 0, MEM_RELEASE);
  end;

end;

function TPalWindow.GetText: String;
var
  iLineCount, iLineLength, iLineIndex: integer;
  szBuffer: array of Char;
begin
  Result := '';
  iLineCount := 0;
  iLineLength := 0;
  iLineIndex := 0;

  if IncomingTextHwnd <> 0 then
  begin
    iLineCount := sendmessageW(IncomingTextHwnd, EM_GETLINECOUNT, 0, 0);
    iLineIndex := sendmessageW(IncomingTextHwnd, EM_LINEINDEX, iLineCount - 2, 0);
    iLineLength := sendmessageW(IncomingTextHwnd, EM_LINELENGTH, iLineIndex, 0);
    if iLineLength = 0 then
      exit;
    SetLength(szBuffer, Pred(iLineLength));
    szBuffer[0] := Char(iLineLength);
    sendmessageW(IncomingTextHwnd, EM_GETLINE, iLineCount - 2, LPARAM(szBuffer));
    Result := Trim(PChar(szBuffer));
    szBuffer := Nil;
  end;
end;

function TPalWindow.IncomingTextHwndToString: String;
begin
  Result := inttostr(Self.IncomingTextHwnd);
end;

function TPalWindow.MainHwndToString: String;
begin
  Result := inttostr(Self.MainHwnd);
end;

function TPalWindow.NickListHwndToString: String;
begin
  Result := inttostr(Self.NickListHwnd);
end;

function TPalWindow.OutgoingTextHwndToString: String;
begin
  Result := inttostr(Self.OutgoingTextHwnd);
end;

procedure TPalWindow.SendPalRTF(aRichEdit: TRichedit);
var
  memStream: TMemoryStream;
  strList: TStringList;
begin
    memStream := TMemoryStream.Create;
    strList := TStringList.Create;
    try
      memStream.Clear;
      aRichEdit.Lines.SaveToStream(memStream);
      memStream.Position := 0;
      strList.Clear;
      strList.LoadFromStream(memStream);
      SendText(AnsiString(strList.Text));
    finally
      memStream.Free;
      strList.Free;
    end;
end;

procedure TPalWindow.SendText(aMsg: AnsiString);
var
  start_pos, end_pos, txt_len: integer;
begin
  start_pos := 0;
  end_pos := 0;
  txt_len := 0;

  if OutgoingTextHwnd <> 0 then
  begin
    txt_len := SendMessageW(OutgoingTextHwnd, WM_GETTEXTLENGTH, 0, 0);
    If txt_len > 0 Then
    begin
      SendMessageW(OutgoingTextHwnd, EM_GETSEL, start_pos, end_pos);
      SendMessageW(OutgoingTextHwnd, EM_SETSEL, 0, txt_len);
      SendMessageW(OutgoingTextHwnd, WM_CUT, 0, 0);
      SendMessageW(OutgoingTextHwnd, WM_SETTEXT, 0, LPARAM(aMsg));
      PostMessageW(OutgoingTextHwnd, WM_KEYDOWN, VK_RETURN, 0);
      PostMessageW(OutgoingTextHwnd, WM_KEYUP, VK_RETURN, 0);
      Sleep(100);
      SendMessageW(OutgoingTextHwnd, WM_PASTE, 0, 0);
      SendMessageW(OutgoingTextHwnd, EM_SETSEL, txt_len, txt_len);
    end
    else
    begin
      SendMessageW(OutgoingTextHwnd, WM_SETTEXT, 0, LPARAM(aMsg));
      PostMessageW(OutgoingTextHwnd, WM_KEYDOWN, VK_RETURN, 0);
      PostMessageW(OutgoingTextHwnd, WM_KEYUP, VK_RETURN, 0);
    end
  end;
end;

{ TPaltalkList }
Constructor TPaltalkList.Create;
begin
  inherited;
  Self.OwnsObjects := True;
  // Self.GetWindows;
end;

Destructor TPaltalkList.Destroy;
begin
  inherited;
end;

function EnumChildProc(aHwnd: Hwnd; Param: LPARAM): Bool; stdcall;
var
  WindowInfo: TPalWindow;
begin
  Result := True;

  if IsWindowVisible(aHwnd) = True then
  begin
    WindowInfo := TPalWindow(Param);
    case GetDlgCtrlID(aHwnd) of
      202:
        begin
          WindowInfo.FhIncoming := aHwnd;
          Result := False;
        end;
      203:
        begin
          WindowInfo.FhOutgoing := aHwnd;
        end;
      1789:
        begin
          WindowInfo.FhNickList := aHwnd;
          WindowInfo.FbIsRoom := True;
        end;
    end;
  end;
end;

function EnumWindowsProc(aHwnd: Hwnd; Param: LPARAM): Bool; stdcall;
var
  WindowInfo: TPalWindow;
  WindowList: TPaltalkList;
begin
  Result := True;

  WindowList := TPaltalkList(Param);
  if WindowList.GetWindowClass(aHwnd) = 'DlgGroupChat Window Class' then
  begin
    WindowInfo := TPalWindow.Create;
    Try
      WindowInfo.FhMain := aHwnd;
      WindowInfo.FsTitle := WindowList.GetWindowTitle(aHwnd);
      WindowList.Add(WindowInfo);
      EnumChildWindows(aHwnd, @EnumChildProc, LPARAM(WindowInfo));
    Finally
      Result := Boolean(Param);
    End;
  end;
end;

function TPaltalkList.GetWindowClass(Hwnd: Hwnd): string;
begin
  SetLength(Result, 255);
  SetLength(Result, GetClassName(Hwnd, PChar(Result), 255));
end;

procedure TPaltalkList.GetWindows;
begin
  EnumWindows(@EnumWindowsProc, LPARAM(Self));
end;

function TPaltalkList.GetWindowTitle(Hwnd: Hwnd): string;
begin
  SetLength(Result, 255);
  SetLength(Result, GetWindowText(Hwnd, PChar(Result), 255));
end;

procedure TPaltalkList.UpdateList;
begin
  if Self.Count > 0 then
    Self.DeleteRange(0, Self.Count);

  Self.Clear;
  Self.GetWindows;
end;

end.
Departure
Dutchplace_Mod
Dutchplace_Mod
 
Posts: 130
Joined: Sun Jun 24, 2007 2:24 pm

Return to Delphi

Who is online

Users browsing this forum: No registered users and 1 guest

cron