VPF::Почему моя Dll не стопорит процесс

Teran

Дата 2.3.2006, 15:09 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

Ставлю хук на Api функцию RegCreateKeyA
к проекту dll подключаю и форму которая впоследствии должна выскакивать модально и стопорить процесс:

Код


library HookTest;
uses
  Windows,
  SysUtils,
  Classes,
  Forms,
  madCodeHook,
  Warning in 'Warning.pas' {Form1};

var
  RegCreateKeyANext : function (hKey: HKEY; lpSubKey: PAnsiChar; var phkResult: HKEY): Longint; stdcall;
.......

function ChekCreateKey(lpSubKey1 : string): boolean;
begin
.....
Form1:=TForm1.Create(Application);
Form1.Label3.Caption:='Create registy key'+lpSubKey1 ;
if Form1.ShowModal = mrYes then Result:=true
   else Result:= false;                           
Form1.Free;
.......
end;

function RegCreateKeyACallback(hKey: HKEY; lpSubKey: PAnsiChar; var phkResult: HKEY): Longint; stdcall;
begin
if(not ChekCreateKey(lpSubKey))then begin result:=1;exit;end;
Result:=RegCreateKeyANext(hKey,lpSubKey,phkResult)
end;

begin
.....
.....
  HookAPI('Advapi32.dll', 'RegCreateKeyA', @RegCreateKeyACallback, @RegCreateKeyANext);
end;

Dll работает нормально но есть одна проблема например если "поймается" Explorer.exe то эта форма выскакивает "Миллион раз"
не пойму почему там же на ней стоит ShowModal
Не подскажите как это можно поправить? smile

--------------------

Ни цего не понимаю

Snowy

Дата 2.3.2006, 16:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484

Все правильно. Ты же цепляешь к каждому процессу копию dll, а не один и тот же процесс.
Для каждого процесса будет новая инстанция dllки.
А поскольку explorer'ов в системе запущена большая куча, то и для каждого экземпляза запускается новый экземпляр твоей dll и благополучно запускается.

Teran

Дата 2.3.2006, 17:42 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

а как это

Цитата(Snowy @ 2.3.2006, 16:21

)

А поскольку explorer'ов в системе запущена большая куча

ведь в процессах виде всего один

не подскажеш что можно предпринят против этого?

--------------------

Ни цего не понимаю

Snowy

Дата 2.3.2006, 17:56 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484

Против эксплорера не попрешь. Их много и они системные.
А чтобы был только один вызов - используй мьютекс.
Первая же копия его займет, а остальные, видя, что он занят, не будут показывать формочку.

Teran

Дата 2.3.2006, 18:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

расскажи пожалуйста по подробней про

Цитата(Snowy @ 2.3.2006, 17:56

)

А чтобы был только один вызов - используй мьютекс.

или дай какойто примерчик а то я первый раз слышу про этот мьютекс
smile

--------------------

Ни цего не понимаю

Snowy

Дата 2.3.2006, 18:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484

Поиск

Вот первый попавшийся: http://forum.vingrad.ru/index.php?showtopi...st&p=451888

Teran

Дата 2.3.2006, 18:45 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

мне ведь нужно чтобы остальные не просто не показывались но еще и стопорились(как modal) ожидая первого

--------------------

Ни цего не понимаю

Snowy

Дата 2.3.2006, 19:12 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484

Вешай WaitForSingleObject на мьютекс, будет тебе стопор.

Teran

Дата 2.3.2006, 20:35 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

из твоих линков я так думаю что код Петровича мне подойдёт только не знаю как его прикрутить

Код


  tHandledObject = class(tObject)
  protected
    fName  : String;
    fHandle: tHandle;
    fCreated: Boolean;
    procedure SetHandle(const aName :String; aHandle : tHandle);
    procedure ErrorCreate;
  public
    destructor Destroy; override;
    property Name: string read fName;
    property Handle: tHandle read fHandle;
    property Created: Boolean read fCreated;
  end;

{ tSharedMem }

{ 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
    fSize: Integer;
    fDataPtr: Pointer;
  public
    constructor Create(const aName: string; aSize: Integer);
    destructor Destroy; override;
    property Size: Integer read fSize;
    property DataPtr: Pointer read fDataPtr;
  end;

{ tHandledObject }

destructor tHandledObject.Destroy;
begin
  if fHandle <> 0 then  CloseHandle(fHandle);
end;

procedure tHandledObject.ErrorCreate;
resourcestring  sCreateObjectError = 'Ошибка создания %s(%s):'^M^J'%s';
begin
  raise eSharedResources.Create(Format(sCreateObjectError,[ClassName,fName,SysErrorMessage(GetLastError)]));
end;

procedure tHandledObject.SetHandle(const aName :String; aHandle : tHandle);
begin
  fName := aName;
  if aHandle = 0 then
    ErrorCreate;
  fHandle := aHandle;
  fCreated := GetLastError = 0;
end;



{ tSharedMem }

constructor tSharedMem.Create(const aName: string; aSize: Integer);
begin
  fSize := aSize;
  { CreateFileMapping, when called with $FFFFFFFF for the hanlde value,
    creates a region of shared memory }
  SetHandle(aName,CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
              aSize, PChar(aName)));
  { We still need to map a pointer to the handle of the shared memory region }
  fDataPtr := MapViewOfFile(fHandle, FILE_MAP_WRITE, 0, 0, aSize);
  if fDataPtr = nil then
    ErrorCreate;
end;

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

