Perjalanan Pertama Syauqi ke Subang

Read More

I with IM3 goes to Campus

Ringkasan ini tidak tersedia. Harap klik di sini untuk melihat postingan.

Read More

Tentang Nurulloh Laboratory

Nurulloh Laboratory adalah kegiatan Software Engineering yang dilakukan untuk menjawab berbagai kebutuhan masyarakat akan dukungan Teknologi Informasi pada wilayah kerjanya. Kegiatannya terbagi menjadi dua bagian, yakni: Pertama, Penelitian yang menghasilkan produk perangkat lunak prototipe, dipublikasi sebagai perangkat freeware. Kedua, Komersial yang menghasilkan produk penuh dan dijual.

Read More

Tampilan Produk

Programable SMS Center

Sistem Informasi untuk Laboratorium Medik

Kriptografi

Pinger

Autosurfer

Ujian Online

Exporter Basis data dan Validator Ketergantungan Fungsional

Pembangkit Basis Data SI Offline untuk SI Online

Sistem Informasi Pembayaran Uang Mahasiswa

Sistem Informasi Manajemen Perpustakaan

Read More

Perangkat Lunak dalam Promosi atau Tunggu

Tahun 2007

1. Sistem Informasi Medik, untuk Laboratorium Medik.
2. Run and Backup for Sistem Informasi berbasis MS Access, digunakan untuk membackup Sistem Informasi Akademik Sekolah Tinggi Teknologi Garut.

Tahun 2008

1. Portal Kampus digunakan oleh Sekolah Tinggi Teknologi Garut
2. Kolektor Calon Pemilih, digunakan oleh Abdul Halim Datacenter
3. SMS Center, digunakan oleh Abdul Halim Datacenter

Read More

Daftar Perangkat Lunak Penelitian

Tahun 2002 - Sistem Penilaian Kesehatan Baitul Ma'al Wat Tamwil PINBUK Jawa Barat, dalam tugas Kerja Praktek.

Tahun 2003 - Turbo Alkhowarizmi, Analisator Bahasa Pemrograman Indonesia Pascal Like, dalam Tugas Akhir.

Tahun 2006 - Licence Creator, untuk serial number resmi produk Nurulloh Laboratory

Tahun 2007

1. Qur'an Reader, Multi Bahasa dan Suara.
2. Autosurfing, Browser Autopilot.
3. Pinger grafis, digunakan untuk mengecek konektifitas jaringan wifi kota (InterYamusa Network) Sekolah Tinggi Teknologi Garut.
4. Exam Online, dibuat untuk mendukung lomba cerdas cermat online Himpunan Mahasiswa Teknik Informatika Sekolah Tinggi Teknologi Garut.
5. SMS Gateway dan SMS Center
6. AutoExporter Database.

Tahun 2008

1. Remote Dekstop Addition for Internet Environtment, dibuat untuk mendukung pelatihan Nasional Departemen Agama di Ponpes al-Musaddadiyah Garut, namun tidak sempat digunakan.
2. Sistem Informasi Keuangan Online, studi kasus Sekolah Tinggi Teknologi Garut
3. Sistem Informasi Perpustakaan Onlinem studi kasus Sekolah Tinggi Teknologi Garut
4. Kriptografi 32bit (text to image).
5. Digital Information Board (e-Board) / Anjungan Kampus Online, studi kasus Sekolah Tinggi Teknologi Garut.
6. Programable SMS Center, sistem informasi berbasis pesan singkat yang format request dan answer content-nya dapat diprogram dengan menggunakan script.

Read More

Daftar Perangkat Lunak Terjual

Tahun 2004 - Sistem Pembayaran (SIYAR), untuk Sekolah Tinggi Teknologi Garut.

Tahun 2005 - Sistem Absensi Dosen, untuk Sekolah Tinggi Teknologi Garut.

Tahun 2006 - Radio Broadcaster Auto Pilot, untuk PT Radio Yamusa Pratama (Yamusa FM).

Tahun 2007 - Sistem Informasi Hotel (Reservasi), untuk Kampung Sampireun.

Tahun 2008 - Sistem Informasi Perpustakaan, untuk Sekolah Tinggi Teknologi Garut.

Read More

My Family

Berfoto di kamarku (Pesantren Teknik al-Musaddadiyah) bersama orang tuaku selepas Wisuda Sarjana tahun 2003

Read More

Syuqi Ahmad Nurulloh

Syauqi 2 tahun

Syauqi, 1 tahun

Syauqi usia 6 bulan

Syauqi usia 4 bulan

