dll的调用(100分)

怎样调用dll库文件，为什么要 defined a host application,希望能举一个例子，
越详细越好

老大，先看一下书吧

你是什么DLL；com+?

一个例子, 自己看吧

library demohook;

uses
windows,messages,sysutils,
hookproc in 'hookproc.pas'


{$r *.res}

const

hookmemfilename='dllhookmemfile.dta'

htname:array[1..13] of pchar=(
'callwndproc','callwndprocret','cbt','debug','getmessage','journalplayback',
'journalrecord','keyboard','mouse','msgfilter','shell','sysmsgfilter','foregroundidle'
)


type
thookproc = function(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

pshared=^tshared

thook = record
hookhand:hhook

hooktype:integer

hookproc:thookproc

end

tshared = record
hook:array [0..16] of thook

father,self:integer

count:integer

hinst:integer

end

twin = record
msg:tmsg

wclass:twndclass

hmain:integer

end

var
memfile:thandle

sharedshared

win:twin

wmhook:integer


procedure saveinfo(k:integer;str:string);stdcall

var
f:textfile

workpath:string

begin
workpath:=extractfilepath(paramstr(0))

assignfile(f,workpath+'records.txt')

if fileexists(workpath+'records.txt')=false then rewrite(f)
else append(f)

//if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
//else write(f,str)

writeln(f,htname[k]+'----'+str)

closefile(f)

end



procedure inithookdata

var k:integer

begin
with shared^ do
begin
for k:=0 to 14 do hook[k].hookhand:=0

//
hook[0].hooktype:=wh_callwndproc

hook[0].hookproc:=@callwndproc

//
hook[1].hooktype:=wh_callwndprocret

hook[1].hookproc:=@callwndretproc

//
hook[2].hooktype:=wh_cbt

hook[2].hookproc:=@cbtproc

//
hook[3].hooktype:=wh_debug

hook[3].hookproc:=@debugproc

//
hook[4].hooktype:=wh_getmessage

hook[4].hookproc:=@getmsgproc

//
hook[5].hooktype:=wh_journalplayback

hook[5].hookproc:=@journalplaybackproc

//
hook[6].hooktype:=wh_journalrecord

hook[6].hookproc:=@journalrecordproc

//
hook[7].hooktype:=wh_keyboard

hook[7].hookproc:=@keyboardproc

//
hook[8].hooktype:=wh_mouse

hook[8].hookproc:=@mouseproc

//
hook[9].hooktype:=wh_msgfilter

hook[9].hookproc:=@messageproc

//
hook[10].hooktype:=wh_shell

hook[10].hookproc:=@shellproc

//
hook[11].hooktype:=wh_sysmsgfilter

hook[11].hookproc:=@sysmsgproc

//
hook[12].hooktype:=wh_foregroundidle

hook[12].hookproc:=@foregroundidleproc


end

end


function sethook(fset:boolean;hookid:integer):bool;stdcall

begin
with shared^ do
if fset=true then
begin
if hook[hookid].hookhand=0 then
begin
hook[hookid].hookhand:=setwindowshookex(hook[hookid].hooktype,hook[hookid].hookproc,hinstance,0)

if hook[hookid].hookhand<>0 then result:=true
else result:=false

end else result:=true

end else
begin
if hook[hookid].hookhand<>0 then
begin
if unhookwindowshookex(hook[hookid].hookhand)=true then
begin
hook[hookid].hookhand:=0

result:=true

end else result:=false

end else result:=true

end

end


procedure extro

begin
unmapviewoffile(shared)

closehandle(memfile)

end



function windowproc(hwnd,msg,wparam,lparam:longint):lresult
stdcall

var k:integer

begin
result:=defwindowproc(hwnd,msg,wparam,lparam)

case msg of
wm_destroy:
begin
for k:=0 to 12 do sethook(false,k)

postmessage(findwindow('winhook',nil),wm_destroy,0,0)

exitthread(0)

end

end

if msg=wmhook then
begin
if wparam>0 then
begin
if sethook(true,wparam-1)=true then postmessage(findwindow('winhook',nil),wmhook,wparam,0)

end else
begin
if sethook(false,-wparam-1)=true then postmessage(findwindow('winhook',nil),wmhook,wparam,0)

end

end

end


procedure run;stdcall

//var k:integer

begin
win.wclass.lpfnwndproc:= @windowproc

win.wclass.hinstance:= hinstance

win.wclass.lpszclassname:='widehook'

registerclass(win.wclass)

win.hmain:=createwindowex(ws_ex_toolwindow,win.wclass.lpszclassname,'widehook',ws_caption,0,0,1,1,0,0,hinstance,nil)

fillchar(shared^,sizeof(tshared),0)

shared^.self:=win.hmain

shared^.hinst:=hinstance

inithookdata

wmhook:=registerwindowmessage(pchar('wm_hook'))

while(getmessage(win.msg,win.hmain,0,0))do
begin
translatemessage(win.msg)

dispatchmessage(win.msg)

end

end


procedure dllentrypoint(fdwreason:dword)

begin
case fdwreason of
dll_process_detach:
extro

end

end


exports run


begin
//建立内存映象文件，用来保存全局变量
memfile:=createfilemapping($ffffffff,nil,page_readwrite,0,sizeof(tshared),hookmemfilename)

shared:=mapviewoffile(memfile,file_map_write,0,0,0)

dllproc:=@dllentrypoint

end.

unit hookproc;


interface

uses windows,messages,sysutils


const
htname:array[1..13] of pchar=(
'callwndproc','callwndprocret','cbt','debug','getmessage','journalplayback',
'journalrecord','keyboard','mouse','msgfilter','shell','sysmsgfilter','foregroundidle'
)



function callwndproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function callwndretproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function cbtproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function debugproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function getmsgproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function journalplaybackproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function journalrecordproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function keyboardproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function mouseproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function messageproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function shellproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function sysmsgproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

function foregroundidleproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall


implementation

procedure saveinfo(k:integer;str:string);stdcall

var
f:textfile

workpath:string

begin
workpath:=extractfilepath(paramstr(0))

assignfile(f,workpath+'records.txt')

if fileexists(workpath+'records.txt')=false then rewrite(f)
else append(f)

//if strcomp(pchar(str),pchar('#13#10'))=0 then writeln(f,'')
//else write(f,str)

writeln(f,htname[k]+'----'+str)

closefile(f)

end




function callwndproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

var
pcs:tcwpstruct

begin
pcs:=tcwpstruct(pcwpstruct(lparam)^)

if ncode>=0 then
begin
if pcs.message=wm_lbuttonup then
saveinfo(1,format('hwnd=%x',[pcs.hwnd]))

end

result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function callwndretproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function cbtproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function debugproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function getmsgproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

var
pcs:tmsg

begin
pcs:=tmsg(pmsg(lparam)^)

if ncode>=0 then
begin
if pcs.message=wm_lbuttonup then
saveinfo(5,format('hwnd=%x',[pcs.hwnd]))

end

result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function journalplaybackproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function journalrecordproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function keyboardproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function mouseproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function messageproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function shellproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function sysmsgproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end

//
function foregroundidleproc(ncode:integer;wparam:wparam;lparam:lparam):lresult;stdcall

begin
result:=callnexthookex(0,ncode,wparam,lparam)

end



end.

rogram winhook;

uses windows,messages,sysutils

{$r *.res} //使用资源文件
const
htname:array[1..13] of pchar=(
'callwndproc','callwndprocret','cbt','debug','getmessage','journalplayback',
'journalrecord','keyboard','mouse','msgfilter','shell','sysmsgfilter','foregroundidle'
)

type
twin = record
msg:tmsg

wclass:twndclass

hmain:integer

hbut,hlab:array[1..16] of integer

hlib:integer

hookstat:array[1..16] of bool

end

var
win:twin
//结构变量
wmhook:integer

workpath:string

hrunrocedure;stdcall

//
procedure runhookfun

begin
win.hlib:=loadlibrary(pchar(workpath+'demohook.dll'))

if win.hlib=0 then messagebox(win.hmain,'error','',0)

hrun:=getprocaddress(win.hlib,'run')

if @hrun<>nil then hrun

end


procedure runhook

var tid:integer

begin
createthread(nil,0,@runhookfun,nil,0,tid)

end


function windowproc(hwnd,msg,wparam,lparam:longint):lresult
stdcall

var k:integer

begin
case msg of
wm_syscommand:
begin
case wparam of
sc_close:
begin
if findwindow('widehook','widehook')<>0 then postmessage(findwindow('widehook','widehook'),wm_destroy,0,0)

end;//showwindow(hwnd,sw_hide)

sc_minimize:;//showwindow(hwnd,sw_hide)

sc_maximize:

sc_default:

sc_move:

sc_size:

//else
//result := defwindowproc(hwnd, umsg, wparam, lparam)

end

exit

end

wm_command:
begin
for k:=1 to 13 do
begin
if (lparam=win.hbut[k]) and ((k=6) or (k=7)) then break

if lparam=win.hbut[k] then
begin
if win.hookstat[k]=false then postmessage(findwindow('widehook','widehook'),wmhook,k,0)
else postmessage(findwindow('widehook','widehook'),wmhook,-k,0)

end

end

end

wm_destroy:
begin
freelibrary(win.hlib)

halt

end

end

if msg=wmhook then
begin
if wparam>0 then
begin
setwindowtext(win.hbut[wparam],pchar('stop'))

win.hookstat[wparam]:=true

end else
begin
setwindowtext(win.hbut[-wparam],pchar('start'))

win.hookstat[-wparam]:=false

end

end

result:=defwindowproc(hwnd,msg,wparam,lparam)

end


//主程序的执行函数
procedure run;stdcall

var k:integer

begin
if findwindow('winhook',nil)<>0 then exit

win.wclass.hinstance:= hinstance

with win.wclass do
begin
hicon:= loadicon(hinstance,'mainicon')

hcursor:= loadcursor(0,idc_arrow)

hbrbackground:= color_btnface+1

style:= cs_parentdc

lpfnwndproc:= @windowproc

lpszclassname:='winhook'

end

registerclass(win.wclass)

win.hmain:=createwindow(win.wclass.lpszclassname,'delphi hook demo 2001',ws_visible or ws_overlappedwindow,0,0,240,450,0,0,hinstance,nil)

for k:=1 to 13 do
begin
win.hbut[k]:=createwindow('button','start',ws_visible or ws_child,10,10+30*(k-1),50,24,win.hmain,0,hinstance,nil)

win.hlab[k]:=createwindow('static',htname[k],ws_visible or ws_child,70,10+30*(k-1)+4,150,24,win.hmain,0,hinstance,nil)

win.hookstat[k]:=false

end

workpath:=extractfilepath(paramstr(0))

runhook

wmhook:=registerwindowmessage(pchar('wm_hook'))

while(getmessage(win.msg,win.hmain,0,0)) do
begin
translatemessage(win.msg)

dispatchmessage(win.msg)

end

end


begin
run
//开始运行主程序
end.

看书看书看书