syslistview32 的一些高级应用技巧

问题:得到了syslistview32 类句柄如何获其内容?并定位到某一行? ( 积分: 200 )
分类:数据库-文件型
 
来自:fbi9999, 时间:2005-09-30 14:04:00, ID:3224504

得到了syslistview32 类句柄如何获其内容?并定位到某一行?

来自:suninrain, 时间:2005-09-30 14:30:36, ID:3224559

看看下面这个能不能帮你的忙
---------------------------
1.根据StringGrid组件的句柄,想直接通过消息如WM_GETTEXT等来获取StringGrid的内容,显然不可行,普通的Windows消息不能直接获取到某个Cell的内容,TStringGrid并不是Windows的组件,而是Delphi自己的组件,它的Cell内容是存放在TStrings列表中的。
2.根据鼠标所在的位置,通过屏幕取词的技术,是可以Hook到鼠标下的某个Cell的内容,但在实际应用中也不可行,因为不是所有想Hook的Cell都是在显示区可见的,而ApiHook的屏幕取词技术要求Cell的文本重画,才能取得其内容。

既然上面两种方法都不可行,那么我们就要寻找新的方法。
1.思考
由于StringGrid是Delphi自写的组件,而不是Windows的控件,因此要获取StringGrid的某个Cell的内容,只能是获取到StringGrid的对象实例,才能以StringGrid.Cell[X, Y]这样的方式取得任意Cell的内容。
2.启发
在Delphi中,在自己的程序中,用FindControl,是可以根据组件对象的句柄获得对象实例的。那么我们在Hook其他程序的时候能不能采用这种方法来获取StringGrid对象的实例呢?这有个问题,即使我们能够获取到StringGrid的对象实例,但是返回的实例地址是个在其他程序进程地址空间的私有地址(<2GB),这在我们的程序中是无法进行访问的。这个问题不难解决,屏幕取词技术不也是截获到了其他程序的屏幕输出文本吗!?
3.实现
有了上面的思考和启发,那我们就能整理出一个思路来啦。
a.写一个DLL,将Hook StringGrid的代码都放在DLL中,在DLL中,还要包括GetMessage钩子的代码,目的是为了能通过全局钩子将DLL注入到目标程序,使Hook StringGrid的代码运行在目标进程中,这样就可以正确使用FindControl返回的StringGrid实例(也只有在目标进程内调用FindControl,才能够返回StringGrid实例地址)。
b.注入到目标进程的Hook功能,我们怎么进行控制呢?我们怎么让Hook代码知道我们要Hook哪个Cell的内容?怎么询问得知目标StringGrid的行数、列数,以进行正确的遍历获取Cell?... 通过内存映射进行Hook DLL和主程序的数据共享,就可以啦。不过这样实用时不是很方便,因为需要在目标进程中执行Hook代码,显然不能直接调用Hook DLL中的函数,在GetMessage钩子回调函数中来做,也不是很妥当,控制不方便。最好的方法就是在目标进程中创建一个隐形窗口,在该隐形窗口的消息处理中作文章。我们可以通过发送消息的方式通知隐形窗口,执行Hook代码。OK!
c.按照上面的思路,我编写了HookSG.dll和测试程序,不过并没有Hook得到想要的结果。是哪里出了问题呢?分析上面的流程,最大的可能就是FindControl并返回实际的StringGrid对象实例,否则,后面的StringGrid.Cells[X, Y]这样的获取Cell内容的代码是断不会有问题的,我也能够确认Hook的代码是在目标进程中执行的。查看FindControl的源代码:
function FindControl(Handle: HWnd): TWinControl;
var
 OwningProcess: DWORD;
begin
 Result := nil;
 if (Handle <> 0) and (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
    (OwningProcess = GetCurrentProcessId) then // 都进行了判断调用进程ID是否为Handle所在进程
 begin
   if GlobalFindAtom(PChar(ControlAtomString)) = ControlAtom then
     Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)))
   else
     Result := ObjectFromHWnd(Handle);
 end;
end;
function ObjectFromHWnd(Handle: HWnd): TWinControl;
var
 OwningProcess: DWORD;
begin
 if (GetWindowThreadProcessID(Handle, OwningProcess) <> 0) and
    (OwningProcess = GetCurrentProcessID) then
   Result := Pointer(SendMessage(Handle, RM_GetObjectInstance, 0, 0))
 else
   Result := nil;
end;
再看InitControls中:
procedure InitControls;
var
 UserHandle: HMODULE;
begin
 WindowAtomString := Format('Delphi%.8X',[GetCurrentProcessID]);
 WindowAtom := GlobalAddAtom(PChar(WindowAtomString));
 ControlAtomString := Format('ControlOfs%.8X%.8X', [HInstance, GetCurrentThreadID]);
 ControlAtom := GlobalAddAtom(PChar(ControlAtomString));
 RM_GetObjectInstance := RegisterWindowMessage(PChar(ControlAtomString));
 ...
end;
问题就在这里啦。ControlAtomString是根据模块句柄(模块加载基地址)和线程ID动态生成的,目标进程的模块基地址就是EXE基地址,一般是0x00400000,但DLL的模块加载基地址就不是这个了,默认是0x10000000,而实际上可能因为这个地址已经被占用(有其他DLL被加载到这个地址)而进行重定位,所以初始化时添加的Atom和目标进程的ControlAtom就不一样,FindControl当然就不能找到StringGrid对象实例啦。
清楚了这一点,解决起来就简单了,我们自己写个FindControl函数,以目标进程基地址来动态生成ControlAtomString,添加ControlAtom不就可以啦。在DLL中取EXE的基地址,用GetModuleHandle(nil)即可。
OK。解决了这些问题,Hook其他程序的StringGrid的内容就水到渠成,没什么障碍啦。

补充:
上面提到的方法,不仅仅可以Hook其他程序的StringGrid的内容,实际上还可以获取更多的从TWinControl继承的窗口组件的内容、属性、...,拥有了对象的实例,你基本上就拥有了对对象的完全控制。

源代码:



2004-12-31 14:14:26    
发表评语&raquo;&raquo;&raquo;    

2004-12-31 14:27:25    不知道怎么贴上附件。给个下载地址吧:http://www.jpdocomo.com/lichengbin/HookSG.zip


