AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein GUI-Design mit VCL / FireMonkey / Common Controls Delphi Eintrag an anderes Programm während seiner Laufzeit senden

Eintrag an anderes Programm während seiner Laufzeit senden

Ein Thema von Alois · begonnen am 25. Jul 2005 · letzter Beitrag vom 26. Jul 2005
Antwort Antwort
Alois

Registriert seit: 23. Jul 2005
71 Beiträge
 
Delphi 10 Seattle Professional
 
#1

Eintrag an anderes Programm während seiner Laufzeit senden

  Alt 25. Jul 2005, 19:08
Hi,

ich habe ein Programm in dem sich eine ListView-Komponente befindet.
Wie kann ich aus einem anderen Programm heraus Einträge in dieses
Formular wärend seiner Laufzeit hinzufügen?

Hat jemand eine Idee?

Gruss Alois
  Mit Zitat antworten Zitat
Benutzerbild von jfheins
jfheins

Registriert seit: 10. Jun 2004
Ort: Garching (TUM)
4.579 Beiträge
 
#2

Re: Eintrag an anderes Programm während seiner Laufzeit send

  Alt 25. Jul 2005, 19:17
Imho musst du mit MSDN-Library durchsuchenFindwindow usw. das Fensterhandle der ListView ermitteln, und dann kannst du per MSDN-Library durchsuchenListView_InsertItem() (unit CommCtrls) ein Item einfügen

Übergabe von ListView_InsertItem(): http://msdn.microsoft.com/library/de...res/lvitem.asp
  Mit Zitat antworten Zitat
Alois

Registriert seit: 23. Jul 2005
71 Beiträge
 
Delphi 10 Seattle Professional
 
#3

Re: Eintrag an anderes Programm während seiner Laufzeit send

  Alt 25. Jul 2005, 19:37
Hi @jheins,

Dank für die prompte Antwort... aber hast Du mal ein einfaches Beispiel?
Wäre toll wenn Du's hier posten könntest.

Danke im vorraus.

Gruss Alois
  Mit Zitat antworten Zitat
Benutzerbild von jfheins
jfheins

Registriert seit: 10. Jun 2004
Ort: Garching (TUM)
4.579 Beiträge
 
#4

Re: Eintrag an anderes Programm während seiner Laufzeit send

  Alt 25. Jul 2005, 19:53
Hier hast du ein Beispiel für ListView_InsertItem (auch wenn das mit dem Icon nicht geht ) : http://www.delphipraxis.net/internal...=306407#306407

(DP Suche nach ListView_InsertItem nächstes mal selber machen, ok ?)

und für das Handle kannst du dir den Code z.B. von WinSpy (by toms) generieren lassen
  Mit Zitat antworten Zitat
Alois

Registriert seit: 23. Jul 2005
71 Beiträge
 
Delphi 10 Seattle Professional
 
#5

Re: Eintrag an anderes Programm während seiner Laufzeit send

  Alt 25. Jul 2005, 20:27
Hi @jheis,

das ist mir etwas zu hoch. Kann man das nicht an einem Beispielquelltext genauer erläutern?

Wie gesagt Ich habe ein TlistView (lvwQueue) mit einer Spalte.
Gefüllt wird die Tabelle aus dem Programm heraus mit:
Delphi-Quellcode:
var Zeile: TListItem;
begin
  Zeile := lvwQueue.Items.Add;
  Zeile.ImageIndex := 0;
  Zeile.Caption := 'c:/Programme/Notepad.exe';
end;
Der Code von WinSpy sieht so aus:
Delphi-Quellcode:
var
  wnd: HWND;
begin
  wnd := FindWindow('TfrmMain','Explorer');
  wnd := FindWindowEx(wnd, 0, 'TListView', nil);
  if wnd <> 0 then
  begin
   // ShowMessage('Window found. Handle: ' + IntToStr(wnd));
     writeln('Window found. Handle: ' + IntToStr(wnd));
     FlashWindow(wnd);
  end;
end.
Kann mir jetzt jemand sagen wie es weiter geht?? Ich steh auf dem Schlauch

Gruss Alois
  Mit Zitat antworten Zitat
Benutzerbild von jfheins
jfheins

Registriert seit: 10. Jun 2004
Ort: Garching (TUM)
4.579 Beiträge
 
#6

Re: Eintrag an anderes Programm während seiner Laufzeit send

  Alt 25. Jul 2005, 20:44
Delphi-Quellcode:
infolist.mask := LVIF_TEXT;
        // Item-Index
        infolist.iItem := 0;
        infolist.iSubItem := 0;
        // Text
        infolist.pszText := 'Das Programm wurde gestartet';

        ListView_InsertItem(<Hier das handle zur Listview>,infolist);
