用WM_GETTEXT取SkyPe中文的问题,只能取一部分 用GetWindowTextW也不行(300分)

  • 主题发起人 主题发起人 cxz9
  • 开始时间 开始时间
C

cxz9

Unregistered / Unconfirmed
GUEST, unregistred user!
用WM_GETTEXT取SkyPe中文的问题,只能取一部分
用GetWindowTextW,WideString也不行
取QQ的中文件英文都好好的

2008-1-15 下午 05:27:
测?
2008-1-15 下午 05:28:
[下午 04:52:07] 小笨笨 说?
2008-1-15 下午 05:39:
rwrewrew
下午 03:58:
Skype SMS is fun!
附完整代码:
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RichEdit;
type
TForm2 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
end;

var
Form2: TForm2;
ClassName1: array[0..255] of char;
implementation
{$R *.dfm}
function GetWndText(hWnd: HWND): string;
var
Ret: LongInt;
mText: PChar;
Buf: Integer;
begin
Ret := SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0) + 1;
GetMem(mText, Ret);
try
SendMessage(hWnd, WM_GETTEXT, Ret, LPARAM(mText));
Result := mText;
//WideCharToString(mText);
finally
FreeMem(mText, Ret);
end;
end;

{
function GetWndText(hWnd: HWND): WideString;
begin
// UNICODE &
HANDLE
//SetLength(Result, GetWindowTextLength(hWnd) + 1);
SetLength(Result, SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0) + 1);
GetWindowTextW(hWnd, PWideChar(Result), Length(Result));
SetLength(Result, Length(Result) - 1);
showmessage(Result);
end;
}
{function GetWndText(hWnd: HWND): string;
var
Ret: LongInt;
mText: PChar;
Buf: Integer;
begin
Ret := SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0) + 1;
GetMem(mText, 2 * Ret);
try
SendMessage(hWnd, WM_GETTEXT, 2*Ret, LPARAM(mText));
Result := mText;
//WideCharToString(mText);
finally
FreeMem(mText, Ret);
end;
end;
}
{function GetWndText(hWnd: HWND): string;
var
Ret: LongInt;
mText: PChar;
Buf: Integer;
CopyData: CopyDataStruct;
begin
Ret := SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0) + 1;
GetMem(mText, Ret);
try
//Buf := LongInt(mText);
CopyData.dwData := 0;
CopyData.lpData := nil;
CopyData.cbData := Ret;
//SendMessage(hWnd, WM_GETTEXT, Ret, Buf);
// SendMessage(hWnd, WM_COPYDATA, Ret, Buf);
PostMessage(hWnd, WM_COPYDATA, 0, LPARAM(@CopyData));
showmessage(IntToStr(CopyData.cbData ));
Result := StrPas(CopyData.lpData);
finally
FreeMem(mText, Ret);
end;
end;
}
function EnumProc(wnd: HWND;
lb2: TMemo): BOOL;
stdcall;
var
ClassName2: array[0..255] of char;
tt: TStringList;
begin
Result := True;
GetClassName(wnd, ClassName2, 255);
if (wnd <> 0) and (string(ClassName2) = 'TRichView') then
begin
tt := TStringList.Create;
try
lb2.Lines.Add(IntToHex(wnd, 6) + ':' + string(ClassName2));
tt.Text := GetWndText(wnd);
//lb2.Lines.Add(TT.AnsiStrings.Text);
lb2.Lines.AddStrings(tt);
//lb2.Lines.Add(GetWndText(wnd));
finally
tt.Free;
end;
end;

end;

function EnumWindowsProc(wHandle: HWND;
lb: TMemo): Bool;
stdcall;
export;
var
//Title: array[0..255] of char;
Title: string;
begin
Result := True;
GetClassName(wHandle, ClassName1, 255);
if wHandle <> 0 then
begin
//if string(ClassName1) <> 'CabinetWClass' then
// Title := GetWndText(wHandle);
// if (string(ClassName1) = '#32770') and (Pos('的对话', Title) > 0) then
//wHandle := findwindow('#32770', '鲁博【朋友】与qqeip的对话');
if (string(ClassName1) = 'TskMultiChatForm.UnicodeClass') then
begin
EnumChildWindows(wHandle, @EnumProc, Integer(lb));
end;
end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc, Integer(Memo1));
end;

