از این تابع برای بدست آوردن UserNameکسی که Login کرده است استفاده می شود.

function GetUserName : String;
var
   pcUser   : PChar;
   dwUSize : DWORD;
begin
   dwUSize := 21;
   GetMem( pcUser, dwUSize );
   try
      if Windows.GetUserName( pcUser, dwUSize ) then
         Result := pcUser
   finally
      FreeMem( pcUser );
   end;

procedure TForm1.Button1Click(Sender: T);

  function PalabraAleatoria(Longitud: integer): string;
  const
    Letras = "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  var
    n  : integer;
  begin
    Result:="";
    for n:=1 to Longitud do Result:=Result+Letras[1+Random(Length(Letras))];
  end;

begin
  Caption:=PalabraAleatoria(10);
end;

از طریق این تابع می توانید یک فایل لینک از برنامه مورد نظر خود ایجاد کنید
procedure TForm1.Button1Click(Sender: T);
 
  procedure CreaLnk( Exe,
                     Argumentos,
                     DirTrabajo,
                     NombreLnk,
                     DirDestino:string);
  var
    Objeto: IUnknown;
    UnSlink: IShellLink;
    FicheroP: IPersistFile;
    WFichero: WideString;
  begin
    Objeto := CreateCom(CLSID_ShellLink);
    UnSlink := Objeto as IShellLink;
    FicheroP := Objeto as IPersistFile;
    with UnSlink do
      begin
        SetArguments( PChar(Argumentos) );
        SetPath( PChar(Exe) );
        SetWorkingDirectory( PChar(DirTrabajo) );
      end;
    WFichero := DirDestino + "\" + NombreLnk;
    FicheroP.Save(PWChar(WFichero),False);
  end;

begin
  CreaLnk( "c:\windows\Notepad.exe", {File Exe}
           "c:\Autoexec.bat",        {Arguments}
           "c:\",                    {Diretory  Base (For Search File Source)}
           "Editor Autoexec.lnk",    {File Name Link Output}
           "c:\"   {Output Directory}
           );
end;

به دست آوردن کلیه برنامه های نصب شده در ویندوز:

Registry; uses

procedure TForm1.Button1Click(Sender: T);

const CLAVE =

"\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall";

reg : TRegistry;

Lista : TStringList;

Lista2 : TStringList;

i,n : integer;

{Creamos cosas temporales}

{Create temporal things}

reg := TRegistry.Create;

Lista := TStringList.Create;

Lista2 := TStringList.Create;

{Cargamos todas las subkeys}

{Load all the subkeys}

with Reg do

begin

RootKey := HKEY_LOCAL_MACHINE;

OpenKey(CLAVE,false);

GetKeyNames(Lista);

end;

{Cargamos todos los Nombres de valores}

{Load all the Value Names}

for i := 0 to Lista.Count -1 do

begin

reg.OpenKey(CLAVE + "\" +Lista.Strings[i],false);

reg.GetValueNames(Lista2);

{Mostraremos s?lo los que tengan "DisplayName"}

{We will show only if there is "DisplayName"}

n:=Lista2.IndexOf("DisplayName");

if (n <> -1) and (Lista2.IndexOf("UninstallString")<>-1) then

begin

{DisplayName+UnInstallString}

Memo1.Lines.Append ( reg.ReadString(Lista2.Strings[n])+"-"+

reg.ReadString(Lista2.Strings[Lista2.IndexOf("UninstallString")]) );

end;

end;

{Liberamos temporales}

{Free temporals}

Lista.Free;

Lista2.Free;

reg.CloseKey;

reg.Destroy;

end;

از این برنامه برای اجرا کردن یک برنامه تحت Dos و برگرداندن خروجی آن به فرم شما و نمایش آن در یک Memo است.

  procedure RunDosInMemo(Que:String;EnMemo:TMemo);
  const
     CUANTOBUFFER = 2000;
  var
    Seguridades         : TSecurityAttributes;
    PaLeer,PaEscribir   : THandle;
    start               : TStartUpInfo;
    ProcessInfo         : TProcessInformation;
    Buffer              : Pchar;
    BytesRead           : DWord;
    CuandoSale          : DWord;
  begin
    with Seguridades do
    begin
      nlength              := SizeOf(TSecurityAttributes);
      binherithandle       := true;
      lpsecuritydeor := nil;
    end;
    {Creamos el pipe...}
    if Createpipe (PaLeer, PaEscribir, @Seguridades, 0) then
    begin
      Buffer  := AllocMem(CUANTOBUFFER + 1);
      FillChar(Start,Sizeof(Start),#0);
      start.cb          := SizeOf(start);
      start.hStdOutput  := PaEscribir;
      start.hStdInput   := PaLeer;
      start.dwFlags     := STARTF_USESTDHANDLES +
                           STARTF_USESHOWWINDOW;
      start.wShowWindow := SW_HIDE;
 
      if CreateProcess(nil,
         PChar(Que),
         @Seguridades,
         @Seguridades,
         true,
         NORMAL_PRIORITY_CLASS,
         nil,
         nil,
         start,
         ProcessInfo)
      then
        begin
          {Espera a que termine la ejecucion}
          repeat
            CuandoSale := WaitForSingle( ProcessInfo.hProcess,100);
            Application.ProcessMessages;
          until (CuandoSale <> WAIT_TIMEOUT);
          {Leemos la Pipe}
          repeat
            BytesRead := 0;
            {Llenamos un troncho de la pipe, igual a nuestro buffer}
            ReadFile(PaLeer,Buffer[0],CUANTOBUFFER,BytesRead,nil);
            {La convertimos en una string terminada en cero}
            Buffer[BytesRead]:= #0;
            {Convertimos caracteres DOS a ANSI}
            OemToAnsi(Buffer,Buffer);
            EnMemo.Text := EnMemo.text + String(Buffer);
          until (BytesRead < CUANTOBUFFER);
        end;
      FreeMem(Buffer);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
      CloseHandle(PaLeer);
      CloseHandle(PaEscribir);
    end;
  end;

به عنوان مثال:

  RunDosInMemo("chkdsk.exe c:\",Memo1);

برای اضافه کردن اسکرول بار به لیست باکس خود از این روش استفاده کنید..

ListBox1.Perform(LB_SETHORIZONTALEXTENT, 300, 0 );

یا از این روش

SendMessage( ListBox1.Handle, LB_SETHORIZONTALEXTENT, 300, 0 );

Speed test