Delphi Hook K3

来源：互联网发布：淘宝差评师曝光平台" 编辑：程序博客网时间：2024/05/02 02:25

前述

K3工业版插件编程很多K3接口开发人员都有经验，这里提供另外一个思路，采用直接HOOK的形式来进行编程，一样可以实现我们想要的结果

需求

1销售出库单中，表头输入客户，当用户在表体输入商品离焦后，检查该商品是否在用户自定义的客户商品对应表中，如无，则给予信息提示

2 销售出库单中，加一菜单，有权限的用户点击该按钮可从价格管理库中获取最新单价，并写入到表体单价栏中

分析

K3版本为V10.1商业版，在现有资料上无法直接通过K3给出的接口来进行编程，所以考虑通过外挂形式拦截相关消息来完成

难点

1 如何获取当前登录的用户信息和帐套信息(用户名和SQL登录连接字符串)

2 如何取得销售出库单窗体中用户输入的客户和商品信息

3 如何响应表格的单元格离焦事件

程序

1 获取当前登录的用户信息和帐套信息(用户名和SQL登录连接字符串)

用Prcocess Explorer工具进行跟踪，发现用户登录的时候调用了kdlogin.dll，用eXeScope工具打开该dll，再将tlb文件导出并导入到delphi工程文件中，查看该文件，熟悉K3的人看到这些代码就可以判定出_clsLogin正是我们此次需求需要的接口

_clsLogin = interface(IDispatch)

['{E67BCB9D-B9AB-4931-A829-84529E5ADD41}']

function Get_Propertys(Index: OleVariant): OleVariant; safecall;

function Get_AcctName: WideString; safecall;

function Get_LogStatus: Integer; safecall;

function Get_PropsString: WideString; safecall;

function Get_UserName: WideString; safecall;

function Get_DBMSVersion: WideString; safecall;

function Get_DBMSName: WideString; safecall;

function Get_AcctType: WideString; safecall;

function Get_SetupType: WideString; safecall;

function Get_AcctID: WideString; safecall;

function Get_SubID: WideString; safecall;

function Get_AcctClosed: WideString; safecall;

procedure Set_AcctClosed(var Param1: WideString); safecall;

function Login(const cSubID: WideString; const cSubName: WideString; bChangeMts: WordBool; const vecAcctTypeFilter: IDispatch): Integer; safecall;

。。。。。。

所以方案定为将原kdlogin.dll 改成其它名字如kdlogin2.dll，做一个伪装的kdlogin.dll，让K3调用它原来的dll对应的函数之前先调用我们的dll相关的函数，就可获取我们所要的信息而又不破坏它原来的程序。

要在它创建_clsLogin的实例的时候中做一些动作，首先我们要了解COM的一些相关知识，

1 COM对象的4个标准函数：

DllCanUnloadNow, DllGetClassObject,DllRegisterServer, DllUnregisterServer

加载kdlogin.dll的同时加载原dll即现在的kdlogin2.dll，将其4个函数的原地址保存

var

hKDLogin: THandle;

OldDllCanUnloadNow: TDLLCanUnloadNow;

OldDllGetClassObject: TDLLGetClassObject;

OldDllRegisterServer: TDLLRegisterServer;

OldDllUnregisterServer: TDLLUnregisterServer;

OldCreateInstance_clsLogin: TCreateInstance;

OldLoginProc: TLoginProc;

bHaveHook_clsLogin_ClassFactory: Boolean = False;

bHaveHook_clsLogin: Boolean = False;

procedure InitKDLoginDll;

begin

hKDLogin := LoadLibrary(PChar(ExtractFilePath(GetKDLOGINPath) + 'KDLogin2.dll'));

@OldDllCanUnloadNow := GetProcAddress(hKDLogin, 'DllCanUnloadNow');

@OldDllGetClassObject := GetProcAddress(hKDLogin, 'DllGetClassObject');

@OldDllRegisterServer := GetProcAddress(hKDLogin, 'DllRegisterServer');

@OldDllUnregisterServer := GetProcAddress(hKDLogin, 'DllUnregisterServer');

