等待高手~~取得运行中的程序的图标（附我的代码），呆了两天了：~~~~~

to 楼上：谢谢回复呀，但是我这里有的嘛~~
function MyGetWindowIcon(wnd:HWND):HIcon;
begin
  Result:=GetClassLong(wnd,GCL_HICON);
  if Result=0 then
    Result:=SendMessage(wnd,WM_GETICON,ICON_BIG,0);
end;
再拿出来晒晒~~都快发霉了~~~~~~谢谢

用 Windows API 函数：ExtractAssociatedIcon
别忘了加: uses ShellApi;
即可解决你的问题。

我这里得到的不是应用程序的路径呀~~~~~我这里得到的是窗口的Handle和窗口标
题栏的caption；或者，有没有方法，由程序的Handle得到程序的路径？隔了一个周末，再拿出来晒晒先~~~~~

晒干了没？！看看GetClassLong的返回值！！！！！！！！！！！！如果为零的话，那这里出了问题！！
否则去其它地方找！！function MyGetWindowIcon(wnd:HWND):HIcon;
begin
  Result:=GetClassLong(wnd,GCL_HICON);　＜
  if Result=0 then
    Result:=SendMessage(wnd,WM_GETICON,ICON_BIG,0);
end;

to CoolSlob()：我加了你的这个函数了的呀~~调用的时候是
wnd:=GetParent(Windows.FindWindow(nil,PChar(AppListBox.Items[AppNum])));
AppName_Btn[AppNum].Glyph.Handle:=MyGetWindowIcon(wnd);这样还是不行的呀~~~~~继续晒晒~~~~~~

to dearmite(我是笨笨!)：你测试过我的代码没呀？？没测试就在这里说哦~~~高手高手我爱你，就想老鼠爱大米^_*

继续晒你~~~~~~wnd:=GetParent(Windows.FindWindow(nil,PChar(AppListBox.Items[AppNum])));
ShowMessage(IntToStr(MyGetWindowIcon(Wnd)));//告诉我这个值!!
//要不我到OICQ里聊吧~~反正我今天处于失意状态，不想　　做事！！
AppName_Btn[AppNum].Glyph.Handle:=MyGetWindowIcon(wnd);

或者，有没有方法，由程序的Handle得到程序的路径？
这个办法可以解决：
如果知道一个窗口的句饼，可以用快照把他所属的进程找出来，也就得到了其应用程序的路径。不过有点笨，我不知道还有什么更好的办法，等高手指出吧。

大家运行一下就可以知道我说的是怎么会事了呀~~to CoolSlob()：我不好意思呀~~公司里不让挂QQ的~~~我的MSN: [email protected] heyouxian():怎么用快照把已知窗口Handle的进程的程序路径找到呢？谢谢指点~~天快阴了~~也得再晒晒：~~~~

不帮你晒了~~
我不上MSN~~

呵呵，你到delphi的第2张安装盘上找Jedi_Project的Open Source Project。上面有例子！在windows2000下的任务管理器中的应用程序列表就包含了程序的图标。那个例子完全就是win2k的任务管理器的翻版！你看看就明白了，如果还不明白和我联系！

procedure TMainForm.BuildProcessList(Rebuild: Boolean = False);
var
  SnapProcHandle, ProcessHandle: THandle;
  ProcessEntry: TProcessEntry32;
  Next: Boolean;
  FileInfo: TSHFileInfo;
  ProcessVersion: DWORD;
  FindItem: TListItem;
  I: Integer;
  ProcList: TList;
  Added, Changed: Boolean;  procedure CheckChanged;
begin
  if ProcessListView.ItemFocused = FindItem then Changed := True;
