IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Langage Delphi Discussion :

Détection mode debug


Sujet :

Langage Delphi

  1. #1
    Membre habitué
    Développeur .NET
    Inscrit en
    Juin 2002
    Messages
    274
    Détails du profil
    Informations professionnelles :
    Activité : Développeur .NET

    Informations forums :
    Inscription : Juin 2002
    Messages : 274
    Points : 174
    Points
    174
    Par défaut Détection mode debug
    Salut,
    Y a t'il un moyen de détecter dans le code si l'appli est lancée par l'IDE Delphi ou en standalone ?
    Merci

  2. #2
    Membre chevronné
    Avatar de Pierre Castelain
    Inscrit en
    Avril 2002
    Messages
    523
    Détails du profil
    Informations forums :
    Inscription : Avril 2002
    Messages : 523
    Points : 1 943
    Points
    1 943
    Par défaut
    Une unité trouvée il y a quelques temps sur le web :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
     
    (**************************************************************)
    (* Unit Name:   DelRun                                        *)
    (* Description: Detect whether the current process is running *)
    (*              under the control of Delphi under Windows 95  *)
    (*              and NT.                                       *)
    (* Author:      Yorai Aminov                                  *)
    (* Created:     30 April 1998                                 *)
    (* Updates:     12 April 1999                                 *)
    (*                Use correct IsDebuggerPresent on Windows 98 *)
    (*                                                            *)
    (* Copyright (c) 1998, 99 Yorai Aminov                        *)
    (**************************************************************)
    unit DelRun;
     
    interface
     
    uses
      Windows, Classes, SysUtils;
     
    function RunningUnderDelphi: Boolean;
     
    implementation
    uses
      Registry;
     
    { NtQueryInformation constants }
     
    const
      ProcessBasicInformation = 0;
     
    { NtQueryInformation types }
     
    type
      TProcessBasicInformation = packed record
        ExitStatus: Integer;
        PebBaseAddress: Pointer;
        AffinityMask: Integer;
        BasePriority: Integer;
        UniqueProcessID: Integer;
        InheritedFromUniqueProcessID: Integer;
      end;
     
      TNtQueryInformationProcess =
        function(hProcess: THandle; ProcessInformationClass: Integer;
          var ProcessInformation; ProcessInformationLength: Integer;
          var ReturnLength: Integer): Integer; stdcall;
     
    { NT IsDebuggerPresent prototype }
     
    type
      TIsDebuggerPresent = function: BOOL; stdcall;
     
    { Retrieve parent process ID from NtQueryInformation }
     
    function GetParentProcessIDForNT: Integer;
    var
      hNTDLL: Integer;
      NtQueryInformationProcess: TNtQueryInformationProcess;
      PBI: TProcessBasicInformation;
      ReturnLength: Integer;
    begin
      Result := 0;
      // Attempt to load NTDLL
      hNTDLL := LoadLibrary('NTDLL.DLL');
      if hNTDLL <> 0 then
      begin
        // Retrieve address of NtQueryInformationProcess
        NtQueryInformationProcess &#58;= GetProcAddress&#40;hNTDLL, 'NtQueryInformationProcess'&#41;;
        if Assigned&#40;NTQueryInformationProcess&#41; then
        begin
          // Call NtQueryInformationProcess
          NtQueryInformationProcess&#40;GetCurrentProcess, ProcessBasicInformation,
            PBI, SizeOf&#40;PBI&#41;, ReturnLength&#41;;
          // Return parent process ID
          Result &#58;= PBI.InheritedFromUniqueProcessID;
        end;
        // Release NTDLL
        FreeLibrary&#40;hNTDLL&#41;;
      end;
    end;
     
    &#123; Check for debugger under NT &#125;
     
    function IsDebuggerPresentForNT&#58; Boolean;
    var
      Kernel32&#58; THandle;
      FIsDebuggerPresent&#58; TIsDebuggerPresent;
    begin
      Result &#58;= False;
      // Attempt to load KERNEL32
      Kernel32 &#58;= LoadLibrary&#40;'KERNEL32.DLL'&#41;;
      if Kernel32 <> 0 then
      begin
        // Retrieve address of IsDebuggerPresent
        FIsDebuggerPresent &#58;= GetProcAddress&#40;Kernel32, 'IsDebuggerPresent'&#41;;
        // Return True if a debugger is present
        if Assigned&#40;FIsDebuggerPresent&#41; then
          Result &#58;= FIsDebuggerPresent;
        // Release KERNEL32
        FreeLibrary&#40;Kernel32&#41;;
      end;
    end;
     
    &#123; ToolHelp32 constants &#125;
     
    const
      TH32CS_SNAPPROCESS  = $00000002;
     
    &#123; ToolHelp32 types &#125;
     
    type
      PProcessEntry32 = ^TProcessEntry32;
      TProcessEntry32 = record
        dwSize&#58; DWORD;
        cntUsage&#58; DWORD;
        th32ProcessID&#58; DWORD;
        th32DefaultHeapID&#58; DWORD;
        th32ModuleID&#58; DWORD;
        cntThreads&#58; DWORD;
        th32ParentProcessID&#58; DWORD;
        pcPriClassBase&#58; Longint;
        dwFlags&#58; DWORD;
        szExeFile&#58; array&#91;0..MAX_PATH - 1&#93; of Char;// Path
      end;
     
    &#123; ToolHelp32 function prototypes &#125;
     
    type
      TCreateToolhelp32Snapshot =
        function&#40;dwFlags, th32ProcessID&#58; DWORD&#41;&#58; THandle; stdcall;
      TProcess32First =
        function&#40;hSnapshot&#58; THandle; var lppe&#58; TProcessEntry32&#41;&#58; BOOL;
    stdcall;
      TProcess32Next =
        function&#40;hSnapshot&#58; THandle; var lppe&#58; TProcessEntry32&#41;&#58; BOOL;
    stdcall;
     
     
    function GetParentProcessIDForWindows&#58; Integer;
    var
      Kernel32&#58; THandle;
      CreateToolhelp32Snapshot&#58; TCreateToolhelp32Snapshot;
      Process32First&#58; TProcess32First;
      Process32Next&#58; TProcess32Next;
      Snapshot&#58; THandle;
      Entry&#58; TProcessEntry32;
      WalkResult&#58; Boolean;
      ID&#58; ULONG;
    begin
      Result &#58;= 0;
      // Attempt to load KERNEL32
      Kernel32 &#58;= LoadLibrary&#40;'KERNEL32.DLL'&#41;;
      if Kernel32 <> 0 then
      begin
        // Retrieve ToolHelp32 function addresses
        CreateToolhelp32Snapshot &#58;=
          GetProcAddress&#40;Kernel32, 'CreateToolhelp32Snapshot'&#41;;
        Process32First &#58;= GetProcAddress&#40;Kernel32, 'Process32First'&#41;;
        Process32Next &#58;= GetProcAddress&#40;Kernel32, 'Process32Next'&#41;;
        if Assigned&#40;CreateToolhelp32Snapshot&#41; and
           Assigned&#40;Process32First&#41; and
           Assigned&#40;Process32Next&#41; then
        begin
          // Retrieve current process ID for comparison
          ID &#58;= GetCurrentProcessId;
          // Create processes snapshot
          Snapshot &#58;= CreateToolhelp32Snapshot&#40;TH32CS_SNAPPROCESS, 0&#41;;
          if Integer&#40;Snapshot&#41; <> -1 then
          begin
            // Start walking list of processes
            Entry.dwSize &#58;= SizeOf&#40;TProcessEntry32&#41;;
            WalkResult &#58;= Process32First&#40;Snapshot, Entry&#41;;
            // Walk through entire list until result can be determined
            while &#40;GetLastError <> ERROR_NO_MORE_FILES&#41; and &#40;Result = 0&#41; do
            begin
              if WalkResult then
              begin
                // If this is the current process, return its parent
                if Entry.th32ProcessID = ID then
                  Result &#58;= Entry.th32ParentProcessID;
              end;
              // Move to next item in the process list
              Entry.dwSize &#58;= SizeOf&#40;TProcessEntry32&#41;;
              WalkResult &#58;= Process32Next&#40;Snapshot, Entry&#41;;
            end;
            // Release handle to the snapshot
            CloseHandle&#40;Snapshot&#41;;
          end;
        end;
        // Release KERNEL32
        FreeLibrary&#40;Kernel32&#41;;
      end;
    end;
     
    &#123; Process database constants &#125;
     
    const
      fDebugSingle        = $00000001;
     
    &#123; Process database types &#125;
     
    type
      PProcessDatabase = ^TProcessDatabase;
      TProcessDatabase = packed record
        DontCare1&#58; array&#91;0..7&#93; of Integer;
        Flags&#58; Integer;
        DontCare2&#58; array&#91;0..11&#93; of Integer;
        DebugeeCB&#58; Integer;
        DontCare3&#58; array&#91;0..22&#93; of Integer;
        DontCare4&#58; Word;
      end;
     
    function IsDebuggerPresentForWindows&#58; Boolean;
    var
      PDB&#58; PProcessDatabase;
      TID&#58; Integer;
      Obsfucator&#58; ULONG;
    begin
      Result &#58;= False;
      Obsfucator &#58;= 0;
      TID &#58;= GetCurrentThreadID;
      // Calculate Obsfucator
      asm
        MOV     EAX, FS&#58;&#91;18h&#93;
        SUB     EAX, 10h
        XOR     EAX, &#91;TID&#93;
        MOV     &#91;Obsfucator&#93;, EAX
        // Obsfucator &#58;= &#40;@TIB - $10&#41; xor GetCurrentThreadID
      end;
      if Obsfucator <> 0 then
      begin
        // Retriece pointer to the PDB
        PDB &#58;= Pointer&#40;GetCurrentProcessID xor Obsfucator&#41;;
        // Return True if process is being debugged
        Result &#58;= &#40;PDB^.Flags and fDebugSingle&#41; <> 0;
      end;
    end;
     
    function GetParentProcessID&#58; Integer;
    begin
      // If Windows 95/98 or NT 5.0+, use ToolHelp32
      if &#40;Win32Platform = VER_PLATFORM_WIN32_NT&#41; and
         &#40;Win32MajorVersion < 5&#41; then
        Result &#58;= GetParentProcessIDForNT else
        Result &#58;= GetParentProcessIDForWindows;
    end;
     
    function IsDebuggerPresent&#58; Boolean;
    begin
      // If Windows 95, use PDB. Otherwise, use NT's IsDebuggerPresent
      if &#40;Win32Platform = VER_PLATFORM_WIN32_NT&#41; or
        &#40;&#40;Win32Platform = VER_PLATFORM_WIN32_WINDOWS&#41; and
         &#40;&#40;Win32MajorVersion > 4&#41; or
          &#40;&#40;Win32MajorVersion = 4&#41; and &#40;Win32MinorVersion > 0&#41;&#41;&#41;&#41; then
        Result &#58;= IsDebuggerPresentForNT else
        Result &#58;= IsDebuggerPresentForWindows;
    end;
     
    procedure EnumWindowsProc&#40;Window&#58; THandle; LParam&#58; Integer&#41;; stdcall;
    var
      ClassName&#58; string;
    begin
      // Allocate space for class name
      SetLength&#40;ClassName, 255&#41;;
      // Retrieve window's class name
      GetClassName&#40;Window, PChar&#40;ClassName&#41;, 255&#41;;
      // Reallocate string length
      SetLength&#40;ClassName, StrLen&#40;PChar&#40;ClassName&#41;&#41;&#41;;
      // If window belongs to an instance of Delphi, add to list
      if ClassName = 'TAppBuilder' then
        TList&#40;LParam&#41;.Add&#40;Pointer&#40;Window&#41;&#41;;
    end;
     
    function RunningUnderDelphi&#58; Boolean;
    var
      List&#58; TList;
      i&#58; Integer;
      ID, ParentID&#58; Integer;
      reg&#58; TRegistry;
    begin
      try
        result &#58;= False;
        // Retrieve ID for the parent process
        ParentID &#58;= GetParentProcessID;
        // If ID found and being debugged, check for Delphi
        if &#40;ParentID <> 0&#41; and &#40;IsDebuggerPresent&#41; then
        begin
          // Create a list of window handles
          List &#58;= TList.Create;
          // Fill list with window handles for instances of Delphi
          EnumWindows&#40;@EnumWindowsProc, Integer&#40;List&#41;&#41;;
          // Check Delphi instances
          for i &#58;= 0 to List.Count - 1 do
          begin
            // Get process ID for the Delphi window
            GetWindowThreadProcessID&#40;Integer&#40;List&#91;i&#93;&#41;, @ID&#41;;
            // Compare IDs
            if ID = ParentID then
            begin
              // The process parent ID is Delphi's process ID
              Result &#58;= True;
              Break;
            end;
          end;
          // Free list
          List.Free;
        end;
      except
        result&#58;= false;
      end;
    end;
     
    end.

  3. #3
    Membre chevronné
    Avatar de Clorish
    Profil pro
    Inscrit en
    Juin 2003
    Messages
    2 474
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2003
    Messages : 2 474
    Points : 2 158
    Points
    2 158
    Par défaut
    Eventuelement cette unite me branche aussi .... est il possible de l'avoir sous forme de lien plutot (ou en meme temps) c'est pas toujours top le copier coller ...

    Merci.
    On passe du temps a vous repondre, alors soyez sympas, passez du temps ..... a vous relire !
    --
    Pourquoi tant de haine pour cette pauvre aide Delphi ????
    Aiiimezzz laaaaa .... Si-Non-Cham-Pi-Gnon !!!
    --
    Pour plus de Renseignements : Venez me rejoindre sur Msn .... Promis je mords pas

  4. #4
    Membre chevronné
    Avatar de Pierre Castelain
    Inscrit en
    Avril 2002
    Messages
    523
    Détails du profil
    Informations forums :
    Inscription : Avril 2002
    Messages : 523
    Points : 1 943
    Points
    1 943
    Par défaut
    Quel est le problème avec le copier/coller ?

  5. #5
    Membre habitué
    Développeur .NET
    Inscrit en
    Juin 2002
    Messages
    274
    Détails du profil
    Informations professionnelles :
    Activité : Développeur .NET

    Informations forums :
    Inscription : Juin 2002
    Messages : 274
    Points : 174
    Points
    174
    Par défaut
    Merci beaucoup c'est presque parfait !!
    Je dis "presque" car cette partie du code (tout à la fin) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    if result then 
        begin 
          reg&#58;= TRegistry.Create; 
          reg.Access&#58;= KEY_READ; 
          reg.RootKey&#58;= HKEY_LOCAL_MACHINE; 
          if reg.OpenKey&#40;'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', false&#41; then 
          begin 
            if reg.ValueExists&#40;'Common licenses'&#41; then 
              result&#58;= Reg.ReadString&#40;'Common Licenses'&#41; = 'Z&#58;\PROSIM' 
            else 
              result&#58;= false; 
            reg.CloseKey; 
          end 
          else 
           result&#58;= false; 
          reg.Free; 
        end;
    ...renvoie "false" à tous les coups (et pour cause), d'ailleurs je ne sais pas à quoi sert cette entrée registre
    Donc en virant ça ça marche impec' !
    Merci

  6. #6
    Membre chevronné
    Avatar de Pierre Castelain
    Inscrit en
    Avril 2002
    Messages
    523
    Détails du profil
    Informations forums :
    Inscription : Avril 2002
    Messages : 523
    Points : 1 943
    Points
    1 943
    Par défaut
    Hum... On dirait que j'avais un peu bricolé le code original. Tu as raison, cela ne sert à rien. Je l'ai enlevé du code.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 7
    Dernier message: 07/03/2009, 12h09
  2. Mode debug
    Par sivaller dans le forum Assembleur
    Réponses: 9
    Dernier message: 12/10/2004, 14h33
  3. chargement DLL mode debug/release
    Par bihorece dans le forum C++Builder
    Réponses: 3
    Dernier message: 21/06/2004, 15h05
  4. Recupération lors d'un plantage (en mode debug)
    Par aRCHiMeD dans le forum MFC
    Réponses: 3
    Dernier message: 15/01/2004, 18h09

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo