WONG BODOH NGAKU PINTER: Juli 2012

Senin, 16 Juli 2012

jalankan aplikasi menggunakan delphi

untuk menjalankan aplikasi lain dari delphi ..!! kita bisa menggunakan fungsi bawaan dari delphi ..!

function WinExec (lpCmdLine : PChar; uCmdShow : integer) : integer;

dalam fungsi itu terdapat dua parameter yaitu :

path dan nama file yang akan di eksekusi
behavior window mode untuk aplikasi yang akan dibuka

SW_SHOWNORMAL atau 1 : untuk window mode normal
SW_SHOWMINIMIZED atau 2 : untuk window mode minimized
SW_SHOWMAXIMIZED atau 3 : untuk window mode maximized

contoh penulisannya seperti ini :

procedure TForm1.Button1Click(Sender: TObject);

begin

WinExec('C:\Windows\notepad.exe','SW_SHOWNORMAL');

end;

atau

WinExec('C:\Windows\notepad.exe',1);

untuk contoh projectnya silakan lihat dibawah ini :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    Snormal: TRadioButton;
    Smax: TRadioButton;
    Smin: TRadioButton;
    Button3: TButton;
    Button4: TButton;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SnormalClick(Sender: TObject);
    procedure SmaxClick(Sender: TObject);
    procedure SminClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  jendela : integer;
implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
Snormal.Checked:=true;
jendela:=1; // jendela normal
end;

procedure TForm1.SnormalClick(Sender: TObject);
begin
jendela:=1; // jendela normal
end;

procedure TForm1.SminClick(Sender: TObject);
begin
jendela:=2; // jendela minimize
end;

procedure TForm1.SmaxClick(Sender: TObject);
begin
jendela:=3; // jendela maximize
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
WinExec('C:\Windows\notepad.exe',jendela);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
WinExec('C:\Program Files\Windows NT\Accessories\wordpad.exe',jendela);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
WinExec('C:\Windows\system32\cmd.exe',jendela);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
WinExec('C:\Windows\system32\mspaint.exe',jendela);

end;

end.

download source code

Minggu, 15 Juli 2012

bikin folder autorun.inf dengan delphi

kali ini saya pengen share cara bikin sebuah folder autorun.inf seperti punya smadav ..!!! ^,^

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    DriveComboBox1: TDriveComboBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
myfile1,myfile2 : textfile;
text,lokasi   : string ;
begin
lokasi:=DriveComboBox1.Drive+':\autorun.inf';
CreateDir(lokasi);

AssignFile(myfile1, lokasi+'\desktop.ini');
  Rewrite(myfile1);
    Writeln(myfile1, '[.ShellClassInfo]');
    Writeln(myfile1, 'CLSID={2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}');
CloseFile(myfile1);

