PProcessEntryW = ^TProcessEntryW;
  TProcessEntryW = Record
    dwSize:DWORD;
    {$IFDEF CPUX64}
    cntUsage:UInt64;
    {$ELSE}
    cntUsage:DWORD;
    {$ENDIF}
    th32ProcessID:DWORD;
    th32DefaultHeapID:DWORD;
    th32ModuleID:DWORD;
    cntThreads:DWORD;
    th32ParentProcessID:DWORD;
    pcPriClassBase:DWORD;
    dwFlags:DWORD;
    szExeFile:Array[0..MAX_PATH - 1] of WideChar;
  end;

将数据类型tagPROCESSENTRY32中的cntUsage修改下即可 X86下用32位的无符号整数X64下用64位的无符号整数

之前搜了好多有人在MSDN社区说把dwFlags修改成64位整数结果测试后完全无效....

只修改个cntUsage即可 Win7 SP1 X64测试完全可用

Patch1:

不过有个很蛋疼的问题是 这套API本应该是给32位用的 64位用本来就不合适

强制改数据类型用是可以用但是 数据会错位...

cntUsage修改成8位直接的64位整数后直接取th32ProcessID的话肯定会返回0

解决方法就是向前挪2位....

Patch2:

PID

th32ProcessID        = PDWORD(PByte(DWORD(@tagPROCESSENTRY32) + 8))^;

父进程PID

th32ParentProcessID  = PDWORD(PByte(DWORD(@tagPROCESSENTRY32) + 32))^;

进程名称

szExeFile            = PWideChar(PByte(DWORD(@tagPROCESSENTRY32) + 44));

其余的不用基本没啥用

下面代码只为实现不考虑线程安全因素 仅供参考

unit Unit_Main;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
  TForm_Main = class(TForm)
    Memo: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Procedure ShareMSG(Var Msg:TMessage); Message WM_COPYDATA;
  end;
Var
  Form_Main: TForm_Main;
  uMax     :Integer;
implementation
{$R *.dfm}
Procedure TForm_Main.ShareMSG(Var Msg:TMessage);
begin
  if Msg.Msg = WM_COPYDATA then
  begin
    Caption    := '第:' + IntToStr(PCopyDataStruct(Msg.LParam)^.cbData) + '次收到数据!~';
    Msg.Result := 1; //返回1
  end;
end;

Function ThreadProc(lpParam:Pointer):DWORD; Stdcall;
Var
  hWin  :HWND;
  Data  :TCopyDataStruct;
  uCount:Integer;
begin
  Result := 0;
  hWin   := HWND(lpParam);
  for uCount := 1 to uMax do
  begin
    ZeroMemory(@Data, SizeOf(Data));
    Data.dwData := 0;
    Data.cbData := uCount;  //数据的大小
    Data.lpData := Nil;     //数据内存指针
    if SendMessage(hWin, WM_COPYDATA, 0, lParam(@Data)) = 1 then
    begin
      Form_Main.Memo.Lines.Add('第:' + IntToStr(uCount) + '次发送!~');
    end;
    Sleep(30);
  end;    
end;  

procedure TForm_Main.Button1Click(Sender: TObject);
Var
  hWin :HWND;
  lThread   :THandle;
  lThreadId :DWORD;  
begin
  hWin := FindWindowW('TForm_Main', 'Process_B'); 
  if hWin > 32 then
  begin
    uMax    := StrToInt(Edit1.Text);
    lThread := CreateThread(nil, 0, @ThreadProc, Pointer(hWin), 0, lThreadId);
    CloseHandle(lThread);
  end Else
  begin
    Memo.Lines.Text := '没有找到进程B的窗口';
  end;    
end;
end.

  private
    { Private declarations }
    Procedure OnMove(Var Message:TMessage);  Message WM_MOVE;
  public
    { Public declarations }
  end;

Procedure TForm_Main.OnMove(Var Message:TMessage);
begin
  If GetWindowRect(Form_Main.Handle, lpRect) And (Metrics.X > 0) And (Metrics.Y > 0) Then
  begin
    if lpRect.Left < 30 then
    begin
      Form_Main.Left := 0 - (Form_Main.Width - 10);  //左隐藏
    end Else
    if (Metrics.X - lpRect.Right) < 30 then
    begin
      Form_Main.Left := Metrics.X - 10;   //又隐藏
    end Else
    if lpRect.Top < 30 then
    begin
      Form_Main.Top := 0 - (Form_Main.Height - 10);  //上隐藏
    end Else
    if (Metrics.Y - lpRect.Bottom) < 30 then
    begin                                        //下隐藏
      Form_Main.Top := Metrics.Y - 60;
    end;
  end;
end;

Type
  THTTPHead = (nHead, nGet, nPost);

  PWebHead = ^TWebHead;
  TWebHead = Record
    uCode :Word;
    szSer :Array [0..64] Of AnsiChar;
  End;

  PDomain = ^TDomain;
  TDomain = Record
    szUrl  :Array [0..255] Of AnsiChar;
    szHost :Array [0..255] Of AnsiChar;
    szFile :Array [0..255] Of AnsiChar;
    bSSL   :Boolean;
    nPort  :Word;
  End;

Const
  UserAgent:PAnsiChar = 'Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko';
  Header   :PAnsiChar = 'Content-Type: application/x-www-form-urlencoded'#13#10#$0;

Function StrStrIA(lpFirst, lpSrch: PAnsiChar): PAnsiChar; stdcall; external 'shlwapi.dll' name 'StrStrIA';
Function StrNCatA(lpFirst, lpSrch:PAnsiChar; cchMax:Integer): PAnsiChar; stdcall; external 'shlwapi.dll' name 'StrNCatA';
Function StrToIntA(lpSrch: PAnsiChar): Integer; stdcall; external 'shlwapi.dll' name 'StrToIntA';

Function StrPosA(lpSrch, lpFirst:PAnsiChar):Integer;
Var
  Cmp :PAnsiChar;
begin
  Result := 0;
  if (lpSrch = Nil) Or (lpFirst = Nil) then Exit;
  if DWORD(lpSrch) = DWORD(lpFirst) then
  begin
    Result := 1;
    Exit;
  end;
  Cmp := StrStrIA(lpFirst, lpSrch);
  if Cmp <> Nil then
  begin
    Result := DWORD(Cmp) - DWORD(lpFirst) + 1;
  end;
end;

Procedure DeleteA(lpszStr:PAnsiChar; Index, Count:Integer);
Var
  uSize :Integer;
begin
  uSize  := lstrlenA(lpszStr);
  if uSize = Count then
  begin
   lstrcpyA(@lpszStr[index - 1], @lpszStr[Index + Count -1]);
   ZeroMemory(@lpszStr[index -1], Index + Count);
  end else begin
   lpszStr[Index - 1] := #0;
   StrNCatA(lpszStr, @lpszStr[Index + Count - 1], uSize);
  end;
end;

Function CopyA(lpszStr:PAnsiChar; Index, Count:Integer):PAnsiChar;
begin
  Result := GetMemory(Count - Index + 1);
  lstrcpynA(Result, @lpszStr[Index -1], Count);
end;

Function ParseURL(szUrl:PAnsiChar):PDomain;
Var
  nSize   :DWORD;
  szSeek  :PAnsiChar;
  szCmp   :PAnsiChar;
begin
  Result := GetMemory(SizeOf(TDomain));
  ZeroMemory(Result, SizeOf(TDomain));
  if StrStrIA(szUrl, 's://') <> Nil then Result^.bSSL := True;
  nSize  := StrPosA('://', szUrl);
  if nSize > 0 then
  begin
    szSeek := @szUrl[nSize + 2];
    lstrcpyA(@Result^.szUrl, szUrl);
  end else
  begin
    szSeek := szUrl;
    lstrcpyA(@Result^.szUrl, 'http://');
    lstrcatA(@Result^.szUrl, szUrl);
  end;
  nSize  := StrPosA(':', szSeek);
  if nSize > 0 then
  begin
    lstrcpynA(@Result^.szHost, szSeek, nSize);
    szSeek := @szSeek[nSize];
    nSize  := StrPosA('/', szSeek);
    if nSize > 0 then
    begin
      lstrcpynA(@Result^.szFile, szSeek, nSize);
      Result^.nPort := StrToIntA(Result^.szFile);
      ZeroMemory(@Result^.szFile, 256);
      szSeek := @szSeek[nSize - 1];
    end;
  end Else
  begin
    nSize  := StrPosA('/', szSeek);
    if nSize > 0 then lstrcpynA(@Result^.szHost, szSeek, nSize) Else lstrcpyA(@Result^.szHost, szSeek);
    szCmp  := StrStrIA(szUrl, 's://');
    if szCmp <> Nil then
    begin
      nSize := DWORD(szCmp) - DWORD(szUrl);
      if nSize  > 0 then Result^.nPort := 443;
    End Else Result^.nPort := 80;
  end;
  nSize  := StrPosA('/', szSeek);
  if nSize > 0 then lstrcpynA(@Result^.szFile, @szSeek[nSize], 255);
  if lstrlenA(@Result^.szFile)  = 0 then lstrcpyA(@Result^.szFile, '/');
end;

Function GetCode(szHead:PAnsiChar):Integer;
Var
  szSeek :PAnsiChar;
  uRet   :Integer;
begin
  Result := 0;
  szSeek := szHead;
  uRet   := StrPosA(' ', szSeek);
  if uRet > 0 then
  begin
    Inc(szSeek, uRet);
    uRet := StrPosA(' ', szSeek);
    if uRet > 0 then
    begin
      szSeek[uRet-1] := #$0;
      Result := StrToIntA(szSeek);
      szSeek[uRet-1] := ' ';
    end;
  end;
end;

Function GetWebSer(szHead:PAnsiChar):PAnsiChar;
Var
  szSeek :PAnsiChar;
  uRet   :Integer;