end;begin
  if FDisableUpdate then Exit;
  ProcList := TList.Create;
  Added := False;
  Changed := False;
  with ProcessListView do
  try
    FDisableUpdate := True;
    try
      if Rebuild then
      begin
        Screen.Cursor := crHourGlass;
        Items.BeginUpdate;
        Items.Clear;
        FProcess_Cnt := 0;
        FThreads_Cnt := 0;
      end else
        SendMessage(Handle, WM_SETREDRAW, 0, 0);
      SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
      if SnapProcHandle <> THandle(-1) then
      begin
        ProcessEntry.dwSize := Sizeof(ProcessEntry);
        Next := Process32First(SnapProcHandle, ProcessEntry);
        while Next do
        begin
          ProcList.Add(Pointer(ProcessEntry.th32ProcessID));
          FindItem := FindData(0, Pointer(ProcessEntry.th32ProcessID), True, False);
          with ProcessEntry do if FindItem = nil then
          begin // New Process
            Added := True;
            if IsWin2k then
            begin
              ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, th32ProcessID);
              if Handle <> 0 then
              begin
                if GetModuleFileNameEx(ProcessHandle, 0, szExeFile, SizeOf(szExeFile)) = 0 then
                  StrPCopy(szExeFile, '[Idle]');
                CloseHandle(ProcessHandle);
              end;
            end;
            ProcessVersion := SHGetFileInfo(szExeFile, 0, FileInfo, Sizeof(FileInfo), SHGFI_EXETYPE);
            SHGetFileInfo(szExeFile, 0, FileInfo, Sizeof(FileInfo), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
            with Items.Add, ProcessEntry do
            begin
              Caption := AnsiLowerCase(ExtractFileName(szExeFile));
              Data := Pointer(th32ProcessID);
              ImageIndex := FileInfo.iIcon;
              StateIndex := GetPriorityIconIndex(pcPriClassBase);
              SubItems.AddObject(Format('%.8x', [th32ProcessID]), Pointer(th32ProcessID));
              SubItems.AddObject(Format('%d', [pcPriClassBase]), Pointer(pcPriClassBase));
              SubItems.AddObject(Format('%d', [cntThreads]), Pointer(cntThreads));
              SubItems.AddObject(GetProcessVersion(ProcessVersion), Pointer(ProcessVersion));
              SubItems.Add(szExeFile);
              SubItems.AddObject(Format('(%.8x)', [th32ParentProcessID]), Pointer(th32ParentProcessID));
              Inc(FProcess_Cnt);
              Inc(FThreads_Cnt, cntThreads);
            end;
          end else
          with FindItem do
          begin // Any changes in existing process ?
            if SubItems.Objects[1] <> Pointer(pcPriClassBase) then
            begin
              SubItems.Objects[1] := Pointer(pcPriClassBase);
              SubItems.Strings[1] := Format('%d', [pcPriClassBase]);
              StateIndex := GetPriorityIconIndex(pcPriClassBase);
            end;
            if SubItems.Objects[2] <> Pointer(cntThreads) then
            begin
              Inc(FThreads_Cnt, cntThreads - DWORD(SubItems.Objects[2]));
              SubItems.Objects[2] := Pointer(cntThreads);
              SubItems.Strings[2] := Format('%d', [cntThreads]);
              CheckChanged;
            end;
          end;
          Next := Process32Next(SnapProcHandle, ProcessEntry);
        end;
        CloseHandle(SnapProcHandle);
      end;
      if Added then // find the names of parent processes
      begin
        for I := 0 to Items.Count - 1 do
        begin
          FindItem := FindData(0, Items[I].SubItems.Objects[5], True, False);
          if FindItem <> nil then Items[I].SubItems[5] := FindItem.Caption;
        end;
        AlphaSort;
      end;
      for I := Items.Count - 1 downto 0 do // delete non-existing processes
        if ProcList.IndexOf(Items[I].Data) = -1 then
        begin
          Dec(FProcess_Cnt);
          Dec(FThreads_Cnt, DWORD(Items[I].SubItems.Objects[2]));
          Items.Delete(I);
        end;
      if GetNextItem(nil, sdAll, [isSelected]) = nil then
      begin
        if ItemFocused = nil then ItemFocused := Items[0];
        ItemFocused.Selected := True;
      end else
        if Changed then BuildThreadsList(DWORD(ItemFocused.Data));
      UpdateStatusLine(True);
    finally
      if Rebuild then
        Items.EndUpdate
      else
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
    end;
  finally
    FDisableUpdate := False;
    ProcList.Free;
    Screen.Cursor := crDefault;
  end;
end;

我的demo里没有这个程序呀~~帮帮忙把dfm一起贴过来好不好？？谢谢先呀^_*

to smhpnuaa(农奴翻身感谢党):我还没收到呢~~~~~什么，你还没发出呀？呵呵

to smhpnuaa(农奴翻身感谢党):我收到了~~但是出错呢~~少文件~~~我用的是Delphi6呀~~~~[Fatal Error] ToolHelpViewer.dpr(13): File not found: 'JclAppInst.dcu'

www.xlrj.com/common.rar你自己下载吧！

to smhpnuaa:我下载了，但是还是少那个'JclAppInst.dcu'呢？这是你安装的控件吧？我就看看源码了吧，谢谢哈等一下再开贴给你分。顺便说一句：www.xlrj.com是你竹叶？做得不错哦^_*

{******************************************************************************}
{                                                                              }
{ Project JEDI Code Library (JCL)                                              }
{                                                                              }
{ The contents of this file are subject to the Mozilla Public License Version  }
{ 1.1 (the "License"); you may not use this file except in compliance with the }
{ License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ }
{                                                                              }
{ Software distributed under the License is distributed on an "AS IS" basis,   }
{ WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
{ the specific language governing rights and limitations under the License.    }
{                                                                              }
{ The Original Code is JclAppInst.pas.                                         }
{                                                                              }
{ The Initial Developer of the Original Code is documented in the accompanying }
{ help file JCL.chm. Portions created by these individuals are Copyright (C)   }
{ of these individuals.                                                        }
{                                                                              }
{******************************************************************************}
{                                                                              }
{ This unit contains a class and support routines for controlling the number   }
{ of concurrent instances of your application that can exists at any time. In  }
{ addition there is support for simple interprocess communication between      }
{ these instance including a notifaction mechanisme.                           }
{                                                                              }
{ Unit owner: Petr Vones                                                       }
{ Last modified: February 12, 2001                                             }
{                                                                              }
{******************************************************************************}unit JclAppInst;{$I JCL.INC}interfaceuses
  Windows, Messages, Classes,
  JclBase, JclFileUtils, JclSynch;//------------------------------------------------------------------------------
// Message constants
//------------------------------------------------------------------------------const
  AI_INSTANCECREATED = $0001;
  AI_INSTANCEDESTROYED = $0002;
  AI_USERMSG = $0003;//------------------------------------------------------------------------------
// Application instances manager class
//------------------------------------------------------------------------------type
  TJclAppInstances = class (TObject)
  private
    FCPID: DWORD;
    FMapping: TJclSwapFileMapping;
    FMappingView: TJclFileMappingView;
    FMessageID: DWORD;
    FOptex: TJclOptex;
    function GetAppWnds(Index: Integer): HWND;
    function GetInstanceCount: Integer;
    function GetProcessIDs(Index: Integer): DWORD;
    function GetInstanceIndex(ProcessID: DWORD): Integer;
  protected
    procedure InitData;
    procedure NotifyInstances(const W, L: Longint);
    procedure RemoveInstance;
  public
    constructor Create;
    destructor Destroy; override;
    class function BringAppWindowToFront(const Wnd: HWND): Boolean;
    class function GetApplicationWnd(const ProcessID: DWORD): HWND;
    class procedure KillInstance;
    class function SetForegroundWindow98(const Wnd: HWND): Boolean;
    function CheckInstance(const MaxInstances: Word): Boolean;
    procedure CheckMultipleInstances(const MaxInstances: Word);
    procedure CheckSingleInstance;
    function SendData(const WindowClassName: string; const DataKind: DWORD;
      const Data: Pointer; const Size: Integer; const OriginatorWnd: HWND): Boolean;
    function SendString(const WindowClassName: string; const DataKind: DWORD;
      const S: string; const OriginatorWnd: HWND): Boolean;
    function SendStrings(const WindowClassName: string; const DataKind: DWORD;
      const Strings: TStrings; const OriginatorWnd: HWND): Boolean;
    function SwitchTo(const Index: Integer): Boolean;
    procedure UserNotify(const Param: Longint);
    property AppWnds[Index: Integer]: HWND read GetAppWnds;
    property InstanceIndex[ProcessID: DWORD]: Integer read GetInstanceIndex;
    property InstanceCount: Integer read GetInstanceCount;
    property MessageID: DWORD read FMessageID;
    property ProcessIDs[Index: Integer]: DWORD read GetProcessIDs;
  end;function JclAppInstances: TJclAppInstances;//------------------------------------------------------------------------------
// Interprocess communication routines
//------------------------------------------------------------------------------function JclReadMessageCheck(var Message: TMessage; const DataKind: DWORD;
  const IgnoredOriginatorWnd: HWND): Boolean;
procedure JclReadMessageData(const Message: TMessage; var Data: Pointer; var Size: Integer);
procedure JclReadMessageString(const Message: TMessage; var S: string);
procedure JclReadMessageStrings(const Message: TMessage; const Strings: TStrings);implementationuses
  SysUtils,
  JclStrings, JclSysUtils;const  { strings to form a unique name for file mapping and optex objects }  JclAIPrefix = 'Jcl';
  JclAIOptex = '_Otx';
  JclAIMapping = '_Map';  { window message used for communication between instances }  JclAIMessage = '_Msg';  { maximum number of instance that may exist at any time }  JclAIMaxInstances = 256;  { name of the application window class }  ClassNameOfTApplication = 'TApplication';type{ management data to keep track of application instances. this data is shared
  amongst all instances and must be appropriately protected from concurrent
  access at all time }  PJclAISharedData = ^TJclAISharedData;
  TJclAISharedData = packed record
    MaxInst: Word;
    Count: Word;
    ProcessIDs: array [0..JclAIMaxInstances] of DWORD;
  end;var  { the single global TJclAppInstance instance }  AppInstances: TJclAppInstances;//==============================================================================
// TJclAppInstances
//==============================================================================class function TJclAppInstances.BringAppWindowToFront(const Wnd: HWND): Boolean;
begin
  if IsIconic(Wnd) then
    SendMessage(Wnd, WM_SYSCOMMAND, SC_RESTORE, 0);
  Result := SetForegroundWindow98(Wnd);
end;//------------------------------------------------------------------------------function TJclAppInstances.CheckInstance(const MaxInstances: Word): Boolean;
begin
  FOptex.Enter;
  try
    with PJclAISharedData(FMappingView.Memory)^ do
    begin
      if MaxInst = 0 then
        MaxInst := MaxInstances;
      Result := Count < MaxInst;
      ProcessIDs[Count] := GetCurrentProcessId;
      Inc(Count);
    end;
  finally
    FOptex.Leave;
  end;
  if Result then
    NotifyInstances(AI_INSTANCECREATED, FCPID);
end;//------------------------------------------------------------------------------procedure TJclAppInstances.CheckMultipleInstances(const MaxInstances: Word);
begin
  if not CheckInstance(MaxInstances) then
  begin
    SwitchTo(0);
    KillInstance;
  end;
end;//------------------------------------------------------------------------------

procedure TJclAppInstances.CheckSingleInstance;
begin
  CheckMultipleInstances(1);
end;//------------------------------------------------------------------------------constructor TJclAppInstances.Create;
begin
  inherited Create;
  FCPID := GetCurrentProcessId;
  InitData;
end;//------------------------------------------------------------------------------destructor TJclAppInstances.Destroy;
begin
  if (FMapping <> nil) and (FOptex <> nil) then
    RemoveInstance;
  FreeAndNil(FMapping);
  FreeAndNil(FOptex);
  inherited;
end;//------------------------------------------------------------------------------class function TJclAppInstances.GetApplicationWnd(const ProcessID: DWORD): HWND;
type
  PTopLevelWnd = ^TTopLevelWnd;
  TTopLevelWnd = record
    ProcessID: DWORD;
    Wnd: HWND;
  end;
var
  TopLevelWnd: TTopLevelWnd;  function EnumWinProc(Wnd: HWND; Param: PTopLevelWnd): BOOL; stdcall;
  var
    PID: DWORD;
    C: array [0..Length(ClassNameOfTApplication) + 1] of Char;
  begin
    GetWindowThreadProcessId(Wnd, @PID);
    if (PID = Param^.ProcessID) and (GetClassName(Wnd, C, SizeOf(C)) > 0) and
      (C = ClassNameOfTApplication) then
    begin
      Result := False;
      Param^.Wnd := Wnd;
    end
    else
      Result := True;
  end;begin
  TopLevelWnd.ProcessID := ProcessID;
  TopLevelWnd.Wnd := 0;
  EnumWindows(@EnumWinProc, LPARAM(@TopLevelWnd));
  Result := TopLevelWnd.Wnd;
end;//------------------------------------------------------------------------------function TJclAppInstances.GetAppWnds(Index: Integer): HWND;
begin
  Result := GetApplicationWnd(GetProcessIDs(Index));
end;//------------------------------------------------------------------------------function TJclAppInstances.GetInstanceCount: Integer;
begin
  FOptex.Enter;
  try
    Result := PJclAISharedData(FMappingView.Memory)^.Count;
  finally
    FOptex.Leave;
  end;
end;//------------------------------------------------------------------------------function TJclAppInstances.GetInstanceIndex(ProcessID: DWORD): Integer;
var
  I: Integer;
begin
  Result := -1;
  FOptex.Enter;
  try
    with PJclAISharedData(FMappingView.Memory)^ do
    begin
      for I := 0 to Count - 1 do
        if ProcessIDs[I] = ProcessID then
        begin
          Result := I;
          Break;
        end;
    end;
  finally
    FOptex.Leave;
  end;
end;//------------------------------------------------------------------------------function TJclAppInstances.GetProcessIDs(Index: Integer): DWORD;
begin
  FOptex.Enter;
  try
    with PJclAISharedData(FMappingView.Memory)^ do
      if Index >= Count then
        Result := 0
      else
        Result := ProcessIDs[Index];
  finally
    FOptex.Leave;
  end;
end;//------------------------------------------------------------------------------procedure TJclAppInstances.InitData;
var
  UniqueAppID: string;
begin
  UniqueAppID := JclAIPrefix + ParamStr(0);
  CharReplace(UniqueAppID, '\', '_');
  FOptex := TJclOptex.Create(UniqueAppID + JclAIOptex, 4000);
  FOptex.Enter;
  try
    FMapping := TJclSwapFileMapping.Create(UniqueAppID + JclAIMapping,
      PAGE_READWRITE, SizeOf(TJclAISharedData), nil);
    FMappingView := FMapping.Views[FMapping.Add(FILE_MAP_ALL_ACCESS, SizeOf(TJclAISharedData), 0)];
    if not FMapping.Existed then
      FillChar(FMappingView.Memory^, SizeOf(TJclAISharedData), #0);
  finally
    FOptex.Leave;
  end;
  FMessageID := RegisterWindowMessage(PChar(UniqueAppID + JclAIMessage));
end;//------------------------------------------------------------------------------class procedure TJclAppInstances.KillInstance;
begin
  Halt(0);
end;//------------------------------------------------------------------------------procedure TJclAppInstances.NotifyInstances(const W, L: Integer);
var
  I: Integer;
  Wnd: HWND;
  TID: DWORD;
  Msg: TMessage;  function EnumWinProc(Wnd: HWND; Message: PMessage): BOOL; stdcall;
  begin
    with Message^ do
      SendNotifyMessage(Wnd, Msg, WParam, LParam);
    Result := True;
  end;begin
  FOptex.Enter;
  try
    with PJclAISharedData(FMappingView.Memory)^ do
      for I := 0 to Count - 1 do
      begin
        Wnd := GetApplicationWnd(ProcessIDs[I]);
        TID := GetWindowThreadProcessId(Wnd, nil);
        while Wnd <> 0 do
        begin // Send message to TApplication queue
          if PostThreadMessage(TID, FMessageID, W, L) or
            (GetLastError = ERROR_INVALID_THREAD_ID) then
            Break;
          Sleep(1);
        end;
        Msg.Msg := FMessageID;
        Msg.WParam := W;
        Msg.LParam := L;
        EnumThreadWindows(TID, @EnumWinProc, LPARAM(@Msg));
      end;
  finally
    FOptex.Leave;
  end;
end;//------------------------------------------------------------------------------procedure TJclAppInstances.RemoveInstance;
var
  I: Integer;
begin
  FOptex.Enter;
  try
    with PJclAISharedData(FMappingView.Memory)^ do
      for I := 0 to Count - 1 do
        if ProcessIDs[I] = FCPID then
        begin
          ProcessIDs[I] := 0;
          Move(ProcessIDs[I + 1], ProcessIDs[I], (Count - I) * SizeOf(DWORD));
          Dec(Count);
          Break;
        end;
  finally
    FOptex.Leave;
  end;
  NotifyInstances(AI_INSTANCEDESTROYED, FCPID);
end;

//------------------------------------------------------------------------------function TJclAppInstances.SendData(const WindowClassName: string;
  const DataKind: DWORD; const Data: Pointer; const Size: Integer;
  const OriginatorWnd: HWND): Boolean;
type
  PEnumWinRec = ^TEnumWinRec;
  TEnumWinRec = record
    WindowClassName: PChar;
    OriginatorWnd: HWND;
    CopyData: TCopyDataStruct;
    Self: TJclAppInstances;
  end;
var
  EnumWinRec: TEnumWinRec;  function EnumWinProc(Wnd: HWND; Data: PEnumWinRec): BOOL; stdcall;
  var
    ClassName: array[0..200] of Char;
    I: Integer;
    PID: DWORD;
    Found: Boolean;
  begin
    if (GetClassName(Wnd, ClassName, SizeOf(ClassName)) > 0) and
      (StrComp(ClassName, Data.WindowClassName) = 0) then
    begin
      GetWindowThreadProcessId(Wnd, @PID);
      Found := False;
      Data.Self.FOptex.Enter;
      try
        with PJclAISharedData(Data.Self.FMappingView.Memory)^ do
          for I := 0 to Count - 1 do
            if ProcessIDs[I] = PID then
            begin
              Found := True;
              Break;
            end;
      finally
        Data.Self.FOptex.Leave;
      end;
      if Found then
        SendMessage(Wnd, WM_COPYDATA, Data.OriginatorWnd, LPARAM(@Data.CopyData));
    end;
    Result := True;
  end;begin
  EnumWinRec.WindowClassName := PChar(WindowClassName);
  EnumWinRec.OriginatorWnd := OriginatorWnd;
  EnumWinRec.CopyData.dwData := DataKind;
  EnumWinRec.CopyData.cbData := Size;
  EnumWinRec.CopyData.lpData := Data;
  EnumWinRec.Self := Self;
  Result := EnumWindows(@EnumWinProc, Integer(@EnumWinRec));
end;//------------------------------------------------------------------------------function TJclAppInstances.SendString(const WindowClassName: string;
  const DataKind: DWORD; const S: string; const OriginatorWnd: HWND): Boolean;
begin
  Result := SendData(WindowClassName, DataKind, PChar(S), Length(S) + 1,
    OriginatorWnd);
end;//------------------------------------------------------------------------------function TJclAppInstances.SendStrings(const WindowClassName: string;
  const DataKind: DWORD; const Strings: TStrings; const OriginatorWnd: HWND): Boolean;
var
  S: string;
begin
  S := Strings.Text;
  Result := SendData(WindowClassName, DataKind, Pointer(S), Length(S), OriginatorWnd);
end;//------------------------------------------------------------------------------class function TJclAppInstances.SetForegroundWindow98(const Wnd: HWND): Boolean;
var
  ForeThreadID, NewThreadID: DWORD;
begin
  if GetForegroundWindow <> Wnd then
  begin
    ForeThreadID := GetWindowThreadProcessId(GetForegroundWindow, nil);
    NewThreadID := GetWindowThreadProcessId(Wnd, nil);
    if ForeThreadID <> NewThreadID then
    begin
      AttachThreadInput(ForeThreadID, NewThreadID, True);
      Result := SetForegroundWindow(Wnd);
      AttachThreadInput(ForeThreadID, NewThreadID, False);
      if Result then
        Result := SetForegroundWindow(Wnd);
    end
    else
      Result := SetForegroundWindow(Wnd);
  end
  else
    Result := True;
end;//------------------------------------------------------------------------------function TJclAppInstances.SwitchTo(const Index: Integer): Boolean;
begin
  Result := BringAppWindowToFront(AppWnds[Index]);
end;//------------------------------------------------------------------------------procedure TJclAppInstances.UserNotify(const Param: Integer);
begin
  NotifyInstances(AI_USERMSG, Param);
end;//------------------------------------------------------------------------------function JclAppInstances: TJclAppInstances;
begin
  if AppInstances = nil then
    AppInstances := TJclAppInstances.Create;
  Result := AppInstances;
end;//==============================================================================
// Interprocess communication routines
//==============================================================================function JclReadMessageCheck(var Message: TMessage; const DataKind: DWORD;
  const IgnoredOriginatorWnd: HWND): Boolean;
begin
  if Message.Msg = WM_COPYDATA then
    Result := (TWMCopyData(Message).From <> IgnoredOriginatorWnd) and
      (TWMCopyData(Message).CopyDataStruct^.dwData = DataKind)
  else
    Result := False;
  Message.Result := Integer(Result);
end;//------------------------------------------------------------------------------procedure JclReadMessageData(const Message: TMessage; var Data: Pointer; var Size: Integer);
begin
  with TWMCopyData(Message) do
    if Msg = WM_COPYDATA then
    begin
      Size := CopyDataStruct^.cbData;
      GetMem(Data, Size);
      Move(CopyDataStruct^.lpData^, Data^, Size);
    end;
end;//------------------------------------------------------------------------------procedure JclReadMessageString(const Message: TMessage; var S: string);
begin
  with TWMCopyData(Message) do
    if Msg = WM_COPYDATA then
      SetString(S, PChar(CopyDataStruct^.lpData), CopyDataStruct^.cbData);
end;//------------------------------------------------------------------------------procedure JclReadMessageStrings(const Message: TMessage; const Strings: TStrings);
var
  S: string;
begin
  with TWMCopyData(Message) do
    if Msg = WM_COPYDATA then
    begin
      SetString(S, PChar(CopyDataStruct^.lpData), CopyDataStruct^.cbData);
      Strings.Text := S;
    end;
end;//------------------------------------------------------------------------------initializationfinalization
  FreeAndNil(AppInstances);end.

调试易

等待高手取得运行中的程序的图标（附我的代码），呆了两天了：~~~

解决方案 »