Dani Amarullah

Just Try in Error

View Process & Kill

Hmmm Bete ga puguh mending aja sigw post lagi dechhh,wekekekekek….
sekarang si gw maubagi2 lagi artikel yang si gw dah kumpulin dan mau berbagi dengan teman2..hehehehe yaitu buat aplikasi untuk melihat semua prosess di windows yang sedang berjalan wokeyyy, serta untuk meng KILL nya,wakakakakaka…
langsung aja ke TKP,wakakakaka… pertama biasa

siapkan :

  1. Cemilan
  2. Roko
  3. Kopi
  4. Winamp
  5. dan Berdoa jangan lupa,hehehehe

Ok langsung aja buka delphi nya brooooooo
Ini Source nya broooooo(cuma dikit ko listing nya,wekekekekkekee)….

unit Unit1;

interface

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

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

var
  Form1: TForm1;
  x,a : integer;
  CaptionApplication : String;

implementation

{$R *.dfm}

function KillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  FProcessEntry32.dwSize:=SizeOf(FProcessEntry32);
  ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32);
  while Integer(ContinueLoop)0 do  begin
  if (
     (UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=
       UpperCase(ExeFileName))
      or
     (UpperCase(FProcessEntry32.szExeFile)=
       UpperCase(ExeFileName))
    ) then
    Result :=
    Integer(
      TerminateProcess(
      OpenProcess(
        PROCESS_TERMINATE,
        BOOL(0),
        FProcessEntry32.th32ProcessID
      ),
      0
      )
    );
   ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
  MyHandle: THandle;
  Struct: TProcessEntry32;
begin
  ListBox2.Clear;
  if listbox2.ItemIndex < 0 then
  listBox2.itemindex := 0;
  MyHandle:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  Struct.dwSize:=Sizeof(TProcessEntry32);
  if Process32First(MyHandle, Struct) then
  ListBox2.Items.Add(Struct.szExeFile);
  while Process32Next(MyHandle, Struct) do
  ListBox2.Items.Add(Struct.szExeFile);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ListBox2.ItemIndex >= 0 then
  begin
  CaptionApplication:=ListBox2.Items.Strings[listBox2.itemindex];
  if CaptionApplication  '' then
  begin
    KillTask(CaptionApplication);
    Button1.Click;
  end
  else
    Button1.Click;
  end;
    Button1.Click;
end;

end.
Syntax Highlighted with http://delphi-id.org/syntax

bisa didonlot semua source di sini —-> Download here…

SkrinSuuut nya…
taskmanager.jpg

Beressss deh, semoga bermanfaat ya brooooo….Wakakakakaaaaa

July 20, 2007 Posted by p2bf | Artikelah, D3lPhE | | 2 Comments

Membuat Aplikasi Hiden in Task Manager

OK mannnnn sekarang saya ada sebuah contoh program yang bisa Hide di proses taskmanager(Ctrl+Alt+Del).

pertama donlot dulu file dll nya disini Tapi maaf untuk source dll nya salah lom punya,hehehehe cuma dapet dari mana gitu saya lupa lagi…heheheh

ini perintah untuk penggunaannya.

function HideXP(hProg: HWND): Boolean; stdcall; external 'hide.dll' name 'HideProcess';

procedure TForm1.Button1Click(Sender: TObject);
begin
  if HideXP(Application.Handle) then ShowMessage('Hidden');
end;
Syntax Highlighted with http://delphi-id.org/syntax

Semoga bermanfaat dan digunakan untuk yang bermanfaat pula…..

best Regards
Dani Amarullah

July 18, 2007 Posted by p2bf | D3lPhE | | 1 Comment

Net Send Ganti ID Pengirim

Ok jumpa lagi,wakakakakakaka….

sekarang sigw mau ngasih tips buat yang suka kirim2 pesan antar LAN pake Command “Net Send”, artikel disini akan bahas buat mengganti ID pengirimnya… Ok langsung aja..
Buat New Aplikasi terus nama unitnya NetSend.pas

unit NetSend;

interface

uses
  Windows, Messages, Classes, Dialogs, Forms,
  IdIPWatch, BtnCtrls,
  XPMan, Controls, StdCtrls, IdBaseComponent, IdComponent;

type
  TForm1 = class(TForm)
  IdIPWatch1: TIdIPWatch;
  Memo1: TMemo;
  Label8: TLabel;
  Label7: TLabel;
  Label6: TLabel;
  Label5: TLabel;
  Label3: TLabel;
  Label2: TLabel;
  Label1: TLabel;
  Edit1: TEdit;
  ComboBox1: TComboBox;
  ImageButton1: TImageButton;
  XPManifest1: TXPManifest;
  ImageButton2: TImageButton;
  procedure FormCreate(Sender: TObject);
  procedure CaptionBox1Close(Sender: TObject);
  procedure ImageButton2Click(Sender: TObject);
  procedure ImageButton1Click(Sender: TObject);
  procedure Memo1Change(Sender: TObject);
  procedure Memo1KeyPress(Sender: TObject; var Key: Char);
  private
  { Private declarations }
  public
  { Public declarations }
  end;

var
  Form1: TForm1;
  fromsaha: string;

implementation

{$R *.dfm}

type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;
function CreateNetResourceList(ResourceType: DWord;
        NetResource: PNetResource;
        out Entries: DWord;
        out List: PNetResourceArray): Boolean;
var
  EnumHandle: THandle;
  BufSize: DWord;
  Res: DWord;
begin
  Result := False;
  List := Nil;
  Entries := 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET,
      ResourceType,
      0,
      NetResource,
      EnumHandle) = NO_ERROR then begin
  try
  BufSize := $4000;  // 16 kByte
  GetMem(List, BufSize);
  try
  repeat
    Entries := DWord(-1);
    FillChar(List^, BufSize, 0);
    Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
    if Res = ERROR_MORE_DATA then
    begin
    ReAllocMem(List, BufSize);
    end;
  until Res  ERROR_MORE_DATA;
  Result := Res = NO_ERROR;
  if not Result then
  begin
    FreeMem(List);
    List := Nil;
    Entries := 0;
  end;
  except
  FreeMem(List);
  raise;
  end;
  finally
  WNetCloseEnum(EnumHandle);
  end;
  end;
end;

procedure ScanNetworkResources(ResourceType, DisplayType:
   DWord; List: TStrings);
procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(ResourceType, NetResource,
   Entries, NetResourceList) then
  try
  for i := 0 to Integer(Entries) - 1 do
  begin
  if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
  (NetResourceList[i].dwDisplayType = DisplayType) then begin
  List.AddObject(NetResourceList[i].lpRemoteName,
      Pointer(NetResourceList[i].dwDisplayType));
  end;
  if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER)  0 then
  ScanLevel(@NetResourceList[i]);
  end;
  finally
  FreeMem(NetResourceList);
  end;
end;
begin
  ScanLevel(Nil);
end;

function NetMessageBufferSendSubstA(ServerName, MsgName,
  FromName, Msg: AnsiString): Boolean;
{.$DEFINE SYNCHRONOUS}
const
  szService = '\\mailslot\\messngr';
  MaxBufLen = $700;
var

  hFile: THandle;
  WrittenBytes: DWORD;
{$IFNDEF SYNCHRONOUS}
  ovs: OVERLAPPED;
  EventName: AnsiString;
{$ENDIF}
begin
  Result := False;
  if Length(Msg) * sizeof(AnsiChar) > MaxBufLen then
  SetLength(Msg, MaxBufLen div sizeof(AnsiChar));
{$IFNDEF SYNCHRONOUS}
  EventName := 'NetSendEvent_' + ServerName;
{$ENDIF}
  ServerName := '\\\\' + Servername + szService;
  hFile := CreateFileA(
  @ServerName[1], GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING,
  FILE_ATTRIBUTE_NORMAL or FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED, 0);
  if hFile  INVALID_HANDLE_VALUE then
  try
  Msg := FromName + #0 + MsgName + #0 + Msg;
{$IFNDEF SYNCHRONOUS}
  ovs.hEvent := CreateEventA(nil, True, False, @EventName[1]);
  WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, @ovs);
{$ELSE}
  WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, nil);
{$ENDIF}
  Result := GetLastError = ERROR_IO_PENDING;
  finally
{$IFNDEF SYNCHRONOUS}
  if WaitForSingleObject(ovs.hEvent, INFINITE)  WAIT_TIMEOUT then
{$ENDIF}
    CloseHandle(hFile);
  end;