var
  FirstInstance :tSharedMem;

procedure CheckOneInstance(const ApplicationName :String);
 // Проверяет что программа с идентификатором ApplicationName уже запущена.
 // Если это так, то предыдущий экземпляр "выталкивается" на поверхность и
 // выполняется Halt(1)
var HPtr: pHandle;
begin
  FirstInstance := tSharedMem.Create('PetrovichSoft_FirstInstace_'
       +AnsiUpperCase(StringReplace(ApplicationName,'\','/',[rfReplaceAll])),
                                         SizeOf(Application.Handle));
  HPtr := pHandle(FirstInstance.DataPtr);
  if  HPtr^ = 0  then  // это первый экземпляр программы в памяти?
    HPtr^ := Application.Handle  //да
  else begin  // нет, не первый. Вытащим первый на поверхность
    if IsIconic(HPtr^) then  ShowWindow(HPtr^, SW_RESTORE);
    SetForegroundWindow(HPtr^);
    Halt(1); // и отваливаем
  end;
end;

а вот мой юнит в Dll

Код


unit Warning;

interface

uses
  Windows, Graphics, Forms,
   Classes, Controls, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Label3: TLabel;
    btnAllow: TBitBtn;
    btnDeny: TBitBtn;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

подскажи пожалуйста как сделать

--------------------

Ни цего не понимаю

Teran

Дата 3.3.2006, 12:38 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

Вот что я получил:

Код


library HookTest;
uses
  Windows,
  SysUtils,
  Classes,
  Forms,
  madCodeHook,
  Warning in 'Warning.pas' {Form1};

type
  tHandledObject = class(tObject)
  protected
    fName  : String;
    fHandle: tHandle;
    fCreated: Boolean;
    procedure SetHandle(const aName :String; aHandle : tHandle);
  public
    destructor Destroy; override;
    property Name: string read fName;
    property Handle: tHandle read fHandle;
    property Created: Boolean read fCreated;
  end;

  tSharedMem = class(tHandledObject)
  private
    fSize: Integer;
    fDataPtr: Pointer;
  public
    constructor Create(const aName: string; aSize: Integer);
    destructor Destroy; override;
    property Size: Integer read fSize;
    property DataPtr: Pointer read fDataPtr;
  end;

var
 FirstInstance :tSharedMem;

  RegCreateKeyANext : function (hKey: HKEY; lpSubKey: PAnsiChar; var phkResult: HKEY): Longint; stdcall;
.......
destructor tHandledObject.Destroy;
begin
  if fHandle <> 0 then CloseHandle(fHandle);
end;

procedure tHandledObject.SetHandle(const aName :String; aHandle : tHandle);
begin
  fName := aName;
  if aHandle = 0 then MessageBox(0,'SetHandle','Error',MB_OK);
  fHandle := aHandle;
  fCreated := GetLastError = 0;
end;

{ tSharedMem }
constructor tSharedMem.Create(const aName: string; aSize: Integer);
begin
  fSize := aSize;
  SetHandle(aName,CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,aSize, PChar(aName)));
  fDataPtr := MapViewOfFile(fHandle, FILE_MAP_WRITE, 0, 0, aSize);
  if fDataPtr = nil then MessageBox(0,'tSharedMem.Create','Error',MB_OK);
end;

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

function CheckOneInstance(const ApplicationName :String):boolean;
var HPtr: pHandle;
begin                                                                                                                                                                                               
  FirstInstance := tSharedMem.Create(ApplicationName,SizeOf(Application.Handle)); 

  HPtr := pHandle(FirstInstance.DataPtr);  //MessageBox(0,Pchar(IntToStr(SizeOf(Application.Handle))),Pchar(IntToStr(Application.Handle)),MB_OK);

  if  HPtr^ = 0 then begin HPtr^ :=Application.Handle; result:=true; end 
   else begin 
       result:=false; 
//    if IsIconic(HPtr^) then ShowWindow(HPtr^, SW_RESTORE);
//    SetForegroundWindow(HPtr^);
//    WaitForSingleObject(HPtr^,100000);
//    Halt(1);
  end;
end;

.......

function ChekCreateKey(lpSubKey1 : string): boolean;
begin
 if not CheckOneInstance('CreateRegistyKey') then begin result:=false;exit;end;

 Form1:=TForm1.Create(Application);
 Form1.Label3.Caption:='Create registy key'+lpSubKey1 ;
 if Form1.ShowModal = mrYes then Result:=true
    else Result:= false;                           
 Form1.Free;

 if FirstInstance.Created then FirstInstance.Free; 
end;

function RegCreateKeyACallback(hKey: HKEY; lpSubKey: PAnsiChar; var phkResult: HKEY): Longint; stdcall;
begin
if(not ChekCreateKey(lpSubKey))then begin result:=1;exit;end;
Result:=RegCreateKeyANext(hKey,lpSubKey,phkResult)
end;

begin
.....
.....
  HookAPI('Advapi32.dll', 'RegCreateKeyA', @RegCreateKeyACallback, @RegCreateKeyANext);
end;

Но как ни странно всеравно вылетают милионы форм
может это из-за того что в: function CheckOneInstance(const ApplicationName :String):boolean; - Application.Handle равен нулю?? вот и выполняется всегда это равенство: if HPtr^ = 0 then

--------------------

Ни цего не понимаю

Teran

Дата 6.3.2006, 20:02 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3

Но когда делаю это не в dll а на форме Mutex - нормально отрабатывает

--------------------

Ни цего не понимаю

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »