[ Delphi / Pascal ] — начинающим: задаем вопросы (архивная - 2015)

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by banned, 6 May 2007.

Thread Status:
Not open for further replies.
  1. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Scripter
    Code:
    Program DSelfDel;
    Uses
    Windows;
    
    {
    Few more ways to go:
    1. Self-deleting .BAT file
    2. Create temporary file using CreateFile() with FILE_FLAG_DELETE_ON_CLOSE flag.
    
    URL: http://forum.vingrad.ru/act-ST/f-1/t-12088/unread-1/anchor-entry77762/0.html
    }
    
    Type
         TInitStruct = Packed Record
                         pExitProcess: Pointer;
                         pWaitForSingleObject: Pointer;
                         pSleep: Pointer;
                         pDeleteFile: Pointer;
                         pCloseHandle: Pointer;
                         hParent: THandle;
                         szFileName: Array[0..MAX_PATH-1] Of Char;
                       End;
    
    Procedure SelfDel; Assembler;
    Asm
      call @code
      @pExitProcess: dd 0
      @pWaitForSingleObject: dd 0
      @pSleep: dd 0
      @pDeleteFile: dd 0
      @pCloseHandle: dd 0
      @hParent: dd 0
      // MAX_PATH = 260 { windows.pas }
      @szFileName: db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
    
      @code:
      // ******************************
      // full injection code:
      pop ebp
    
      push INFINITE
      mov ebx, TInitStruct(ebp).hParent
      push ebx
      call TInitStruct(ebp).pWaitForSingleObject
    
      mov ebx, TInitStruct(ebp).hParent
      push ebx
      call TInitStruct(ebp).pCloseHandle
    
      @delfile:
        lea ebx, TInitStruct(ebp).szFileName
        push ebx
        call TInitStruct(ebp).pDeleteFile
        or eax, eax
        jne @exit
    
        push 500
        call TInitStruct(ebp).pSleep
      jmp @delfile
    
      @exit:
      push 0
      call TInitStruct(ebp).pExitProcess
    End;
    
    Function GetCodeSize(P: PByte): Cardinal; Assembler;
    Asm
      mov ebx, eax
      mov cl, 0C3h
      @loop:
      inc eax
      cmp [eax], cl
      jnz @loop
      sub eax, ebx
      inc eax
    End;
    
    {
    used links:
    http://www.codeproject.com/useritems/selfdel.asp
    http://undocumented.ntinternals.net/
    }
    Function GetProcessEntryPointAddress(hProcess, hThread: THandle): Cardinal;
    Var
        read, dwFSBase, dwImageBase, dwOffset, dwOptHeaderOffset, dd: Cardinal;
                                                             context: TContext;
                                                               entry: LDT_ENTRY;
    Begin
      //
      // get the current thread context
      //
      context.ContextFlags:=CONTEXT_FULL Or CONTEXT_DEBUG_REGISTERS;
      GetThreadContext(hThread, context);
      //
      // use the segment register value to get a pointer to
      // the TEB
      //
      GetThreadSelectorEntry(hThread, context.SegFs, entry);
      dwFSBase:=(entry.BaseHi ShL 24) Or (entry.BaseMid ShL 16) Or (entry.BaseLow);
      //
      // read the teb
      //
      ReadProcessMemory(hProcess, Ptr(dwFSBase + 48), @dd, 4, read); {1}
      //
      // read the peb from the location pointed at by the teb
      //
      ReadProcessMemory(hProcess, Ptr(dd + 8), @dwImageBase, 4, read); {2}
      //
      // figure out where the entry point is located;
      //
      ReadProcessMemory(hProcess, Ptr(dwImageBase + $3C), @dwOffset, 4, read); {3}
    
      dwOptHeaderOffset:=(dwImageBase + dwOffset + 4 + 20);
    
      ReadProcessMemory(hProcess, Ptr(dwOptHeaderOffset + 16), @dd, 4, read); {4}
      result:=dwImageBase + dd;
    End;
    
    Function DeleteSelf: Boolean;
    Var
        CodeSize, EntryPoint, dummy: Cardinal;
                         InitStruct: TInitStruct;
                            hKrnl32: HModule; 
                                 St: String;
                                 Pt: PByte;
                                 si: STARTUPINFO;
                                 pi: PROCESS_INFORMATION;
    Begin
      result:=False;
      ZeroMemory(@si, SizeOf(si));
      si.cb:=SizeOf(si);
      If CreateProcess(Nil, PChar('explorer.exe'), Nil, Nil, False, CREATE_SUSPENDED Or IDLE_PRIORITY_CLASS, Nil, Nil, si, pi) Then
        Begin
          With InitStruct Do
            Begin
              DuplicateHandle(GetCurrentProcess, GetCurrentProcess, pi.hProcess, @hParent, 0, FALSE, 0);
              hKrnl32:=GetModuleHandle('kernel32');
              pExitProcess:=GetProcAddress(hKrnl32, 'ExitProcess');
              pWaitForSingleObject:=GetProcAddress(hKrnl32, 'WaitForSingleObject');
              pSleep:=GetProcAddress(hKrnl32, 'Sleep');
              pDeleteFile:=GetProcAddress(hKrnl32, 'DeleteFileA');
              pCloseHandle:=GetProcAddress(hKrnl32, 'CloseHandle');
              FillChar(szFileName, MAX_PATH, 0);
              St:=ParamStr(0);
              Move(St[1], szFileName, Length(St));
            End;
          Pt:=@SelfDel;
          Inc(Pt, 5); // offset to structure
          WriteProcessMemory(GetCurrentProcess, Pt, @InitStruct, SizeOf(InitStruct), dummy);
          Dec(Pt, 5); // restore offset to program start
          CodeSize:=GetCodeSize(Pt);
          EntryPoint:=GetProcessEntryPointAddress(pi.hProcess, pi.hThread);
          VirtualProtectEx(pi.hProcess, Ptr(entrypoint), CodeSize, PAGE_EXECUTE_READWRITE, dummy);
          WriteProcessMemory(pi.hProcess, Ptr(entrypoint), Pt, CodeSize, dummy);
          FlushInstructionCache(pi.hProcess, Ptr(entrypoint), CodeSize);
          ResumeThread(pi.hThread);
          CloseHandle(pi.hThread);
          CloseHandle(pi.hProcess);
          result:=True;
        End;
    End;
    
    Begin
      DeleteSelf;
    End.
    
    Но антивирусы в частности каспер ругается на этот код
     
    1 person likes this.
  2. Scripter

    Scripter Member

    Joined:
    3 Sep 2008
    Messages:
    141
    Likes Received:
    95
    Reputations:
    6
    тогда к сожалению меня это не устраивает :(
     
  3. slesh

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

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,224
    Reputations:
    455
    2 Scripter вообще в консоле когда нужно указать путь в котором содержаться пробелы, то нужно взять путь в ковычках. т.е. типа del "c:\program file\file.exe"
     
    1 person likes this.
  4. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Scripter а зачем тебе полный путь к программе если брать относительный то все долно работать на ура! и ненадо паритсья с русскими буквами и пробелами
     
  5. slesh

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

    Joined:
    5 Mar 2007
    Messages:
    2,702
    Likes Received:
    1,224
    Reputations:
    455
    2 transserg а ты не думал, что программа во время выполнения могла сменить текщую директорию? Или допустим быть запущенной с другой текущей директорией.
    типа типа \dir\dir\prog.exe
    А вообще я уже человеку объяснил что пути нужно брать в ковычки, и предварительно перегонять из Ansi в OEM
     
  6. 0ldbi4

    0ldbi4 Elder - Старейшина

    Joined:
    14 Apr 2008
    Messages:
    264
    Likes Received:
    51
    Reputations:
    10
    Почему строчка:
    ReadLn(f, memo1.Lines.add);
    Дает эту ошибку:
    [DCC Error] UnitX.pas(59): E2035 Not enough actual parameters
     
  7. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    потому что memo1.Lines.add это метод тоесть функция а не строка
    сделай так
    Code:
    var
       s:string;
    begin
       ReadLn(f, s);
       memo1.Lines.add(s);
    end;
    
    
     
    #4567 transserg, 5 Nov 2009
    Last edited by a moderator: 5 Nov 2009
  8. 0ldbi4

    0ldbi4 Elder - Старейшина

    Joined:
    14 Apr 2008
    Messages:
    264
    Likes Received:
    51
    Reputations:
    10
    Уже разобрался, но всё равно спасибо
     
  9. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    Использую при создании ПО критические секции. Но одна из последних программ постоянно зависает и, чую я, по вине неправильного их использования.

    Грешу на кусочек кода в потоке:
    Code:
      if accounts.Count > 0 then
      begin
        CriticalSection.Enter;
          account := accounts.Strings [0];
          accounts.Delete (0);
        CriticalSection.Leave;
      end else
      begin
        to_log ('come to an end accounts');
        exit;
      end;
    и функцию:
    Code:
    function to_used (str : string) : integer;
    var
      t : textfile;
    begin
      CriticalSection.Enter;
        assignfile (t, curdir + '\config\send - used accounts.txt');
        append (t);
        writeln (t, str);
        closefile (t);
      CriticalSection.Leave;
      Result := 1;
    end;
    accounts - tstringlist массив строк, строки в него загружаются из файла, при запуске программы.

    Кто что может посоветовать?

    Заранее спасибо.
     
  10. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Пуховой
    попробуй использовать
    Code:
     var
      sect1 : TRTLCriticalSection;
    
    В форм криэйт
    Code:
     initializeCriticalSection(sect1);        // Инициализации критической секции
    
    Code:
    EnterCriticalSection (sect1); //войти в критическую секцию
    //Твой код критического участка
    LeaveCriticalSection(sect1); //выйти в критическую секцию
    
    а это на форм дестрой
    Code:
      DeleteCriticalSection(sect1);
    
    а ты случаем ни где не используеш terminateThread?
    проверь еще выходит ли поток из критической секции..
     
    #4570 transserg, 5 Nov 2009
    Last edited: 5 Nov 2009
    2 people like this.
  11. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    transserg, спасибо, буду пробовать без "обертки" TCriticalSection.

    Тестирую очень просто.

    Код потока без обертки TCriticalSection:
    Code:
    procedure inv.Execute;
    begin
      EnterCriticalSection (CriticalSection);
        form1.Memo2.Lines.Add (timetostr (time));
      LeaveCriticalSection (CriticalSection);
      new_inv (); // запуск нового потока
    end;
    Код потока с оберткой TCriticalSection:
    Code:
    procedure inv.Execute;
    begin
      CriticalSection.Enter;
        form1.Memo2.Lines.Add (timetostr (time));
      CriticalSection.Leave;
      new_inv (); // запуск нового потока
    end;
    Второй вариант "поломался" на 20000-ной строчке в memo. Первый (ваш) пока работает, тьфу-тьфу-тьфу.

    Буду тестировать, спасибо огромное!
     
  12. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    Отловил я-таки момент зависания.

    В процедуре обновления списка прокси-серверов.

    Code:
    procedure TForm1.Timer3Timer(Sender: TObject);
    var
      s : widestring;
      http : tidhttp;
    begin
      http := tidhttp.create;
      http.ReadTimeout := 30000;
      s := httpget (http, 'http://awmproxy.com/proxy.php?Id=********&d=1');
      if extractb (s, '[^\r\n]*[^\r\n]') <> nil then
      begin
        CriticalSection.Enter;
          proxys.Clear;
          proxys.AddStrings (extractb (s, '[^\r\n]*[^\r\n]'));
        CriticalSection.Leave;
      end;
      http.Free;
    end;
    В момент, когда критическая секция занята, в нее стучится этот код. И все - зависает.

    Как иправить, подскажите, пожалуйста :confused:
     
  13. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Пуховой попробуй не таймер использовать а отдельный поток
     
  14. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    transserg, так и сделал... Но сама суть - почему все-таки программа зависает, при стуке таймера в критическую секцию? Вопрос покоя не дает :(
     
  15. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    2 Пуховой
    Code:
    http.ReadTimeout := 30000;
    
    30 секунд ждать не много? если у тебя 1000 итераций то уйдет 60 часов + задержки таймера.

    у тебя задержка в такймере сколько стоит?
    Зависает всмысле форма не обновляется или программа ничего не делает?
    если форма то добавть в цикл потока или той функции котороая больше всего времени отнимает
    Application.ProcessMessage;
     
  16. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    transserg, задержка в таймере - 10 минут. Т.е. - каждые 10 минут обновляется список прокси-серверов, но дело не в этом. Критическая секция используется только при обновлении самого списка, не более, а на это уходит дай бог 1 мсек.

    Сл. эксперимент. Тело таймера:
    При использовании критической секции другим потоком, в момент обращения таймера к ней программа также виснет (приостанавливают работу потоки, перестает отвечать главная форма).

    Чую, надо ковырять глубже, интерес разобрал :)
     
  17. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Пуховой
    для того чтоб форма не подвисала используй Application.ProcessMessage; или как варинат преостанавливай потоки на время обновления списка проксей
     
  18. Пуховой

    Joined:
    25 Nov 2007
    Messages:
    46
    Likes Received:
    37
    Reputations:
    0
    transserg, application.processmessages здесь не поможет.

    Известно одно - таймер тыкается в крит. секцию и все идет "не по плану". Буду копать глубже.

    Спасибо за ответы :)
     
  19. Adekvatnyj

    Adekvatnyj Member

    Joined:
    28 Oct 2009
    Messages:
    18
    Likes Received:
    25
    Reputations:
    -3
    При компиляции программы вываливается "Access violation...". Появляется дебаггер с ассамблерным кодом. Работаю на дельфи 7
     
  20. transserg

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

    Joined:
    2 Jul 2008
    Messages:
    147
    Likes Received:
    25
    Reputations:
    2
    Adekvatnyj зедсь есть экстрасенсы? =) код выложи
    или хотяб часть на которую грешиш
     
Thread Status:
Not open for further replies.