Usia 1 Hari

Read More

Tungganganku

NMax 2018

Fino Premium 2016

Jimny 1988

Jupiter MX 2012

Tahun 2007, Yamaha Speed Extreme Raider

Yamaha Jupiter MX, 135 CC - Z 4748 DY

Tahun 2004, Blackstone

Honda Kharisma 125 CC - T 5532 DY

Read More

Mengubah wallpaper dan mematikan screensaver dengan memanipulasi registry

uses registry;
procedure TForm1.FormCreate(Sender: TObject) ;
var
reg:TRegistry;
begin
reg:=TRegistry.Create;
with reg do begin
try
if OpenKey('\Control Panel\desktop', False) then begin
//change wallpaper and tile it
reg.WriteString ('Wallpaper','c:\windows\CIRCLES.bmp') ;
reg.WriteString ('TileWallpaper','1') ;
//disable screen saver//('0'=disable, '1'=enable)
reg.WriteString('ScreenSaveActive','0') ;
//update changes immediately
SystemParametersInfo (SPI_SETDESKWALLPAPER,0, nil,SPIF_SENDWININICHANGE) ;
SystemParametersInfo (SPI_SETSCREENSAVEACTIVE,0, nil,SPIF_SENDWININICHANGE) ;
end
finally
reg.Free;
end;
end;
end;

Read More

Menampilkan Informasi BIOS