end;

function NetMessageBufferSendSubstW(ServerName, MsgName,
  FromName, Msg: WideString): Boolean;
begin
  result := NetMessageBufferSendSubstA(ServerName, MsgName,
   FromName, Msg);
end;

function NetSendMsg(name_, text_: string): DWORD;
{$IFDEF USENORMALNETSEND}
var
  msgname: WideString;
  msgtext: WideString;
{$ENDIF}
begin
  while name_[1] = '\\' do delete(name_, 1, 1);
{$IFDEF USENORMALNETSEND}
  msgname := WideString(name_);
  msgtext := WideString(text_);
  Result := NetMessageBufferSend(nil, PWideChar(msgname), nil,
     PWideChar(msgtext), sizeof(WideChar) * Length(msgtext));
{$ELSE}
  case NetMessageBufferSendSubstA(name_ , name_, fromsaha, text_) of
  True: result := ERROR_SUCCESS;
  else
  result := ERROR_ACCESS_DENIED;
  end;
{$ENDIF}
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  Label7.Caption := IdIPWatch1.LocalName;
  Label8.Caption := IdIPWatch1.LocalIP;
  ComboBox1.Text := Label7.Caption;
  ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER,
     ComboBox1.Items);
end;

procedure TForm1.CaptionBox1Close(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.ImageButton2Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo1.SetFocus;
end;

procedure TForm1.ImageButton1Click(Sender: TObject);
begin
  if Memo1.Text='' then
  begin
  ShowMessage('Isi dulu pesannya bozzz....');
  Memo1.Clear;
  end
  else
  begin
  Fromsaha:=Edit1.Text;
  NetSendMsg(ComBobox1.Text, Memo1.Text);
  ImageButton1.Enabled:=False;
  Edit1.Text := 'Dhanie';
  Memo1.SetFocus;
  Memo1.Clear;
  end;
end;

procedure TForm1.Memo1Change(Sender: TObject);
begin
  If Memo1.Text='' then
  ImageButton1.Enabled:=False
  else
  ImageButton1.Enabled:=True;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
  If key=#13 then
  ImageButton1.Click;
end;
end.
Syntax Highlighted with http://delphi-id.org/syntax

Ok sekarang buat unit barudengan nama kirim.pas

unit kirim;

interface

uses
  Windows;

implementation

uses NetSend;

type

  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;
function CreateNetResourceList(ResourceType: DWord;
        NetResource: PNetResource;
        out Entries: DWord;
        out List: PNetResourceArray): Boolean;
var
  EnumHandle: THandle;
  BufSize: DWord;
  Res: DWord;
begin
  Result := False;
  List := Nil;
  Entries := 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET,
      ResourceType,
      0,
      NetResource,
      EnumHandle) = NO_ERROR then begin
  try
  BufSize := $4000;  // 16 kByte
  GetMem(List, BufSize);
  try
  repeat
    Entries := DWord(-1);
    FillChar(List^, BufSize, 0);
    Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
    if Res = ERROR_MORE_DATA then
    begin
    ReAllocMem(List, BufSize);
    end;
  until Res  ERROR_MORE_DATA;
  Result := Res = NO_ERROR;
  if not Result then
  begin
    FreeMem(List);
    List := Nil;
    Entries := 0;
  end;
  except
  FreeMem(List);
  raise;
  end;
  finally
  WNetCloseEnum(EnumHandle);
  end;
  end;