So bekommst du ein Item an Position 0 in die Listview - für Subitems einfach bei iSubItem die jeweilige Position setzen
  Mit Zitat antworten Zitat
Alois

Registriert seit: 23. Jul 2005
71 Beiträge
 
Delphi 10 Seattle Professional
 
#7

Re: Eintrag an anderes Programm während seiner Laufzeit send

  Alt 26. Jul 2005, 00:32
Hi @jfheins,

das hat leider nicht so hingehauen. Ich konnte zwar Einträge in die Zeile[0] hinzufügen, aber sobald ich mit den Standardbefehlen zur Bearbeitung auf die ListView-Komponente zugegriffen habe, verabschiedete sich das Programm ins Nirvana.

Ich habe eine viel bessere Methode gefunden bei der es bei mir zumindest klappt:

In dem Beispielprogramm wird die Kommandozeile (ParmStr) von einer 2. Instanz zu der 1. Instanz übertragen und in ein Memofenster eingetragen.
Vorteil: Das geschieht auch wenn das Fenster minimiert ist. Ausserdem wird das mehrfache Starten der Anwendung verhindert.
Nachteil: Ist das Fenster minimiert, klappt es leider nicht in den Vordergrund auf, sondern bleibt im Hintergrund.

Vielleicht kann ja einer diesen Code noch etwas verfeinern

Delphi-Quellcode:
{ In the projects DPR file you have code looking like this: }

program OneInstanceDemo;

uses
  Forms,
  Unit1 in 'Unit1.pas{OneInstanceDemoMainform},
  PBOnceOnly;

{$R *.res}

{You can create a GUID for the processname via Ctrl-Shift-G in the IDE, just
remove the enclosing square brackets.

The main form needs a message handler for WM_COPYDATA, and also a method to
handle a command-line parameter. The example form only shows the passed
parameter in a memo.}


const
  ProcessName = '{53F0DF5B-B69D-40B7-9B2C-A9E515CCFC80}';

begin
  if AlreadyRunning(ProcessName, TOneInstanceDemoMainform) then
    Exit;

  Application.Initialize;
  Application.CreateForm(TOneInstanceDemoMainform, OneInstanceDemoMainform);
  Application.Run;
end.
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Buttons, StdCtrls;

type
  TOneInstanceDemoMainform = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    procedure WMCopyData(var msg: TWMCopyData); message WM_COPYDATA;
    procedure HandleParameter(const param: string);
  public
    { Public declarations }
  end;

var
  OneInstanceDemoMainform: TOneInstanceDemoMainform;

implementation

uses PBOnceOnly;
{$R *.DFM}