end.

object Form2: TForm2
Left = 192
Top = 133
Width = 638
Height = 392
Caption = 'Form2'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 8
Top = 16
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 92
Top = 8
Width = 505
Height = 345
Lines.Strings = (
'')
TabOrder = 1
end
end
 
因为中英文的字符有差别,英文当然会好取些了,中文的字符在不同的环境中是不一样长的,
 
顶上 好像文档上说GetWindowTextW就可以的
 
Ret := SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0) + 1;
改为
Ret := SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0) * 2 + 1;
试试。
 
新版本的3.6 已经改为用DirectUIHWND了
Skype uses 'TChatContentControl' for its chat content and MSN Live 'DirectUIHWND' which
这是VB的代码 可以取到 但改为Delphi的却不行
Private Type tGUID
lData1 As Long
nData2 As Integer
nData3 As Integer
abytData4(0 To 7) As Byte
End Type
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, riid As tGUID, ppvObject As Object) As Long
Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, rgvarChildren As Variant, pcObtained As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Dim IID_IAccessible As tGUID
Private Const OBJID_CLIENT As Long = &amp;HFFFFFFFC

Private Sub EnumHistory()
Dim hWnd As Long
Dim hr As Long 'HRESULT
Dim childCount As Long
Dim WindowObject As IAccessible
Dim accChildren() As Variant
Dim nReceived As Long
Dim i As Long
Dim sStr As String

hWnd = FindWindowEx(0, 0, "TskMultiChatForm.UnicodeClass", vbNullString)
If hWnd <> 0 then
hWnd = FindWindowEx(hWnd, 0, "TChatBackground", vbNullString)
If hWnd <> 0 then
hWnd = FindWindowEx(hWnd, 0, "TPanel", vbNullString)
If hWnd <> 0 then
hWnd = FindWindowEx(hWnd, 0, "TPanel", vbNullString)
If hWnd <> 0 then
hWnd = FindWindowEx(hWnd, 0, "TChatContentControl", vbNullString)
If hWnd <> 0 then
hr = AccessibleObjectFromWindow(hWnd, OBJID_CLIENT, IID_IAccessible, WindowObject)
If hr >= 0 then
childCount = WindowObject.accChildCount
ReDim accChildren(childCount - 1)
If childCount > 0 then
hr = AccessibleChildren(WindowObject, 0, childCount, accChildren(0), nReceived)
If hr >= 0 then
sStr = ""

For i = 0 To nReceived - 1
If TypeOf accChildren(i) Is IAccessible then
Debug.Print "Found object: " &amp;
accChildren(i).accName(0) &amp;
vbCr
sStr = sStr &amp;
accChildren(i).accName(0) &amp;
vbCr
else
Debug.Print "Found object:" &amp;
"(" &amp;
i &amp;
"," &amp;
nReceived &amp;
")" &amp;
WindowObject.accName(accChildren(i)) &amp;
vbCr
sStr = sStr &amp;
WindowObject.accName(accChildren(i)) &amp;
vbCr
End If
Next i
MsgBox sStr
else
Debug.Print "Accessible Chilren failed with code: " &amp;
hr
End If
End If
else
Debug.Print "AccessibleObjectFromWindow failed with code: " &amp;
hr
End If
else
Debug.Print "Could not find TChatContentControl"
End If
else
Debug.Print "Could not find TPanel #2"
End If
else
Debug.Print "Could not find TPanel #1"
End If
else
Debug.Print "Could not find the TChatBackground class"
End If
else
Debug.Print "Could not find a chat window"
End If
End Sub
Private Sub Form_Load()
With IID_IAccessible
.lData1 = &amp;H618736E0
.nData2 = &amp;H3C3D
.nData3 = &amp;H11CF
.abytData4(0) = &amp;H81
.abytData4(1) = &amp;HC
.abytData4(2) = &amp;H0
.abytData4(3) = &amp;HAA
.abytData4(4) = &amp;H0
.abytData4(5) = &amp;H38
.abytData4(6) = &amp;H9B
.abytData4(7) = &amp;H71
End With

EnumHistory
End Sub
 
那可能是你改错了.
 
后退
顶部