DLL参数传递问题~~(10分)

  • 主题发起人 主题发起人 linuxping
  • 开始时间 开始时间
L

linuxping

Unregistered / Unconfirmed
GUEST, unregistred user!
DLL代码:

unit Procc;

interface
uses Windows, Messages, SysUtils,StrUtils, Variants, Classes,Dialogs,TLHelp32;

function AdjustProcessPrivilege(ProcessHandle:THandle;Token_Name:Pchar):boolean;stdcall;
function IsFoundProc(AName:PChar):Boolean;stdcall;
function FoundProc(AName:PChar):THandle;stdcall;
function KillProc(AName:PChar):Boolean;stdcall;

implementation

function AdjustProcessPrivilege(ProcessHandle:THandle;Token_Name:Pchar):boolean;stdcall;
var
Token:Cardinal;
TokenPri:_TOKEN_PRIVILEGES;
ProcessDest:int64;
l:DWORD;
begin
Result:=False;
if OpenProcessToken(ProcessHandle,TOKEN_Adjust_Privileges,Token) then
begin
if LookupPrivilegeValue(nil,Token_Name,ProcessDest) then
begin
TokenPri.PrivilegeCount:=1;
TokenPri.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
TokenPri.Privileges[0].Luid:=ProcessDest;
l:=0;
//更新进程令牌,成功返回TRUE
if AdjustTokenPrivileges(Token,False,TokenPri,sizeof(TokenPri),nil,l) then
Result:=True;
end;
end;
end;

function IsFoundProc(AName:PChar):Boolean;stdcall;
begin
Result:=FoundProc(AName)<>0;
end;


function FoundProc(AName:PChar):THandle;stdcall;
var
hSnapShot:THandle;
bExist:Boolean;
pProcess :PPROCESSENTRY32;

sProcName:PChar;
begin
Result:=0;
hSnapShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); //创建进程快照
If hSnapShot = 0 Then Exit;
GetMem(pProcess,SizeOf(TProcessEntry32));
//FillChar(pProcess,SizeOf(TProcessEntry32),0);
//ShowMessage(IntToStr(SizeOf(TProcessEntry32)));
pProcess^.dwSize := SizeOf(TProcessEntry32);
bExist:=Process32First(hSnapShot, pProcess^);
if (not bExist) then FreeMem(pProcess);
While (bExist) do
begin
sProcName:=pProcess.szExeFile;
if AnsiCompareText(sProcName,AName)=0 then
begin
Result:=pProcess.th32ProcessID;
Exit;
end;
//FillChar(pProcess,SizeOf(TProcessEntry32),0);
pProcess^.dwSize := SizeOf(TProcessEntry32);
bExist:=Process32Next(hSnapShot, pProcess^);
end;
FreeMem(pProcess);
CloseHandle(hSnapShot);
end;

function KillProc(AName:PChar):Boolean;stdcall;
var
hProc:THandle;
MyProc:HWND;
begin
Result:=False;
try
hProc:=FoundProc(AName);
if hProc=0 then Exit;

if AdjustProcessPrivilege(GetCurrentProcess,'SeDebugPrivilege') then
begin
MyProc:=OpenProcess(PROCESS_ALL_ACCESS ,False,hProc);
TerminateProcess(MyProc,1);
Result:=True;
end;

except
//abort all Errors~
end;

end;

end.

//////////////////////////////
调用:
type TFound=function(AName:string):Boolean;
TKill=function(AName:string):Boolean;

pFound=^TFound;
pKill=^TKill;

type
TForm1 = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
pfd, pkl:TFarProc;
tfd:TFound;
tkl:TKill;
hMd:THandle;
sName:PChar;
begin
hMd:=LoadLibrary('Project1.dll');
if hMd=0 then raise Exception.Create('load Error~');

try
pfd:=GetProcAddress(hMd,'IsFoundProc');
if (pfd=nil) then raise Exception.Create('Function1 not found~');
tfd:=TFound(Pfd);

pkl:=GetProcAddress(hMd,'KillProc');
if pkl=nil then raise Exception.Create('Function2 not found~');
tkl:=TKill(pkl);

GetMem(sName,260);
StrCopy(sName,'QQ.EXE');
if tfd(sName) then
tkl(sName);
FreeMem(sName);
finally
FreeLibrary(hMd);
end;
end;

end.

这是帮网友写的东西.可是参数传递却把我给搞得累死了~
>> 单步调试到:
function IsFoundProc(AName:PChar):Boolean;stdcall;
begin
Result:=FoundProc(AName)<>0; <------------AName居然是乱码!!!!!!
end;
 
PChar -- String
 
老兄,我用的是pchar!!!!
 
<Delphi源代码分析>里将PCHAR和STRING的区别讲得非常详细,见意你看看。还详细讲述了在DLL中传递字符串需要注意的东西。
 
多谢'火山'!
可是远水救不了进火~
 
你太马虎了。
type TFound=function(AName:string):Boolean;stdcall;
TKill=function(AName:string):Boolean;stdcall;

pFound=^TFound;
pKill=^TKill;
 
TFound=function(AName:string):Boolean;stdcall;
TKill=function(AName:string):Boolean;stdcall;
后面不加Stdcall则Delphi默认调用约定是前三个参数用寄存器传递。而DLL那边有stdcall则认为参数是在栈里面。两边约定的东西不一致啊。呵呵。
 
tfd:=TFound(Pfd); -> tfd := TFound(Pfd)(sName); 试试,好象是TFound(Pfd)后面少了参数
 
多谢wr960204!!!!

也谢谢其他人的帮助!!!
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
784
import
I
I
回复
0
查看
732
import
I
I
回复
0
查看
905
import
I
后退
顶部