procedure TOneInstanceDemoMainform.FormCreate(Sender: TObject);
begin
  memo1.Text := Format('Thread ID: %x'#13#10, [GetCurrentThreadID]);
  HandleCommandline(HandleParameter);
end;

procedure TOneInstanceDemoMainform.HandleParameter(const param: string);
begin
  memo1.Lines.Add(param);
end;

procedure TOneInstanceDemoMainform.WMCopyData(var msg: TWMCopyData);
begin
  HandleSendCommandline(msg.CopyDataStruct^, HandleParameter);
end;

end.
Delphi-Quellcode:
{The work of dissecting the passed commandline is left to the PBOnceOnly unit,
since it "knows" how it packaged the parameters in the other instance. The
technique used by the unit is rather simple: the first instance creates a
memory mapped file and stores its main threads thread ID into this file. It
cannot store the main forms handle since the form has not been created yet
when AlreadyRunning is called. It would be a bad idea anyway since a forms
handle can change over the form objects lifetime. The second instance gets
this handle, uses EnumThreadWindows to find the first instances main form
handle (doing this way avoids problems with the IDE designers form instance
during development), packages the command line and sends it over to the found
window. The second instance will then terminate since AlreadyRunning returns
true in it. It never creates any of the autocreated forms or datamodules and
never enters its message loop.}


{== PBOnceOnly ========================================================}
{: Implements a function to detect a running instance of the program and
  (optionally) pass over any command line to the first instances main
  window.
@author Dr. Peter Below
@desc  Version 1.0 created 2003-02-23


        Last modified      2003-02-23



If a command line has to be passed over we need the window handle of the
first instances main window, to send a WM_COPYDATA message to it. Since
the first instance may not have gotten around to creating its main
form window handle yet we retry a couple of times and wait a bit in
between. This process can be configured by setting the MAX_RETRIES and
RETRIES_INTERVAL variables before calling AlreadyRunning.   }

{======================================================================}
{$BOOLEVAL OFF} {Unit depends on shortcut boolean evaluation}
unit PBOnceOnly;

interface

uses Windows;

var
  {: Specifies how often we retry to find the first instances main
     window. }

  MAX_RETRIES: Integer = 10;

  {: Specifies how long, in milliseconds, we sleep between retries. }
  RETRIES_INTERVAL: Integer = 1000;

{-- AlreadyRunning ----------------------------------------------------}
{: Checks for another instance of the program and optionally passes over
  this instances command line.
@Param aProcessName is a unique name to be used to identify this program.
@Param aMainformClass is the programs main form class, can be nil.
@Param passCommandline indicates whether to pass the command line, true
  by default.
@Param allowMultiuserInstances indicates whether to allow other
  instances of the program to run in another user context. Only applies
  to Windows terminal server or XP. True by default.
@Returns true if there is another instance running, false if not.
@Precondition The function has not been called already. It must only
  be called once per program run.
@Desc Creates a memory mapped file with the passed process name,
  optionally with an added 'Global' prefix. If the MMF already existed
  we know that this is a second instance. The first instance stores its
  main thread ID into the MMF, the second one uses that with
  EnumThreadWindows to find the first instances main window and sends
  the command line via WM_COPYDATA to this window, if requested.
@Raises Exception if creation of the MMF fails for some reason.
}
{ Created 2003-02-23 by P. Below
-----------------------------------------------------------------------}

function AlreadyRunning(const aProcessName: string;
  aMainformClass: TClass = nil;
  passCommandline: Boolean = true;
  allowMultiuserInstances: Boolean = true): Boolean;

type
  {: Callback type used by HandleSendCommandline. The callback will
     be handed one parameter at a time. }

  TParameterEvent = procedure(const aParam: string) of object;

{-- HandleSendCommandline ---------------------------------------------}
{: Dissect a command line passed via WM_COPYDATA from another instance
@Param data contains the data received via WM_COPYDATA.
@Param onParameter is a callback that will be called with every passed
  parameter in turn.
@Precondition  onParameter <> nil
}
{ Created 2003-02-23 by P. Below
-----------------------------------------------------------------------}

procedure HandleSendCommandline(const data: TCopyDataStruct;
  onParameter: TParameterEvent);

{-- HandleCommandline -------------------------------------------------}
{: This is a convenience procedure that allows handling of this
  instances command line parameters to be done the same way as
  a command line send over from another instance.
@Param onParameter will be called for every command line parameter in turn.
@Precondition  onParameter <> nil
}
{ Created 2003-02-23 by P. Below
-----------------------------------------------------------------------}

procedure HandleCommandline(onParameter: TParameterEvent);

implementation

uses Messages, Classes, Sysutils;

{ The THandledObject and TShareMem classes come from the D6 IPCDemos
  demo project. }


type
  THandledObject = class(TObject)
  protected
    FHandle: THandle;
  public
    destructor Destroy; override;
    property Handle: THandle read FHandle;
  end;

{ This class simplifies the process of creating a region of shared memory.
  In Win32, this is accomplished by using the CreateFileMapping and
  MapViewOfFile functions. }


  TSharedMem = class(THandledObject)
  private
    FName: string;
    FSize: Integer;
    FCreated: Boolean;
    FFileView: Pointer;
  public
    constructor Create(const Name: string; Size: Integer);
    destructor Destroy; override;
    property Name: string read FName;
    property Size: Integer read FSize;
    property Buffer: Pointer read FFileView;
    property Created: Boolean read FCreated;
  end;

procedure Error(const Msg: string);
begin
  raise Exception.Create(Msg);
end;

{ THandledObject }

destructor THandledObject.Destroy;
begin
  if FHandle <> 0 then
    CloseHandle(FHandle);
end;

{ TSharedMem }

constructor TSharedMem.Create(const Name: string; Size: Integer);
begin
  try
    FName := Name;
    FSize := Size;
    { CreateFileMapping, when called with $FFFFFFFF for the handle value,
      creates a region of shared memory }

    FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
      Size, PChar(Name));
    if FHandle = 0 then abort;
    FCreated := GetLastError = 0;
    { We still need to map a pointer to the handle of the shared memory region
}

    FFileView := MapViewOfFile(FHandle, FILE_MAP_WRITE, 0, 0, Size);
    if FFileView = nil then abort;
  except
    Error(Format('Error creating shared memory %s (%d)', [Name,
      GetLastError]));
  end;
end;

destructor TSharedMem.Destroy;
begin
  if FFileView <> nil then
    UnmapViewOfFile(FFileView);
  inherited Destroy;
end;


var
  { This object is destroyed by the unit finalization }
  ProcessInfo: TSharedMem = nil;

{ Check if we are running in a terminal client session }

function IsRemoteSession: Boolean;
const
  sm_RemoteSession = $1000; { from WinUser.h }
begin
  Result := GetSystemMetrics(sm_RemoteSession) <> 0;
end;

{ Check if we are running on XP or a newer version. XP is Windows NT 5.1 }

