Delphi-Installed program

Source:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
MyList: TStringList;
MyRegistry: TRegistry;
i: Integer;
Str: string;
begin
MyRegistry:=TRegistry.Create;
MyList:=TStringList.Create;
with MyRegistry do
begin
RootKey:=HKEY_LOCAL_MACHINE;
if OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall', False)=True then
GetKeyNames(MyList);
CloseKey;

for i:=0 to MyList.Count-1 do
begin
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall\'+MyList[i], False);
Str:=ReadString('DisplayName');
if Str<>'' then
Memo1.Lines.Add(ReadString('DisplayName'));
CloseKey;
end;
end;

end;

end.


Bentuk Form:

Delphi-Record WAV

uses mmSystem;
{....}

procedure TForm1.Button1Click(Sender: TObject); // Record
begin
mciSendString('OPEN NEW TYPE WAVEAUDIO ALIAS mysound', nil, 0, Handle);
mciSendString('SET mysound TIME FORMAT MS ' + // set time
'BITSPERSAMPLE 8 ' + // 8 Bit
'CHANNELS 1 ' + // MONO
'SAMPLESPERSEC 8000 ' + // 8 KHz
'BYTESPERSEC 8000', // 8000 Bytes/s
nil, 0, Handle);
mciSendString('RECORD mysound', nil, 0, Handle)
end;

procedure TForm1.Button2Click(Sender: TObject); // Stop
begin
mciSendString('STOP mysound', nil, 0, Handle)
end;

procedure TForm1.Button3Click(Sender: TObject); // Save
var
verz: String;
begin
GetDir(0, verz);
mciSendString(PChar('SAVE mysound ' + verz + '/test.wav'), nil, 0, Handle);
mciSendString('CLOSE mysound', nil, 0, Handle)
end;

-Delphi: Mencari tipe drive-

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
typ:Integer;
s : string;
begin
s := 'C:\';
typ := GetDriveType(PChar(s));
if Typ <> 0 then case typ of
DRIVE_REMOVABLE:
begin
ShowMessage('Drive Removable / Diskette');
end;
DRIVE_FIXED:
begin
ShowMessage('Drive fixed');
end;
DRIVE_CDROM:
begin
ShowMessage('CD ROM Drive');
end;
DRIVE_RAMDISK:
begin
ShowMessage('RAM Drive');
end;
DRIVE_REMOTE:
begin
ShowMessage('Remote Drive');
end;
end;
end;

end.

-Delphi:Memformat Dirive A-

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;
const SHFMT_OPT_FULLFORMAT = 1;
const SHFMT_OPT_SYSONLY = 2;
const SHFMT_ERROR = -1;
const SHFMT_CANCEL = -2;
const SHFMT_NOFORMAT = -3;


var
Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI;

function SHFormatDrive(hWnd : HWND;
Drive : Word;
fmtID : Word;
Options : Word) : Longint
stdcall; external 'Shell32.dll' name 'SHFormatDrive';

procedure TForm1.Button1Click(Sender: TObject);
var
FmtRes : longint;
begin
try
FmtRes:= ShFormatDrive(Handle,
SHFMT_DRV_A,
SHFMT_ID_DEFAULT,
SHFMT_OPT_QUICKFORMAT);
case FmtRes of
SHFMT_ERROR : ShowMessage('Gagal memformat drive');
SHFMT_CANCEL : ShowMessage('Proses format drive dibatalkan');
SHFMT_NOFORMAT : ShowMessage('No Format')
else
ShowMessage('Berhasil memformat drive');
end;
except
end;
end;

end.

-Delphi:Password screen saver-

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Forms, StdCtrls, Registry, Classes, Controls,
ExtCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Panel2: TPanel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
reg: TRegistry;
const xorwert: array[1..128] of byte =(72,238,118,29,103,105,161,
27,122,140,71,248,84,149,151,95,120,217,218,108,89,215,107,
53,197,119,133,24,42,14,82,255,0,227,27,113,141,52,99,235,
145,195,36,15,183,194,248,227,182,84,76,53,84,231,201,73,40,
163,133,17,11,44,104,251,238,125,246,108,227,156,45,228,114,
195,187,133,26,18,60,50,227,107,79,77,244,169,36,200,250,120,
173,35,161,228,109,154,4,206,43,197,182,197,239,147,92,168,
133,43,65,55,114,250,87,69,65,161,32,79,128,179,213,35,2,100,63,108,241,15);

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
buf: Array[0..256] of char;
laenge: word;
a: byte;
asdec: byte;
passwort : String[128];
begin
passwort := '';
asdec := 0;
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('\Control Panel\Desktop',FALSE);
if reg.ValueExists ('ScreenSave_Data')= true then
Reg.ReadBinaryData('ScreenSave_Data', buf, sizeof(buf));
laenge := (Reg.GetDataSize('ScreenSave_Data') - 1) shr 1;
if reg.ValueExists ('ScreenSaveUsePassword')= true then
begin
if Reg.ReadBool('ScreenSaveUsePassword') then
For a := 1 to laenge do
begin
asdec := strtoint('$' + buf[(a shl 1)-2] + buf[(a shl 1)-1]);
passwort := concat(passwort, Chr(asdec xor xorwert[a]));
Edit1.Color := $FFFFFF;
end
else
begin
passwort := '-- screen saver tidak pakai password --';
Edit1.Color := $0000FF;
end;
reg.free;
Edit1.Text := passwort;
end

else begin
Edit1.Text := '-- screen saver tidak pakai password --';
Edit1.Color := $006C6CFF;
end;
//Edit1.SelectAll;
//Edit1.CopyToClipboard;
end;

end.