end;

procedure ScanNetworkResources(ResourceType, DisplayType:
      DWord; List: TStrings);
procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(ResourceType, NetResource,
      Entries, NetResourceList) then try
  for i := 0 to Integer(Entries) - 1 do  begin
  if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
  (NetResourceList[i].dwDisplayType = DisplayType) then begin
  List.AddObject(NetResourceList[i].lpRemoteName,
      Pointer(NetResourceList[i].dwDisplayType));
  end;
  if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER)  0 then
  ScanLevel(@NetResourceList[i]);
  end;
  finally
  FreeMem(NetResourceList);
  end;
end;
begin
  ScanLevel(Nil);
end;

function NetMessageBufferSendSubstA(ServerName, MsgName,
    FromName, Msg: AnsiString): Boolean;
{.$DEFINE SYNCHRONOUS}
const
  szService = '\\mailslot\\messngr';
  MaxBufLen = $700;
var
  hFile: THandle;
  WrittenBytes: DWORD;
{$IFNDEF SYNCHRONOUS}
  ovs: OVERLAPPED;
  EventName: AnsiString;
{$ENDIF}
begin
  Result := False;
  if Length(Msg) * sizeof(AnsiChar) > MaxBufLen then
  SetLength(Msg, MaxBufLen div sizeof(AnsiChar));
{$IFNDEF SYNCHRONOUS}
  EventName := 'NetSendEvent_' + ServerName;
{$ENDIF}
  ServerName := '\\\\' + Servername + szService;
  hFile := CreateFileA(
  @ServerName[1], GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_EXISTING,
  FILE_ATTRIBUTE_NORMAL or FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED, 0);
  if hFile  INVALID_HANDLE_VALUE then
  try
  Msg := FromName + #0 + MsgName + #0 + Msg;
{$IFNDEF SYNCHRONOUS}
  ovs.hEvent := CreateEventA(nil, True, False, @EventName[1]);
  WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, @ovs);
{$ELSE}
  WriteFile(hFile, Pointer(Msg)^, Length(Msg), WrittenBytes, nil);
{$ENDIF}
  Result := GetLastError = ERROR_IO_PENDING;
  finally
{$IFNDEF SYNCHRONOUS}
  if WaitForSingleObject(ovs.hEvent, INFINITE)  WAIT_TIMEOUT then
{$ENDIF}
    CloseHandle(hFile);
  end;
end;

function NetMessageBufferSendSubstW(ServerName, MsgName,
    FromName, Msg: WideString): Boolean;
begin
  result := NetMessageBufferSendSubstA(ServerName, MsgName, FromName, Msg);
end;

function NetSendMsg(name_, text_: string): DWORD;
{$IFDEF USENORMALNETSEND}
var
  msgname: WideString;
  msgtext: WideString;
{$ENDIF}
begin
  while name_[1] = '\\' do delete(name_, 1, 1);
{$IFDEF USENORMALNETSEND}
  msgname := WideString(name_);
  msgtext := WideString(text_);
  Result := NetMessageBufferSend(nil, PWideChar(msgname), nil,
     PWideChar(msgtext), sizeof(WideChar) * Length(msgtext));
{$ELSE}
  case NetMessageBufferSendSubstA(name_ , name_, fromsaha, text_) of
  True: result := ERROR_SUCCESS;
  else
  result := ERROR_ACCESS_DENIED;
  end;
{$ENDIF}
end;
end.
Syntax Highlighted with http://delphi-id.org/syntax


Download here..

klo sudah beres lalu uses unit tersebut dengan cara File|use unit|lalu pilih yang kirim.pas.

Klo sesuai sehh begini hasilnya..

netsend.jpg

Hasil pesannya sbb…

screen.jpg

Ok Selesai…wakakakaaka selamat mencoba…

July 13, 2007 Posted by p2bf | D3lPhE | | 2 Comments

« Previous Entries