indice


Funzione per convertire un valore da esadecimale a decimale
Come mostrare il contenuto di una directory e delle sue sotto directory.
Come ricercare un testo all'interno di un componente Memo.
Quanto stiamo spremendo il nostro processore?
Come mappare l'hard-disk.
Quante applicazioni abbiamo installato nel nostro sistema?
Salvare la clipboard in un file.
Data e ora di creazione e modifica di un file.
Fotografa lo schermo.



Funzione per convertire da esadecimale a decimale (HEX to DEC)
Funzione che permette di convertire un valore scritto in esadecimale in valore decimale
function HEX_to_DEC(Value: string): Int64;
var
Lungezza, i : Byte;
ValoreDEC: Int64;
Value2 : string;
begin
Result := 0;
for i := 1 to Length( Value ) do
Value2 := Value[ i ] + Value2; // Invertiamo il valore esadecimale
Value := Value2; // be....(a voi scoprire il perché!)
for Lungezza := Length(Value) - 1 downto 0 do
begin
ValoreDEC := Pos(Value[Lungezza +1],'0123456789ABCDEF')-1;
if (ValoreDEC < 0 ) or (ValoreDEC > 15) then
begin
ShowMessage('Valore inserito non valido');
Result := 0;
exit;
end;
Result := Result + ValoreDEC shl (4 * Lungezza);
end;
end;


Come mostrare il contenuto di una directory e delle sue sotto directory.
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 ricercare un testo all'interno di un componente Memo.
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;


Quanto stiamo spremendo il nostro processore?
Possiamo sapere con queste poche righe di codice a che percentuale il nostro processore sta lavorando!
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;  



Quante applicazioni abbiamo installato nel nostro sistema?
Utilizzando questo TIPS possiamo sapere quanti e quali programmi abbiamo installato sulla nostro computer.

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;


Salvare la clipboard in un file.
L’esempio seguente è valido solo per dati in formato testo, ma può essere modificato facilmente intervenendo su “CF_TEXT”, cambiando TEXT con il tipo di dato presente nella clipboard. Ad esempio nel caso di dati in formato testo basta effettuare una chiamata alla funzione SaveClipboardTextDataToFile() seguita dal nome del file: SaveClipboardTextDataToFile( 'c:\temp.txt' );.

 function SaveClipboardTextDataToFile( sFileTo : string ) : boolean;
var
  ps1,
  ps2   : PChar;
  dwLen : DWord;
  tf    : TextFile;
  hData : THandle;
begin
  Result := False;
  with Clipboard do
  begin
    try
      Open;
      if( HasFormat( CF_TEXT ) ) then
      begin
        hData :=
          GetClipboardData( CF_TEXT );

        ps1 := GlobalLock( hData );
        dwLen := GlobalSize( hData );

        ps2 := StrAlloc( 1 + dwLen );

        StrLCopy( ps2, ps1, dwLen );

        GlobalUnlock( hData );
        
        AssignFile( tf, sFileTo );
        ReWrite( tf );
        Write( tf, ps2 );
        CloseFile( tf );

        StrDispose( ps2 );

        Result := True;
      end;
    finally
      Close;
    end;
  end;
end;


Data e ora di creazione e modifica di un file.
La funzione FileAge() restituisce il date/time stamp (data e ora di creazione o di modifica) di un file. Il valore ottenuto mediante questa funzione è un intero, prima di essere utilizzato deve essere convertito in un valore TdateTime (float). Il codice seguente mostra come effettuare questa operazione..
procedure TForm1.Button1Click(Sender: TObject);
var
  File_Name: string;
  DateTimeStamp: integer;
  Date_Time: TDateTime;
begin
  File_Name := 'c:\Documenti\test.doc';
  DateTimeStamp := FileAge(File_Name);
  // FileAge returns -1 if file not found
  if DateTimeStamp < 0 then
    ShowMessage('File non trovato')
  else begin
    // Converte nel formato TDateTime
    Date_Time := FileDateToDateTime(DateTimeStamp);
    Label1.Caption := DateToStr(Date_Time);
    Label2.Caption := TimeToStr(Date_Time);
  end;
end;


Fotografa lo schermo.
Salviamo in una bitmap quello che vediamo sul video, praticamente uno screen shot.
procedure TForm1.Button1Click(Sender: TObject);
var
  DeskTopDC: HDc;
  DeskTopCanvas: TCanvas;
  DeskTopRect: TRect;
  Bitmap: TBitmap;
begin
  DeskTopDC := GetWindowDC(GetDeskTopWindow);
  DeskTopCanvas := TCanvas.Create;
  DeskTopCanvas.Handle := DeskTopDC;
  DeskTopRect := Rect(0,0,Screen.Width,Screen.Height);
  Bitmap := TBitmap.Create;
  with Bitmap do
  begin
    Width := Screen.Width;
    Height:= Screen.Height;
    PixelFormat := pfDevice;
  end;
  Bitmap.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect);
  Bitmap.SaveToFile ('c:\temp\sample.bmp');
  Bitmap.Free;
  DesktopCanvas.Free;
  ReleaseDC(GetDeskTopWindow,DeskTopDC);
end;



ritorna    indice

Vai alla pagina:  indice, programmi, database, componenti, link , relax .