Últimos Temas de: 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

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.