begin
  Result := Nil;
  szSeek := szHead;
  uRet   := StrPosA('Server:', szSeek);
  if uRet > 0 then
  begin
    Inc(szSeek, uRet + 7);
    uRet := StrPosA(#13, szSeek)-1;
    if uRet > 0 then
    begin
      szSeek[uRet] := #$0;
      Result := GetMemory(lstrlenA(szSeek) + 6);
      lstrcpyA(Result, szSeek);
      szSeek[uRet] := #13;
    end;
  end;
end;

Function GetPowered(szHead:PAnsiChar):PAnsiChar;
Var
  szSeek :PAnsiChar;
  uRet   :Integer;
begin
  Result := Nil;
  szSeek := szHead;
  uRet   := StrPosA('x-powered-by:', szSeek);
  if uRet > 0 then
  begin
    Inc(szSeek, uRet + 13);
    uRet := StrPosA(#13, szSeek)-1;
    if uRet > 0 then
    begin
      szSeek[uRet] := #$0;
      Result := GetMemory(lstrlenA(szSeek) + 6);
      lstrcpyA(Result, szSeek);
      szSeek[uRet] := #13;
    end;
  end;
end;

Function HTTP_Exec(lpHead:THTTPHead; szUrl:PAnsiChar; Data:Pointer; dSize:DWORD; Cookies:PAnsiChar; Var uCode:DWORD):PByte;
Const
  IntBufSize  = 8192;
Var
  Session   :HINTERNET;
  Connect   :HINTERNET;
  Resource  :HINTERNET;
  dwFlags   :DWORD;
  Buffer    :Array[0..IntBufSize-1] of AnsiChar;
  uSize     :DWORD;
  uRecv     :DWORD;
  dwDomain  :PDomain;
  Stream    :TMemoryStream;
begin
  Result    := Nil;
  uCode     := 0;
  Stream    := TMemoryStream.Create;
  dwDomain  := ParseURL(szUrl);
  if dwDomain = Nil then Exit;
  if dwDomain^.bSSL then dwFlags := INTERNET_FLAG_SECURE Else dwFlags := 0;
  if Cookies <> Nil then InternetSetCookieA(szUrl, Nil, Cookies);
  Session   := InternetOpenA(UserAgent, INTERNET_OPEN_TYPE_PRECONFIG, Nil, Nil, 0);
  if Session <> Nil then
  begin
    Connect := InternetConnectA(Session, @dwDomain^.szHost, dwDomain^.nPort, Nil, Nil, INTERNET_SERVICE_HTTP, 0, 0);
    if Connect <> Nil then
    begin
      case lpHead of
        nHead :
        begin
          Resource := HttpOpenRequestA(Connect, 'HEAD', @dwDomain^.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
          if Resource <> Nil then
          begin
            if HttpSendRequestA(Resource, Nil, 0, Nil, 0) then
            begin
              uSize := SizeOf(Buffer);
              ZeroMemory(@Buffer, uSize);
              uRecv := 0;
              if HttpQueryInfoA(Resource, HTTP_QUERY_RAW_HEADERS_CRLF, @Buffer, uSize, uRecv) then
              begin
                Stream.WriteBuffer(Buffer, lstrlenA(@Buffer));
                uCode := GetCode(@Buffer);
              end;
            end;
          end;
        end;
        nGet  :
        begin
          Resource := HttpOpenRequestA(Connect, 'GET', @dwDomain^.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
          if Resource <> Nil then
          begin
            if HttpSendRequestA(Resource, Nil, 0, Nil, 0) then
            begin
              uSize := SizeOf(DWORD);
              uRecv := 0;
              if HttpQueryInfoA(Resource, HTTP_QUERY_STATUS_CODE Or HTTP_QUERY_FLAG_NUMBER, @uCode, uSize, uRecv) then
              begin
                repeat
                  if InternetReadFile(Resource, @Buffer, IntBufSize, uRecv) then
                  begin
                    Stream.WriteBuffer(Buffer, uRecv);
                  end;
                until uRecv = 0;
              end;
            end;
          end;
        end;
        nPost :
        begin
          Resource := HttpOpenRequestA(Connect, 'POST', @dwDomain^.szFile, Nil, Nil, Nil, dwFlags Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0);
          if Resource <> Nil then
          begin
            If HttpAddRequestHeadersA(Resource, Header, lstrlenA(Header), dwFlags Or HTTP_ADDREQ_FLAG_ADD Or HTTP_ADDREQ_FLAG_REPLACE) Then
            begin
              if HttpSendRequestA(Resource, Nil, 0, Data, dSize) then
              begin
                uSize := SizeOf(DWORD);
                uRecv := 0;
                if HttpQueryInfoA(Resource, HTTP_QUERY_STATUS_CODE Or HTTP_QUERY_FLAG_NUMBER, @uCode, uSize, uRecv) then
                begin
                  repeat
                    if InternetReadFile(Resource, @Buffer, IntBufSize, uRecv) then
                    begin
                      Stream.WriteBuffer(Buffer, uRecv);
                    end;
                  until uRecv = 0;
                end;
              end;
            end;
          end;
        end;
      end;
      InternetCloseHandle(Connect);
    end;
    InternetCloseHandle(Session);
  end;
  if Stream.Size > 0 then
  begin
    Result := GetMemory(Stream.Size);
    CopyMemory(Result, Stream.Memory, Stream.Size);
  end;
  Stream.Free;
end;