function GetBiosInfoAsText: string;
var
p, q: pchar;
begin
q := nil;
p := PChar(Ptr($FE000));
repeat
if q <> nil then begin
if not (p^ in [#10, #13, #32..#126, #169, #184]) then begin
if (p^ = #0) and (p - q >= 8) then begin
Result := Result + TrimRight(String(q)) + #13#10;
end;
q := nil;
end;
end else
if p^ in [#33..#126, #169, #184] then
q := p;
inc(p);
until p > PChar(Ptr($FFFFF));
Result := TrimRight(Result);
end;

Read More

Checksum BIOS

function GetBiosCheckSum: string;
var
s: int64;
i: longword;
p: PChar;
begin
i := 0;
s := 0;
p := PChar($F0000);
repeat
inc(s, Int64(Ord(p^)) shl i);
if i < 64 then inc(i) else i := 0;
inc(p);
until p > PChar($FFFFF);
Result := IntToHex(s,16);
end;

Read More

Nomor Serial BIOS

uses SHA1, Base64;

function GetHashedBiosInfo: string;
var
SHA1Context: TSHA1Context;
SHA1Digest: TSHA1Digest;
begin
// Get the BIOS data
SetString(Result, PChar(Ptr($F0000)), $10000);
// Hash the string
SHA1Init(SHA1Context);
SHA1Update(SHA1Context, PChar(Result), Length(Result));
SHA1Final(SHA1Context, SHA1Digest);
SetString(Result, PChar(@SHA1Digest), sizeof(SHA1Digest));
// Return the hash string encoded in printable characters
Result := B64Encode(Result);
end;

Read More

Nomor Serial BIOS

uses SHA1, Base64;

function GetHashedBiosInfo: string;
var
SHA1Context: TSHA1Context;
SHA1Digest: TSHA1Digest;
begin
// Get the BIOS data
SetString(Result, PChar(Ptr($F0000)), $10000);
// Hash the string
SHA1Init(SHA1Context);
SHA1Update(SHA1Context, PChar(Result), Length(Result));
SHA1Final(SHA1Context, SHA1Digest);
SetString(Result, PChar(@SHA1Digest), sizeof(SHA1Digest));
// Return the hash string encoded in printable characters
Result := B64Encode(Result);
end;

Read More

Mematikan Mouse dan Keyboard selama 5 detik

procedure TForm1.Button1Click(Sender: TObject) ;

function FuncAvail
(_dllname, _funcname: string; var _p: pointer):
boolean;
var _lib: tHandle;
begin
Result := false;
_p := NIL;
if LoadLibrary(PChar(_dllname)) = 0 then exit;
_lib := GetModuleHandle(PChar(_dllname)) ;
if _lib <> 0 then
begin
_p := GetProcAddress(_lib, PChar(_funcname)) ;
if _p <> NIL then Result := true;
end;
end;


var
xBlockInput : function(Block: BOOL):
BOOL; stdcall;

begin
if FuncAvail
('USER32.DLL', 'BlockInput', @xBlockInput) then
begin
xBlockInput(true) ;
Sleep(5000) ;
xBlockInput(false) ;
end;
end;

Read More

Mengambil nama komputer dan penggunanya

function GetComputerNetName: string;
var
buffer: array[0..255] of char;
size: dword;
begin
size := 256;
if GetComputerName(buffer, size) then
Result := buffer
else
Result := ''
end;

Function GetUserFromWindows: string;
Var
UserName : string;
UserNameLen : Dword;
Begin
UserNameLen := 255;
SetLength(userName, UserNameLen) ;
If GetUserName(PChar(UserName), UserNameLen) Then
Result := Copy(UserName,1,UserNameLen - 1)
Else
Result := 'Unknown';
End;

Read More

Menampilkan proses yang sedang berjalan di Windows

function EnumProcess(hHwnd: HWND; lParam : integer): boolean; stdcall;
var
pPid : DWORD;
title, ClassName : string;
begin
//if the returned value in null the
//callback has failed, so set to false and exit.
if (hHwnd=NULL) then
begin
result := false;
end
else
begin
//additional functions to get more
//information about a process.
//get the Process Identification number.
GetWindowThreadProcessId(hHwnd,pPid);
//set a memory area to receive
//the process class name
SetLength(ClassName, 255);
//get the class name and reset the
//memory area to the size of the name
SetLength(ClassName,
GetClassName(hHwnd,
PChar(className),
Length(className)));
SetLength(title, 255);
//get the process title; usually displayed
//on the top bar in visible process
SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
//Display the process information
//by adding it to a list box
ProcessForm.ProcessListBox.Items.Add
('Class Name = ' + className +
'; Title = ' + title +
'; HWND = ' IntToStr(hHwnd) +
'; Pid = ' + IntToStr(pPid));
Result := true;
end;
end;

procedure TProcessForm.GetProcessButtonClick(Sender: TObject);
begin
//Clear any previous calls
if ProcessListBox.Count > 0 then
ProcessListBox.Clear;
//define the tag flag
lp := 0; //globally declared integer
//call the windows function with the address
//of handling function and show an error message if it fails
if EnumWindows(@EnumProcess,lp) = false then
ShowMessage('Error: Could not obtain
process window hook from system.');
end;

Read More

Mematikan ALT+TAB, CTRL+ESC, CTRL+ALT+DEL

procedure SystemKeys(Disable: Boolean) ;
var OldVal : LongInt;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING,
Word(Disable), @OldVal, 0) ;
end;

Read More

Mematikan Ctrl+Alt+Del Kedua

procedure DisableTaskMgr(bTF: Boolean);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_CURRENT_USER;

reg.OpenKey('Software', True);
reg.OpenKey('Microsoft', True);
reg.OpenKey('Windows', True);
reg.OpenKey('CurrentVersion', True);
reg.OpenKey('Policies', True);
reg.OpenKey('System', True);

if bTF = True then
begin
reg.WriteString('DisableTaskMgr', '1');
end
else if bTF = False then
begin
reg.DeleteValue('DisableTaskMgr');
end;
reg.CloseKey;
end;

// Example Call:
procedure TForm1.Button1Click(Sender: TObject);
begin
DisableTaskMgr(True);
end;

Read More

Mematikan Ctrl+Alt+Del Pertama

uses
Registry;

procedure EnableCTRLALTDEL(YesNo : boolean);
const
sRegPolicies = '\Software\Microsoft\Windows\CurrentVersion\Policies';
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;

procedure TForm1.Button1Click(Sender: TObject);
begin
EnableCTRLALTDEL(true);
end;

Read More

Melihat Nomor Serial Harddisk

function GetHardDiskSerial(const DriveLetter: Char): string;
var
NotUsed: DWORD;
VolumeFlags: DWORD;
VolumeInfo: array[0..MAX_PATH] of Char;
VolumeSerialNumber: DWORD;
begin
GetVolumeInformation(PChar(DriveLetter + ':\'),
nil, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed,
VolumeFlags, nil, 0);
Result := Format('Label = %s VolSer = %8.8X',
[VolumeInfo, VolumeSerialNumber])
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetHardDiskSerial('c'));
end;

Read More

Melihat informasi CPU

unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
Tfrm_main = class(TForm)
img_info: TImage;

procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }

procedure info(s1, s2: string);
end;
var
frm_main: Tfrm_main;
gn_speed_y: Integer;
gn_text_y: Integer;
const
gn_speed_x: Integer = 8;
gn_text_x: Integer = 15;
gl_start: Boolean = True;
implementation
{$R *.DFM}

procedure Tfrm_main.FormShow(Sender: TObject);
var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
b1: Word;
s, s1, s2, s3, s_all: string;
begin
//Set the startup colour of the image
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));
gn_text_y := 5; //position of the 1st text
asm //asm call to the CPUID inst.
mov eax,0 //sub. func call
db $0F,$A2 //db $0F,$A2 = CPUID instruction
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
for i := 0 to 3 do //extract vendor id
begin
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1:= s1 + chr(b);
b := lo(_edx);
s2:= s2 + chr(b);
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('CPU', '');
info(' - ' + 'Vendor ID: ', s + s2 + s1);
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
//06B1
//|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
b := lo(_eax) and 15;
info(' - ' + 'Stepping ID: ', IntToStr(b));
b := lo(_eax) shr 4;
info(' - ' + 'Model Number: ', IntToHex(b, 1));
b := hi(_eax) and 15;
info(' - ' + 'Family Code: ', IntToStr(b));
b := hi(_eax) shr 4;
info(' - ' + 'Processor Type: ', IntToStr(b));
//31. 28. 27. 24. 23. 20. 19. 16.
// 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
b := lo((_eax shr 16)) and 15;
info(' - ' + 'Extended Model: ', IntToStr(b));
b := lo((_eax shr 20));
info(' - ' + 'Extended Family: ', IntToStr(b));
b := lo(_ebx);
info(' - ' + 'Brand ID: ', IntToStr(b));
b := hi(_ebx);
info(' - ' + 'Chunks: ', IntToStr(b));
b := lo(_ebx shr 16);
info(' - ' + 'Count: ', IntToStr(b));
b := hi(_ebx shr 16);
info(' - ' + 'APIC ID: ', IntToStr(b));
//Bit 18 =? 1 //is serial number enabled?
if (_edx and $40000) = $40000 then
info(' - ' + 'Serial Number ', 'Enabled')
else
info(' - ' + 'Serial Number ', 'Disabled');
s := IntToHex(_eax, 8);
asm //determine the serial number
mov eax,3
db $0F,$A2
mov _ecx,ecx
mov _edx,edx
end;
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
info(' - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);
asm
mov eax,1
db $0F,$A2
mov _edx,edx
end;
info('', '');
//Bit 23 =? 1
if (_edx and $800000) = $800000 then
info('MMX ', 'Supported')
else
info('MMX ', 'Not Supported');
//Bit 24 =? 1
if (_edx and $01000000) = $01000000 then
info('FXSAVE & FXRSTOR Instructions ', 'Supported')
else
info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');
//Bit 25 =? 1
if (_edx and $02000000) = $02000000 then
info('SSE ', 'Supported')
else
info('SSE ', 'Not Supported');
//Bit 26 =? 1
if (_edx and $04000000) = $04000000 then
info('SSE2 ', 'Supported')
else
info('SSE2 ', 'Not Supported');
info('', '');
asm //execute the extended CPUID inst.
mov eax,$80000000 //sub. func call
db $0F,$A2
mov _eax,eax
end;
if _eax > $80000000 then //any other sub. funct avail. ?
begin
info('Extended CPUID: ', 'Supported');
info(' - Largest Function Supported: ', IntToStr(_eax - $80000000));
asm //get brand ID
mov eax,$80000002
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3:= s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s3 + s + s1 + s2;
asm
mov eax,$80000003
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s_all + s3 + s + s1 + s2;
asm
mov eax,$80000004
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('Brand String: ', '');
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
info('', ' - ' + s_all + s3 + s + s1 + s2);
end
else
info(' - Extended CPUID ', 'Not Supported.');
end;

procedure Tfrm_main.info(s1, s2: string);
begin
if s1 <> '' then
begin
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.Font.Color := clyellow;
img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);
end;
if s2 <> '' then
begin
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.Font.Color := clWhite;
img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
end;
Inc(gn_text_y, 13);
end;
end.

Read More

Menutup Notepad

procedure TForm1.Button1Click(Sender: TObject);
var Hnd: THandle;
begin
Hnd := FindWindow (PChar ('Notepad'), nil);
if Hnd > 0 then
SendMessage (Hnd, WM_CLOSE, 0, 0);
end;

Read More

Mematikan screen saver sementara

procedure TForm1.AppMessage (var Msg: TMsg; var Handled: boolean);
begin
if (Msg.Message = WM_SYSCOMMAND) and (Msg.wParam = SC_SCREENSAVE) then
Handled := true;
end;

dituliskan pada modul event OnCreate Form:

Application.OnMessage := AppMessage;

Read More

Membuat scrollbar horisontal untuk komponen Listbox

procedure HorScrollBar (ListBox: TListBox; MaxWidth: integer);
var i, w: integer;
begin
if MaxWidth >= 0 then
SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT, MaxWidth, 0)
else begin
{ get largest item }
for i := 0 to ListBox.Items.Count - 1 do with ListBox do begin
w := Canvas.TextWidth (Items [i]);
if w > MaxWidth then
MaxWidth := w;
end;
SendMessage(ListBox.Handle, LB_SETHORIZONTALEXTENT,
MaxWidth + GetSystemMetrics (SM_CXFRAME), 0);
end;
end;

Read More

Dialog untuk memilih direktori

uses FileCtrl;

var
Dir: string;
(...)
Dir := 'C:\Windows';
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
Label1.Caption := Dir;

Read More

Membuat Direktori Baru

var
Dir: string;
(...)
Dir := 'C:\APPS\SALES\LOCAL';
ForceDirectories(Dir);
if DirectoryExists(Dir) then
Label1.Caption := Dir + ' successfully created.'

Read More

Get the long file name from a shortened (8 + 3) file name

function LongFileName (ShortName: string): string;
var SR: TSearchRec;
begin
Result := '';
if (pos ('\\', ShortName) + pos ('*', ShortName) +
pos ('?', ShortName) <> 0) or not FileExists (ShortName)
then
{ ignore NetBIOS name, joker chars and invalid file names }
Exit;
while FindFirst (ShortName, faAnyFile, SR) = 0 do begin
{ next part as prefix }
Result := '\' + SR.Name + Result;
SysUtils.FindClose (SR); { the SysUtils, not the WinProcs procedure! }
{ directory up (cut before '\') }
ShortName := ExtractFileDir (ShortName);
if length (ShortName) <= 2 then
Break; { ShortName contains drive letter followed by ':' }
end;
Result := ExtractFileDrive (ShortName) + Result;
end;

Read More

Get the short file name (8 + 3) from a Win32 long file name

function ShortFileName (const FileName: string): string;
var aTmp: array[0..255] of char;
begin
if not FileExists (FileName) then
Result := ''
else if GetShortPathName (PChar (FileName), aTmp, Sizeof (aTmp) - 1) = 0
then
Result:= FileName
else
Result:= StrPas (aTmp);
end;

Read More

Melihat Kode Sumber Web (HTML) Dengan Komponen TWEBBrowser

uses ActiveX;

procedure WBViewSourceDialog(AWebBrowser: TWebbrowser) ;
const
CGID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}';
HTMLID_VIEWSOURCE = 2;

var
CmdTarget : IOleCommandTarget;
vaIn, vaOut: OleVariant;
PtrGUID: PGUID;
begin
New(PtrGUID) ;
PtrGUID^ := CGID_WebBrowser;
if AWebBrowser.Document <> nil then
try
AWebBrowser.Document.QueryInterface(IOleCommandTarget, CmdTarget) ;
if CmdTarget <> nil then
try
CmdTarget.Exec(PtrGUID, HTMLID_VIEWSOURCE, 0, vaIn, vaOut) ;
finally
CmdTarget._Release;
end;
except
end;
Dispose(PtrGUID) ;
end;

procedure TForm1.FormCreate(Sender: TObject) ;
begin
WebBrowser1.Navigate('http://www.delphi.about.com') ;
end;

procedure TForm1.Button1Click(Sender: TObject) ;
begin
WBViewSourceDialog(WebBrowser1) ;
end;

Read More

Menutup Internet Explorer

function CloseIEs(Wnd : HWnd; Form : TForm1) : Boolean; export; stdcall;
var
sCap : array [0..255] of char;
begin
GetWindowText (Wnd, sCap, sizeof(sCap));
if pos ('Microsoft Internet Explorer', sCap) > 0 then
begin
PostMessage (Wnd, WM_CLOSE, 0, 0);
end
else
begin
// check by class name!
GetClassName (Wnd, sCap, sizeof(sCap));
if sCap = 'IEFrame' then
PostMessage (Wnd, WM_CLOSE, 0, 0);
end;

CloseIEs := true; { next window, please }
end;

begin
// close all hidden instances
EnumWindows(@CloseIEs, 0);
end.

Read More

Mematikan Monitor

{ turn off your monitor }
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
{ turn on your monitor }
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, - 1);

