HMODULE getCurrModuleHandle()
{
MEMORY_BASIC_INFORMATION info;
::VirtualQuery((LPCVOID)(&getCurrModuleHandle), &info, sizeof(info));

HMODULE getCurrModuleHandle()
{
MEMORY_BASIC_INFORMATION info;
::VirtualQuery((LPCVOID)(&getCurrModuleHandle), &info, sizeof(info));

{
函数
procedure pinghost(ip:string;var info:string);
ip:目标IP地址;
info:ping了随后发生的音讯(1)或(2);
(1)成功新闻
ip 发送测试的字符数 重临时间
(2)出错新闻
Can not find host!

function MainApplicationHandle: HWND;
var
  MainModule: HMODULE;
  CurrentPID: DWORD;
  WindowsPID: DWORD;
begin
  MainModule := GetModuleHandle(nil);
  CurrentPID := GetCurrentProcessID();

return (HMODULE)info.AllocationBase;
}

return (HMODULE)info.AllocationBase;
}

【澳门金沙国际】获得当前模块句柄,dll获得主窗體的handle。使用
uses ping;
procedure TForm1.Button1Click(Sender: TObject);
var
str:string;
ping:Tping;
begin
ping:=Tping.create ;//一定要初试化哦
ping.pinghost(‘127.0.0.1’,str);
memo1.Lines.Add(str);
ping.destroy ;
end;

  Result := 0;
澳门金沙国际,  while True do
  begin
    Result := FindWindowEx(0, Result, ‘TApplication’, nil);
    if (Result = 0) then Exit; // 未找到

}
unit ping;

    GetWindowThreadProcessID(Result, WindowsPID);
    if (WindowsPID = CurrentPID) and
       (HMODULE(GetWindowLong(Result, GWL_HINSTANCE)) = MainModule)
    then Exit; // 找到!!
  end;
end;

interface

 

uses

Windows, SysUtils, Classes,  Controls, Winsock,
StdCtrls;

type
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize: Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation;
end;

TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho = function(IcmpHandle:THandle;
DestinationAddress: DWORD;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall;

Tping =class(Tobject)

private
{ Private declarations }
hICMP: THANDLE;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
public
procedure   pinghost(ip:string;var info:string);
constructor create;
destructor destroy;override;
{ Public declarations }
end;

var
hICMPdll: HMODULE;

implementation

constructor Tping.create;
begin
inherited create;
hICMPdll := LoadLibrary(‘icmp.dll’);
@ICMPCreateFile := GetProcAddress(hICMPdll, ‘IcmpCreateFile’);
@IcmpCloseHandle := GetProcAddress(hICMPdll,’IcmpCloseHandle’);
@IcmpSendEcho := GetProcAddress(hICMPdll, ‘IcmpSendEcho’);
hICMP := IcmpCreateFile;
end;

destructor Tping.destroy;
begin
FreeLibrary(hIcmpDll);
inherited destroy;
end;

 

procedure Tping.pinghost(ip:string;var info:string);
var
// IP Options for packet to send
IPOpt:TIPOptionInformation;
FIPAddress:DWORD;
pReqData,pRevData:PChar;
// ICMP Echo reply buffer
pIPE:PIcmpEchoReply;
FSize: DWORD;
MyString:string;
FTimeOut:DWORD;
BufferSize:DWORD;
begin

 

if ip <> ” then
begin
FIPAddress := inet_addr(PChar(ip));
FSize := 40;
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pRevData,FSize);
GetMem(pIPE,BufferSize);
FillChar(pIPE^, SizeOf(pIPE^), 0);
pIPE^.Data := pRevData;
MyString := ‘Test Net – Sos Admin’;
pReqData := PChar(MyString);
FillChar(IPOpt, Sizeof(IPOpt), 0);
IPOpt.TTL := 64;
FTimeOut := 4000;
try
IcmpSendEcho(hICMP, FIPAddress, pReqData, Length(MyString),@IPOpt, pIPE,
BufferSize, FTimeOut);
if pReqData^ = pIPE^.Options.OptionsData^ then
info:=ip+ ‘ ’ + IntToStr(pIPE^.DataSize) + ‘   ’
+IntToStr(pIPE^.RTT);
except
info:=’error’;
FreeMem(pRevData);
FreeMem(pIPE);
Exit;
end;
FreeMem(pRevData);
FreeMem(pIPE);
end;

 

end;

 

end.

相关文章