end;

2 COM的调用顺序为：调用dll的导出函数DLLGetClassObject à创建类工厂对象à调用类工厂对象的接口函数àCreateInstanceà通过QueryInterface将查询出的指定的接口指针返回给客户端à客户端通过接口调用接口函数à调用完后执行DLLCanUnloadNow

所以入口就从Hook原dll函数DLLGetClassObject开始

function DllGetClassObject(const clsid: TCLSID; const iid: TIID; out pv): HResult stdcall;

begin

Result := OldDllGetClassObject(clsid, iid, pv);

if IsEqualGUID(clsid, CLASS_clsLogin) and IsEqualGUID(iid, IID_IClassFactory) then

begin

if not bHaveHook_clsLogin_ClassFactory then

begin

bHaveHook_clsLogin_ClassFactory := True;

Hook_clsLogin_ClassFactory(IClassFactory(pv));

end;

procedure Hook_clsLogin_ClassFactory(iclsFac: IClassFactory); //

begin

OldCreateInstance_clsLogin := HookCom(iclsFac, 3 * 4, @NewCreateInstance_clsLogin);

end;

说明：接口变量其实就是一个指针，指向实现它的对象的接口函数列表的起始地址，IClassFactory继承IUnknown，而CreateInstance是IClassFactory的第一个函数,32位地址

IInterface = interface

['{00000000-0000-0000-C000-000000000046}']

function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;

function _AddRef: Integer; stdcall;

function _Release: Integer; stdcall;

end;

IUnknown = IInterface;

IClassFactory = interface(IUnknown)

['{00000001-0000-0000-C000-000000000046}']

function CreateInstance(const unkOuter: IUnknown; const iid: TIID;

out obj): HResult; stdcall;

function LockServer(fLock: BOOL): HResult; stdcall;

end;

function NewCreateInstance_clsLogin(self: IUnknown; const unkOuter: IUnknown;

const iid: TIID; out obj): HResult; stdcall;

var

iUnk: IUnknown;

iLogin: _clsLogin;

hr: HRESULT;

begin

Result := OldCreateInstance_clsLogin(self, unkOuter, iid, obj);

iUnk := IUnknown(obj);

hr := iUnk.QueryInterface(IID__clsLogin, iLogin); //

if hr = s_ok then

begin

if not bHaveHook_clsLogin then

begin

gLogin := iLogin;

bHaveHook_clsLogin := True;

@OldLoginProc := HookCom(iLogin, 4 * 20, @NewLoginProc);

end;

说明：_clsLogin继承IDispatch，IDispatch继承IUnknown，接口函数Login_是clsLogin的第14个函数，所以位置为IDispatch的函数个数4+ IUnknown的函数个数3

=> 4+3+13=20

function NewLoginProc(iUnk: IUnknown; const cSubID: WideString; const cSubName: WideString; bChangeMts: WordBool;

const vecAcctTypeFilter: IDispatch): Integer; safecall;

var

iLogin: _clsLogin;

begin

Result := OldLoginProc(iUnk, cSubID, cSubName, bChangeMts, vecAcctTypeFilter);

if Result <> 0 then

begin

iLogin := _clsLogin(iUnk);

SetUserKdName(iLogin.UserName);

SetPropsString(iLogin.PropsString);

end;

说明：这里就得到了我们想要的登录用户名和数据库连接字符串信息。注意：第一个参数为接口变量

function HookCom(intf: IUnknown; OldFuncID: Integer; newfunc: Pointer): Pointer;

var

p: Pointer;

begin

p := Pointer(intf);

p := Pointer(p^);

p := Pointer(Integer(p) + OldFuncID);

Result := Pointer(p^);

if PatchComAddress(p, newfunc) then

else savekey('HookCom PatchComAddress error');

try

except

savekey('log iadr failed');

end;

说明：通过接口函数在该接口的位置，取得该函数的地址，并保存。

function PatchComAddress(oldfunc, newfunc: Pointer): longbool;

var

lpflOldProtect: DWORD; //32位

begin

try

VirtualProtect(oldfunc, 4, PAGE_READWRITE, @lpflOldProtect);

PDWORD(oldfunc)^ := DWORD(newfunc);

VirtualProtect(oldfunc, 4, lpflOldProtect, @lpflOldProtect);

Result := True;

except

Result := False;

savekey('PaCom Failed');

end;

说明：让原接口函数的指针指向我们函数的地址，这样就会先执行我们的函数。

另外3个函数在此需求中无需变动，将原函数地址返回即可

function DllRegisterServer: HResult stdcall;

begin

Result := OldDllRegisterServer;

end;

function DllUnregisterServer: HResult stdcall;

begin

Result := OldDllUnregisterServer;

end;

function DllCanUnloadNow: HResult stdcall;

begin

Result := OldDllCanUnloadNow;

end;

用户打开销售出库窗体，我们要在该窗体创建的时候加上我们自定义的菜单，还要取得用户在表头输入的客户信息和在表体输入的商品信息，并在用户输入商品离焦后触发该控件的离焦事件，就必须要取得表头edit控件的实例和表体grid控件的实例

用Process Explorer工具进行跟踪，发现创建销售出库窗体的时候调用了加载了kdtext.ocx和spr32x30.ocx 文件，就是表头和表体所用到的控件，将这个2个文件的tlb导入到delphi中

