| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Запуск одной копии программы и обнаружение ее при повторном запус [D7, Win2k]

Страницы:   < 1 2 >

Fantom ©   (2005-01-21 10:07:00) 

Всем привет!
Тема не самая новая и уже проелась, но вчера просидел 3 часа в поисках примера по етому поводу так ничего толкового не нашел... Помогите пожалуйста.
Есть программа, написанная на Delphi. Мне нужно чтобы пользователь мог запусть ее только один раз, а при повторном запуске, если прога уже запущена, первая копия становилась активной независимо свернутая она на панель или весит в трее...
Спасибо!

---

Digitman   (2005-01-21 10:49:00) [21]

одно из решений - использование именованых программных каналов для коммуникации между процессами

unit IPCThread;

interface

uses
 Windows, Messages, SysUtils, Classes;

const

 sIPCPipeName    = 'SomeIPCchannel';
 MAX_MSG_SIZE    = 1024;
 DEFAULT_TIMEOUT = 5000;
 TM_CONNECT      = WM_USER + 1000;
 TM_SENDMSG      = WM_USER + 1001;

type

 ETransportError = class(Exception); //исключение по отказу транспорта (например, соединение разорвано)
 EActionError = class(Exception); //исключение в ходе исполнения акции

 TSignature = (CallSig, ResultSig); //сигнатура транспортного пакета
 TAction = Integer; //код акции

//заголовок информациионного пакета
 PDataBlockHeader = ^TDataBlockHeader;
 TDataBlockHeader = packed record
   Signature: TSignature; //сингатура
   Action: TAction; //код акции
   ExceptionFlag: Boolean; //флаг исключения для пакета с сигнатурой результата
   WaitEvent: DWord; //событие ожидания результата инф.транзакции
   ParamSize: DWord; //кол-во байт параметра акции
 end;

//информационный пакет
 PDataBlock = ^TDataBlock;
 TDataBlock = packed record
   Header: TDataBlockHeader; //заголовок
   Params: array[0..MAX_MSG_SIZE - SizeOf(TDataBlockHeader) - 1] of Byte; //параметры
 end;

const
 DataBlockHdrSize = SizeOf(TDataBlockHeader);

type

//прототип ф-ции обработки вызванной акции
 TActionHandler = function(Action: TAction; Params: Pointer; ParamSize: DWord; out ResultData; out ResultSize: DWord): Boolean;

//базовый класс транспортного трэда

 TIPCThread = class(TThread)
 private
   FPipeName: String;
   hPipe: THandle;
   hWnd: THandle;
   ovr, ovw: TOverlapped;
   FEvents: array[0..1] of THandle;
   FConnected, FPendingConnect, FPendingRead, FPendingWrite: Boolean;
   FInBuf, FOutBuf: PDataBlock; //буферы приема/передачи
   FBytesRead, FBytesWritten: DWord;
   FActionHandler: TActionHandler;
   FSendQueue: TThreadList; //очередь передаваемых инф.пакетов
   FPendingQueue: TList; //список объектов-событий ожидания результатов акций
   FRecvQueue: TThreadList; //очередь принятых инф.пакетов
   procedure ClearSendingQueue;
   procedure ClearReceivingQueue;
   procedure ClearPendingQueue;
   procedure ProcessReadEvent;
   procedure ProcessWriteEvent;
   procedure ProcessMessages;
   procedure ProcessTransport;
   procedure ProcessIncomingCall;
   procedure ProcessIncomingResult;
   procedure MsgQuit(var Message: TMessage); message WM_QUIT;
   procedure MsgSendMsg(var Message: TMessage); message TM_SENDMSG;
 protected
   procedure DoTerminate; override;
   procedure DoConnect; virtual;
   procedure DoDisconnect; virtual;
   procedure Execute; override;
 public
   constructor Create(WndHandle: THandle; PipeName: String; ActionHandler: TActionHandler);
   destructor Destroy; override;
//после УСПЕШНОГО исполнения акции во избежание утечек памяти
//следует вызвать FreeMem(ResultData), если ResultSize > 0
   function CallAction(Action: TAction; Params: Pointer; ParamSize: DWord; out ResultData: Pointer; out ResultSize: DWord): Boolean;
   property Connected: Boolean read FConnected;
 end;

//класс транспортного трэда клиента
 TIPCClientThread = class(TIPCThread)
 private
   FServerName: String;
 protected
   procedure DoConnect; override;
   procedure DoDisconnect; override;
 public
   constructor Create(WndHandle: THandle; ServerName, PipeName: String; ActionHandler: TActionHandler);
 end;

//класс транспортного трэда сервера
 TIPCServerThread = class(TIPCThread)
 private
 protected
   procedure DoConnect; override;
   procedure DoDisconnect; override;
 public
 end;
продолжение следует...

---

REA   (2005-01-21 10:43:00) [22]

Я делал так (насчет трея не знаю):

Function CheckStart: Boolean;
Var
 HWin: HWnd;
 CName, SavTitle, FileName: String;
 CopyStruct: TCopyDataStruct;
Begin
 SavTitle := Application.Title;
 Application.Title := '';
 HWin := FindWindow('TApplication', PChar(SavTitle));
 If (HWin<>0) Then
 Begin
   If IsIconic(HWin) then
     ShowWindow(HWin, SW_Restore);
   BringWindowToTop(HWin);
   SetForegroundWindow(HWin);
   If ParamCount>0 Then
   Begin
     CopyStruct.dwData := 1;
     FileName := ParamStr(1);
     CopyStruct.cbData := Length(FileName);
     CopyStruct.lpData := PChar(FileName);
     CName := TSketchMainForm.ClassName;
     HWin := FindWindow(PChar(CName), Nil);
     If HWin<>0 Then
       SendMessage(HWin, WM_COPYDATA, Application.Handle, Integer(@CopyStruct));
   End;
   Result := False;
 End Else
 Begin
   Application.Title := SavTitle;
   Result := True;
 End;
End;

---

Страницы:   < 1 2 >

Наверх