Arsip: Mo coba bwat program sederhana ......

 
user image
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 :?
user image
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...
user image
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....
user image
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]
user image
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.
user image
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
user image
more 18 years ago

danzfx

wew tengkyu :D wa coba dolo,,,,,,,,,,,
user image
more 18 years ago

danzfx

klo yang bukan dari control panel gimana?,,, :?
user image
more 18 years ago

kaka-delphi

cyber_hecker
Wah.... njahatin space & bandwidth ..... Dasar :D :D
user image
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
Share to

Random Topic

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com