Dosen adalah pendidik profesional dan ilmuwan dengan tugas utama mentransformasikan, mengembangkan, dan menyebarluaskan ilmu pengetahuan, teknologi melalui pendidikan, penelitian, dan pengabdian kepada masyarakat (Permendikbud 49/2014 Pasal 1:14)

Sekolah Tinggi Teknologi Garut

Diselenggarakan mulai tahun 1991 dan bernaung di bawah Yayasan Al-Musaddadiyah. http://www.sttgarut.ac.id/

Program Studi Teknik Informatika

Berdiri pada tanggal 30 Juni 1998 dan terakreditasi B. http://informatika.sttgarut.ac.id/

Rinda Cahyana

Dosen PNS Kementrian Riset, Teknologi, dan Pendidikan Tinggi, dpk Sekolah Tinggi Teknologi Garut sejak tahun 2005

21 Juli 2008

16 Juli 2008

I with IM3 goes to Campus



Presentasi bersama IM3 tentang internet di acara Masa Orientasi Siswa SMU Ciledug
Aula Utama al-Musaddadiyah, 16 Juli 2008


Apakah Internet itu?

Definisi Menurut Wikipedia: The Internet is a worldwide, publicly accessible series of interconnected computer networks that transmit data by packet switching using the standard Internet Protocol (IP). It is a "network of networks" that consists of millions of smaller domestic, academic, business, and government networks, which together carry various information and services, such as electronic mail, online chat, file transfer, and the interlinked web pages and other resources of the World Wide Web (WWW).

Sederhananya, internet merupakan gabungan jaringan komputer seluruh dunia yang dengannya setiap orang dapat berbagi sumber daya dan layanan, juga berkomunikasi

Internet itu ramai tidak sih?

