Código Delphi [-]
// Esta funcion dibuja un texto usando letras, jeje
function StrToStr(Str: string): string;
var
  Bitmap: TBitmap;
  i,j: integer;
begin
  Result:= '';
  // Creamos un Bitmap
  Bitmap:= TBitmap.Create;
  try
    // Ajustamos el tipo y tamaño de la fuente
    Bitmap.Canvas.Font.Name:= 'Arial Black';
    Bitmap.Canvas.Font.Size:= 16;
    // Ajustamos el tamaño del Bitmap al tamaño del texto
    Bitmap.Width:= Bitmap.Canvas.TextWidth(Str);
    Bitmap.Height:= Bitmap.Canvas.TextHeight(Str);
    // Escribimos el texto en el bitmap
    Bitmap.Canvas.TextOut(0,0,Str);
    // Vamos leyendo pixel a pixel del bitmap
    for j:= 0 to Bitmap.Height - 1 do
    begin
      for i:= 0 to Bitmap.Width - 1 do
        // Por cada pixel blanco añadimos la letra _ al resultado
        if Bitmap.Canvas.Pixels[i,j] = $FFFFFF then
          Result:= Result + '_'
        else
          // y por cada pixel que no es blanco añadimos una X
          Result:= Result + 'X';
      // Al final de cada fila de pixeles añadimo al resultado un salto de linea
      Result:= Result + #13#10;
    end;
  finally
    // Eliminamos el bitmap, ya no lo necesitamos
    Bitmap.Free;
  end;
end;

// Por ejemplo
ShowMessage(StrToStr('ClubDelphi') );

Código Delphi [-]
uses
  // Winsock tiene que estar en las uses
  Windows, SysUtils, Winsock;

// Cada conexion se ejecuta en un thread diferente
function ThreadProc(Socket: TSocket): Integer;
var
  Str: String;
begin
  Result:= 0;
  try
    // En este bucle se mandan los numeros
    repeat
      // Un retardo de 100 ms entre numero y numero
      Sleep(100);
      // Convertimos el numero a hexadecimal, para que quede bonito
      Str:= IntToHex(Random(MAXINT),8);
      // y lo mandamos hasta que nuestro cliente se desconecte 
    until send(Socket,PChar(Str)^,Length(Str)+1,0) = SOCKET_ERROR;
  finally
    // Cerramos la conexion
    Shutdown(Socket,SD_SEND);  // SD_SEND = 1;
    CloseSocket(Socket);
    // Terminamos el thread
    EndThread(0);
  end;
end;

// Este es el bucle principal
procedure Aleator;
var
  WSADATA: TWSADATA;
  ServerSocket: TSocket;
  LocalAddr: TSockaddr;
  ClientSocket: TSocket;
  RemoteAddr: TSockaddr;
  AddrSize: Integer;
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  ThreadId: LongWord;
begin  
  Randomize;
  // Inicializamos Winsock
  if WSAStartup(MAKEWORD(1, 1), WSADATA) = 0 then
  try
    // Creamos el Socket del servidor
    ServerSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
    if ServerSocket <> INVALID_SOCKET then
    begin
      // Configuramos la ip y el puerto que vamos a usar
      with LocalAddr do
      begin
        sin_family := AF_INET;
        // Aqui colocamos el puerto a usar
        sin_port := htons(1978);
        // Aqui indicamos que usaremos cualquier ip de nuestro equipo
        sin_addr.s_addr := htonl(INADDR_ANY);
        // Si queremos limitarnos a una ip en concreto usaremos la siguiente linea
        // sin_addr.s_addr:= Inet_Addr('127.0.0.1');
      end;
      // Ponemos el Socket a la escucha ...
      if bind(ServerSocket, LocalAddr, sizeof(LocalAddr)) <> SOCKET_ERROR then
        if listen(ServerSocket, SOMAXCONN) <> SOCKET_ERROR then
        begin
          repeat
            TimeVal.tv_sec := 0;
            TimeVal.tv_usec := 500;
            FD_ZERO(FDSet);
            FD_SET(ServerSocket, FDSet);
            // Comprobamos el estado del socket
            if select(0, @FDSet, nil, nil, @TimeVal) > 0 then
            begin
              AddrSize := sizeof(RemoteAddr);
              // Aceptamos la nueva conexion y creamos un nuevo Thread
              ClientSocket := accept(ServerSocket, @RemoteAddr, @AddrSize);
              if ClientSocket <> INVALID_SOCKET then
                // Creamos un nuevo tread usando la API
                BeginThread(nil, 0, @ThreadProc, Pointer(ClientSocket),
                  0, ThreadID);
            end;
          until FALSE; // Aquí ponemos la condición que nos apetezca
        end;
    end;
  finally
    WSACleanup();
  end;
end;

Código Delphi [-]
uses UrlMon, ShellApi;

procedure Raulito(Min, Max: Integer);
var
  i: Integer;
  Path: Array[0..MAX_PATH] of Char;
begin
  FillChar(Path,Sizeof(Path),#0);
  // Obtenemos el directorio temporal
  if GetTempPath(Sizeof(Path)-1, @Path) <> 0 then
  begin
    // Creamos el directorio "Raulito", dentro del temporal, si no existe ya 
    if DirectoryExists((String(Path) + 'Raulito')) or
      CreateDir(String(Path) + 'Raulito') then
    begin
      // Comenzamos el bucle
      for i:= Min to Max do
        // Bajamos la imagen al directorio "Raulito"
        UrlDownloadToFile(nil,
          PChar(Format('http://www.telefonica.net/web2/recurrente/tira/tira%d.png',[i])),
          PChar(String(Path) + Format('Raulito\tira%d.png',[i])),0,nil);
      // Mostramos la carpeta "Raulito"
      Shellexecute(0,nil,PChar(String(Path) + 'Raulito'),nil,nil,SW_SHOW);
    end;
  end;
end;


// Por ejemplo
Raulito(80,89);
// O si queremos todas (hasta hoy)
Raulito(0,89);

Código Delphi [-]
program bf;

{$APPTYPE CONSOLE}

uses Windows, SysUtils, Classes;

// Esta funcion interpreta el codigo
procedure Brainfuck(Codigo: String);
const
  // El tamaño del array, el estandar es 30000
  Size = 30000;
  // Mensajes de error del interprete
  strPointerError = 'El puntero no es valido';
  strBracketError = 'Se encontro un bracket sin pareja';
var
  i,j: Integer;
  Min, Max, P: PByte;
begin
  // Obtenemos memoria para alojar el array de bytes
  GetMem(Min,Size);
  try
    // Inicializamos el array a cero
    FillChar(Min^,Size,#0);
    // Establecemos el limite superior e inferior
    Max:= Min;
    inc(Max,Size - 1);
    // Inicializamos el puntero en la primera posicion del array
    P:= Min;
    i:= 1;
    // Comenzamos a recorrer el codigo
    while (i <= Length(Codigo)) do
    begin
      case Codigo[i] of
        '>': begin  // Incrementamos el puntero
               if P = Max then
                 raise Exception.Create(strPointerError);
               inc(P);
             end;
        '<': begin  // Decrementamos el puntero
               if P = Min then
                 raise Exception.Create(strPointerError);
               dec(P);
             end;
        '+': inc(P^); // Incrementamos el valor actual
        '-': dec(P^); // Leemos el valor actual
        '.': Write(Char(P^)); // Imprimime el valor actual
        ',': Read(Char(P^)); // Lee un valor de la entrada
        '[': if P^ = 0 then // Comienza un bucle
             begin
               j:= 1;
               // Como la condicion es cero saltamos al final del bucle
               repeat
                 inc(i);
                 if i > Length(Codigo) then
                    raise Exception.Create(strBracketError);
                  case Codigo[i] of
                    '[': inc(j);
                    ']': dec(j);
                  end;
               until (j=0);
             end;
        ']': if P^ <> 0 then // Finaliza un bucle
             begin
               j:= 1;
               repeat
                 dec(i);
                 // Como la condicion no es cero saltamos al principio del bucle
                 if i < 1 then
                    raise Exception.Create(strBracketError);
                  case Codigo[i] of
                    '[': dec(j);
                    ']': inc(j);
                  end;
               until (j=0);
             end;
      end;
      inc(i);
    end;
  finally
    // Liberamos la memoria del array
    FreeMem(Min);
  end;
end;

begin
  // Comprobamos que nos han pasado el fichero con el codigo
  if ParamCount = 1 then
  try
    with TStringList.Create do
    try
      // Abrimos el fichero con el codigo
      LoadFromFile(ParamStr(1));
      // Lo interpretamos
      Brainfuck(Text);
    finally
      Free;
    end;
  except
    // Si ocurre una excepcion la imprimimos
    On E: Exception do
    begin
      Writeln(E.Message);
    end;
  end;
end.

• si buscas por sector: no devuelve nada
• si buscas por cluster: no devuelve nada
• si buscas por sector cluster: el resultado es inútil...:D

Código Delphi [-]
//Esta función invierte el contenido del texto pasado (Upper)
Function Invertir(Texto: String) : String;
Var I : Integer;
Begin
    For I := Length(Texto) downto 1 DO
        Result := Result + Texto[i];
    Result := UpperCase(Result);
End;



// Algunos ejemplos inútiles 
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( Invertir('SOMETEMOS'));
ShowMessage( Invertir('RECONOCER'));
ShowMessage( Invertir('SOLDADLOS'));
ShowMessage( Invertir('Amigo no gima.'));
ShowMessage( Invertir('Sé verlas al revés.') );
ShowMessage( Invertir('Se lo creí, mareada. Era miércoles') );
ShowMessage( Invertir('No solo no lo son') );
ShowMessage( Invertir('Nada, yo soy Adán') );
ShowMessage( Invertir('La ruta nos aportó otro paso natural') );
ShowMessage( Invertir('Dábale arroz a la zorra el abad') );
ShowMessage( Invertir('Anita lava la tina'));
ShowMessage( Invertir('Anita la gorda lagartona no traga la droga latina'));
end;

Código Delphi [-]
{*******************************************************}
{                                                       }
{       Pelota Loca, un programa inútil (?)             }
{                                                       }
{       Copyright (c) 2006 David Esperalta              }
{                                                       }
{               GNU Public License                      }
{                                                       }
{*******************************************************}

program PelotaLoca;

{$APPTYPE CONSOLE}

uses
  Forms,
  Windows,
  Classes,
  SysUtils,
  Controls,
  ExtCtrls,
  Graphics;

const
  CANTIDAD_MOVIMIENTO = 15; { Cantidad de movimiento }

var
  FForm  : TForm;
  FShape : TShape;

type
  TAuxiliar = class
  private
    FTimer: TTimer;
    procedure TimerTick(Sender: TObject);
    procedure KeyDownEvent(Sender: TObject;
               var Key: Word; Shift: TShiftState);
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TAuxiliar }

constructor TAuxiliar.Create;
begin
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 100;
  FTimer.Enabled  := true;
  FTimer.OnTimer  := TimerTick;
end;

destructor TAuxiliar.Destroy;
begin
  FTimer.Free;
  inherited Destroy;
end;

procedure TAuxiliar.KeyDownEvent(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  with FShape do case Key of
    VK_UP:    Top  := Top  - CANTIDAD_MOVIMIENTO;
    VK_RIGHT: Left := Left + CANTIDAD_MOVIMIENTO;
    VK_DOWN:  Top  := Top  + CANTIDAD_MOVIMIENTO;
    VK_LEFT:  Left := Left - CANTIDAD_MOVIMIENTO;
  end;
end;

procedure TAuxiliar.TimerTick(Sender: TObject);
resourcestring
  rsCaption = 'Top: %d - Left: %d';
begin
  with FShape do
  begin
    FForm.Caption := Format(rsCaption, [Top, Left]);

    if (Left > FForm.Width)  then Left := 2;
    if (Top  > FForm.Height) then Top  := 2;

    if (Left < 0) then Left := (FForm.Width  - Width);
    if (Top  < 0) then Top  := (FForm.Height - Height);

    if (GetKeyState(VK_UP) and $4000) > 0
      then Top  := Top  - CANTIDAD_MOVIMIENTO;

    if (GetKeyState(VK_DOWN) and $4000) > 0
      then Top  := Top  + CANTIDAD_MOVIMIENTO;

    if (GetKeyState(VK_LEFT) and $4000) > 0
      then Left := Left - CANTIDAD_MOVIMIENTO;

    if (GetKeyState(VK_RIGHT) and $4000) > 0
      then Left := Left + CANTIDAD_MOVIMIENTO;
  end;
end;

procedure Inicializar();
var
  FAuxilar: TAuxiliar;
begin
  FAuxilar := TAuxiliar.Create;
  FForm    := TForm.Create(nil);
  FShape   := TShape.Create(FForm);

  with FForm do
  begin
    Width       := 400;
    Height      := 300;
    Color       := clWhite;
    KeyPreview  := true;
    BorderStyle := bsDialog;
    Position    := poDesktopCenter;
    OnKeyDown   := FAuxilar.KeyDownEvent;
  end;

  with FShape do
  begin
    Width       := 20;
    Height      := 20;
    Parent      := FForm;
    Brush.Color := clRed;
    Pen.Color   := clWhite;
    Shape       := stCircle;
    Top         := CANTIDAD_MOVIMIENTO;
    Left        := CANTIDAD_MOVIMIENTO;
  end;

  try
    FForm.ShowModal;
  finally
    FForm.Free;
    FAuxilar.Free;
  end;
end;

begin { application }

  Inicializar();

end.

Código Delphi [-]
{··············································}
{······························· dec - 20005 ··}
{··············································}
{·} unit UMsgPopup; interface {················}
{·} uses Forms,{···}StdCtrls, {················}
{·} Windows,Classes,Graphics; {················}
{·} procedure MsgPopup(const msg: {············}
{·} string; const wait: integer); {············}
{·} implementation {···························}
{·} procedure MsgPopup(const msg: {············}
{·} string; const wait: integer); {············}
{·} var {······································}
{·····} i,max: integer; {······················}
{·····} lbMsg:{}TLabel; {······················}
{·····} fmMsg:{·}TForm; {······················}
{·····} panel:{·}TRect; {······················}
{·} begin {····································}
{···} fmMsg := TForm.Create(nil); {············}
{···} try {····································}
{·····} with fmMsg do {························}
{·····} begin {································}
{·······} Width  := 350; {·····················}
{·······} Height := 110; {·····················}
{·······} Color := clWhite; {··················}
{·······} Caption:=' '+msg; {··················}
{·······} SystemParametersInfo {···············}
{·······} (48, 0, @panel,  0); {···············}
{·······} Top := panel.Bottom; {···············}
{·······} BorderStyle := bsToolWindow; {·······}
{·······} FormStyle{·}:=  fsStayOnTop; {·······}
{·······} lbMsg:=TLabel.Create(fmMsg); {·······}
{·······} Left := panel.Right-fmMsg.Width-2; {·}
{·······} max :=panel.Bottom-fmMsg.Height-2; {·}
{·······} with lbMsg do {······················}
{·······} begin {······························}
{·········} Top{}:= 30; {······················}
{·········} Left := 10; {······················}
{·········} Height:=30; {······················}
{·········} Parent {}:=fmMsg; {················}
{·········} AutoSize :=false; {················}
{·········} Caption{}:=  msg; {················}
{·········} Font.Size :={}14; {················}
{·········} Font.Name := 'Arial'; {············}
{·········} Font.Color{}:= clRed; {············}
{·········} Alignment:= taCenter; {············}
{·········} Font.Style:=[fsBold]; {············}
{·········} Width := fmMsg.Width; {············}
{·······} end ; {······························}
{·······} Show; {······························}
{·······} i := Top; {··························}
{·······} while(i>=max)do {····················}
{·······} begin {······························}
{·········} Top := i; {························}
{·········} Dec(i,2); {························}
{·········} Refresh ; {························}
{·······} end; {·······························}
{·····} end; {·································}
{···} finally {································}
{·····} Sleep(wait); {·························}
{·····} fmMsg.Free;; {·························}
{···} end; {···································}
{·} end; {·····································}
{.} end. {·····································}
{························ www.ClubDelphi.com ·····}
{··············································}

Código Delphi [-]
// **********************************************************
// Este código esta basado, y MUCHO, en este otro
// http : / / perso.wanadoo.es/plcl/speaker/playspkr.html
// En la misma pagina podéis encontrar otra canciones.
// **********************************************************
unit Beeper;

interface

uses Windows, SysUtils, Classes;

type
  // Esta la clase del thread que reproduce la cancion
  TBeeper = class(TThread)
  private
    procedure PlayString(Str: String);
    procedure PlayTone(Pitch, Value, Sustain: Integer) ;
  protected
    procedure Execute; override;
  public
    constructor Create; 
    destructor Destroy; override;
  end;

implementation

// Las siguinetes constantes y variables tienen que ver con "cosas" musicales,
// y como de musica no tengo ni idea, pues no se para que sirven.
var
  Octave: Integer;
  Whole: Integer;
  Value: Integer;
  Fill: Integer;
  Octtrack: Boolean;
  Octprefix: Boolean;

const
  HZ = 1000;

  SECS_PER_MIN = 60;
  WHOLE_NOTE = 4;
  MIN_VALUE  = 64;
  DFLT_VALUE = 4;
  FILLTIME = 8;
  STACCATO = 6;
  NORMAL = 7;
  LEGATO = 8;
  DFLT_OCTAVE  = 4;
  MIN_TEMPO  = 32;
  DFLT_TEMPO = 120;
  MAX_TEMPO  = 255;
  NUM_MULT  = 3;
  DENOM_MULT  = 2;
  Notetab: array ['A'..'G'] of Integer = (9, 11, 0, 2, 4, 5, 7);

  OCTAVE_NOTES = 12;
  Pitchtab: array[0..83] of Integer =
(
(*        C     C#    D     D#    E     F     F#    G     G#    A     A#    B*)
(* 0 *)   65,   69,   73,   78,   82,   87,   93,   98,  103,  110,  117,  123,
(* 1 *)  131,  139,  147,  156,  165,  175,  185,  196,  208,  220,  233,  247,
(* 2 *)  262,  277,  294,  311,  330,  349,  370,  392,  415,  440,  466,  494,
(* 3 *)  523,  554,  587,  622,  659,  698,  740,  784,  831,  880,  932,  988,
(* 4 *) 1047, 1109, 1175, 1245, 1319, 1397, 1480, 1568, 1661, 1760, 1865, 1975,
(* 5 *) 2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,
(* 6 *) 4186, 4435, 4698, 4978, 5274, 5588, 5920, 6272, 6644, 7040, 7459, 7902
);

  
  // Wish you a Merry Christmas
  Cancion = 'T160' +
            'd gL8gagf# L4ece' +
            'aL8abag L4f#df# bL8b>c< ba' +
            'L4ged8d8 eaf#g2d ggg' +
            'f#2f# gf#e d2a bL8aagg' +
            'L4>d< dd8d8 L4eaf#g1';

{ TBeeper }

// Creamos el trhead y inicializamos las variables
constructor TBeeper.Create;
begin
  inherited Create(FALSE);
  Octave:= DFLT_OCTAVE;
  Whole:= (HZ * SECS_PER_MIN * WHOLE_NOTE) div DFLT_TEMPO;
  Fill:= NORMAL;
  Value:= DFLT_VALUE;
  Octtrack:= FALSE;
  Octprefix:= TRUE;
end;

destructor TBeeper.Destroy;
begin
  inherited;
end;

// Reproducimos la cancion en un bucle hasta que el thread termina
procedure TBeeper.Execute;
begin
  inherited;
  while not Terminated do
  begin
     // Reproducir cancion
     PlayString(Cancion);
     // Hacer una pequeña pausa
     Sleep(200); // Pausa
  end;
end;

// Esta función devuelve el valor de un numero dentro de una cadena de texto.
// La variable i termina apuntando a la ultima cifra del numero.
function GetNum(Str: String; var i: Integer): Integer;
var
  j: Integer;
begin
  // Inicializamos el resultado
  Result:= 0;  
  while TryStrToInt(Copy(Str,i+1,1),j) do
  begin
    Result:= (Result * 10) + j;
    inc(i);
  end;
end;

// Esto reproduce la canción. Básicamente analiza la cadena y la convierte
// en tonos que se envían al altavoz. Otra vez "cosas" musicales, jeje
procedure TBeeper.PlayString(Str: String);
var
  Pitch, OldFill, LastPitch, i: Integer;
  Sustain, Timeval, Tempo: Integer;
begin
  LastPitch:= OCTAVE_NOTES * DFLT_OCTAVE;
  Str:= Uppercase(Str);
  i:= 1;
  while i <= Length(Str) do
  begin
    case Str[i] of
      'A'..'G': begin
        Pitch:= Notetab[Str[i]] + Octave * OCTAVE_NOTES;
        if (Copy(Str,i+1,1) = '#') or  (Copy(Str,i+1,1) = '+') then
        begin
          inc(Pitch);
          inc(i);
        end else if Copy(Str,i+1,1) = '-' then
        begin
          dec(Pitch);
          inc(i);
        end;
        if Octtrack and not Octprefix then
        begin
          if abs(Pitch-Lastpitch) > abs(Pitch+OCTAVE_NOTES-LastPitch) then
          begin
              inc(Octave);
              inc(Pitch,OCTAVE_NOTES);
          end;
          if abs(Pitch-Lastpitch) > abs((Pitch-OCTAVE_NOTES)-LastPitch) then
          begin
              dec(Octave);
              dec(Pitch,OCTAVE_NOTES);
          end;
        end;
        Octprefix:= FALSE;
        LastPitch:= Pitch;
        Timeval:= GetNum(Str,i);
        if (Timeval <= 0) or (Timeval > MIN_VALUE) then
          Timeval:= Value;
        Sustain:= 0;
        while Copy(Str,i+1,1) = '.' do
        begin
          inc(Sustain);
          inc(i);
        end;
        Oldfill:= Fill;
        if Copy(Str,i+1,1) = '_' then
        begin
          Fill:= LEGATO;
          inc(i);
        end;
        Playtone(Pitch, Timeval, Sustain);
        Fill:= OldFill;
      end;
      'O': begin
        if Copy(Str,i+1,1) = 'N' then
        begin
          Octprefix:= FALSE;
          Octtrack:= FALSE;
          inc(i);
        end else if Copy(Str,i+1,1) = 'L' then
        begin
          Octtrack:= TRUE;
          inc(i);
        end else
        begin
          Octave:= GetNum(Str,i);
          if Octave >= (High(Pitchtab) div OCTAVE_NOTES) then
            Octave:= DFLT_OCTAVE;
          Octprefix:= TRUE;
        end;
      end;
      '>': begin
        if (Octave < (High(Pitchtab) div OCTAVE_NOTES) - 1) then
          inc(Octave);
          Octprefix:= TRUE;
        end;
      '<': begin
          if (Octave > 0) then
            dec(Octave);
          Octprefix:= TRUE;
      end;
      'N': begin
        Pitch:= GetNum(Str,i);
        Sustain:= 0;
        while Copy(Str,i+1,1) = '.' do
        begin
          inc(i);
          inc(Sustain);
        end;
        Oldfill:= Fill;
        if Copy(Str,i+1,1) = '_' then
        begin
          Fill:= LEGATO;
          inc(i);
        end;
        Playtone(Pitch - 1, Value, Sustain);
        Fill:= OldFill;
      end;
      'L': begin
        Value:= GetNum(Str,i);
        if (Value <= 0) or (Value > MIN_VALUE) then
          Value:= DFLT_VALUE;
      end;
      'P','~': begin
        Timeval:= Getnum(Str,i);
        if (Timeval <= 0) or (Timeval > MIN_VALUE) then
          Timeval:= Value;
        Sustain:= 0;
        while Copy(Str,i+1,1) = '.' do
        begin
          inc(i);
          inc(Sustain);
        end;
        PlayTone(-1, Timeval, Sustain);
      end;
      'T': begin
        Tempo:= GetNum(Str,i);
        if (Tempo < MIN_TEMPO) or (Tempo > MAX_TEMPO) then
          Tempo:= DFLT_TEMPO;
        Whole:= (HZ * SECS_PER_MIN * WHOLE_NOTE) div tempo;
      end;
      'M': begin
         if Copy(Str,i+1,1) = 'N' then
          begin
            Fill:= NORMAL;
            inc(i);
          end else if Copy(Str,i+1,1) = 'L' then
          begin
            Fill:= LEGATO;
            inc(i);
          end else if Copy(Str,i+1,1) = 'S' then
          begin
            Fill:= STACCATO;
            inc(i);
          end;
      end;
    end;
    inc(i);
  end;
end;

// Esta funcion envia un tono al altavoz
procedure TBeeper.PlayTone(Pitch, Value, Sustain: Integer);
var
  Sound, Silence, Snum, Sdenom: Integer;
begin
  Snum:= 1;
  Sdenom:= 1;
  while Sustain > 0 do
  begin
    Snum:= Snum * NUM_MULT;
    Sdenom:= Sdenom * DENOM_MULT;
    dec(Sustain);
  end;
  if Pitch = -1 then
    Sleep(Whole * Snum div (Value * Sdenom))
  else begin
    Sound:= (Whole * Snum) div (Value * Sdenom)
          - (Whole * (FILLTIME - Fill)) div (Value * FILLTIME);
    Silence:= Whole * (FILLTIME - Fill) * Snum div (FILLTIME * Value * Sdenom);
  Windows.Beep(Pitchtab[Pitch],Sound);
  if Fill <> LEGATO then
    Sleep(Silence);
  end;
end;

// Aqui creamos el thread al cargarse la unidad
initialization
  with TBeeper.Create do
    // Le indicamos que se destruya al terminarr
    FreeOnTerminate:= TRUE;
finalization

end.

Código Delphi [-]
Begin      
      ShowMessage('Hello World '); 
end;

Código Delphi [-]
 ShowMessage('Hello Universe');

Código Delphi [-]
unit UCMorse;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  CodMorse : Array [48..90] of String =
                ('-----','.----','..---','...--','....-','.....',
                 '-....','--...','---..','----.','---...','-.-.-.',
                 '','-...-','','..--..','','.-','-...','-.-.','-..',
                 '.','..-.','--.','....','..','.---','-.-','.-..',
                 '--','-.','---','.--.','--.-','.-.','...','-','..-',
                 '...-','.--','-..-','-.--','--..');
var
  Form1: TForm1;

implementation

{$R *.DFM}

function ConvaCMorse(T:String):String;
var
  paso : String;
  I : Integer;
begin
  Paso := '';
  For I := 1 to length(T) do begin
      If T[i] <> ' ' then
         Insert(CodMorse[Ord(T[i])],Paso,Length(Paso)+1);
         Insert(' ',Paso,Length(Paso)+1);
  end;
  Result := Paso;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  Texto : String;
  I     : Integer;
begin
  Texto := 'sos';
  Texto := uppercase(Texto);
  ShowMessage(Texto+#10#13+ConvaCMorse(Texto));
end;

end.

Código Delphi [-]
// Opción tradicional y más sana:

Function F1 :Integer;
Begin
  Result := 4;
End;

procedure TForm1.Button1Click(Sender: TObject);
Var
  I :Integer;
begin
  I := F1 ();

  If I = 5 Then
    ShowMessage ('F1 devolvió 5.')
  Else
    { NOTA: Canon debidamente pagado a Julián, a la SGAE y a la SAGARPA :D }
    ShowMessage ('¡Pabernosmatao!  F1 devolvió ' + IntToStr (I) + '.');
end;

// Extravagancia de fiebre de sábado por la noche:

Type
  TInteger = Record
    Valor :Integer;
  End;

Function F2 :TInteger;
Begin
  Result.Valor := 4;
End;

procedure TForm1.Button2Click(Sender: TObject);
begin
  With F2 () Do
    If Valor = 5 Then
      ShowMessage ('F2 devolvió 5.')
    Else
      { NOTA: Canon debidamente pagado a Julián, a la SGAE y a la SAGARPA :D }
      ShowMessage ('¡Pabernosmatao!  F2 devolvió ' + IntToStr (Valor) + '.');
end;

Código Delphi [-]
procedure Al_Ayuda;
begin
  if (MessageDlg('¿Alguien conoce la utilidad de la función _CopyObject?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
     ShowMessage('Llame urgentemente a Al Gonzalez');
end;

Código Delphi [-]
try
Destination.Assign(Source); 
except
  on EConvertError do Destination := Source;
end;

Código Delphi [-]
unit WindowsUses;

interface

uses Windows, SysUtils, Forms, Messages, Classes;

procedure Mostrar(Forma: TForm;Value:Boolean;PosX,PosY:integer);
procedure ExpandirForma(Forma:TForm;Ancho,Largo:integer);
function FormaCreada(Nombre: String): boolean;
procedure DestruirForma(Forma: TForm);
procedure MinimizarForma(Forma: TForm);
procedure MaximizarForma(Forma: TForm);
procedure RestaurarForma(Forma: TForm);
procedure MinimizarAplicacion;
procedure FinalizarAplicacion;

implementation

procedure Mostrar(Forma: TForm;Value:Boolean;PosX,PosY:integer);
var Ban: Boolean;
begin
Ban := FormaCreada(Forma.Name);
if Ban
   then begin
        with Forma do
          begin
          Left := PosX;
          Top := PosY;
          Visible := Value;
          end;
        end;
end;

procedure ExpandirForma(Forma:TForm;Ancho,Largo:integer);
var Ban: boolean;
begin
ban := FormaCreada(Forma.Name);
if Ban then begin
            with Forma do
              begin
              Height:= Largo;
              Width:= Ancho;
              end;
            end;
end;

function FormaCreada(Nombre: string): boolean;
var Ban: boolean;
    i: integer;
begin
Ban := False;
i := 0;
while (Ban = False) and (i<= Screen.FormCount-1) do
  begin
  if Screen.Forms[i].Name = Nombre
    then ban := True
    else Inc(i,1);
  end;
Result := Ban;
end;

procedure DestruirForma(Forma: TForm);
var Ban: boolean;
begin
Ban := FormaCreada(Forma.Name);
if Ban
   then Forma.Destroy;
end;

procedure MinimizarForma(Forma: TForm);
var Ban: boolean;
begin
Ban := FormaCreada(Forma.Name);
if Ban then begin
            with Forma do
            WindowState := wsMinimized;
            end;
end;

procedure MaximizarForma(Forma: TForm);
var Ban: boolean;
begin
Ban := FormaCreada(Forma.Name);
if Ban then begin
            with Forma do
            WindowState := wsMaximized;
            end;
end;

procedure RestaurarForma(Forma: TForm);
var Ban: boolean;
begin
Ban := FormaCreada(Forma.Name);
if Ban then begin
            with Forma do
            WindowState := wsNormal;
            end;
end;

procedure MinimizarAplicacion;
begin
Application.Minimize;
end;

procedure FinalizarAplicacion;
begin
Application.Terminate;
end;

end.

Código Delphi [-]
 
procedure MyMakeDir(Dir: string);
begin
If not DirectoryExists(ExtractFileDir(Dir)) then
 MyMakeDir(ExtractFileDir(Dir));
MkDir(Dir);
end;

Código Delphi [-]
program sandez;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  s = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  i, j, k: byte;
  stmp: string;
begin
  stmp := s;
  j := length(s);
  Randomize;
  for k := 1 to 12 do
  begin
    for i := 1 to j do stmp[i] := s[random(j)];
    writeln(stmp);
  end;
end.

Código SQL [-]
Declare @Str varchar(60)
--Select @str='Anita lava la tina'
Select @str='Ana lleva al oso la avellana'

Select
case when reverse(substring(replace(@str, ' ',''),(len(replace(@str, ' ',''))/2)+2,(len(replace(@str, ' ',''))/2)+1))=substring(replace(@str, ' ',''),1,(len(replace(@str, ' ',''))/2)) then 1 else 0 end EsPali

Código Delphi [-]
procedure EjecutarRA(stUserDomain, stProg, stParam: String);
begin
   WinExec(PChar('runas /user:'+ stUserDomain+' '+chr(34)+stProg+ ' '+ stParam+chr(34)),SW_SHOWNORMAL);
end;

Código Delphi [-]
procedure rascame(ParteDelCuerpo:TBody,Intensidad:integer,Tiempo:TTime);
var QueMano:TBody;
     MePica:boolean;
begin
  MePica:=True;
  QueMano:=Tbody.Create;
  QueMano.Assign(ParteDelCuerpo);
  While MePica=True 
      then begin
          With ParteDelCuerpo do
               Lapsus:=Tiempo;
               Fuerza:=Intensidad;
          end;
          Try 
            QueMano.Rascame;
          except
            QueMano.Message(10,10,'Eres manco!!! no puedo rascarte'); 
          finally
            QueMano.YaPaso;
            MePica.Status:=False;
         end;
  QueMano:= nil;
 ParteDelCuerpo.Free; 
end;