Come mostrare il contenuto di una directory e delle sue sottodirectory

La procedura mostra tutti i file e le directory (incluse le sottodirectory) contenute nella directory inserita come parametro della funzione. I risultati sono archiviati una lista di stringhe denominata List:

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

Implementare una procedura per ricercare del testo all’interno di un controllo Memo (controllo all’interno del quale è possibile inserire più righe di testo), non è complicato come potrebbe apparire.
L’esempio proposto prevede che sul form sia presente un controllo Memo (Memo1) e un componente FindDialog (denominato FindDialog1).

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

Quanto sarà “indaffarato” il processore del nostro personal computer? Di seguito un utile tip che mostra, in percentuale, l’utilizzo del processore. 
Il progetto prevedere che in un form siano presenti due oggetti TButton, due TLabel e un TTimer.

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 

In talune applicazioni può capitare di dover creare una unità disco logica che faccia riferimento al percorso di rete di un disco su un server remoto. Il tip proposto si occupa proprio di  "mappare" un disco in modo del tutto automatico
 
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

Questo tip funziona solo su sistemi Windows 2000/NT/XP e consente di disattivare le funzioni di chiusura del sistema, logoff dell’utente e CTRL+ALT+CANC (funzione per far apparire il task manager). Il tutto è realizzato sfruttando funzioni del registro di sistema.
 
{

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

Quante e quali sono le applicazioni installate nel nostro sistema Windows? Semplice basta, da pannello di controllo, richiamare l’applicazioni di installazione applicazioni! E se volessimo realizzare la medesima funzionalità in una nostra applicazione? Semplice basta utilizzare questo semplicissimo tip.

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;