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) |
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. |
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. |
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? |
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; |
Quante applicazioni abbiamo installato nel nostro 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; |
Salvare la clipboard in un file. |
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. |
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. |
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; |
Vai alla pagina: indice, programmi, database, componenti, link , relax . |