Read More

Mematikan Komputer

SetSystemPowerState(False, True); //Forces the system down
SetSystemPowerState(True, False); //Makes a "soft" off

Read More

Simulasi Penekanan Tombol Keyboard

{1. PostKeyEx32 function}

procedure PostKeyEx32(key: Word; const shift: TShiftState; specialkey: Boolean);
{************************************************************
* Procedure PostKeyEx32
*
* Parameters:
* key : virtual keycode of the key to send. For printable
* keys this is simply the ANSI code (Ord(character)).
* shift : state of the modifier keys. This is a set, so you
* can set several of these keys (shift, control, alt,
* mouse buttons) in tandem. The TShiftState type is
* declared in the Classes Unit.
* specialkey: normally this should be False. Set it to True to
* specify a key on the numeric keypad, for example.
* Description:
* Uses keybd_event to manufacture a series of key events matching
* the passed parameters. The events go to the control with focus.
* Note that for characters key is always the upper-case version of
* the character. Sending without any modifier keys will result in
* a lower-case character, sending it with [ssShift] will result
* in an upper-case character!
************************************************************}
type
TShiftKeyInfo = record
shift: Byte;
vkey: Byte;
end;
byteset = set of 0..7;
const
shiftkeys: array [1..3] of TShiftKeyInfo =
((shift: Ord(ssCtrl); vkey: VK_CONTROL),
(shift: Ord(ssShift); vkey: VK_SHIFT),
(shift: Ord(ssAlt); vkey: VK_MENU));
var
flag: DWORD;
bShift: ByteSet absolute shift;
i: Integer;
begin
for i := 1 to 3 do
begin
if shiftkeys[i].shift in bShift then
keybd_event(shiftkeys[i].vkey, MapVirtualKey(shiftkeys[i].vkey, 0), 0, 0);
end; { For }
if specialkey then
flag := KEYEVENTF_EXTENDEDKEY
else
flag := 0;
keybd_event(key, MapvirtualKey(key, 0), flag, 0);
flag := flag or KEYEVENTF_KEYUP;
keybd_event(key, MapvirtualKey(key, 0), flag, 0);
for i := 3 downto 1 do
begin
if shiftkeys[i].shift in bShift then
keybd_event(shiftkeys[i].vkey, MapVirtualKey(shiftkeys[i].vkey, 0),
KEYEVENTF_KEYUP, 0);
end; { For }
end; { PostKeyEx32 }

procedure TForm1.Button1Click(Sender: TObject);
begin
PostKeyEx32(VK_LWIN, [], False);
PostKeyEx32(Ord('D'), [], False);
PostKeyEx32(Ord('C'), [ssctrl, ssAlt], False);
end;
{************************************************************}
{2. With keybd_event API}

procedure TForm1.Button1Click(Sender: TObject);
begin
{or you can also try this simple example to send any
amount of keystrokes at the same time. }
{Pressing the A Key and showing it in the Edit1.Text}
Edit1.SetFocus;
keybd_event(VK_SHIFT, 0, 0, 0);
keybd_event(Ord('A'), 0, 0, 0);
keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0);
{Presses the Left Window Key and starts the Run}
keybd_event(VK_LWIN, 0, 0, 0);
keybd_event(Ord('R'), 0, 0, 0);
keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;
{***********************************************************}
{3. With keybd_event API}

procedure PostKeyExHWND(hWindow: HWnd; key: Word; const shift: TShiftState;
specialkey: Boolean);
{************************************************************
* Procedure PostKeyEx
*
* Parameters:
* hWindow: target window to be send the keystroke
* key : virtual keycode of the key to send. For printable
* keys this is simply the ANSI code (Ord(character)).
* shift : state of the modifier keys. This is a set, so you
* can set several of these keys (shift, control, alt,
* mouse buttons) in tandem. The TShiftState type is
* declared in the Classes Unit.
* specialkey: normally this should be False. Set it to True to
* specify a key on the numeric keypad, for example.
* If this parameter is true, bit 24 of the lparam for
* the posted WM_KEY* messages will be set.
* Description:
* This
procedure sets up Windows key state array to correctly
* reflect the requested pattern of modifier keys and then posts
* a WM_KEYDOWN/WM_KEYUP message pair to the target window. Then
* Application.ProcessMessages is called to process the messages
* before the keyboard state is restored.
* Error Conditions:
* May fail due to lack of memory for the two key state buffers.
* Will raise an exception in this case.
* NOTE:
* Setting the keyboard state will not work across applications
* running in different memory spaces on Win32 unless AttachThreadInput
* is used to connect to the target thread first.
*Created: 02/21/96 16:39:00 by P. Below
************************************************************}
type
TBuffers = array [0..1] of TKeyboardState;
var
pKeyBuffers: ^TBuffers;
lParam: LongInt;
begin
(* check if the target window exists *)
if IsWindow(hWindow) then
begin
(* set local variables to default values *)
pKeyBuffers := nil;
lParam := MakeLong(0, MapVirtualKey(key, 0));
(* modify lparam if special key requested *)
if specialkey then
lParam := lParam or $1000000;
(* allocate space for the key state buffers *)
New(pKeyBuffers);
try
(* Fill buffer 1 with current state so we can later restore it.
Null out buffer 0 to get a "no key pressed" state. *)
GetKeyboardState(pKeyBuffers^[1]);
FillChar(pKeyBuffers^[0], SizeOf(TKeyboardState), 0);
(* set the requested modifier keys to "down" state in the buffer*)
if ssShift in shift then
pKeyBuffers^[0][VK_SHIFT] := $80;
if ssAlt in shift then
begin
(* Alt needs special treatment since a bit in lparam needs also be set *)
pKeyBuffers^[0][VK_MENU] := $80;
lParam := lParam or $20000000;
end;
if ssCtrl in shift then
pKeyBuffers^[0][VK_CONTROL] := $80;
if ssLeft in shift then
pKeyBuffers^[0][VK_LBUTTON] := $80;
if ssRight in shift then
pKeyBuffers^[0][VK_RBUTTON] := $80;
if ssMiddle in shift then
pKeyBuffers^[0][VK_MBUTTON] := $80;
(* make out new key state array the active key state map *)
SetKeyboardState(pKeyBuffers^[0]);
(* post the key messages *)
if ssAlt in Shift then
begin
PostMessage(hWindow, WM_SYSKEYDOWN, key, lParam);
PostMessage(hWindow, WM_SYSKEYUP, key, lParam or $C0000000);
end
else
begin
PostMessage(hWindow, WM_KEYDOWN, key, lParam);
PostMessage(hWindow, WM_KEYUP, key, lParam or $C0000000);
end;
(* process the messages *)
Application.ProcessMessages;
(* restore the old key state map *)
SetKeyboardState(pKeyBuffers^[1]);
finally
(* free the memory for the key state buffers *)
if pKeyBuffers <> nil then
Dispose(pKeyBuffers);
end; { If }
end;
end; { PostKeyEx }

procedure TForm1.Button1Click(Sender: TObject);
var
targetWnd: HWND;
begin
targetWnd := FindWindow('notepad', nil)
if targetWnd <> 0 then
begin
PostKeyExHWND(targetWnd, Ord('I'), [ssAlt], False);
end;
end;
{***********************************************************}
{3. With SendInput API}

procedure TForm1.Button1Click(Sender: TObject);
const
Str: string = 'writing writing writing';
var
Inp: TInput;
I: Integer;
begin
Edit1.SetFocus;
for I := 1 to Length(Str) do
begin
Inp.Itype := INPUT_KEYBOARD;
Inp.ki.wVk := Ord(UpCase(Str[i]));
Inp.ki.dwFlags := 0;
SendInput(1, Inp, SizeOf(Inp));
Inp.Itype := INPUT_KEYBOARD;
Inp.ki.wVk := Ord(UpCase(Str[i]));
Inp.ki.dwFlags := KEYEVENTF_KEYUP;
SendInput(1, Inp, SizeOf(Inp));
Application.ProcessMessages;
Sleep(80);
end;
end;

procedure SendAltTab;
var
KeyInputs: array of TInput;
KeyInputCount: Integer;

procedure KeybdInput(VKey: Byte; Flags: DWORD);
begin
Inc(KeyInputCount);
SetLength(KeyInputs, KeyInputCount);
KeyInputs[KeyInputCount - 1].Itype := INPUT_KEYBOARD;
with KeyInputs[KeyInputCount - 1].ki do
begin
wVk := VKey;
wScan := MapVirtualKey(wVk, 0);
dwFlags := KEYEVENTF_EXTENDEDKEY;
dwFlags := Flags or dwFlags;
time := 0;
dwExtraInfo := 0;
end;
end;
begin
KeybdInput(VK_MENU, 0); // Alt
KeybdInput(VK_TAB, 0); // Tab
KeybdInput(VK_TAB, KEYEVENTF_KEYUP); // Tab
KeybdInput(VK_MENU, KEYEVENTF_KEYUP); // Alt
SendInput(KeyInputCount, KeyInputs[0], SizeOf(KeyInputs[0]));
end;

Read More

Memulai Kembali Program