2005-1-3 16:43:20    说明:
HookSG.EXE/SG.EXE都是Test.dpr编译得到,SG.EXE是被Hook的程序(编译时Hook按钮的Enabled设为False,避免操作乱套),HookSG.EXE是Hook主程序。
测试:
启动HookSG.EXE、SG.EXE,将SG.EXE中Handle编辑框的内容复制到HookSG.EXE的Handle编辑框中,点击Hook按钮,当HookSG.EXE程序的Row/Col、Cell[X,Y]按钮激活之后说明HookSG.dll已经成功注入SG.EXE的进程,隐形窗口也已经被创建,HookSG.EXE获取SG.EXE中的StringGrid页的StringGrid的任意Cell内容的功能已经具备。Row/Col按钮为查询StringGrid的行列数目,Cell[X,Y]为获取Row/Column对应Cell的内容。


2005-1-4 11:51:49    重新更新了一下,测试时比以前方便直观一些啦。
http://www.jpdocomo.com/lichengbin/HookSG(New).zip  


2005-1-11 14:09:24    补充:
运用这种技术,实际上能够做到的远不止此!甚至可以Hook到其他程序中Form上的任意继承自TWinControl的窗口组件(有句柄)或其他非窗口组件(无句柄、可视或不可视)的内容,如以前DFW好象有个贴子就是问然后Hook其他程序的Label的内容的。要实现上面所说的,只要知道被Hook的Form的定义即可,而通常Delphi创建的程序,Form都会在EXE的资源部分,只需要通过一些资源查看工具提取出资源中Form定义内容即可。有了窗体的定义,我们在Hook DLL中同样声明一个这样的定义。如
type
 TFormHack = class(TForm)
   Label1: TLabel;
   Button1: TButton;
   Label2: TLabel;
   Memo1: TMemo;
 end;
这样我们通过FindControl找到Form的对象实例Form1,然后只需象TFormHack(Form1).Label1这样,就可以获取到Label1的实例啦。
另外,实际上我们也可以通过Form1.Components记录的Form1上的组件列表来进行Form1上的组件遍历,这种方式同样也可以得到Form1上的任意组件的实例。


2005-2-2 18:00:01    原存放域名2月份将到期,原源代码下载地址不再有效,请到新的下载地址进行下载:
<A HREF="http://lichengbin.iii-grp.com/HookSG.zip">HookSG初版</A>,  <A HREF="http://lichengbin.iii-grp.com/HookSG(New).zip">HookSG改进版</A>

来自:fbi9999, 时间:2005-09-30 15:10:01, ID:3224655

to suninrain:
多谢你,好像太深奥了.可能我是菜鸟吧.我要如何改你的程序才能为我所用呀?
在HookSG(New).zip源代码里
我改了按钮"hook"里面的代码.加了destwnd:=2558916;
点击按钮"Cell[X,Y]"后却说我"索引超界了"为何? 我的syslistview32类里明明有三行六列内容呀.句柄是没错的.

注:其实我取的东西是中游游戏房间的syslistview32类.里面是游戏玩家的信息

来自:lichengbin, 时间:2005-09-30 15:20:40, ID:3224677

上面那个只能获取Delphi开发的程序的

刘麻子大虾的,试试

uses CommCtrl;

function ListView_GetItemText_Ex(hwndLV: HWND; i, iSubItem: Integer;
 pszText: PChar; cchTextMax: Integer): Integer;
var
 LVItem: TLVItem;
 ProcessID, ProcessHD, Temp: DWORD;
 MemPoint: Pointer;
begin
 GetWindowThreadProcessId(hwndLV, ProcessID);

 ProcessHD := OpenProcess(
   PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE,
   FALSE, ProcessID);

 MemPoint := VirtualAllocEx(ProcessHD, nil, SizeOf(TLVItem) + cchTextMax,
   MEM_COMMIT, PAGE_READWRITE);

 LVItem.iSubItem := iSubItem;
 LVItem.cchTextMax := cchTextMax;
 LVItem.pszText := PChar(Integer(MemPoint) + SizeOf(TLVItem));
   
 WriteProcessMemory(ProcessHD, MemPoint, @LVItem, SizeOf(TLVItem), Temp);
 Result := SendMessage(hwndLV, LVM_GETITEMTEXT, i, Integer(MemPoint));

 ReadProcessMemory(ProcessHD, Pointer(Integer(MemPoint) + SizeOf(TLVItem)),
   pszText, cchTextMax, Temp);

 VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TLVItem) + cchTextMax, MEM_DECOMMIT);  
 VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 TextBuffer: array[0..100] of Char;
begin
 ListView_GetItemText_Ex($01590346, 0, 0, TextBuffer, 100);
 ShowMessage(TextBuffer);
end;
至于定位,用LVM_SETITEMSTATE消息同理应用即可

来自:fbi9999, 时间:2005-09-30 15:35:48, ID:3224698

to lichengbin:
多谢.成功获得信息了.我的SysListView32类的句柄是通过第三方工具获得的.我自己编的以下两行代码为什么不能获取SysListView32类句柄?请能再指点我一下吗?

hparent:=findwindow('clientframe_cmainframe',nil);
hparent:= FindWindowEx(hparent,0,'SysListView32','list1');

//SysListView32类是clientframe_cmainframe类里的组件.clientframe_cmainframe类就是中游的游戏房间.

来自:lichengbin, 时间:2005-09-30 17:43:42, ID:3224849

那可能这个SysListView32控件不是clientframe_cmainframe的直接子窗口呗

来自:fbi9999, 时间:2005-10-01 11:47:35, ID:3224859

to lichengbin and to 大家:
  如何定位行?我用LVM_SETITEMSTATE替换原来的LVM_GETITEMTEXT却不行. 分我会照给诸位的.

来自:cpjin, 时间:2005-10-01 15:06:00, ID:3225090

取句柄
GetCursorPos(Poss);
Handle := WindowFromPoint(Poss);
HandleEdit.Text := IntToStr(Handle);
GetClassName(Handle, Buf, 1024);
ClassEdit.Text := Buf;
SendMessage(Handle, WM_GETTEXT, 1024, Integer(@Buf));
TextEdit.Text := Buf;
s:=TextEdit.Text;

来自:fbi9999, 时间:2005-10-01 16:15:58, ID:3225110

to 大家:
定位到某一行问题,我已解决了.代码如下,但如何能发鼠标右键消息过去那一行?或获得那一行坐标值?

uses CommCtrl;
{$R *.dfm}

function ListView_GetItemText_Ex(hwndLV: HWND; i, iSubItem: Integer;
 pszText: PChar; cchTextMax: Integer): Integer;