function IsXP: Boolean;
begin
  Result :=
    (Sysutils.Win32Platform = VER_PLATFORM_WIN32_NT)
    and
    ((Sysutils.Win32MajorVersion > 5)
    or
    ((Sysutils.Win32MajorVersion = 5)
    and
    (Sysutils.Win32MinorVersion > 0)
    )
    );
end;

{ Check if we are running in a Windows terminal client session or on
  Windows XP.  }


function IsWTSOrXP: Boolean;
begin
  Result := IsRemoteSession or IsXP
end;

type
  { Helper class to hold classname and found window handle for
    EnumThreadWindows }

  TEnumhelper = class
  public
    FClassname: string;
    FWnd: HWND;
    constructor Create(const aClassname: string);
    function Matches(wnd: HWND): Boolean;
  end;

constructor TEnumhelper.Create(const aClassname: string);
begin
  inherited Create;
  FClassname := aClassname;
end;

function TEnumhelper.Matches(wnd: HWND): Boolean;
var
  classname: array[0..127] of Char;
begin
  classname[0] := #0;
  Windows.GetClassname(wnd, classname, sizeof(classname));
  Result := AnsiSametext(Fclassname, classname);
  if result then
    FWnd := wnd;
end;

function EnumProc(wnd: HWND; helper: TEnumHelper): BOOL; stdcall;
begin
  Result := not helper.Matches(wnd);
end;

function FindFirstInstanceMainform(const aClassname: string): HWND;
var
  threadID: DWORD;
  helper: TEnumHelper;
begin
  threadID := PDWORD(Processinfo.FFileView)^;
  helper := TEnumHelper.Create(aclassname);
  try
    EnumThreadWindows(threadID, @EnumProc, Integer(helper));
    Result := helper.FWnd;
  finally
    helper.Free;
  end;
end;

function AlreadyRunning(const aProcessName: string;
  aMainformClass: TClass = nil;
  passCommandline: Boolean = true;
  allowMultiuserInstances: Boolean = true): Boolean;
  function Processname: string;
  begin
    if not allowMultiuserInstances and IsWTSorXP then
      Result := 'Global\' + aProcessName
    else
      Result := aProcessName;
  end;

  procedure StoreThreadID;
  begin
    PDWORD(ProcessInfo.FFileView)^ := GetCurrentThreadID;
  end;

  function GetCommandline: string;
  var
    sl: TStringlist;
    i: Integer;
  begin
    if ParamCount = 1 then
      Result := ParamStr(1)
    else begin
      sl := TStringlist.Create;
      try
        for i := 1 to ParamCount do
          sl.Add(ParamStr(i));
        Result := sl.Text;
      finally
        sl.free;
      end; { Finally }
    end;
  end;

  procedure DoPassCommandline;
  var
    wnd: HWND;
    S: string;
    copydata: TCopyDataStruct;
    retries: Integer;
  begin
    retries := 0;
    repeat
      wnd := FindFirstInstanceMainform(aMainformclass.Classname);
      if wnd <> 0 then
      begin
        S := GetCommandline;
        copydata.dwData := Paramcount;
        copydata.cbData := Length(S) + 1;
        copydata.lpData := PChar(S);
        SendMessage(wnd, WM_COPYDATA, 0, integer(@copydata));
      end
      else begin
        Inc(retries);
        Sleep(RETRIES_INTERVAL);
      end;
    until (wnd <> 0) or (retries > MAX_RETRIES);
  end;

begin
  Assert(not Assigned(ProcessInfo),
    'Do not call AlreadyRunning more than once!');
  ProcessInfo := TSharedMem.Create(Processname, Sizeof(DWORD));
  Result := not ProcessInfo.Created;
  if Result then
  begin
    if passCommandline and Assigned(aMainformClass) and (ParamCount > 0) then
        DoPassCommandline;
  end
  else
    StoreThreadID;
end;

procedure HandleSendCommandline(const data: TCopyDataStruct;
  onParameter: TParameterEvent);
var
  i: Integer;
  sl: TStringlist;
begin
  Assert(Assigned(onParameter), 'OnParameter cannot be nil');
  if data.dwData = 1 then
    onParameter(PChar(data.lpData))
  else
  begin
    sl := TStringlist.Create;
    try
      sl.Text := PChar(data.lpData);
      for i := 0 to sl.Count - 1 do
        onParameter(sl[i]);
    finally
      sl.Free;
    end; { Finally }
  end;
end;

procedure HandleCommandline(onParameter: TParameterEvent);
var
  i: Integer;
begin
  Assert(Assigned(onParameter), 'OnParameter cannot be nil');
  for i := 1 to ParamCount do
    onParameter(ParamStr(i));
end;

initialization
finalization
  ProcessInfo.Free;
end.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:40 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz