Come mostrare il contenuto di una directory e delle sue sottodirectory

uses SysUtils

procedure STO_SearchDirectory(List: TStrings; Directory: String;
const Recursive: Boolean);
var
bFoundFile: Boolean;
mySearchRec: TSearchRec;
sFileName: String;
begin
Directory := IncludeTrailingPathDelimiter(Directory);
bFoundFile := FindFirst(Directory + '*.*', faAnyFile, mySearchRec) = 0;
while bFoundFile do
begin
    if (mySearchRec.Name[1] <> '.') then
    begin
      sFileName := Directory + mySearchRec.Name;
      if ((mySearchRec.Attr and faDirectory) = 0) then
      begin
        List.Add(sFileName);
      end
      else
      begin
        sFileName := IncludeTrailingPathDelimiter(sFileName);
        List.Add(sFileName);
          if Recursive then
          STO_SearchDirectory(List, sFileName, Recursive);
      end;
    end;
      bFoundFile := FindNext(mySearchRec) = 0;
end;
FindClose(mySearchRec);
end;

procedure Starter;
var
slFilenames: TStrings;
begin
slFileNames := TStringList.Create;
try
STO_SearchDirectory(slFileNames, 'C:\temp\', True);
finally
    slFileNames.Free;
end;
end;

Come ricerca del testo all'interno di un controllo Mem

procedure TForm1.FindDialog1Find(Sender: TObject); 
var Buffer, Pos, tPointer : PChar; 
    BuffLength            : Word; 
begin 
   With Sender as TFindDialog do 
   begin 
      GetMem(tPointer, Length(FindText) + 1); 
      StrPCopy(tPointer, FindText); 
      BuffLength:= Memo1.GetTextLen + 1; 
      GetMem(Buffer,BuffLength); 
      Memo1.GetTextBuf(Buffer,BuffLength); 
      Pos:= Buffer + Memo1.SelStart + Memo1.SelLength; 
      Pos:= StrPos(Pos, tPointer); 
      if Pos = NIL then MessageBeep(0) 
      else 
      begin 
        Memo1.SelStart:= Pos - Buffer; 
        Memo1.SelLength:= Length(FindText); 
      end; 
      FreeMem(tPointer, Length(FindText) + 1); 
      FreeMem(Buffer,BuffLength); 
      Memo1.SetFocus; 
end; 
end;

Come ottenere la percentuale d'utilizzo del processore

unit unit1;

interface 

uses 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
ComCtrls, CommCtrl, StdCtrls, Menus,WinSpool, ExtCtrls, Buttons, Registry; 

type
TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Timer1: TTimer;
    Button2: TButton;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
private
    { Private declarations }
    started : boolean;
    reg : TRegistry;
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
num: array[0..1024] of byte;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_DYN_DATA; Reg.OpenKey('PerfStats\StartStat',false); 
Reg.ReadBinaryData('KERNEL\CPUUsage', num, Sizeof(num));
Reg.CloseKey;
started := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
CPUU: integer;
begin
if started then
begin
    Reg.OpenKey('PerfStats\StatData', false);
    Reg.ReadBinaryData('KERNEL\CPUUsage', CPUU, SizeOf(Integer));
    Reg.CloseKey;
    Label1.Caption := IntToStr(CPUU) + '%';
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
num: array[0..1024] of byte;
begin
       Reg.OpenKey('PerfStats\StopStat', false);
       Reg.ReadBinaryData('KERNEL\CPUUsage', num, SizeOf(num));
       Reg.Free;
       Started := false;
end;

end.

Come mappare l'hard-disk

DWORD WNetAddConnection2( 
    LPNETRESOURCE lpNetResource,  
    LPCTSTR lpPassword,
    LPCTSTR lpUsername,
    DWORD dwFlags 
   ); 

Function MappaDischi(LocalUnit, UserN, PassW: String): boolean; 
var 
  NRW: NetResource;
  Res: DWORD; begin 
  Result := False; 

  NRW.dwType := RESOURCETYPE_DISK; 
  NRW.lpLocalName := PChar(LocalUnit + ':');
  NRW.lpRemoteName := PChar('\\indirizzoIP\D$'); 
  NRW.lpProvider := ''; 

  Res = WNetAddConnection2(NRW, PChar(PassW), PChar(UserN), 
CONNECT_UPDATE_PROFILE) 

  Result := (Res <> NO_ERROR) 
  If Not Result Then ShowMessage('Non Φ possibile eseguire la mappatura); 
end;  

Come disabilitare il logoff, task manager e shutdown

{

Usage:
 EnableCTRLALTDEL(False);
}

procedure EnableCTRLALTDEL(YesNo : boolean);
const
	sRegPolicies = 'SoftwareMicrosoftWindowsCurrentVersionPolicies';
begin
  with TRegistry.Create do
  try
    RootKey:=HKEY_CURRENT_USER;
    if OpenKey(sRegPolicies+'System',True) then
    begin
      case YesNo of
        False:
          begin
            WriteInteger('DisableTaskMgr',1);
          end;
        True:
          begin
            WriteInteger('DisableTaskMgr',0);
          end;
      end;
    end;
    CloseKey;
    if OpenKey(sRegPolicies+Explorer',True) then
    begin
      case YesNo of
        False:
          begin
            WriteInteger('NoChangeStartMenu',1);
            WriteInteger('NoClose',1);
            WriteInteger('NoLogOff',1);
          end;
        True:
          begin
            WriteInteger('NoChangeStartMenu',0);
            WriteInteger('NoClose',0);
            WriteInteger('NoLogOff',0);
          end;
      end;
    end;
    CloseKey;
  finally
    Free;
  end;
end;

Come ricavare la lista delle applicazioni installate nel sistema

procedure TForm1.Button1Click(Sender: TObject);
const
  REGKEYAPPS = 'SOFTWAREMicrosoftWindows
	               CurrentVersionUninstall';

var
  reg    : TRegistry;
  List1  : TStringList;
  List2  : TStringList;
  i, n   : integer;

begin
  reg    := TRegistry.Create;
  List1  := TStringList.Create;
  List2  := TStringList.Create;

  with reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(REGKEYAPPS, false);
    GetKeyNames(List1);
  end;
  for i := 0 to List1.Count -1 do
  begin
    reg.OpenKey(REGKEYAPPS + '' + List1.Strings[i],false);
    reg.GetValueNames(List2);

    n := List2.IndexOf('DisplayName');
    if (n <> -1) and 
       (List2.IndexOf('UninstallString') <> -1) then
    begin
      ListBox1.Items.Add(
          (reg.ReadString(List2.Strings[n])));
    end;
  end;
  List.Free;
  List2.Free;
  reg.CloseKey;
  reg.Destroy;
end;