var
 LVItem: TLVItem;
 ProcessID, ProcessHD, Temp: DWORD;
 MemPoint: Pointer;
begin
 GetWindowThreadProcessId(hwndLV, ProcessID);


 ProcessHD := OpenProcess(
   PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE,
   FALSE, ProcessID);

 MemPoint := VirtualAllocEx(ProcessHD, nil, SizeOf(TLVItem) + cchTextMax,
   MEM_COMMIT, PAGE_READWRITE);

lvitem.state:=LVIS_SELECTED;
lvitem.stateMask:=LVIS_SELECTED;
WriteProcessMemory(ProcessHD, MemPoint,@LVItem,SizeOf(TLVItem), Temp);
SendMessage(hwndLV, LVM_SETITEMSTATE,i, Integer(MemPoint));


 VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TLVItem) + cchTextMax, MEM_DECOMMIT);  
 VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);

end;

procedure TForm1.Button1Click(Sender: TObject);
var
 TextBuffer: array[0..100] of Char;
begin
  ListView_GetItemText_Ex(984608,10, 0, TextBuffer, 100);

end;

来自:刘麻子, 时间:2005-10-01 17:07:39, ID:3225140

先贴一些代码片断,仅供参考:

 // 扩展的ListView项目选取函数
function ListView_SetItemState_Ex(hwndLV: HWND; i: Integer; data, mask: UINT): Bool;
var          
 LVItem: TLVItem;
 ProcessID, ProcessHD, Temp: DWORD;
 MemPoint: Pointer;
begin
 GetWindowThreadProcessId(hwndLV, ProcessID);

 ProcessHD := OpenProcess(
   PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, FALSE, ProcessID);

 MemPoint := VirtualAllocEx(ProcessHD, nil, SizeOf(TLVItem), MEM_COMMIT, PAGE_READWRITE);

 LVItem.stateMask := mask;
 LVItem.state := data;
 WriteProcessMemory(ProcessHD, MemPoint, @LVItem, SizeOf(TLVItem), Temp);

 Result := (SendMessage(hwndLV, LVM_SETITEMSTATE, i, Integer(MemPoint)) <> 0);

 VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TLVItem), MEM_DECOMMIT);
 VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);
end;

 // 扩展的ListView项目读取函数
function ListView_GetItemText_Ex(hwndLV: HWND; i, iSubItem: Integer;
 pszText: PChar; cchTextMax: Integer): Integer;
var
 LVItem: TLVItem;
 ProcessID, ProcessHD, Temp: DWORD;
 MemPoint: Pointer;
begin
 GetWindowThreadProcessId(hwndLV, ProcessID);

 ProcessHD := OpenProcess(
   PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE,
   FALSE, ProcessID);

 MemPoint := VirtualAllocEx(ProcessHD, nil, SizeOf(TLVItem) + cchTextMax,
   MEM_COMMIT, PAGE_READWRITE);

 LVItem.iSubItem := iSubItem;
 LVItem.cchTextMax := cchTextMax;
 LVItem.pszText := PChar(Integer(MemPoint) + SizeOf(TLVItem));

 WriteProcessMemory(ProcessHD, MemPoint, @LVItem, SizeOf(TLVItem), Temp);
 Result := SendMessage(hwndLV, LVM_GETITEMTEXT, i, Integer(MemPoint));

 ReadProcessMemory(ProcessHD, Pointer(Integer(MemPoint) + SizeOf(TLVItem)),
   pszText, cchTextMax, Temp);

 VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TLVItem) + cchTextMax, MEM_DECOMMIT);
 VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);
end;

 // 扩展的TreeView_GetItem (取得TreeView指定子项目)
function TreeView_GetItem_Ex(hwndTV: HWND; var TVItem: TTVItem): Bool;
var
 ProcessID, ProcessHD, Temp: DWORD;
 pszText, MemPoint: Pointer;
begin
 Result := FALSE;

 GetWindowThreadProcessId(hwndTV, ProcessID);

 ProcessHD := OpenProcess(
   PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, FALSE, ProcessID);
 if (ProcessHD = 0) then Exit;

 MemPoint := VirtualAllocEx(ProcessHD, nil,
   SizeOf(TTVItem) + TVItem.cchTextMax + 1,
   MEM_COMMIT, PAGE_READWRITE);
 if (MemPoint = nil) then Exit;

 pszText := TVItem.pszText; // 保存本进程地址
 PChar(pszText)^ := #0;
 TVItem.pszText := PChar(Integer(MemPoint) + SizeOf(TTVItem));
 if (WriteProcessMemory(ProcessHD, MemPoint, @TVItem, SizeOf(TVItem), Temp) = FALSE) then Exit;
 if (WriteProcessMemory(ProcessHD, TVItem.pszText, pszText, 1, Temp) = FALSE) then Exit;

 Result := (SendMessage(hwndTV, TVM_GETITEM, 0, LongInt(MemPoint)) <> 0);

 if (ReadProcessMemory(ProcessHD, TVItem.pszText, pszText, TVItem.cchTextMax + 1, Temp) = FALSE) then
 begin
   Result := FALSE;
   Exit;
 end;
 TVItem.pszText := pszText; // 恢复本进程地址

 VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TTVItem) + TVItem.cchTextMax + 1, MEM_DECOMMIT);
 VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);
end;

 // 取指定TreeView子项目文字
function TreeView_GetItem_Text(hwndTV: HWND; hitem: HTreeItem): string;
var
 Buffer: array[0..50] of Char;
 TVItem: TTVItem;
begin
 TVItem.hItem := hitem;
 TVItem.mask := TVIF_TEXT;
 TVItem.pszText := @Buffer[0];
 TVItem.cchTextMax := 50;

 if TreeView_GetItem_Ex(hwndTV, TVItem) then
   Result := Buffer
 else
   Result := '';
end;

 // 扩展的ListView_FindItem
function ListView_FindItem_Ex(hwndLV: HWND; iStart: Integer; var LVFindInfo: TLVFindInfo): Integer;
var
 ProcessID, ProcessHD, Temp: DWORD;
 psz, MemPoint: Pointer;
begin
 Result := -1; // 默认查找失败

 GetWindowThreadProcessId(hwndLV, ProcessID);

 ProcessHD := OpenProcess(
   PROCESS_VM_OPERATION or PROCESS_VM_READ or PROCESS_VM_WRITE, FALSE, ProcessID);
 if (ProcessHD = 0) then Exit;

 MemPoint := VirtualAllocEx(
   ProcessHD, nil, SizeOf(TLVFindInfo) + StrLen(LVFindInfo.psz) + 1, MEM_COMMIT, PAGE_READWRITE);
 if (MemPoint = nil) then Exit;

 psz := LVFindInfo.psz; // 保存本进程地址
 LVFindInfo.psz := PChar(Integer(MemPoint) + SizeOf(TLVFindInfo));
 if (WriteProcessMemory(ProcessHD, MemPoint, @LVFindInfo, SizeOf(TLVFindInfo), Temp) = FALSE) then Exit;
 if (WriteProcessMemory(ProcessHD, LVFindInfo.psz, psz, StrLen(psz) + 1, Temp) = FALSE) then Exit;

 Result := SendMessage(hWndLv, LVM_FINDITEM, iStart, LongInt(MemPoint));

 LVFindInfo.psz := psz; // 恢复本进程地址

 VirtualFreeEx(ProcessHD, MemPoint, SizeOf(TLVFindInfo) + StrLen(psz) + 1, MEM_DECOMMIT);
 VirtualFreeEx(ProcessHD, MemPoint, 0, MEM_RELEASE);
end;

来自:leosoft, 时间:2005-10-01 17:13:23, ID:3225145

都是高手啊,长见识!

来自:刘麻子, 时间:2005-10-01 17:17:08, ID:3225149

右键消息,应该可以直接发给ListView控件,求坐标值则可以试试LVM_GETITEMPOSITION,注意地址也需要是目标进程的..

问题讨论没有结束 ...

Posted in 软件开发 at September 26, 2006. by 傻猫 .    Views: 5360    No Comments

SQL 字符替换语句

替换“详细地址”中含有 “桂王桥西街66号”的字符为“桂王桥西街七家巷2号

update aipu_main set 详细地址=REPLACE(详细地址,'桂王桥西街66号','桂王桥西街七家巷2号') where 详细地址 like '%桂王桥西街66号%'

Posted in 软件开发 at September 26, 2006. by 傻猫 .    Views: 3365    No Comments

最近比较烦

最近比较烦,很快又要到年底了,今年又有什么收获呢? 突然觉得今年过的好快,一晃就过了多半了,事情太多,烦心的事也很多。

希望烦恼快快过去,每一天都开心,工作顺利,生意兴隆。

Posted in 我的生活 at September 25, 2006. by 傻猫 .    Views: 3800    1 Comment

让你Maxthon也使用Gecko核心

要想Maxthon浏览器使用Gecko核心,首先你必须给Maxthon浏览器安装一个名为Mozilla ActiveX Control的插件,这样它才能真正调用Gecko核心。在安装时最好选择默认路径,然后重启Maxthon浏览器,点击“文件” - “新建” - “使用Gecko核心”选项后,重启Maxthon浏览器就可以更换为Gecko核心了,而且只需一次设置即可,只要以后不取消“使用Gecko核心”前面的对勾,Maxthon浏览器就会一直使用该核心。

  Gecko虽然在速度和安全方面有所提升,但是在使用Gecko核心上还存在很多问题。

  Gecko核心是Mozilla, Firefox以及早先的网景浏览器所使用的内核。由于目前大多数网页在制作的时候都是以针对IE浏览器设定的规范来开发的,所以在使用Gecko核心浏览这些网页时就会因不兼容造成显示错误或某些功能失效的情况。

  可能是在开发者开发Gecko核心的时候还没有出现鼠标滚轮横行天下的局面,Gecko核心还不支持鼠标滚轮,并且还不能使用超级拖放等功能。

Posted in 杂七杂八 at September 15, 2006. by 傻猫 .    Views: 2552    No Comments

南合文斗 - 让泪化作相思雨

↑↑↑↑点击播放

 南合文斗 - 让泪化作相思雨

作曲:崔文斗 作词:崔文斗

这是一片很寂寞的天,下着有些伤心的雨
这是一个很在乎的我和一个无所谓的结局
曾经为了爱而努力,曾经为了爱而逃避
逃避那熟悉的往事,逃避那陌生的你

这是一片很寂寞的天,下着有些伤心的雨
这是一个很在乎的我和一个无所谓的结局
再也不知道你的消息,再也不知道你的秘密
只有那熟悉的往事,只有那陌生的你

在那些黑色和白色的梦里
不再有蓝色和紫色的记忆
在这个相遇又分手的年纪
只留下雨打风吹的痕迹

为了那苍白的爱情的继续
为了那得到又失去的美丽
就让这擦干又流出的泪水
化作漫天相思的雨

Posted in 休闲娱乐 at September 14, 2006. by 傻猫 .    Views: 2615    No Comments

How to use a dialog window to select a folder

You can accomplish this without using a TOpenDialog component. First, add FileCtrl to the Uses. Now the SelectDirectory function can be used. Drop a TButton component on your Form. Place the following code in the button's onClick event to get a demonstration of how this function works:

~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button1Click(Sender: TObject) ;
const
     SELDIRHELP = 1000;
var
   dir: String;
begin
   dir := 'C:';
   if SelectDirectory(
        dir,
        [sdAllowCreate,
        sdPerformCreate,
        sdPrompt],
        SELDIRHELP
      ) then
     Button1.Caption := dir;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~

Posted in 软件开发 at September 12, 2006. by 傻猫 .    Views: 2888    No Comments

How to add a button to the IE Toolbar

From Zarko Gajic,
Your Guide to Delphi Programming.
FREE Newsletter. Sign Up Now!
Here's how to add a button to Interner Explorer toolbar:
1. ButtonText = Text at the bottom of the button
2. MenuText = The tools menu item with a reference to your program.
3. MenuStatusbar = *Ignore*
4. CLSID = Your unique classID. You can use GUIDTOSTRING to create a new CLSID (for each button).
5. Default Visible := Display it.
6. Exec := Your program path to execute.
7. Hoticon := (Mouse Over Event) ImageIndex in shell32.dll
8. Icon := ImageIndex in shell32.dll

After you run the code below, start a new instance of IE. You might need to go to View | Toolbars | Customize and move your button from "Available toolbar buttons" to "Current toolbar buttons"

~~~~~~~~~~~~~~~~~~~~~~~~~
procedure CreateExplorerButton;
const
// the same explanation as for the CLSID
TagID = '\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\';
var
Reg: TRegistry;
ProgramPath: string;
RegKeyPath: string;
begin
ProgramPath := 'c:\folder\exename.exe';
Reg := TRegistry.Create;
try
with Reg do begin
RootKey := HKEY_LOCAL_MACHINE;
RegKeyPath := 'Software\Microsoft\Internet Explorer\Extensions';
OpenKey(RegKeyPath + TagID, True) ;
WriteString('ButtonText', 'Your program Button text') ;
WriteString('MenuText', 'Your program Menu text') ;
WriteString('MenuStatusBar', 'Run Script') ;
WriteString('ClSid', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}') ;
WriteString('Default Visible', 'Yes') ;
WriteString('Exec', ProgramPath) ;
WriteString('HotIcon', ',4') ;
WriteString('Icon', ',4') ;
end
finally
Reg.CloseKey;
Reg.Free;
end;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~


Posted in 软件开发 at September 12, 2006. by 傻猫 .    Views: 3358    No Comments

webbrowser应用技巧

这里介绍如何用程序的方法获得WebBrowser控件中的HTML的源代码,并可以通过修改源代码内容来修改页面内容(注意:不是显示一个新的页面)。

首先要加入WebBrowser控件,加入控件的方面我就不说了。获得源代码方法有两种:

一、方法1(严格说,这个方法只不过是调用WebBrowser自己的菜单命令"查看源文件而已",并非我们所希望的)
关键代码:

#include "mshtmcid.h"
void CHtmlView::OnMethod1()
{
CWnd* pWnd = NULL;

CWnd* pWndShell = m_browser.GetWindow(GW_CHILD); // get the webbrowser window pointer

if (pWndShell)
{
pWnd = pWndShell->GetWindow(GW_CHILD); //get the child window pointer
}

if (pWnd != NULL)
{
WPARAM wParam = MAKEWPARAM(IDM_VIEWSOURCE, 1); //convert to unsigned 32 bit value and pass it to wparam
pWnd->SendMessage(WM_COMMAND, wParam, (LPARAM)this->m_hWnd); //cool send a message to retreive the source.
}
}

二、方法2

原理在于取得IPersistStreamInit接口指针,然后把网页写到IStream流中去。
关键代码:

#include "mshtml.h"
//在SourceView中填写HtmlView中网页的源程序
void CMainFrame::OnMethod2()
{
IHTMLDocument2 *pHTMLDocument=NULL;
IPersistStreamInit *pPSI=NULL;

IStream *pStream=NULL;
HGLOBAL hHTMLText;

if (!(pHTMLDocument = (IHTMLDocument2*)m_pHtmlView->m_browser.GetDocument()))
return;

if (FAILED(pHTMLDocument->QueryInterface(&pPSI)))
{
// pHTMLDocument->Release();
return;
}

hHTMLText = GlobalAlloc(GMEM_FIXED, MAX_SIZE);
CreateStreamOnHGlobal(hHTMLText, TRUE, &pStream);
pPSI->Save(pStream, FALSE);

// m_pSourceView->SetWindowText((char*)hHTMLText);

long nEditLength = m_pSourceView->GetEditCtrl().GetWindowTextLength();
m_pSourceView->GetEditCtrl().SetSel(0, nEditLength);
m_pSourceView->GetEditCtrl().ReplaceSel("");
char *pText = (char*)hHTMLText;
long lHtmlLength = strlen(pText);
CString str("");
long n = 0;
for (long i=0; i < lHtmlLength; i++)
{
if (*pText != 0x0d && *pText != 0x0a)
{
str += *pText;
pText++;
}
else
{
pText++;
if (*pText == 0x0a)
pText++;
str += "\r\n";
nEditLength = m_pSourceView->GetEditCtrl().GetWindowTextLength();
m_pSourceView->GetEditCtrl().SetSel(nEditLength, nEditLength);
m_pSourceView->GetEditCtrl().ReplaceSel(str);
str.Empty();
}
}

pStream->Release();
pPSI->Release();
// pHTMLDocument->Release();
}

三、修改HTML源代码以改变网页的显示

这部分比较有意思,可以当作是一个小的HTML编辑器,看看预演效果。特别的不是显示一个新文件,而是修改原来的HTML文件。
关键代码:

//根据SourceView里的HTML文本改变HtmlView里的显示
void CMainFrame::OnChangehtml()
{
IHTMLDocument2 *pHTMLDocument=NULL;
IPersistStreamInit *pPSI=NULL;

IStream *pStream=NULL;
HGLOBAL hHTMLText;

if (!(pHTMLDocument = (IHTMLDocument2*)m_pHtmlView->m_browser.GetDocument()))
return;

if (FAILED(pHTMLDocument->QueryInterface(&pPSI)))
{
// pHTMLDocument->Release();
return;
}

pHTMLDocument->clear();
pPSI->InitNew();

LPCTSTR strText = m_pSourceView->LockBuffer();
DWORD dwLength = strlen(strText);
hHTMLText = GlobalAlloc(GMEM_FIXED, dwLength);
memset(hHTMLText, 0, dwLength);
memcpy(hHTMLText, strText, dwLength);
m_pSourceView->UnlockBuffer();
CreateStreamOnHGlobal(hHTMLText, TRUE, &pStream);
ULARGE_INTEGER libNewSize;
libNewSize.QuadPart = dwLength;
pStream->SetSize(libNewSize);这一步必须要,否则显示时会有多余字符出现
pPSI->Load(pStream);

pStream->Release();
pPSI->Release();
// pHTMLDocument->Release();
}

有时侯不能显示出网页而显示的是源码文本,比如微软网站的首页就是这种情况。把源码中的这句话 < META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso8859-1" />去掉就可以了。原因不明。如果您知道原因请告诉我。




来自:bj8888, 时间:2004-2-5 22:57:00, ID:2438668
这里有平时我自己用TWebBrowser做程序的一些心得和上网收集到的部分例子和资料,整理了一下,希望能给有兴趣用TWebBrowser编程的朋友带来些帮助。



1、初始化和终止化(Initialization & Finalization)

  大家在执行TWebBrowser的某个方法以进行期望的操作,如ExecWB等的时候可能都碰到过“试图激活未注册的丢失目标”或“OLE对象未注册”等错误,或者并没有出错但是得不到希望的结果,比如不能将选中的网页内容复制到剪贴板等。以前用它编程的时候,我发现ExecWB有时侯起作用但有时侯又不行,在Delphi生成的缺省工程主窗口上加入TWebBrowser,运行时并不会出现“OLE对象未注册”的错误。同样是一个偶然的机会,我才知道OLE对象需要初始化和终止化(懂得的东东实在太少了)。
  我用我的前一篇文章《Delphi程序窗口动画&正常排列平铺的解决》所说的方法编程,运行时出了上面所说的错误,我便猜想应该有OleInitialize之类的语句,于是,找到并加上了下面几句话,终于搞定!究其原因,我想大概是由于TWebBrowser是一个嵌入的OLE对象而不算是用Delphi编写的VCL吧。

  initialization
   OleInitialize(nil);
  finalization
   try
    OleUninitialize;
   except
   end;

  这几句话放在主窗口所有语句之后,“end.”之前。

--------------------------------------------------------------------------------------------------------

2、EmptyParam

  在Delphi 5中TWebBrowser的Navigate方法被多次重载:

  procedure Navigate(const URL: WideString); overload;
  procedure Navigate(const URL: WideString; var Flags: OleVariant); overload;
  procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:     OleVariant); overload;
  procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:     OleVariant; var PostData: OleVariant); overload;
  procedure Navigate(const URL: WideString; var Flags: OleVariant; var TargetFrameName:     OleVariant; var PostData: OleVariant; var Headers: OleVariant); overload;

  而在实际应用中,使用后几种方法调用时,由于我们很少用到后面几个参数,但函数声明又要求是变量参数,一般的做法如下:

  var
   t:OleVariant;
  begin
   webbrowser1.Navigate(edit1.text,t,t,t,t);
  end;

  需要定义变量t(还有很多地方要用到它),很麻烦。其实我们可以用EmptyParam来代替(EmptyParam是一个公用的Variant空变量,不要对它赋值),只需一句话就可以了:

  webbrowser1.Navigate(edit1.text,EmptyParam,EmptyParam,EmptyParam,EmptyParam);

  虽然长一点,但比每次都定义变量方便得多。当然,也可以使用第一种方式。

  webbrowser1.Navigate(edit1.text)

--------------------------------------------------------------------------------------------------------

3、命令操作

  常用的命令操作用ExecWB方法即可完成,ExecWB同样多次被重载:

  procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT); overload;
  procedure ExecWB(cmdID: OLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn:
    OleVariant); overload;
  procedure ExecWB(cmdID: rOLECMDID; cmdexecopt: OLECMDEXECOPT; var pvaIn:
    OleVariant; var pvaOut: OleVariant); overload;

  打开: 弹出“打开Internet地址”对话框,CommandID为OLECMDID_OPEN(若浏览器版本为IE5.0,
      则此命令不可用)。
  另存为:调用“另存为”对话框。
      ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT, EmptyParam,
           EmptyParam);


  打印、打印预览和页面设置: 调用“打印”、“打印预览”和“页面设置”对话框(IE5.5及以上版本才支持打
                印预览,故实现应该检查此命令是否可用)。
      ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, EmptyParam,
           EmptyParam);
      if QueryStatusWB(OLECMDID_PRINTPREVIEW)=3 then
       ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT,
           EmptyParam,EmptyParam);
      ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, EmptyParam,
           EmptyParam);


  剪切、复制、粘贴、全选: 功能无须多说,需要注意的是:剪切和粘贴不仅对编辑框文字,而且对网页上的非编
               辑框文字同样有效,用得好的话,也许可以做出功能特殊的东东。获得其命令使能状
               态和执行命令的方法有两种(以复制为例,剪切、粘贴和全选分别将各自的关键字替
               换即可,分别为CUT,PASTE和SELECTALL):
   A、用TWebBrowser的QueryStatusWB方法。
     if(QueryStatusWB(OLECMDID_COPY)=OLECMDF_ENABLED) or
      OLECMDF_SUPPORTED) then
      ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, EmptyParam,
           EmptyParam);
   B、用IHTMLDocument2的QueryCommandEnabled方法。
     var
      Doc: IHTMLDocument2;
     begin
      Doc :=WebBrowser1.Document as IHTMLDocument2;
      if Doc.QueryCommandEnabled('Copy') then
       Doc.ExecCommand('Copy',false,EmptyParam);
     end;

  查找: 参考第九条“查找”功能。

--------------------------------------------------------------------------------------------------------

4、字体大小

  类似“字体”菜单上的从“最大”到“最小”五项(对应整数0~4,Largest等假设为五个菜单项的名字,Tag 属性分别设为0~4)。
   A、读取当前页面字体大小。
     var
      t: OleVariant;
     Begin
      WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,
       EmptyParam,t);
      case t of
      4: Largest.Checked :=true;
      3: Larger.Checked :=true;
      2: Middle.Checked :=true;
      1: Small.Checked :=true;
      0: Smallest.Checked :=true;
      end;
     end;
   B、设置页面字体大小。
     Largest.Checked :=false;
     Larger.Checked :=false;
     Middle.Checked :=false;
     Small.Checked :=false;
     Smallest.Checked :=false;
     TMenuItem(Sender).Checked :=true;
     t :=TMenuItem(Sender).Tag;
     WebBrowser1.ExecWB(OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER,
      t,t);

--------------------------------------------------------------------------------------------------------