Berapa jumlah pengguna internet sekarang? Menurut Internet Word Stats, jumlah pengguna internet hingga Maret 2008 adalah 1,407,724,920 pengguna (http://www.internetworldstats.com)

Berselancar internet melalui IM3

Sedikitnya ada dua saluran yang disediakan oleh kebanyakan Provider Seluler, yakni: General Packet Radio Service (GPRS / 2.5G) dan High Speed Download Packet Access (HSDPA / 3.5G)

IM3 adalah operator yang pertama kali menggunakan GPRS. Teknologi yang bisa membuat pengaksesan data menjadi lebih cepat, dengan kecepatan maksimal mencapai sekitar 144 kbps (kilo byte per second). Tapi sayangnya kelebihan ini belum bisa dilakukan secara maksimal, karena keterbatasan handphone yang tersedia di pasaran Indonesia. Sebagian besar ponsel di pasaran hanya bisa mempunyai kecepatan antara 20-40 kbps. Selain itu sebagian ponsel yang digunakan masih berteknologi single band yang sulit mengakses GPRS. Tapi seiring banyaknya ponsel baru berteknologi dual band, keterbatasan tersebut bisa teratasi. (www.korantempo.com)

Seberapa cepat akses internet via HSDPA IM3?

PT Indosat Tbk baru saja menambah kecepatan akses data layanan mobile broadband 3,5G miliknya usai meng-upgrade teknologi yang digunakan sebelumnya, dari High Speed Downlink Packet Access (HSDPA) menjadi High Speed Packet Access (HSPA). Dengan demikian, kecepatan akses data layanan tersebut yang tadinya cuma memberikan askes downlink maksimal 3,6 Mbps dan uplink 384 kbps, kini bisa mencapai akses download 14,4 Mbps dan upload hingga 1,4 Mbps.  (Achmad Rouzni Noor II – detikinet)

Apa kata pengguna 3.5G IM3?

Sofyan Hadi - divisi IT di PT. Astra Graphia (Fuji Xerox): Saat saya mencoba IM3, ternyata di rumah malah bisa dapat sinyal 3,5G, dan bisa download file dengan speed 30 KB/s…, cepet sekali untuk ukuran di Indonesia. Saya download file 60 MByte kira-kira hanya butuh waktu satu jam yang artinya hanya memakan pulsa Rp. 6.000. Coba bandingkan kalau pake volume base….(60000 KB x Rp 1 = Rp 60.000). Tapi ingat kadang-kadang walaupun dapat sinyal 3.5G, tapi speednya payah, jadi tergantung posisi, dan banyaknya yang lagi pake akses internet. Beruntung di daerah rumah saya bisa dengan kecepatan tersebut diatas. Jadi sekarang dengan biaya Rp 100/menit sudah bisa menikmati internet kecepatan yang lumayan, Jauh diatas kecepatan telkomnet instan dengan tarif yang sama. (isengnulis.wordpress.com)

Contoh tempat nongkrong kaula muda di Internet

  1. Ajang kenalan: Friendster adalah internet social network service, ditemukan oleh Jonathan Abrams pada bulan Maret 2002, dibeli oleh Google seharga US$ 30 juta.
  2. Ajang tuker Video: Youtube adalah video sharing website dimana pengguna dapat melihat, mempublikasikan, dan membagi videonya dengan orang lain. Ditemukan Februari 2005 oleh tiga orang pegawai PayPal, dan dibeli oleh Google seharga US$ 1.65 Milyar
  3. Ajang Komunikasi: Yahoo Messenger, ditemukan oleh Yahoo, diluncurkan tanggal 9 Maret 1998.
  4. Forum Diskusi: Ajang Kita, adalah sebuah forum diskusi di internet yang menyajikan beragam topik. Situs ini dikelola secara personal dan independen, bukan oleh perusahaan atau lembaga tertentu.
Internet dan Pornografi

Berdasarkan laporan yang dikeluarkan oleh American Demographics Magazine menunjukkan adanya peningkatan keberadaan situs porno di internet. Data itu diperoleh dari sextracker.com. Jumlah situs dewasa yang menyediakan pornografi meningkat dari 22.100 pada 1997 menjadi 280.300 pada 2000 atau melonjak 10 kali lebih dalam kurun tiga tahun. Transaksi di Amerika hampir bernilai AS$1,4 miliar pada 1998. Menurut survei yang pernah dilakukan oleh Forester Research pada awal tahun 90-an, hampir 80% lalu lintas internet selalu mengarah ke situs-situs dewasa (porno). (Mudiardjo)

Serangan Setan Melalui Email dan IM

Hasil survei "Online Survival Guide Consumer Reports" secara global per September 2005, 47% responden mengaku menerima konten serta pesan sampah (spam) bernada pornografi. Dari riset itu diperkirakan lebih dari dua juta anak secara tak sengaja melihat pesan sampah bernada porno itu.

Hasil Riset Finkelhor, Mitchell, dan Wolak dari Online Victimazation pada Juni 2000 menyatakan, enam dari sepuluh remaja usia belasan menerima e-mail atau pesan instan (IM) dari orang yang tak dikenal, di mana 63% diantaranya mengaku merespon balik pesan yang diterimanya. Jumlah itu diperkirakan meningkat seiring bertambahnya jumlah pengguna internet di kalangan usia remaja. Hasil survei itu dipaparkan Platform Strategic Manager Microsoft Indonesia Subhan Novianda dalam seminar yang dihadiri sekitar 200 peserta. (Rouzni)

Akibat dari Pornografi

Yayasan Buah Hati melakukan survei sepanjang tahun 2005 di antara kalangan anak-anak SD, usia 9-12 tahun. Respondennya 1.705 anak di Jabodetabek. Ditemukan, ternyata 80 persen dari anak-anak itu sudah mengakses materi pornografi dari bermacam-macam sumber. Bisa di komik-komik, VCD, DVD, dan situs-situs. Dari hasil survei BKKBN tahun 2002 diketahui, hampir 40 persen remaja pernah berhubungan seks sebelum menikah (Maris).

Laki-Laki Atau Perempuankah Yang Menjadi Target Pornografi ?

Berdasarkan survei oleh perusahaan software TopTenReviews ini, 28 persen pengunjung situs porno adalah wanita, 17 persen diantaranya mengaku mengalami kecanduan. (LancasterOnline)

Tips Aman Berselancar
  1. Jangan terlalu percaya terhadap informasi yang diberikan orang di internet.
  2. Waspadalah terhadap orang yang terlalu ingin tahu banyak tentang anda.
  3. Tinggalkan orang yang mempengaruhi atau mempropokasi anda untuk melakukan hal buruk.
  4. Jangan curhat kepada orang yang tidak dikenal.
  5. Hapus kiriman dari sumber yang tidak dikenal.
  6. Selalu ingat bahwa Tuhan juga ada di dunia maya.
Internet Addiction

Kecanduan internet menjadi masalah bagi manusia saat aktivitasnya di dunia maya tidak memberi kontribusi baik terhadap aktivitasnya di dunia nyata, serta menyebabkan dirinya lupa akan kebutuhan fisik, psikologi, dan lingkungan sosial disekitarnya.

Untuk mengukur tingkat kecanduan anda terhadap internet, cobalah mengikuti tes yang disediakan di alamat berikut ini : http://www.netaddiction.com/resources/internet_addiction_test.htm

Mengatasi Kecanduan Internet
  1. Cari tahu masalahnya. Jika Anda menggunakan internet sebagai pelarian dari masalah depresi, gelisah atau masalah hubungan, bukan internet tempat pelariannya. Memanfaatkan internet sebagai tempat pelarian hanya akan membuat Anda semakin candu dengan internet. Psikoterapi bisa menjadi alternatif solusinya. Disana Anda bisa belajar keahlian bagaimana memanajemen stres dengan baik.
  2. Kenali pemicunya. Menjadi seorang pecandu internet tentu karena dipicu suatu hal. Cari tahu dan kenali pemicunya. Apakah Anda bosan, stres atau kesepian? Jika hal tadi yang menjadi penyebabnya, coba buat daftar cara alternatif untuk mengatasi perasaan itu misalnya dengan jalan-jalan bersama teman.
  3. Kurangi sedikit demi sedikit kebiasaan berlama-lama di internet. Bagi yang sudah keranjingan dengan internet, cobalah untuk mengurangi sedikit demi sedikit kebiasaan Anda 'bergaul' terlalu lama dengan internet. Misalnya, jika Anda menghabiskan waktu 10 jam sehari di internet, coba kurangi 2 jam saja untuk melakukan kegiatan yang lain seperti rekreasi, ngobrol dan berkumpul dengan keluarga, atau kegiatan sosial lainnya. Cobalah buat jadwal kapan Anda boleh menghabiskan banyak waktu untuk menggunakan internet dan kapan waktu yang tidak boleh diganggu gugat, tapi harus dipatuhi tentunya. Setidaknya dengan begitu, sedikit demi sedikit Anda bisa mengurangi rasa ketergantungan dari internet.
  4. Ubah pola kebiasan online. Salah satu cara untuk mengurangi ketergantungan internet adalah dengan mengubah pola kebiasaan ber-internet. Terbiasa menonton film online? Coba ubah kebiasaan itu dengan cara pergi ke bioskop. Menelepon langsung orang yang kita cari lebih baik ketimbang mengirimkan e-mail. Atau, ubah kebiasaan Anda berbelanja secara 'maya' di internet dengan cara berbelanja langsung ke toko-toko nyata.
  5. Atur ulang jadwal rutinitas. Jika Anda biasanya memeriksa e-mail pada pagi hari setelah bangun tidur, coba periksalah e-mail tersebut setelah sarapan. Tak adal salahnya menikmati waktu sarapan bersama keluarga karena bisa mempererat keharmonisan hubungan. Jika sepulang dari kantor biasanya Anda langsung nongkrong di internet, tunggulah sampai setelah makan malam. Sambil menunggu makan malam Anda bisa berleyeh-leyeh di sofa sambil mendengarkan musik mungkin? (Ningrum - DetikNews)

15 Juli 2008

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.

14 Juli 2008

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

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

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.

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.

12 Juli 2008

My Family

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

11 Juli 2008

Syuqi Ahmad Nurulloh


Syauqi 2 tahun

Syauqi, 1 tahun

Syauqi usia 6 bulan

Syauqi usia 4 bulan
Usia 1 Hari

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

09 Juli 2008

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;

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;

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;

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;

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;

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;

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;

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;

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

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

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;

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;

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;

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.

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;

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;

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;

Dialog untuk memilih direktori

uses FileCtrl;

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

Membuat Direktori Baru

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

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;

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;

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;

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.

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);

Mematikan Komputer

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

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;

Memulai Kembali Program

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

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;

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;

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;

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;

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;

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;

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;

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;

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;