24 Temmuz 2007 Salı

Get the MAC Address of Network Device

function MacAddress: string;
var
Lib: Cardinal;
Func: function(GUID: PGUID): Longint; stdcall;
GUID1, GUID2: TGUID;
begin
Result := '';

Lib := LoadLibrary('rpcrt4.dll');
if (Lib <> 0) then
begin
@Func := GetProcAddress(Lib, 'UuidCreateSequential');
if Assigned(Func) then
begin
if (Func(@GUID1) = 0) and
(Func(@GUID2) = 0) and
(GUID1.D4[2] = GUID2.D4[2]) and
(GUID1.D4[3] = GUID2.D4[3]) and
(GUID1.D4[4] = GUID2.D4[4]) and
(GUID1.D4[5] = GUID2.D4[5]) and
(GUID1.D4[6] = GUID2.D4[6]) and
(GUID1.D4[7] = GUID2.D4[7]) then
begin
Result := IntToHex(GUID1.D4[2], 2) + '-' +
IntToHex(GUID1.D4[3], 2) + '-' +
IntToHex(GUID1.D4[4], 2) + '-' +
IntToHex(GUID1.D4[5], 2) + '-' +
IntToHex(GUID1.D4[6], 2) + '-' +
IntToHex(GUID1.D4[7], 2);
end;
end;
end;
end;


How to get Information from AMI BIOS

(* -----------------------------------------------

This code will only work on recent ami bios
computers
The memory addresses that BIOS info is stored
at will change according to different BIOS
manufactures, different versions of BIOS and
different computers.
----------------------------------------------- *)

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
StaticText1: TStaticText;
StaticText2: TStaticText;
StaticText3: TStaticText;
StaticText4: TStaticText;
StaticText5: TStaticText;
Edit1: TEdit;
Label5: TLabel;
StaticText6: TStaticText;
StaticText7: TStaticText;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
{$R *.DFM}

// ------------------------------------------- //
function HexToInt (s: string): Integer;
const
Hex : array ['A'..'F'] of Integer = (10,11,12,13,14,15);
var
i : Integer;
begin
Result := 0;
s := UpperCase (s);

for i := 1 to Length (s) do
begin
if s [i] < 'A' then
Result := Result * 16 + Ord (s [i]) - 48
else
Result := Result * 16 + Hex [s [i]];
end;
end;
// ------------------------------------------- //
procedure TForm1.Button1Click(Sender: TObject);
var
Scan, Copyright, Info, Date : string;
Data : Integer;
const
BiosCopyright = $FE0CB; {Good address for AMI BIOS only}
BiosInfo = $FF478; {Good address for AMI BIOS only}
BiosDate = $FFFF5; {Good address for AMI BIOS only}
begin
Data :=(HexToInt(Edit1.Text)); {Convert to Integer}
Scan := (PChar(Ptr(Data))); {Get info for inputted memory address}
Copyright := string (PChar (Ptr (BiosCopyright)));{The same as a debug -d F000:E0CB}
Info := string (PChar (Ptr (BiosInfo)));{The same as a debug -d F000:F478}
Date := string (PChar (Ptr (BiosDate)));{The same as a debug -d F000:FFF5}

label1.caption := Scan;
label2.caption := Date;
label3.caption := Info;
label4.caption := Copyright;
label5.caption := (IntToStr(Data));{Display memory address in decimal}
end;
// ------------------------------------------- //
end.


Power management procedure (shutdown,log off, screensaver, etc)

// Power management procedure (shutdown,log off, screensaver, etc)

function PowerMng(Action : Integer; Force : Boolean) : boolean;
var
rl: Cardinal;
hToken: Cardinal;
tkp: TOKEN_PRIVILEGES;
begin
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
// Get access to windows privilege
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;;
tkp.PrivilegeCount := 1;
AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);

// Shutdown Windows
if (Action = 1) and (Force = False) then
begin
ExitWindowsEx(EWX_SHUTDOWN, 0);
end
else if (Action = 1) And (Force = True) then
begin
ExitWindowsEx(EWX_SHUTDOWN OR EWX_FORCE, 0);
end;

// Restart/Reboot Windows
if (Action = 2) and (Force = false) then
begin
ExitWindowsEx(EWX_REBOOT, 0)
end
else if (Action = 2) and (Force = true) then
begin
ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0);
end;

// Log Off Windows
if (Action = 3) and (Force=false) then
begin
ExitWindowsEx(EWX_LOGOFF, 0);
end
else if (Action = 3) and (Force = true) then
begin
ExitWindowsEx(EWX_LOGOFF or EWX_FORCE, 0);
end;

// Turn off monitor
if (Action = 4) And (Force = true) then
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2);
end
else if (Action = 4) and (Force = true) then // Turn ON monitor
begin
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
end;

// Activating screensaver
if (Action = 5) then
begin
DefWindowProc(Form1.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
end;
end;
end;


Show Systems Disk Space

// Ali Ebrahimi (ebr_ali@yahoo.com)
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
Free1,free2,Total1:Int64;

begin

GetDiskFreeSpaceEx(pchar(ComboBox1.Text) , free1 , total1 , @free2);
Label1.Caption := 'Capacity : ' + IntToStr(Total1) + ' Byte '+ floatToStr(Total1 div (1024*1024)) + ' MB';
Label2.Caption := 'Free space : ' + IntToStr(Free1) + ' Byte '+ floatToStr(Free1 div (1024*1024)) + ' MB';
Label3.Caption := 'Used space : ' + IntToStr(Total1-Free1) + ' Byte '+ floatToStr((Total1-Free1) div (1024*1024)) + ' MB';

end;

procedure TForm1.FormCreate(Sender: TObject);
var
i:Integer;
begin
for i:=Ord('A') to Ord('Z') do
begin
if GetDriveType(pchar(char(i)+':\'))=3 then
ComboBox1.Items.Add(char(i)+':\');
end;
ComboBox1.Text:=ComboBox1.Items.Strings[0];
end;

end.