5、添加到收藏夹和整理收藏夹

     const
     CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';

    var
     p:procedure(Handle: THandle; Path: PChar); stdcall;

    procedure TForm1.OrganizeFavorite(Sender: Tobject);
    var
     H: HWnd;
    begin
     H := LoadLibrary(PChar('shdocvw.dll'));
     if H <> 0 then
     begin
    p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));
      if Assigned(p) then p(Application.Handle, PChar(FavFolder));
     end;
     FreeLibrary(h);
    end;
    
    procedure TForm1.AddFavorite(Sender: TObject);
    var
     ShellUIHelper: ISHellUIHelper;
     url, title: Olevariant;
    begin
     Title := Webbrowser1.LocationName;
     Url := Webbrowser1.LocationUrl;
     if Url <> '' then
     begin
      ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;
      ShellUIHelper.AddFavorite(url, title);
     end;
    end;

  用上面的通过ISHellUIHelper接口来打开“添加到收藏夹”对话框的方法比较简单,但是有个缺陷,就是打开的窗口不是模式窗口,而是独立于应用程序的。可以想象,如果使用与OrganizeFavorite过程同样的方法来打开对话框,由于可以指定父窗口的句柄,自然可以实现模式窗口(效果与在资源管理器和IE中打开“添加到收藏夹”对话框相同)。问题显然是这样的,上面两个过程的作者当时只知道shdocvw.dll中DoOrganizeFavDlg的原型而不知道DoAddToFavDlg的原型,所以只好用ISHellUIHelper接口来实现(或许是他不够严谨,认为是否是模式窗口无所谓?)。
  下面的过程就告诉你DoAddToFavDlg的函数原型。需要注意的是,这样打开的对话框并不执行“添加到收藏夹”的操作,它只是告诉应用程序用户是否选择了“确定”,同时在DoAddToFavDlg的第二个参数中返回用户希望放置Internet快捷方式的路径,建立.Url文件的工作由应用程序自己来完成。

    procedure TForm1.AddFavorite(IE: TEmbeddedWB);
     procedure CreateUrl(AUrlPath, AUrl: PChar);
     var
      URLfile: TIniFile;
     begin
      URLfile := TIniFile.Create(String(AUrlPath));
     RLfile.WriteString('InternetShortcut', 'URL', String(AUrl));
     RLfile.Free;
     end;
    var
     AddFav: function(Handle: THandle;
      UrlPath: PChar; UrlPathSize: Cardinal;
      Title: PChar; TitleSize: Cardinal;
      FavIDLIST: pItemIDList): Bool; stdcall;
     FDoc: IHTMLDocument2;
     UrlPath, url, title: array[0..MAX_PATH] of char;
     H: HWnd;
     pidl: pItemIDList;
     FRetOK: Bool;
    begin
     FDoc := IHTMLDocument2(IE.Document);
     if FDoc = nil then exit;
     StrPCopy(Title, FDoc.Get_title);
     StrPCopy(url, FDoc.Get_url);
     if Url <> '' then
     begin
      H := LoadLibrary(PChar('shdocvw.dll'));
      if H <> 0 then
      begin
       SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl);
       AddFav := GetProcAddress(H, PChar('DoAddToFavDlg'));
       if Assigned(AddFav) then
        FRetOK :=AddFav(Handle, UrlPath, Sizeof(UrlPath), Title, Sizeof(Title), pidl)
      end;
      FreeLibrary(h);
      if FRetOK then
       CreateUrl(UrlPath, Url);
     end
    end;


--------------------------------------------------------------------------------------------------------

6、使WebBrowser获得焦点

  TWebBrowser非常特殊,它从TWinControl继承来的SetFocus方法并不能使得它所包含的文档获得焦点,从而不能立即使用Internet Explorer本身具有得快捷键,解决方法如下:<

  procedure TForm1.SetFocusToDoc;
  begin
   if WebBrowser1.Document <> nil then
    with WebBrowser1.Application as IOleobject do
     DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);
  end;

  除此之外,我还找到一种更简单的方法,这里一并列出:

  if WebBrowser1.Document <> nil then
   IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).focus

  刚找到了更简单的方法,也许是最简单的:

  if WebBrowser1.Document <> nil then
   IHTMLWindow4(WebBrowser1.Document).focus

  还有,需要判断文档是否获得焦点这样来做:

  if IHTMLWindow4(WebBrowser1.Document).hasfocus then

--------------------------------------------------------------------------------------------------------

7、点击“提交”按钮

  如同程序里每个窗体上有一个“缺省”按钮一样,Web页面上的每个Form也有一个“缺省”按钮——即属性为“Submit”的按钮,当用户按下回车键时就相当于鼠标单击了“Submit”。但是TWebBrowser似乎并不响应回车键,并且,即使把包含TWebBrowser的窗体的KeyPreview设为True,在窗体的KeyPress事件里还是不能截获用户向TWebBrowser发出的按键。
  我的解决办法是用ApplicatinEvents构件或者自己编写TApplication对象的OnMessage事件,在其中判断消息类型,对键盘消息做出响应。至于点击“提交”按钮,可以通过分析网页源代码的方法来实现,不过我找到了更为简单快捷的方法,有两种,第一种是我自己想出来的,另一种是别人写的代码,这里都提供给大家,以做参考。

  A、用SendKeys函数向WebBrowser发送回车键
    在Delphi 5光盘上的Info\Extras\SendKeys目录下有一个SndKey32.pas文件,其中包含了两个函数SendKeys和AppActivate,我们可以用SendKeys函数来向WebBrowser发送回车键,我现在用的就是这个方法,使用很简单,在WebBrowser获得焦点的情况下(不要求WebBrowser所包含的文档获得焦点),用一条语句即可:

   Sendkeys('~',true);// press RETURN key

   SendKeys函数的详细参数说明等,均包含在SndKey32.pas文件中。

  B、在OnMessage事件中将接受到的键盘消息传递给WebBrowser。

   procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);
   {fixes the malfunction of some keys within webbrowser control}
   const
    StdKeys = [VK_TAB, VK_RETURN]; { standard keys }
    ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys }
    fExtended = $01000000; { extended key flag }
   begin
    Handled := False;
    with Msg do
    if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
     ((wParam in StdKeys) or
     {$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}
     (wParam in ExtKeys) and
     ((lParam and fExtended) = fExtended)) then
    try
     if IsChild(Handle, hWnd) then { handles all browser related messages }
     begin
      with {$IFDEF VER120}Application_{$ELSE}Application{$ENDIF} as
        IOleInPlaceActiveObject do
       Handled := TranslateAccelerator(Msg) = S_OK;
       if not Handled then
       begin
        Handled := True;
        TranslateMessage(Msg);
        DispatchMessage(Msg);
       end;
       end;
    except
    end;
   end; // MessageHandler

  (此方法来自EmbeddedWB.pas)

--------------------------------------------------------------------------------------------------------

8、直接从TWebBrowser得到网页源码及Html

  下面先介绍一种极其简单的得到TWebBrowser正在访问的网页源码的方法。一般方法是利用TWebBrowser控件中的Document对象提供的IPersistStreamInit接口来实现,具体就是:先检查WebBrowser.Document对象是否有效,无效则退出;然后取得IPersistStreamInit接口,接着取得HTML源码的大小,分配全局堆内存块,建立流,再将HTML文本写到流中。程序虽然不算复杂,但是有更简单的方法,所以实现代码不再给出。其实基本上所有IE的功能TWebBrowser都应该有较为简单的方法来实现,获取网页源码也是一样。下面的代码将网页源码显示在Memo1中。

   Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);

  同时,在用TWebBrowser浏览HTML文件的时候要将其保存为文本文件就很简单了,不需要任何的语法解析工具,因为TWebBrowser也完成了,如下:

   Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);