function NewCreateWindowExA(dwExStyle: DWORD; lpClassName: PAnsiChar;

lpWindowName: PAnsiChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer;

hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND; stdcall;

begin

Result := TCreateWindowExA(hookR_CreateWindowExA.FuncHead)

(dwExStyle, lpClassName, lpWindowName, dwStyle, X, Y, nWidth, nHeight,

hWndParent, hMenu, hInstance, lpParam);

// grid控件

if hFPSPR70 = 0 then

begin

hFPSPR70 := GetModuleHandle('SPR32X30.ocx');

if hFPSPR70 = 0 then

hFPSPR70 := LoadLibrary(PChar(GetSPR32X30Path));

if hFPSPR70 > 0 then

DoHook_FPSPR70_DllGetClassObject;

end;

// edit 控件

if hKDTextCtl = 0 then

begin

hKDTextCtl := GetModuleHandle('KDText.ocx');

if hKDTextCtl = 0 then

hKDTextCtl := LoadLibrary('KDText.ocx');

if hKDTextCtl > 0 then

DoHookKDTextCtl;

end;

procedure DoHookCreateWindow;

begin

DoneHOOK('user32.dll', 'CreateWindowExA', @NewCreateWindowExA, hookR_CreateWindowExA);

end;

说明：Hook CreateWindow 函数是为了找个地方启动 Hook K3的接口，找其他地方也可以。

重点->DoneHOOK函数功能

方案为先将user32.dll的CreateWindowExA函数的前面几行汇编代码复制到另一个地方执行（当然要复制完整的汇编代码，如果复制的代码不完整，会导致程序崩溃），执行完毕后再跳回原地址；同时我们在函数的原起始地址插入跳转指令，让它先执行我们的程序。

procedure DoneHOOK(DLLName, FunName: pchar; NewFun: Pointer; var hookr: THookR);

begin

hookr.NewFun := NewFun;

hookr.DLLName := DLLName;

hookr.FunName := FunName; //

HOOKINIT(hookr);

end;

procedure HOOKINIT(var hookr: THookR);

const

JmpCodeSize = 5; //$E9 8位+32位地址 =5个字节

var

DllHandle: DWORD;

bSize: DWORD;

Code: TJmp;

ptr: Pointer;

lpflOldProtect: DWORD;

hMem: cardinal;

dw:dword;

begin

DllHandle := GetModuleHandle(hookr.DLLName);

if DllHandle = 0 then

begin

DllHandle := loadlibrary(pchar(hookr.DLLName));

if DllHandle = 0 then

begin

MessageBox(0, pchar('GetModuleHandle LoadLibrary Fail'#13#10 + hookr.DLLName + #13#10 + hookr.FunName), 'alert', mb_ok);

exit;

end;

//先取得参数DLLName的Handle

hookr.OldAddr := getprocaddress(DllHandle, hookr.FunName); //原函数地址

if hookr.OldAddr = nil then

begin

MessageBox(0, pchar('GetProcAddress OldAddr Fail:' + hookr.FunName), 'alert11', mb_ok);

exit;

end;

//保存原函数地址

hookr.CodePoint := GetDissasemblerPoint(hookr.OldAddr, 20, JmpCodeSize);

//GetDissasemblerPoin的功能为返回要copy的函数的前面完整代码的字节数，是一个反汇编功能函数，//因为汇编指令的长度根据不同的指令是不一样的，所以要知道到哪里是一句完整的汇编代码，需要反汇

//编，其中jmp命令至少是5个字节

hMem := GlobalAlloc(GMEM_FIXED, hookr.CodePoint + JmpCodeSize);

//分配内存，用来存放copy过来的汇编代码

hookr.FuncHead := GlobalLock(hMem);

//锁定内存中指定的内存块，并返回一个地址值，令其指向内存块的起始处。

hMem := GlobalAlloc(GMEM_FIXED, hookr.CodePoint + JmpCodeSize);

hookr.OrgFuncHead := GlobalLock(hMem);

//第二份为unhook时使用

if not virtualprotect(hookr.FuncHead, hookr.CodePoint + JmpCodeSize, PAGE_EXECUTE_READWRITE, @lpflOldProtect) then

MessageBox(0, pchar('hook virtualprotect failed'), pchar(''), 0);

//把刚才分配的内存保护属性修改成可执行 PAGE_EXECUTE_READWRITE，这样我们后面复制过来的

//汇编代码才能够执行

if not readprocessmemory(glb_hprocess, hookr.OldAddr, hookr.FuncHead, hookr.CodePoint, bSize) then

begin

hookr.OldAddr := nil;

MessageBox(0, pchar('readprocessmemory fail ' + hookr.FunName), pchar('HOOKINIT'), mb_ok);

exit;

end;

//把原函数前面几行汇编代码复制到我们刚申请到的内存

if not readprocessmemory(glb_hprocess, hookr.OldAddr, hookr.OrgFuncHead, hookr.CodePoint, bSize) then

begin

hookr.OldAddr := nil;

MessageBox(0, pchar('readprocessmemory fail ' + hookr.FunName), pchar('HOOKINIT'), mb_ok);

exit;

end;

if Byte(hookr.FuncHead^)=$E9 then

begin

dw:=dword(pointer(dword(hookr.FuncHead)+1)^);

dw:=dw+dword(hookr.OldAddr)-dword(hookr.FuncHead);

dword(pointer((dword(hookr.FuncHead)+1))^):=dw;

end;

//如果拷贝的代码是JMP指令，要重新计算jmp的跳转地址，因为jmp指令的跳转地址是相对地址，

//即地址已经变了

Code.JmpCode := $E9;

Code.Address := DWORD(hookr.OldAddr) - DWORD(hookr.FuncHead) - JmpCodeSize;

//构造jmp指令，跳回原函数

if not WriteProcessMemory(glb_hprocess, Pointer(DWORD(hookr.FuncHead) + hookr.CodePoint), @Code, JmpCodeSize, bSize) then

begin

hookr.OldAddr := nil;

MessageBox(0, pchar('WriteProcessMemory fail ' + hookr.FunName), pchar('HOOKINIT'), mb_ok);

exit;

end;

//把构造的jmp指令写到申请的内存后面

getmem(ptr, hookr.CodePoint);

fillmemory(ptr, hookr.CodePoint, $90); //空操作

//copy出一段代码出来，可能大于6个字节，但是我们的跳转指令只有5个字节，所以会有多余出来

if not WriteProcessMemory(glb_hprocess, hookr.OldAddr, ptr, hookr.CodePoint, bSize) then

begin

hookr.OldAddr := nil;

MessageBox(0, pchar('WriteProcessMemory fail ' + hookr.FunName), pchar('HOOKINIT'), mb_ok);

exit;

end;

hookr.NewWrite.JmpCode := $E9;

hookr.NewWrite.Address := DWORD(hookr.NewFun) - DWORD(hookr.OldAddr) - JmpCodeSize;

//构造调到我们的函数的jmp命令

if not WriteProcessMemory(glb_hprocess, hookr.OldAddr, (@hookr.NewWrite), JmpCodeSize, bSize) then begin

hookr.OldAddr := nil;

MessageBox(0, pchar('WriteProcessMemory fail ' + hookr.FunName), pchar('HOOKINIT'), mb_ok);

exit;

end;

//把构造的jmp指令写入原函数的开头

取得表头edit控件的实例

与Hook kdlogin.dll的_clsLogin接口类似，依次hook DllGetClassObjectàQueryInterfaceàCreateInstanceLic

function NewDllGetClassObject(const clsid: TCLSID; const iid: TIID;

out pv): HResult stdcall;

var

icfac: IClassFactory;

begin

Result := TDllGetClassObject(hookR_DllGetClassObject.FuncHead)(clsid, iid, pv);

if Result = S_OK then

begin

if IsEqualGUID(CLASS_KDText, clsid) then

begin

icfac := IClassFactory(pv);

if not bHaveHook_QueryInterface_IClassFactory then

begin

bHaveHook_QueryInterface_IClassFactory := True;

OldQueryInterface_IClassFactory := HookCom(icfac, 0, @NewQueryInterface_IClassFactory);

end;

function NewQueryInterface_IClassFactory(self: IUnknown; const IID: TGUID; out Obj): HResult; stdcall;

var

ifac2: IClassFactory2;

begin

Result := OldQueryInterface_IClassFactory(self, IID, Obj);

if IsEqualGUID(IID_IClassFactoryLic, IID) then

begin

if not bHaveHook_CreateInstanceLic_IClassFactory2 then

begin

bHaveHook_CreateInstanceLic_IClassFactory2 := True;

ifac2 := IClassFactory2(Obj);

OldCreateInstanceLic_IClassFactory2 := HookCom(ifac2, 4 * 7, @NewCreateInstanceLic_IClassFactory2);

end;

function NewCreateInstanceLic_IClassFactory2(iUnk: IUnknown; const unkOuter: IUnknown; const unkReserved: IUnknown;

const iid: TIID; const bstrKey: WideString; out vObject): HResult; stdcall;

var

uUnk: iUnknown;

iKDText: _KDText;

hr: HRESULT;

icpc: IConnectionPointContainer;

icp: IConnectionPoint;

dwCookie: LongInt;

begin

Result := OldCreateInstanceLic_IClassFactory2(iUnk, unkOuter, unkReserved, iid, bstrKey, vObject);

if Result = s_ok then

begin

uUnk := iUnknown(vObject);

hr := uUnk.QueryInterface(IID__KDText, iKDText);

if hr = s_ok then

begin

hr := uUnk.QueryInterface(IConnectionPointContainer, icpc);

if hr = s_ok then

begin

hr := icpc.FindConnectionPoint(DIID___KDText, icp);

if hr = S_OK then

begin

g_DKDText := T_DKDText.Create(iKDText);

icp.Advise(g_DKDText, dwCookie);

g_DKDText.Cookie := dwCookie;

g_DKDText.ConnectPoint := icp;

gKDEditList.Add(Pointer(g_DKDText));

end;

说明：至此取得了edit控件的实例

取得grid控件的实例并注册事件

与Hook edit控件类似

function NewCreateInstanceLic_IClassFactory2(iUnk: IUnknown; const unkOuter: IUnknown; const unkReserved: IUnknown;

const iid: TIID; const bstrKey: WideString; out vObject): HResult; stdcall;

var

ifpSpread: vaSpread;

aiUnk: IUnknown;

hr: HResult;

icpc: IConnectionPointContainer;

dwCookie: Integer;

begin

Result := OldCreateInstanceLic_IClassFactory2(iUnk, unkOuter, unkReserved, iid, bstrKey, vObject);

aiUnk := iUnknown(vObject);

hr := aiUnk.QueryInterface(DIID__DSpreadSheet, ifpSpread);

if hr = s_ok then

begin

hr := aiUnk.QueryInterface(IConnectionPointContainer, icpc);

if hr = S_OK then

begin

hr := icpc.FindConnectionPoint(DIID__DSpreadEvents, gicp);

if hr = S_OK then

begin

gDSpreadEvents := T_DSpreadEvents.Create(ifpSpread);

gicp.Advise(gDSpreadEvents, dwCookie);

end;

说明：

1 ActiveX 只能通过连接点接口提供事件功能

2一个 COM 组件，允许有多个连接点对象(IConnectionPoint)，管理这些连接点的接口叫“连接点容器”(IConnectionPointContainer)，它是用来响应事件的，只要实现他的事件接口，然后把对象注册进去，当有相应的事件时，注册进去的对象的方法就会被调用

3连接点容器接口只有2个函数，一个是 FindConnectionPoint()，表示查找你想要的连接点；另一个是 EnumConnectionPoints()，表示列出所有的连接点，然后你去选择使用哪个。在实际的应用中，查找法使用最多，占90% ，每一个连接点，可以被多个客户端的接收器(Sink)连接，函数返回连接点的指针

编写grid的离焦事件

type

T_DSpreadEvents = class(TInterfacedObject, IDispatch)

private

FifpSpread: vaSpread;

protected

procedure Click;

procedure LeaveCell(Col: Integer; Row: Integer; NewCol: Integer;

NewRow: Integer; Cancel: PWordBool);

public

constructor Create(ifpSpread: vaSpread);

function GetTypeInfoCount(out Count: Integer): HResult; stdcall;

function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;

function GetIDsOfNames(const IID: TGUID; Names: Pointer;

NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;

procedure InvokeEvent(DispID: TDispID; var Params: TDispParams);

function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;

end;

function T_DSpreadEvents.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;

Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;

begin

InvokeEvent(DispID, TDispParams(Params));

Result := S_OK;

end;

procedure T_DSpreadEvents.InvokeEvent(DispID: TDispID; var Params: TDispParams);

type

PVarDataList = ^TVarDataList;

TVarDataList = array[0..4] of TVarData;

var

Args: PVarDataList;

Col: Integer;

Row: Integer;

NewCol: Integer;

NewRow: Integer;

Cancel: WordBool;

begin

Args := PVarDataList(Params.rgvarg);

try

case DispID of

17:

begin

if gApplyAct then

begin

Col := Variant(Args^[4]);

Row := Variant(Args^[3]);

NewCol := Variant(Args^[2]);

NewRow := Variant(Args^[1]);

Cancel := Variant(Args^[0]);

LeaveCell(Col, Row, NewCol, NewRow, @Cancel);

WordBool(Args^[0].VPointer^) := Cancel;

end;

except

end;

procedure T_DSpreadEvents.LeaveCell(Col: Integer; Row: Integer; NewCol: Integer;

NewRow: Integer; Cancel: PWordBool);

var

sText: string;

iCount: Integer;

iKDText: _KDText;

sCustNumber: string;

sDateTime: string;

_tdatadeal:tdatadeal;

oldCol, oldRow: Integer;

lpText: array[0..MAX_PATH] of Char;

begin

FillChar(lpText, SizeOf(lpText), 0);

GetWindowText(GetParent(FifpSpread.hWnd), lpText, SizeOf(lpText) - 1);

if (lpText = '修改销售出库单') or (lpText = '新建销售出库单') then

begin

oldCol := ifpSpread.Col;

oldRow := ifpSpread.Row;

try

gDSpreadEvents := Self;

FifpSpread.Row := 0;

FifpSpread.Col := Col;

if FifpSpread.Text = '商品代码' then

begin

FifpSpread.Row := Row;

FifpSpread.Col := Col;

sText := FifpSpread.Text;

begin

for iCount := gKDEditList.Count - 1 downto 0 do

begin

try

iKDText := T_DKDText(gKDEditList[iCount]).KDText;

if iKDText.Caption = '客户名称：' then

begin

sCustNumber := iKDText.ItemNumber;

end;

if iKDText.Caption = '日期：' then

begin

sDateTime := iKDText.Text;

end;

except

gKDEditList.Delete(iCount);

end;

if (sText <> '') and (sText <> FItemNumber) then

begin

FItemNumber := sText;

_tdatadeal:=tdatadeal.Create;

if _tdatadeal.IsApplyCustItem =true then

begin

if _tdatadeal.IsInCustItemTable(sText,sCustNumber)=false then

begin

MessageBox(GetParent(FifpSpread.hWnd), PChar('输入资料不在客户商品对应表中:'+sText+','), '', MB_ICONWARNING);

end;

_tdatadeal.Destroy;

end;

end

else FItemNumber := '';

finally

ifpSpread.Col := oldCol;

ifpSpread.Row := oldRow;

end;

说明：ocx控件，其实就是实现了 IDispatch 接口的组件；至此，就实现了取得用户输入的客户和商品信息并响应离焦事件

创建菜单获取价格

用spy++工具跟踪出销售出库窗体类名称，edit控件类名称及表格类名称，编写窗体hook函数

function CBTProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var

lpClass: array[0..MAX_PATH] of Char;

lpText: array[0..MAX_PATH] of Char;

begin

if nCode < 0 then

begin

Result := CallNextHookEx(ghhk, nCode, wParam, lParam);

end

else

begin

FillChar(lpClass, SizeOf(lpClass), 0);

GetClassName(wParam, lpClass, SizeOf(lpClass) - 1);

case nCode of

HCBT_CREATEWND:

begin

if (lpClass = CSThunderRT6FormDC) then

begin

hThunderRT6FormDC := wParam; //取得窗口句柄

end;

if lpClass = CSSPR32X30_SpreadSheet then

begin

if dwOldWndProc_ThunderRT6FormDC = 0 then

dwOldWndProc_ThunderRT6FormDC := GetWindowLong(hThunderRT6FormDC, GWL_WNDPROC);

SetWindowLong(hThunderRT6FormDC, GWL_WNDPROC, DWORD(@WndProc_ThunderRT6FormDC)); //

end;

Result := CallNextHookEx(ghhk, nCode, wParam, lParam);

end;

说明： //钩子回调函数必须按照以下的语法　　

LRESULT CALLBACK HookProc (int nCode,WPARAM wParam, LPARAM lParam );

编写窗体回调函数

function WndProc_ThunderRT6FormDC(hw: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

var

lpText: array[0..MAX_PATH] of Char;

hSpread: HWND;

sBillDate, sCustNumber: string;

sItemNumber: OleVariant;

iCount: Integer;

_tdatadeal: tdatadeal;

cOldPrice, cNewPrice,cQty: Double;

iColPrice, iColItemNumber,iColAmount,iColQty: Integer;

sText: OleVariant;

aObj: T_DSpreadEvents;

begin

FillChar(lpText, SizeOf(lpText), 0);

GetWindowText(hw, lpText, SizeOf(lpText) - 1);

if gApplyAct then

begin

case uMsg of

WM_WINDOWPOSCHANGED:

begin

hSpread := FindWindowEx(hw, 0, CSSPR32X30_SpreadSheet, '');

if hSpread <> 0 then

begin

if (lpText = '修改销售出库单') or (lpText = '新建销售出库单') then

begin

if GetMenu(hw) = 0 then

begin

ghm := CreateMenu;

AppendMenu(ghm, MF_STRING, $BB01, '获取单价');

AppendMenu(ghm, MF_STRING, $BB02, '清空单价');

SetMenu(hw, ghm);

end;

。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。其它消息

end;

Result := CallWindowProc(Pointer(dwOldWndProc_ThunderRT6FormDC), hw, uMsg, wParam, lParam);

end;

说明：通过捕捉WM_WINDOWPOSCHANGED消息，在销售出单中创建菜单

通过查看grid的tlb文件，知道对某一单元格赋值可调用SetFloat方法

function SetFloat(Col: Integer; Row: Integer; Value: Double): WordBool;

总结