Arsip: Mo coba bwat program sederhana ......
more 18 years ago
danzfx
bwat awal2 wa mo bwat program sederhana dolo neeh,,...program untuk membuka tools2 windows dengan klik button.....misalna buka regedit, sysedit,, msconfig ...dll nah code ke button na itu gmn ......thankz :?
more 18 years ago
cyber_hecker
program tutorial 1 - Calling Control Panel applets
kode lengkap :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
RadioGroup1: TRadioGroup;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function RunControlPanelApplet(
sAppletFileName : string) : integer;
begin
Result :=
WinExec(
PChar('rundll32.exe shell32.dll,'+
'Control_RunDLL '+sAppletFileName),
SW_SHOWNORMAL);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
sApplet : Array[0..9] of String =
('access.cpl',
'appwiz.cpl',
'desk.cpl',
'intl.cpl',
'joy.cpl',
'main.cpl',
'mmsys.cpl',
'modem.cpl',
'sysdm.cpl',
'timedate.cpl'
);
begin
if RadioGroup1.ItemIndex in [0..9] then
RunControlPanelApplet(sApplet[RadioGroup1.ItemIndex]) else
ShowMessage('Bego Loe...!');
end;
end.
selamat mengembangkannya...
more 18 years ago
cyber_hecker
program tutorial 2 - Getting a list of installed services
kode lengkap :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
//
// Service Types
//
SERVICE_KERNEL_DRIVER = $00000001;
SERVICE_FILE_SYSTEM_DRIVER = $00000002;
SERVICE_ADAPTER = $00000004;
SERVICE_RECOGNIZER_DRIVER = $00000008;
SERVICE_DRIVER =
(SERVICE_KERNEL_DRIVER or
SERVICE_FILE_SYSTEM_DRIVER or
SERVICE_RECOGNIZER_DRIVER);
SERVICE_WIN32_OWN_PROCESS = $00000010;
SERVICE_WIN32_SHARE_PROCESS = $00000020;
SERVICE_WIN32 =
(SERVICE_WIN32_OWN_PROCESS or
SERVICE_WIN32_SHARE_PROCESS);
SERVICE_INTERACTIVE_PROCESS = $00000100;
SERVICE_TYPE_ALL =
(SERVICE_WIN32 or
SERVICE_ADAPTER or
SERVICE_DRIVER or
SERVICE_INTERACTIVE_PROCESS);
var
Form1: TForm1;
implementation
uses WinSvc;
{$R *.dfm}
{----------------------------------------
mendapatkan list dari services
menghasilkan nilai TRUE, jika berhasil
sMachine:
machine name, ex: \SERVER
empty = local machine
dwServiceType
SERVICE_WIN32,
SERVICE_DRIVER or
SERVICE_TYPE_ALL
dwServiceState
SERVICE_ACTIVE,
SERVICE_INACTIVE or
SERVICE_STATE_ALL
slServicesList
TStrings variable to storage
----------------------------------------}
function ServiceGetList(
sMachine : string;
dwServiceType,
dwServiceState : DWord;
slServicesList : TStrings )
: boolean;
const
// asumsi bahwa servis yang ada
// kurang dari 4096, tambahkan nilainya
// jika diperlukan
cnMaxServices = 4096;
type
TSvcA = array[0..cnMaxServices]
of TEnumServiceStatus;
PSvcA = ^TSvcA;
var
j : integer;
// service control
// manager handle
schm : SC_Handle;
// bytes yang dibutuhkan untuk buffer
// selanjutnya, jika ada
nBytesNeeded,
// jumlah services
nServices,
// pointer untuk membaca service berikutnya
nResumeHandle : DWord;
// service status array
ssa : PSvcA;
begin
Result := false;
// connect to the service
// control manager
schm := OpenSCManager(
PChar(sMachine),
Nil,
SC_MANAGER_ALL_ACCESS);
// if successful...
if(schm > 0)then
begin
nResumeHandle := 0;
New(ssa);
EnumServicesStatus(
schm,
dwServiceType,
dwServiceState,
ssa^[0],
SizeOf(ssa^),
nBytesNeeded,
nServices,
nResumeHandle );
// assume that our initial array
// was large enough to hold all
// entries. add code to enumerate
// if necessary.
for j := 0 to nServices-1 do
begin
slServicesList.
Add( StrPas(
ssa^[j].lpDisplayName ) );
end;
Result := true;
Dispose(ssa);
// close service control
// manager handle
CloseServiceHandle(schm);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ServiceGetList( '',
SERVICE_WIN32,
SERVICE_STATE_ALL,
ListBox1.Items );
end;
end.
selamat berkarya....
more 18 years ago
cyber_hecker
program tutorial 3 - Start / Stop Windows Services
kode lengkap :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses WinSvc;
{$R *.dfm}
{---------------------------------------------------------
start service
menghasilkan nilai TRUE, jika berhasil
sMachine:
machine name, ex: \SERVER
empty = local machine
sService
service name, ie: Alerter
---------------------------------------------------------}
function ServiceStart(
sMachine,
sService : string ) : boolean;
var
// service control
// manager handle
schm,
schs : SC_Handle; // service handle
ss : TServiceStatus;// service status
psTemp : PChar; // temp char pointer
dwChkP : DWord; // check point
begin
ss.dwCurrentState := 0;
// connect to the service
// control manager
schm := OpenSCManager(
PChar(sMachine),
Nil,
SC_MANAGER_CONNECT);
// if successful...
if(schm > 0)then
begin
// open a handle to
// the specified service
schs := OpenService(
schm,
PChar(sService),
// start the service and
SERVICE_START or
// query service status
SERVICE_QUERY_STATUS);
// if successful...
if(schs > 0)then
begin
psTemp := Nil;
if(StartService(
schs,
0,
psTemp))then
begin
// check status
if(QueryServiceStatus(
schs,
ss))then
begin
while(SERVICE_RUNNING
<> ss.dwCurrentState)do
begin
//
// dwCheckPoint contains a
// value that the service
// increments periodically
// to report its progress
// during a lengthy
// operation.
//
// save current value
//
dwChkP := ss.dwCheckPoint;
//
// wait a bit before
// checking status again
//
// dwWaitHint is the
// estimated amount of time
// the calling program
// should wait before calling
// QueryServiceStatus() again
//
// idle events should be
// handled here...
//
Sleep(ss.dwWaitHint);
if(not QueryServiceStatus(
schs,
ss))then
begin
// couldn't check status
// break from the loop
break;
end;
if(ss.dwCheckPoint <
dwChkP)then
begin
// QueryServiceStatus
// didn't increment
// dwCheckPoint as it
// should have.
// avoid an infinite
// loop by breaking
break;
end;
end;
end;
end;
// close service handle
CloseServiceHandle(schs);
end;
// close service control
// manager handle
CloseServiceHandle(schm);
end;
// return TRUE if
// the service status is running
Result :=
SERVICE_RUNNING =
ss.dwCurrentState;
end;
{---------------------------------------------------------
stop service
menghasilkan nilai TRUE, jika berhasil
sMachine:
machine name, ie: \SERVER
empty = local machine
sService
service name, ie: Alerter
---------------------------------------------------------}
function ServiceStop(
sMachine,
sService : string ) : boolean;
var
// service control
// manager handle
schm,
schs : SC_Handle; // service handle
ss : TServiceStatus;// service status
dwChkP : DWord; // check point
begin
// connect to the service
// control manager
schm := OpenSCManager(
PChar(sMachine),
Nil,
SC_MANAGER_CONNECT);
// if successful...
if(schm > 0)then
begin
// open a handle to
// the specified service
schs := OpenService(
schm,
PChar(sService),
// we want to
// stop the service and
SERVICE_STOP or
// query service status
SERVICE_QUERY_STATUS);
// if successful...
if(schs > 0)then
begin
if(ControlService(
schs,
SERVICE_CONTROL_STOP,
ss))then
begin
// check status
if(QueryServiceStatus(
schs,
ss))then
begin
while(SERVICE_STOPPED
<> ss.dwCurrentState)do
begin
//
// dwCheckPoint contains a
// value that the service
// increments periodically
// to report its progress
// during a lengthy
// operation.
//
// save current value
//
dwChkP := ss.dwCheckPoint;
//
// wait a bit before
// checking status again
//
// dwWaitHint is the
// estimated amount of time
// the calling program
// should wait before calling
// QueryServiceStatus() again
//
// idle events should be
// handled here...
//
Sleep(ss.dwWaitHint);
if(not QueryServiceStatus(
schs,
ss))then
begin
// couldn't check status
// break from the loop
break;
end;
if(ss.dwCheckPoint <
dwChkP)then
begin
// QueryServiceStatus
// didn't increment
// dwCheckPoint as it
// should have.
// avoid an infinite
// loop by breaking
break;
end;
end;
end;
end;
// close service handle
CloseServiceHandle(schs);
end;
// close service control
// manager handle
CloseServiceHandle(schm);
end;
// return TRUE if
// the service status is stopped
Result :=
SERVICE_STOPPED =
ss.dwCurrentState;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if(ServiceStart('','alerter' ))then begin
ShowMessage('Services Started');
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if(ServiceStop('','alerter' ))then begin
ShowMessage('Services Stoped');
end;
end;
end.
selamat mencoba...
[/code]
more 18 years ago
cyber_hecker
program tutorial 4 - Lock Mouse Area
kode lengkap :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Rect: TRect;
begin
Rect.Left:=Left;
Rect.Top:= Top;
Rect.Right:=Left+Width;
Rect.Bottom:=Top+Height;
ClipCursor(@Rect);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ClipCursor(nil);
end;
end.
nb. set pada event onResize sama dengan button1Click, walau ukuran form di ubah, maka penguncian area mouse ikut berubah sesuai ukuran windows sekarang.
more 18 years ago
cyber_hecker
program tutorial 5 - Gradient Form
kode lengkap :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R .dfm}
procedure TForm1.FormPaint(Sender: TObject);
var
Row, Ht: Word;
begin
Ht:=(ClientHeight+255) div 256;
for Row:=0 to 255 do
with Canvas do
begin
Brush.Color:=RGB(Row,0,0);
FillRect(Rect(0,Row Ht,ClientWidth,(Row+1)*Ht));
end;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Self.Repaint;
end;
end.
selamat mencoba... :D
more 18 years ago
cyber_hecker
OOT: santai aja... untuk gambar ngambil dari bandwith punyaku kok :P. gak make bandwith server delphi-id :P
more ...
- Pages:
- 1
- 2
reply |
Report Obsolete
Last Articles
Last Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 3 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 4 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 11 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 11 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 11 years ago
Random Topic
- Perintah copy antar drive tidak bekerja
by arjuna_1982 in MsSQL more 15 years ago - Error Terbilang di Fastreport
by delphi1st in Reporting more 16 years ago - Pussssing??? Pingin S@nT4! eNaKnYa KeM4n4 y4????
by n3o_cybertech in Tip n Trik Pemrograman more 16 years ago - mp3 player & announcer
by aireda in Multimedia & Graphic Enhancement more 17 years ago - Nanya : Fungsi 'Select' MySQL
by tox2wow in MySQL more 18 years ago - Error Msjtest40.dll......help.....
by fissas in Hal umum tentang Pascal Indonesia more 15 years ago - parameter harga software
by dinox in OOT more 17 years ago - Query untuk memilih max(date) dari satu tabel
by b_squared in FireBird more 13 years ago - jadikan delphi-id komunitas yg bermoral
by simba in Hal umum tentang Pascal Indonesia more 17 years ago - Virus lokal baru nih
by alnas in Enginering more 16 years ago