--------------------------------------------------------------------------------------------------------

9、“查找”功能

  查找对话框可以在文档获得焦点的时候通过按键Ctrl-F来调出,程序中则调用IOleCommandTarget对象的成员函数Exec执行OLECMDID_FIND操作来调用,下面给出的方法是如何在程序中用代码来做出文字选择,即你可以自己设计查找对话框。

   var
    Doc: IHtmlDocument2;
    TxtRange: IHtmlTxtRange;
   begin
    Doc :=WebBrowser1.Document as IHtmlDocument2;
    Doc.SelectAll;    //此处为简写,选择全部文档的方法请参见第三条命令操作
                //这句话尤为重要,因为IHtmlTxtRange对象的方法能够操作的前提是
                //Document已经有一个文字选择区域。由于接着执行下面的语句,所以不会
                //看到文档全选的过程。
    TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;
    TxtRange.FindText('Text to be searched',0.0);
    TxtRange.Select;
   end;

  还有,从Txt.Get_text可以得到当前选中的文字内容,某些时候是有用的。

--------------------------------------------------------------------------------------------------------

10、提取网页中所有链接

  这个方法来自大富翁论坛hopfield朋友的对一个问题的回答,我本想自己试验,但总是没成功。

  var
   doc:IHTMLDocument2;
   all:IHTMLElementCollection;
   len,i:integer;
   item:OleVariant;
  begin
   doc:=WebBrowser1 .Document as IHTMLDocument2;
   all:=doc.Get_links;             //doc.Links亦可
   len:=all.length;
   for i:=0 to len-1 do begin
    item:=all.item(i,varempty);        //EmpryParam亦可
    memo1.lines.add(item.href);
   end;
  end;

--------------------------------------------------------------------------------------------------------

11、设置TWebBrowser的编码

  为什么我总是错过很多机会?其实早就该想到的,但是一念之差,便即天壤之别。当时我要是肯再多考虑一下,多试验一下,这就不会排到第11条了。下面给出一个函数,搞定,难以想象的简单。

  procedure SetCharSet(AWebBrowser: TWebBrowser; ACharSet: String);
  var
   RefreshLevel: OleVariant;
  Begin
   IHTMLDocument2(AWebBrowser.Document).Set_CharSet(ACharSet);
   RefreshLevel :=7;              //这个7应该从注册表来,帮助有Bug。
   AWebBrowser.Refresh2(RefreshLevel);
  End;

--------------------------------------------------------------------------------------------------------

12、在TWebBrowser中输入字符时激活菜单的解决

  许多朋友编程的时候都遇到了这样一个问题,在TWebBrowser中输入时,键入的字符如果与菜单(用ToolBar做的菜单)的加速键相同就会激活菜单。有朋友解决办法是把加速键前面的“&”符号去掉,使得字符失去“加速”功能,这种方法未尝不可,只不过显得不够“专业”。其实略加分析我们就可以想到,是ToolBar抢先处理了按键(因为ToolBar本身就设计为用来实现具有Windows新风格的菜单),所以只需要修改ToolBar的源代码中处理菜单按键的那部分代码即可,方法如下:

  1)、在$(Delphi)\source\vcl目录下找到comctrls.pas,拷贝到自己的程序所在目录,然后打开它。
  2)、找到TToolBar.CMDialogChar过程,把过程体注释掉(如果你愿意的话,可以修改它)。
  3)、重新编译自己的程序。

  怎么样,是不是很简单?但它确实有效。

--------------------------------------------------------------------------------------------------------

13、去掉TWebBrowser的滚动条

  缺省地,TWebBrowser是滚动条的,虽然我们可以在网页中设置不需要滚动条,不过,有些时候可能会有特殊的要求,比如,网页是有滚动条的,但又想去掉它该怎么办呢?很简单,下面给出两行代码,都可以达到目的,可谓殊途同归。

  1)、IHTMLBodyElementDisp(IHTMLDocument2(WebBrowser1.document).body).scroll:= 'no';
  2)、WebBrowser1.oleobject.Document.body.Scroll := 'no';

  注:第一种方法需要在uses部分加上MSHTML_TLB或者MSHTML。

--------------------------------------------------------------------------------------------------------

14、通过IUniformResourceLocator接口建立Internet快捷方式

  前面说到的显示“添加到收藏夹”模式对话框的方法中举了一个建立Internet快捷方式的例子,就其本身来说不太规范,属于取巧一类的方法。下面介绍的方法是通过接口来实现的。

  procedure CreateIntShotCut(aFileName, aURL: PChar);
   var IURL: IUniformResourceLocator;
   PersistFile: IPersistfile;
  begin
   if Succeeded(CoCreateInstance(CLSID_InternetShortcut,
                    nil,
                    CLSCTX_INPROC_SERVER,
                    IID_IUniformResourceLocator,
                    IURL)) then
   begin
    IUrl.SetURL(aURL, 0);
    Persistfile := IUrl as IPersistFile;
    PersistFile.Save(StringToOleStr(aFileName), False);
   end;
  end;

  其中IUniformResourceLocator接口的声明在IeConst.pas中,IeConst.pas可以在网站IE & Delphi找到; IPersistfile接口的声明在ActiveX.pas中。

  注:这个函数的AURL参数必须包含协议前缀,如“Http://eagleboost.myrice.com”。



来自:andy263, 时间:2004-2-5 22:57:00, ID:2438669
直接从TWebBrowser得到网页源码及Html

  下面先介绍一种极其简单的得到TWebBrowser正在访问的网页源码的方法。一般方法是利用TWebBrowser控件中的Document对象提供的IPersistStreamInit接口来实现,具体就是:先检查WebBrowser.Document对象是否有效,无效则退出;然后取得IPersistStreamInit接口,接着取得HTML源码的大小,分配全局堆内存块,建立流,再将HTML文本写到流中。程序虽然不算复杂,但是有更简单的方法,所以实现代码不再给出。其实基本上所有IE的功能TWebBrowser都应该有较为简单的方法来实现,获取网页源码也是一样。下面的代码将网页源码显示在Memo1中。

   Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);

  同时,在用TWebBrowser浏览HTML文件的时候要将其保存为文本文件就很简单了,不需要任何的语法解析工具,因为TWebBrowser也完成了,如下:

   Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);

注意 uses MSHTML;


Posted in 软件开发 at September 12, 2006. by 傻猫 .    Views: 3679    No Comments