AssignFile(myfile2, 'c:\folder_con.bat');
  Rewrite(myfile2);
    Writeln(myfile2, 'mkdir '+lokasi+'\con\');
    Writeln(myfile2, 'mkdir '+lokasi+'\con\aux\');
    Writeln(myfile2, 'mkdir '+lokasi+'\con\aux\nul\');
    Writeln(myfile2, 'del c:\folder_con.bat');
CloseFile(myfile2);

FileSetAttr(lokasi,faSysFile+faHidden);

WinExec('c:\folder_con.bat',SW_SHOWMINIMIZED);

end;

end.
</div>

download source code

tcolordialog to RGB delphi

cara merubah tcolor ke rgb adalah dengan cara memanfaatkan funsi

GetRValue(); GetGValue() GetBValue();

untuk penulisannya bisa dilihat dibawah :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ColorDialog1: TColorDialog;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var red,green,blue : integer;
begin
if ColorDialog1.Execute then
begin
red:=GetRValue(ColorDialog1.Color);
green:=GetGValue(ColorDialog1.Color);
blue:=GetBValue(ColorDialog1.Color);
label1.Caption:='red[ '+IntToStr(red)+' ] / green[ '+IntToStr(green)+' ] / blue[ '+IntToStr(blue)+' ]';
end;
end;

end.

download source code

ambil username komputer yang aktif dengan delphi 7

cara mengetahui username yang sedang aktif di komputer dengan delphi

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  cnMaxUserNameLen = 254;
var
  sUserName     : string;
  dwUserNameLen : DWord;
begin
  dwUserNameLen := cnMaxUserNameLen-1;
  SetLength(sUserName, cnMaxUserNameLen);
  GetUserName(PChar(sUserName), dwUserNameLen);
  SetLength(sUserName, dwUserNameLen);
  Label1.Caption:=Trim(sUserName);
end;


end.

download source code

Kamis, 12 Juli 2012

draggable mask di flash

buka flash dan buat dokumen baru lalu import sebuah gambar sesuaikan ukuran gambar dengan luas stage lalu bikin lagi sebuah objek lingkaran ( "kecil saja" );
convert to symbol jadikan movie clip keduanya dan beri instance name gambar dan lingkaran
pilih movie clip lingkaran klik F9 untuk masuk panel ActionScript lalu masukan kode dibawah ini

Atau Copas Kode Dibawah

onClipEvent (load) {
 _root.gambar.setMask(_root.lingkaran);
}
onClipEvent (mouseMove) {
 startDrag(_root.lingkaran, true);
}

Download contoh

cari hari pasaran dengan delphi

karena iseng bongkar2 file lama ..!! akhirnya nemu bekas tugas kuliah pas jaman dulu ..!! yaitu mencari hari pasaran dengan applikasi delphi ..!! lihat screenshotnya

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, dateutils;

type
  TForm1 = class(TForm)
    MonthCalendar1: TMonthCalendar;
    Label1: TLabel;
    procedure MonthCalendar1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MonthCalendar1Click(Sender: TObject);
      var awal,cari : tdatetime;
          jml_hari,pilih_pasaran,pilih_hari : integer;
          tanggal,bulan,tahun : word ;
          hari,pasaran : string ;
begin
     tanggal :=StrToInt(FormatDateTime('d',MonthCalendar1.Date));
     bulan :=StrToInt(FormatDateTime('m',MonthCalendar1.Date));
     tahun :=StrToInt(FormatDateTime('yyyy',MonthCalendar1.Date));
     awal:=EncodeDateTime(1970,01,01,0,0,0,0);
     cari:=EncodeDateTime(tahun,bulan,tanggal,0,0,0,0);
     jml_hari:=daysbetween(awal,cari);
     pilih_pasaran:=jml_hari mod 5;
     case pilih_pasaran of
      0:pasaran :='wage';
      1:pasaran :='kliwon';
      2:pasaran :='legi';
      3:pasaran :='pahing';
      4:pasaran :='pon';
     end;
     pilih_hari:=jml_hari mod 7;
      case pilih_hari of
       0:hari :='kamis';
       1:hari :='jumat';
       2:hari :='sabtu';
       3:hari :='minggu';
       4:hari :='senin';
       5:hari :='selasa';
       6:hari :='rabu';
       end;
      Label1.Caption:=hari+' '+pasaran;
end;

end.

maaf jika scriptnya newbie .. untuk switch casenya sebenarnya bisa di kecilin dengan menggunakan array
maklum dulu emang baru belajar .. hehehe ..!! semoga bermanfaat ..!!

source code

Selasa, 10 Juli 2012

lihat nama dan ip lokal komputer dengan delphi

sekarang saya akan share cara mengetahui nama dan IP lokal komputer kita dengan menggunakan delphi , kebetulan saya juga menemukan skrip ini diinternet jadi skalian saya share langsung biar gak lupa ..!! ^,^ .

langsung aja bikin form kosong lalu tambahkan sebuah button dan sebuah label setelah itu masuk ke script editor .. hapus semua script yang ada .. dan copas dengan skript dibawah kalo sudah jalankan applikasi dengan klik F9

selamat mencoba..!!!

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean; 
type 
  Name = array[0..100] of Char; 
  PName = ^Name; 
var 
  HEnt: pHostEnt;
  HName: PName;
  WSAData: TWSAData; 
  i: Integer; 
begin 
  Result := False;     
  if WSAStartup($0101, WSAData) <> 0 then begin 
    WSAErr := 'Winsock is not responding."'; 
    Exit; 
  end; 
  IPaddr := ''; 
  New(HName); 
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin 
    HostName := StrPas(HName^); 
    HEnt := GetHostByName(HName^); 
    for i := 0 to HEnt^.h_length - 1 do 
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.'); 
    SetLength(IPaddr, Length(IPaddr) - 1); 
    Result := True; 
  end
  else begin 
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:='WSANotInitialised'; 
    WSAENETDOWN      :WSAErr:='WSAENetDown'; 
    WSAEINPROGRESS   :WSAErr:='WSAEInProgress'; 
   end; 
  end; 
  Dispose(HName); 
  WSACleanup; 
end;
procedure TForm1.Button1Click(Sender: TObject);
var Host, IP, Err: string;
begin
if GetIPFromHost(Host, IP, Err) then begin
    label1.caption:='Name : '+Host+'  /  IP : '+IP;
  end
  else
    MessageDlg(Err, mtError, [mbOk], 0);
end;

end.

download source code

bikin text enskripsi sederhana dengan delphi 7

text enkripsi yang sangat sederhana menguunakan delphi ..!! disini saya hanya memanipulasi text inputan dengan cara merubah per karakter menjadi desimal trus dirubah menggunakan operasi aritmatika sederhana lalu dirubah lagi menjadi karakter yg berbeda .. oke lansung saja lihat screenshot dibawah ..!!

unit Unit1;

interface

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

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

var
  Form1: TForm1;
  hasil,txt : string;
  pos : integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
hasil:='';
txt:=Memo1.Text;
for pos:=1 to length(txt) do begin
hasil:=hasil+chr((ord(txt[pos])* 2)-3);
end;
memo2.Text:=hasil;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
hasil:='';
  txt :=Memo2.Text;
  for pos:=1 to length(txt) do begin
  hasil:=hasil+chr((ord(txt[pos])+ 3)div 2);
  end;
  Memo1.Text:=hasil;
end;

end.

donwload Source Code

mencari proxy gratisan dengan Proxy Finder Enterprise Edition

oke langsung saja ..!! Proxy Finder Enterprise Edition adalah aplikasi kecil yang biasa digunakan untuk mencari proxy gratisan yang masih aktif yang tersebar diinternet .. cara penggunaannya juga sangat mudah kita tinggak klik menu find .!! maka aplikasi secara otomatis langsung melakukan scanning untuk mencari proxy yang ada diinternet ..!! kita tinggal tunggu hasilnya .. setelah selesai kita bisa menyimpannya di notepad untuk selanjutnya kita gunakan ..!!

tapi sebelumnya kita saring dulu kode proxy yang kita dapat untuk mencari proxy yang paling bagus ..
caranya kita kunjungi website http://www.checker.freeproxy.ru/checker/ lebih detilnya lihat gambar dibawah :

copy kode proxy yg kita simpan di notepad tadi .. lalu kita masukan kesitus http://www.checker.freeproxy.ru/checker/ seperti gambar diatas lalu kita pilih proxy typenya kita pilih saja all http proxies .. kalo sudah tinggal kita klik tombol Check Proxy setelah itu tinggal kita tunggu hasilnya ..!!

tidak semua proxy bisa digunakan jadi silakan dipilih sendiri cari yang bertuliskan proxy is working !

kalo proses diatas sudah selesai ..!! silakan coba kita pakai untuk browsing ^,^ sekian dulu yah ..!! semoga bermanfaat ..!!

download proxy finder

bikin applikasi chatting dengan client server delphi

oke disini aku akan berikan cara mudah bikin applikasi chatting server client yang menurut saya cukup mudah .. gak susah2 amat ..!! silakan lihat screenshot sederhana dibawah :

unit U_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, XPMan, StdCtrls, ComCtrls, winsock, ExtCtrls;

type
  TForm1 = class(TForm)
    Button2: TButton;
    Memo2: TMemo;
    XPManifest1: TXPManifest;
    ServerSocket1: TServerSocket;
    Memo1: TRichEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    procedure Button2Click(Sender: TObject);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  user_klient : string;
implementation

{$R *.dfm}

function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean; 
type 
  Name = array[0..100] of Char; 
  PName = ^Name; 
var 
  HEnt: pHostEnt; 
  HName: PName; 
  WSAData: TWSAData; 
  i: Integer; 
begin 
  Result := False;     
  if WSAStartup($0101, WSAData) <> 0 then begin 
    WSAErr := 'Winsock is not responding."'; 
    Exit; 
  end; 
  IPaddr := ''; 
  New(HName); 
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin 
    HostName := StrPas(HName^); 
    HEnt := GetHostByName(HName^); 
    for i := 0 to HEnt^.h_length - 1 do 
     IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + '.'); 
    SetLength(IPaddr, Length(IPaddr) - 1); 
    Result := True; 
  end
  else begin 
   case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:='WSANotInitialised'; 
    WSAENETDOWN      :WSAErr:='WSAENetDown'; 
    WSAEINPROGRESS   :WSAErr:='WSAEInProgress'; 
   end; 
  end; 
  Dispose(HName); 
  WSACleanup; 
end;


procedure TForm1.Button2Click(Sender: TObject);
var jumlah_koneksi,klient : integer;
begin
Memo1.Lines.Add('<Server> : '+Memo2.Text);
jumlah_koneksi:=ServerSocket1.Socket.ActiveConnections;
if jumlah_koneksi >= 1 then
begin
  for klient := 0 to jumlah_koneksi-1 do
  begin
  ServerSocket1.Socket.Connections[klient].SendText('<Server> : '+Memo2.Text);
  end;
end;
Memo2.Clear;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
memo1.Lines.Add('<Error dari> '+IntToStr(ErrorCode));
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Port:=25;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
ServerSocket1.Open;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var Host, IP, Err: string;
begin
if GetIPFromHost(Host, IP, Err) then begin
    StatusBar1.Panels[0].Text:='Computer Name : '+Host+' / Computer IP : '+IP;
  end
  else
    MessageDlg(Err, mtError, [mbOk], 0);
    Timer1.Enabled:=false;
end;


end.

unit U_Client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, XPMan, StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo2: TMemo;
    XPManifest1: TXPManifest;
    ClientSocket1: TClientSocket;
    Edit1: TEdit;
    Button3: TButton;
    memo1: TRichEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
     private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}



procedure TForm1.Button1Click(Sender: TObject);
begin
ClientSocket1.Host:=Edit1.Text;
ClientSocket1.Port:=25;
ClientSocket1.Open;
//ClientSocket1.Active:=true;
Memo1.Clear;
Timer1.Enabled:=true;
//ClientSocket1.Socket.SendText(ClientSocket1.Host);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
memo1.Lines.Add('<'+Edit2.Text+'>   : '+Memo2.Text);
if (ClientSocket1.Socket.Connected) then
  begin
  ClientSocket1.Socket.SendText('<'+Edit2.Text+'>   : '+Memo2.Text);
  memo2.Clear;
   Button1.Visible:=false;
   //Button3.Caption:='Connected with [ '+ClientSocket1.Host+' ]';
   Button3.Visible:=true;
  end;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
if Socket.RemoteHost <> '' then begin
memo1.Lines.Add('connected with '+Socket.RemoteHost+' success');
end else ShowMessage('koneksi gagal');


end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
memo1.Lines.Add('<'+Edit2.Text+'> error '+IntToStr(ErrorCode));
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//if ClientSocket1.Socket.Connected then begin
 ClientSocket1.Close;
 //ClientSocket1.Active:=false;
 Button3.Visible:=false;
 Button1.Visible:=true;
 //end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Button1.Visible:=false;
   Button3.Caption:='Disconnect';
   Button3.Visible:=true;
   StatusBar1.Panels[0].Text:='connected With Server [ '+ClientSocket1.Host+' ]';
   StatusBar1.Panels[1].Text:='Status : Connected';
   Timer1.Enabled:=False;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='Not Connected With Server ';
StatusBar1.Panels[1].Text:='Status : Disconnected';
end;

end.

mohon maaf dikarenakan saya agak malas mengulas lebih rinci ..jadi disini saya share juga file source code nya silakan didownload dan di utak atik sendiri ..!! ^,^

source code