procedure TForm1.Button1Click(Sender: TObject);
var
FullProgPath: PChar;
begin
FullProgPath := PChar(Application.ExeName);
WinExec(FullProgPath, SW_SHOW);
Application.Terminate;
end;

Read More

Mencegah Alt+F4

public

procedure AppMessage(var Msg: TMSG; var HAndled: Boolean);
end;
{...}
implementation
{...}

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
end;

procedure TForm1.AppMessage(var Msg: TMSG; var Handled: Boolean);
begin
Handled := False;
case Msg.Message of
WM_SYSKEYDOWN:
if Msg.wParam = VK_F4 then
Handled := True; // don't allow ALT-F4
end;
end;

Read More

Copy atau Paste Teks Dari TMemo

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.SelectAll;
Memo1.CopyToClipboard;
Memo1.Clear;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.PasteFromClipboard;
end;

Read More

Mengecilkan semua Jendela

procedure TForm1.Button1Click(Sender: TObject);
var
h: HWnd;
begin
h := Handle;
while h > 0 do
begin
if IsWindowVisible(h) then
PostMessage(h, WM_SYSCOMMAND, SC_MINIMIZE, 0);
h := GetNextWindow(h, GW_HWNDNEXT);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Keybd_event(VK_LWIN, 0, 0, 0);
Keybd_event(Byte('M'), 0, 0, 0);
Keybd_event(Byte('M'), 0, KEYEVENTF_KEYUP, 0);
Keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;

Read More

Menyembunyikan aplikasi dari takslist

{
Contoh ini berjalan di lingkungan Windows 95/98
}
implementation

function RegisterServiceProcess(dwProcessID, dwType: DWORD): DWORD;
stdcall; external 'KERNEL32.DLL';

procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID, 1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID, 0);
end;

Read More

Menyembunyikan aplikasi dari takslist

{
Contoh ini berjalan di lingkungan Windows 95/98
}
implementation

function RegisterServiceProcess(dwProcessID, dwType: DWORD): DWORD;
stdcall; external 'KERNEL32.DLL';

procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID, 1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID, 0);
end;

Read More

Menyembunyikan Program dari Taskbar

procedure TMainForm.FormShow(Sender: TObject);
var
hwndOwner: HWnd;
begin
hwndOwner := GetWindow(Handle, GW_OWNER);
ShowWindow(hwndOwner, SW_HIDE);
// For Windows 2000, additionally call the ShowWindowAsync function:
ShowWindowAsync(hwndOwner, SW_HIDE);
ShowWindowAsync(Self.Handle, SW_HIDE);
end;
{
Prevent the form from reappearing on the Taskbar after minimizing it:
}
private

procedure WMSysCommand(var msg: TWMSysCommand); message WM_SysCommand;
{....}
implementation

procedure TMainForm.WMSysCommand(var msg: TWMSysCommand);
begin
if msg.CmdType and $FFF0 = SC_MINIMIZE then
hide
else
inherited;
end;

Read More

Mengubah Caption Notepad

procedure TForm1.Button1Click(Sender: TObject);
begin
SetWindowText(FindWindow('notepad', nil), 'Hello!');
SendMessage(FindWindow('notepad', nil), WM_SETTEXT, 0, Integer(PChar('Hello!')));
end;

Read More

Konversi Biner ke Desimal

function BinToInt(Value: string): Integer;
var
i, iValueSize: Integer;
begin
Result := 0;
iValueSize := Length(Value);
for i := iValueSize downto 1 do
if Value[i] = '1' then Result := Result + (1 shl (iValueSize - i));
end;


function IntToBin1(Value: Longint; Digits: Integer): string;
var
i: Integer;
begin
Result := '';
for i := Digits downto 0 do
if Value and (1 shl i) <> 0 then
Result := Result + '1'
else
Result := Result + '0';
end;


function IntToBin2(d: Longint): string;
var
x, p: Integer;
bin: string;
begin
bin := '';
for x := 1 to 8 * SizeOf(d) do
begin
if Odd(d) then bin := '1' + bin
else
bin := '0' + bin;
d := d shr 1;
end;
Delete(bin, 1, 8 * ((Pos('1', bin) - 1) div 8));
Result := bin;
end;

Read More

Memetakan Bitmap dari Clipboard ke Object Image

uses clipbrd;
...
procedure TForm1.Button1Click(Sender: TObject) ;
begin
if Clipboard.HasFormat(CF_BITMAP) then Image1.Picture.Bitmap.Assign(Clipboard) ;
end;

Read More