[Cinnamon] Release 1.6

Udah lama ga mainan cinnamon (dektop hasil fork gnome-shell) akhirnya mengeluarkan vesi terbarunya yaitu 1.6 dimanaversi ini udah mendukung desktop 2D kabar gembira bagi yang mempunyai hardware yang tidak bisa mendukung 3D sehingga tidak bisa menyicipi Gnome-Shell atau Cinnamon versi yang lama. kemudian versi ini juga udah mengintegrasikan musik dalam appletya

dan terintegrasi dengan Nemo (hasil fork nautilus 3.4.2).

Read more

Metode Perulangan dan Percabangan Lazarus

Pembuatan form pembelian dimana nantinya didalan form itu ada pemilihan tanggal, bulan dan tahun yang mana di buat dengan perulangan. Kemudian ada pemilihan kode barang dan diikuti dengan munculnya nama barang dan harga yang di mana merupakan metode percabangan.
Berikut tampilan seluruhnya

berikut design tampilan form

kode nya adalah

unit pembelian;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;

type

{ TfrmPembelian }

TfrmPembelian = class(TForm)
cmbTanggal: TComboBox;
cmbBulan: TComboBox;
cmbTahun: TComboBox;
cmbKode: TComboBox;
Label9: TLabel;
txtJumlah: TEdit;
txtNota: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
txtNama: TEdit;
txtHarga: TEdit;
txtTotal: TEdit;
txtBayar: TEdit;
txtKembalian: TEdit;
procedure cmbBulanChange(Sender: TObject);
procedure cmbKodeChange(Sender: TObject);
procedure cmbTahunChange(Sender: TObject);
procedure cmbTanggalChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure txtBayarExit(Sender: TObject);
procedure txtBayarKeyPress(Sender: TObject; var Key: char);
procedure txtJumlahExit(Sender: TObject);
procedure txtJumlahKeyPress(Sender: TObject; var Key: char);
private
{ private declarations }
public
{ public declarations }
end;

var
frmPembelian: TfrmPembelian;

implementation

procedure TfrmPembelian.FormCreate(Sender: TObject);
var
i,j,l:integer;
begin
cmbtanggal.Items.Clear;
for i:=1 to 31 do
begin
cmbtanggal.Items.add(inttostr(i));
end;
cmbbulan.Items.clear;
for j:=1 to 12 do
begin
cmbbulan.items.Add(inttostr(j));
end;
cmbtahun.Items.clear;
for l:=2000 to 2999 do
begin
cmbtahun.items.Add(inttostr(l));
end;
end;

procedure TfrmPembelian.txtBayarExit(Sender: TObject);
begin
if txtbayar.Text='' then txtbayar.Text:='0'; //mengatasi error karena txtbayar belum diisi
if txttotal.Text='' then txttotal.Text:='0'; //error itu cuma terjadi di linux, kalau dijalankan di windows ga error
if strtofloat(txtbayar.Text) < strtofloat(txttotal.Text) then MessageDlg('Maaf bayarnya kurang dari total.', mtInformation, [mbOK], 0) else txtkembalian.Text:=floattostr(strtofloat(txtbayar.Text)-strtofloat(txttotal.Text)); txtbayar.SetFocus; end; procedure TfrmPembelian.txtBayarKeyPress(Sender: TObject; var Key: char); begin if not ( Key in ['0'..'9', #8] ) then Key := #0; end; //jika txtjumlah tidak fokus atau kursor di tempat lain maka lakukan perkalian procedure TfrmPembelian.txtJumlahExit(Sender: TObject); begin if txtjumlah.Text='' then begin MessageDlg('Maaf Jumlah pembelian belum diisi.', mtInformation, [mbOK], 0); txtjumlah.SetFocus; end else txttotal.Text:=floattostr(strtofloat(txtharga.Text)*strtofloat(txtjumlah.Text)); txtbayar.SetFocus; end; //txtjumlah wajib di isi angka kalau tidak diabaikan procedure TfrmPembelian.txtJumlahKeyPress(Sender: TObject; var Key: char); begin if not ( Key in ['0'..'9', #8] ) then Key := #0; end; //ini jika terjadi perubahan text di combo kode procedure TfrmPembelian.cmbKodeChange(Sender: TObject); begin if cmbkode.Text='A1' then begin txtnama.Text:='Sabun Mandi'; txtharga.Text:='2500'; end else if cmbkode.Text='A2' then begin txtnama.Text:='Durian'; txtharga.Text:='10000'; end else if cmbkode.Text='A3' then begin txtnama.Text:='Susu'; txtharga.Text:='5000'; end; txtjumlah.SetFocus; end; //memindahkan kursor procedure TfrmPembelian.cmbTahunChange(Sender: TObject); begin cmbkode.SetFocus; end; procedure TfrmPembelian.cmbBulanChange(Sender: TObject); begin cmbtahun.SetFocus; end; procedure TfrmPembelian.cmbTanggalChange(Sender: TObject); begin cmbbulan.SetFocus; end; initialization {$I pembelian.lrs} end.

Keterangan:
pada procedure TfrmPembelian.txtBayarExit terdapat script jika txtbayar.text='' maka txtbayar.text='0' dan di bawah ini untuk mengatasi error jika di compile di linux, kaau di compile di windows script diatas yang di perlukan dan tidak berpengaruh. Dan penjelasan sedikit udah saya masukkan di dalam script dengan memberikan tanda // semoga dapat membantu memahaminya.

Kemudian untuk txtnama, txtharga dan txtkembalian saya ubah enablenya menjadi flase karena hanya untuk dilihat bukan untuk di inputkan

Read more

Delphi vs Lazarus (Study kasus Pembuatan Kalkulator)

Sudah lama ga posting untuk menuutp tahun 2011 ini saya akan memposting.
Pembuatan kalkulator ini digunakan untuk tugas mata kuliah Perancangan Sistem Berorientasi object, yang kali ini saya membuat dengan menggunakan lazarus, mengapa lazarus? Padahal tugas harus dikerjakan dengan Delphi, karena lazarus free (tanpa harus mengecrak, keygen atau membajak) dan srciptnya sama dengan Delphi, semoga aja dengan menggunakan lazarus dapat mengurangi ketergantungan software yang berbayar. Dan kali ini saya membuat dalam 2 versi yaitu dengan Delphi 7 (hasil pembajakan dan jangan di tiru) kemudian menggunaan lazarus dengan os Jangkar 5.0 (berbasis LinuxMint 12).

Berikut pembuatan dengan lazarus
tampilan seluruh

tampilan formnya

berikut sourcecodenya

unit Kalkulator;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, LCLType;

type

{ TfrmKalkulator }

TfrmKalkulator = class(TForm)
cmd0: TButton;
cmd9: TButton;
cmdTitik: TButton;
cmdPlusMin: TButton;
cmdClear: TButton;
cmdBagi: TButton;
cmdKali: TButton;
cmdKurang: TButton;
cmdTambah: TButton;
cmdSamaDengan: TButton;
cmd1: TButton;
cmd2: TButton;
cmd3: TButton;
cmd4: TButton;
cmd5: TButton;
cmd6: TButton;
cmd7: TButton;
cmd8: TButton;
txtAngka: TEdit;
procedure proses_hitung();
procedure proses_inc(kar : Char);
procedure proses_array(kar : Char);
procedure FormCreate(Sender: TObject);
procedure cmd0Click(Sender: TObject);
procedure cmd1Click(Sender: TObject);
procedure cmd2Click(Sender: TObject);
procedure cmd3Click(Sender: TObject);
procedure cmd4Click(Sender: TObject);
procedure cmd5Click(Sender: TObject);
procedure cmd6Click(Sender: TObject);
procedure cmd7Click(Sender: TObject);
procedure cmd8Click(Sender: TObject);
procedure cmd9Click(Sender: TObject);
procedure cmdPlusMinClick(Sender: TObject);
procedure cmdTitikClick(Sender: TObject);
procedure cmdClearClick(Sender: TObject);
procedure cmdTambahClick(Sender: TObject);
procedure cmdKurangClick(Sender: TObject);
procedure cmdKaliClick(Sender: TObject);
procedure cmdBagiClick(Sender: TObject);
procedure cmdSamaDenganClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ private declarations }
public
{ public declarations }
end;

var
frmKalkulator: TfrmKalkulator;
tempstr : String;
tmpOpr:string;
tmpangka:string;
hasil : Real;

implementation
procedure TfrmKalkulator.FormCreate(Sender: TObject);
begin
hasil := 0;
tempstr := '';
txtangka.Text:= FloatToStr(hasil);
end;

procedure TfrmKalkulator.proses_inc(kar : Char);
begin
tempstr:=txtangka.Text;
tempstr:=tempstr+kar;
hasil:=StrToFloat(tempstr);
txtAngka.Text:=FloatToStr(hasil);
end;
{$R *.lfm}
procedure TfrmKalkulator.cmd0Click(Sender: TObject);
begin
proses_inc('0');
end;

procedure TfrmKalkulator.cmd1Click(Sender: TObject);
begin
proses_inc('1');
end;

procedure TfrmKalkulator.cmd2Click(Sender: TObject);
begin
proses_inc('2');
end;

procedure TfrmKalkulator.cmd3Click(Sender: TObject);
begin
proses_inc('3');
end;

procedure TfrmKalkulator.cmd4Click(Sender: TObject);
begin
proses_inc('4');
end;

procedure TfrmKalkulator.cmd5Click(Sender: TObject);
begin
proses_inc('5');
end;

procedure TfrmKalkulator.cmd6Click(Sender: TObject);
begin
proses_inc('6');
end;

procedure TfrmKalkulator.cmd7Click(Sender: TObject);
begin
proses_inc('7');
end;

procedure TfrmKalkulator.cmd8Click(Sender: TObject);
begin
proses_inc('8');
end;

procedure TfrmKalkulator.cmd9Click(Sender: TObject);
begin
proses_inc('9');
end;

procedure TfrmKalkulator.cmdPlusMinClick(Sender: TObject);
var angka:real;
begin
angka:=StrToFloat(txtAngka.Text);
if (angka>0) then
angka:=(-angka)
else
angka:=angka+(-angka)+(-angka);
txtAngka.Text:=FloatToStr(angka);
end;

procedure TfrmKalkulator.cmdTitikClick(Sender: TObject);
begin
if (pos('.', txtAngka.Text) = 0) then
txtAngka.Text:=txtAngka.Text+'.';
end;

procedure TfrmKalkulator.cmdClearClick(Sender: TObject);
begin
tempstr := '';
hasil := 0;
txtAngka.Text:='0';
tmpopr:='';
tmpangka:='';
end;

procedure TfrmKalkulator.proses_array(kar : Char);
begin
tmpangka:=txtangka.Text;
txtangka.Text:='';
tmpOpr:=kar;

end;

procedure TfrmKalkulator.cmdTambahClick(Sender: TObject);
begin
proses_array('+');
end;

procedure TfrmKalkulator.cmdKurangClick(Sender: TObject);
begin
proses_array('-');
end;

procedure TfrmKalkulator.cmdKaliClick(Sender: TObject);
begin
proses_array('x');
end;

procedure TfrmKalkulator.cmdBagiClick(Sender: TObject);
begin
proses_array('/');
end;

procedure TfrmKalkulator.proses_hitung();
begin
if tmpOpr='+' then txtAngka.Text:=floattostr(strtofloat(tmpangka)+strtofloat(txtAngka.Text));
if tmpOpr='-' then txtAngka.Text:=floattostr(strtofloat(tmpangka)-strtofloat(txtAngka.Text));
if tmpOpr='x' then txtAngka.Text:=floattostr(strtofloat(tmpangka)*strtofloat(txtAngka.Text));
if tmpOpr='/' then txtAngka.Text:=floattostr(strtofloat(tmpangka)/strtofloat(txtAngka.Text));
end;
procedure TfrmKalkulator.cmdSamaDenganClick(Sender: TObject);
begin
proses_hitung();
end;
procedure TfrmKalkulator.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (Key=96) then proses_inc('0');
if (Key=97) then proses_inc('1');
if (Key=98) then proses_inc('2');
if (Key=99) then proses_inc('3');
if (Key=100) then proses_inc('4');
if (Key=101) then proses_inc('5');
if (Key=102) then proses_inc('6');
if (Key=103) then proses_inc('7');
if (Key=104) then proses_inc('8');
if (Key=105) then proses_inc('9');
if (Key=48) then proses_inc('0');
if (Key=49) then proses_inc('1');
if (Key=50) then proses_inc('2');
if (Key=51) then proses_inc('3');
if (Key=52) then proses_inc('4');
if (Key=53) then proses_inc('5');
if (Key=54) then proses_inc('6');
if (Key=55) then proses_inc('7');
if (Key=56) then proses_inc('8');
if (Key=57) then proses_inc('9');
end;
end.

berikut hasil setelah di jalankan.

Semoga aja dengan penggunaa Lazarus ini dapat mengubah pemikiran kita bahwa menggunakan yang Free bisa juga untuk membuat program sesuai dengan yang kita inginkan.

Untuk mengambil lazarus silahkan download di http://sourceforge.net/projects/lazarus/files/

la kog ga da delphinya, he..he... untuk lebih lengkap baca ebook saya aja deh
SIlahkan download disini

kalau mau source kedua2nya yaitu delphi n lazarus silahkan download disini

Read more

Analisis Soal LKS Tingkat Nasional 2011

Berikut ini saya mencoba menganalisis soal LKS tingkat nasional mata lomba IT Networking Support tahun 2011. gambar diatas merupakan topologi yang diberikan panitia, dan saya mencoba analisis ip address dimana nantinya bisa berubah pada waktu lomba. dalam analisis ini menurut pengamatan saya sehingga kalau berbeda dengan kenyataan lomba bukan salah saya.
dari gambar diatas peserta di disuruh membuat:
1. Perakitan komputer Router
2. Instalasi Sistem Operasi untuk Server
3. Instalasi Sistem Operasi untuk PC router
4. Instalasi Sistem Operasi untuk Laptop
5. Networking: Pemasangan Kabel UTP dan RJ45,Instalasi dan setting Access Point
6. PC Router: Konfigurasi PC-Router, Konfigurasi Firewall
7. Konfigurasi dan Administrasi Server: DHCP, DNS, HTTP,Mail, Web Mail, FTP, Proxy, NTP
8. Troubleshooting Jaringan
dan diberi waktu 12 jam.

Analisis
1. PC router akan di rakit dengan cara membongkar dan memasangnya kembali (peserta di suruh menuliskan komponen yang ada di pc router)
2. Sistem operasi untuk server juga menggunakan debian lenny
3. sistem operasi untuk router juga sama yaitu pakai debian lenny
4. sistem oeprasi untuk laptop biasanya pakai windows (XP/7)
5. Untuk pembuatan kabel peserta di suruh membuat kabel cross dan straight, dan access point menggunakan brigde ip mendapatkan dari dhcp di server.
6. Router cuma melakukan nat dari komputer admin menuju server. dan melakukan firewall
7. server di install paket2 yang akan digunakan
8. Toruble shooting nantinya akan di lakukan kesalahan panitia kemudian peserta di suruh membetulkan.

artikel ini bersambung ke lagi (konfigurasi yang diperlukan)

Read more

Kalkun 0.3 Release

Horeeee akhirnya Kalkun 0.3 release juga, kalkun merupakan pengolahan sms dengan menggunakan web yang menggunakan gammu-smsd sehingga nantiny anda bisa memanajemen sms anda dengan tampilan GUI berbasis web. bagi yang pengen mencoba silahka download filenya disini
syaratnya anda harus memakain juga gammu untuk koneksi hp anda dan mysql sebagai database anda.
semoga aja bermanfaat.

Read more

Menterjemahkan Angka Jadi Tulisan di Libreoffice

Berikut ini akan aku share gimana cara membuat fungsi terbilang yang semula angka menjadi tulisan, misalkan kita menuliskan 1200 maka akan di tuliskan seribu dua ratus. mengapa saya menuliskan artikel ini sebenarnya pada waktu bimtek dari beberbagai skpd membuat suatu laporan keuangan yang mana semua skpd tersbut membuatnya di Microsoft Excell kemudian membuat macros dan tidak bisa berjalan di openoffice maupun libreoffice.
Untuk itu aku coba mencari cara agar hal itu bisa diaatasi. berikut langkah2nya
1. Download extension managernya disini
2. Kemudian double klik sehingga otomatis akan terinstall di openoffice maupun libreoffice
3. Kemudian jalankan spreatsheet dan anda tulisakan angka
4. kemudian untuk menjadikan angkan tersebut menjadi text tinggal menuliskan rumus

=numbertext(cellyangadaangkanya)

maka hasilnya akan terlihat (tapi dalam bahasa inggris) kalau mau berbahasa indonesia maka tuliskan rumus

=numbertext(cellyangadaangkanya,"id")

sekian dulu semoga bermanfaat

Read more

Buat Proxy Untuk Sekolahan

Kali ini saya akn menshare pembuatan proxy yang saya lakukan untuk keperluaan sekolah, akan tetapi tulisan ini bisa anda terapan di tempat usaha anda (warnet misalnya) atau perusahaan anda. untuk proxy kali ini saya gabung dengan router sehingga langsung terintegrasi router dengan proxy. langsung aja deh.
1. Install Distro Debian anda (mode text ya)
Soale kalau untuk anak tkj aku suruh buat dengan mode text, kalau untuk anda terserah deh.
2. Anda buat router lihat artikel saya ini
3. kalau sudah kita lanjutkan dengan setting proxy kita

4. Install paket

apt-get install squid

5. Stop services squid

/etc/init.d/squid stop

6. Setting squid.conf
kalau saya buat aku hapus semua dan aku ganti dengan ini

http_port 3128 transparent
icp_port 3130
udp_incoming_address 0.0.0.0
udp_outgoing_address 255.255.255.255
hierarchy_stoplist cgi-bin ?
acl QUERY urlpath_regex cgi-bin \?
no_cache deny QUERY
#PENDEFINISIAN CACHE
cache_mem 1000 MB
cache_swap_low 90
cache_swap_high 95
connect_timeout 1 minutes
negative_ttl 5 minutes
read_timeout 15 minutes
request_timeout 5 minutes
persistent_request_timeout 1 minutes
client_lifetime 5 day
pconn_timeout 120 seconds
shutdown_lifetime 30 seconds
maximum_object_size 20480 KB
minimum_object_size 0 KB
maximum_object_size_in_memory 4096 KB
ipcache_size 1024
ipcache_low 90
ipcache_high 95
fqdncache_size 1024
cache_replacement_policy lru
memory_replacement_policy lru
cache_dir ufs /var/spool/squid 50000 16 256
cache_access_log /var/log/squid/access.log
cache_log /var/log/squid/cache.log
cache_store_log /var/log/squid/store.log
log_ip_on_direct on
debug_options ALL,1
client_netmask 255.255.255.255
ftp_user Squid@
ftp_list_width 32
ftp_passive on
ftp_sanitycheck on
ftp_telnet_protocol on
redirect_children 10
auth_param basic children 10
auth_param basic realm Squid proxy-caching web server
auth_param basic credentialsttl 2 hours
auth_param basic casesensitive off
refresh_pattern ^ftp: 1440 20% 10080
refresh_pattern ^gopher: 1440 0% 1440
refresh_pattern . 0 20% 4320
quick_abort_min 16 KB
quick_abort_max 16 KB
quick_abort_pct 95
##Memblock Akses Internet dari jam 18:00 sore sampai jam 08:00 pagi
#acl not-akses time MTWHFA 00:59-07:00 18:00-24:00
##Memblock Domain terlarang
acl kata_1 dstdomain "/etc/squid/situs"
#Memblock Kata - kata terlarang
acl kata_2 url_regex -i "/etc/squid/kata"
acl all src 0.0.0.0/0.0.0.0
acl manager proto cache_object
acl localhost src 127.0.0.1/255.255.255.255
acl to_localhost dst 127.0.0.0/8
acl SSL_ports port 443 563 6667 7000
acl Safe_ports port 80
acl Safe_ports port 81
acl Safe_ports port 21
acl Safe_ports port 443 563
acl Safe_ports port 70
acl Safe_ports port 210
acl Safe_ports port 1025-65535
acl Safe_ports port 280
acl Safe_ports port 488
acl Safe_ports port 591
acl Safe_ports port 777 110
acl Safe_ports port 4461
acl Safe_ports port 5050
acl CONNECT method CONNECT
http_access deny kata_1
http_access deny kata_2
#http_access deny not-akses
http_access allow manager localhost
acl sekolahan src 192.168.100.1/25
acl bebaspakai src 192.168.100.128/25
http_access allow sekolahan
http_access allow bebaspakai
http_access deny manager
http_access deny !Safe_ports
http_access deny CONNECT !SSL_ports
http_access deny all
http_reply_access allow all
icp_access allow all
miss_access allow all
cache_mgr admin
visible_hostname xwaja.web.id
logfile_rotate 10
buffered_logs off
snmp_port 3401
snmp_access allow localhost
snmp_access deny all
snmp_access deny all
coredump_dir /var/spool/squid
ie_refresh on
##Delay pools
acl download url_regex -i ftp \.exe$ \.mp3$ \.mp4$ \.tar.gz$ \.gz$ \.tar.bz2$ \.rpm$ \.zip$ \.rar$
acl download url_regex -i \.avi$ \.mpg$ \.mpeg$ \.rm$ \.iso$ \.wav$ \.mov$ \.dat$ \.mpe$ \.mid$
acl download url_regex -i \.midi$ \.rmi$ \.wma$ \.wmv$ \.ogg$ \.ogm$ \.m1v$ \.mp2$ \.mpa$ \.wax$
acl download url_regex -i \.m3u$ \.asx$ \.wpl$ \.wmx$ \.dvr-ms$ \.snd$ \.au$ \.aif$ \.asf$ \.m2v$
acl download url_regex -i \.m2p$ \.ts$ \.tp$ \.trp$ \.div$ \.divx$ \.mod$ \.vob$ \.aob$ \.dts$
acl download url_regex -i \.ac3$ \.cda$ \.vro$ \.deb$
delay_pools 1
delay_class 1 1
delay_parameters 1 16000/16000
delay_access 1 allow download
delay_access 1 deny all

7. kita buat situs dan kata yang akan di blok
untuk situs

nano /etc/squid/situs

untuk kata

nano /etc/squid/kata

8. Membuat swap squid

squid -z

9. Konfigurasi rc.local
Beri tambahan di atas exit 0

iptables -t nat -A PREROUTING -s 192.168.78.0/24 -p tcp --dport 80 -j REDIRECT --to-ports 3128

untuk ip 192.168.78.0 diganti alamat network ip yang ke client
10. Restart pc anda

Read more

Buat router dengan debian (edisi revisi)

Study Kasus
Perusahaan memperoleh ip dari ISP yaitu 12.34.56.50/24
Kemudian perusahaan akan membuat sutau router dengan memakain ip 192.168.50.0/24
Router di buat dengan menggunakan linux debian “lenny”
Dalam hal ini saya anggap sudah bisa menginstall linux debian sehingga saya tidak akan menerangkan gimana cara installasinya.
Berikut langkah2 langkah mengkonfigurasi router:


1.Konfigurasi Interfaces network
nano /etc/network/interfaces
kemudian di tambahi berikut
auto eth0
iface eth0 inet static
address 12.34.56.1
netmask 255.255.255.0
network 12.34.56.0
broadcast 12.34.56.255
gateway 12.34.56.78
dns-nameservers 12.34.56.78

auto eth1
iface eth1 inet static
address 192.168.50.1
netmask 255.255.255.0
network 192.168.50.0
broadcast 192.168.50.255
2.Konfigurasi sysctl
nano /etc/sysctl.conf

hilangkan tanda # pada tulisan net.ipv4.ip_forward=1
3.Konfigurasi rc.local
Tambahkan sebelum exit berikut ini
Iptables –t nat –A POSTROUTING –o eth0 –j MASQUERDE

Apabila anda membangun sebuah router maka eth0 merupakan jaringan yang keluar (ke internet) sedangkan eth1 merupakan jaringan yang ke dalam (ke client). Jadi pada konfigurasi dhcp server, semua IP ke client seperti subnetnya menggunakan subnet eth1, netmasknya menggunakan netmask eth1, range ipnya didalam range IP Address eth1, option routers adalah menggunakan IP Address eth1. sedangkan untuk option domain-name-serversnya menggunakan IP Address eth0.

4.Restart pc router anda (perintahnya reboot atau init 6) apabila mau membuat proxy jangan melakukan ini dulu

Read more

Script untuk install aplikasi di linux (part 2)

Kalau yang postingan yeng terdahulu hanya di peruntukan 1 aplikasi aja sekarang aku postingkan yang lebih dari 2 aplikasi sehingga user bisa memilih sesuai keinginan.
berikut scriptnya:

cd "`dirname \"$0\"`"
namaapp="Grafis"
baca="readme.txt"
mintapass="Masukkan Password untuk melanjutkan install"
lisensi="Install Software $namaapp, silahkan digunakan dengan baik. Software yang diinsall dengan program ini merupakan program berlisensi open source sehingga anda dapat menggunakan software dengan bebas dan dapat mengembangkan software tersebut.
Karena dalam lisensi GPL yang mana software dapat didistribusikan sesuai dengan lisensi pembuat program.
kirim saran dan kritik : admin@sodikin.co.cc
Apakah akan dilanjutkan?"
berhasil="Selamat anda Sukses Menginstall $namaapp.
Silahkan anda check, apabila belum ada berarti tadi pemasukkan password salah.
Ulangi lagi dalam setup program."
/usr/bin/zenity --question --title="Install $namaapp" --text="$lisensi" --ok-label="Lanjutkan" --cancel-label="Batal"
if [ "$?" = "1" ]; then
/usr/bin/zenity --info --title="Batal" --text="Anda Membatalkan proses"
rm -f *.tmp
exit 0
fi
/usr/bin/zenity --text-info --title="Selamat datang" --width="560" --height="560" --filename="$baca"
choicess=`/usr/bin/zenity --title="Script Instalasi" --width=500 --height=450 \
--text="Silahkan pilih Salah satu" \
--list --column="Pilihan" --column="Aplikasi yang akan di install" \
--checklist FALSE "DockbarX" FALSE "Gimp" FALSE "Gnomenu" FALSE "OpenOffice" FALSE "d4x" FALSE "Audacious"`
(
echo "# Persiapan"
gksudo -m "$mintapass" "cp $baca install.tmp"
sleep .75
if [ $? -eq 0 ];
then
IFS="|"
for choicee in $choicess
do
if [ "$choicee" = "DockbarX" ];
then
#perintah ini akan membuat folder DockbarX
#kalau mau di ganti untuk instalasi maka
#anda buat folder (misal dockbarx) dalam satu folder
#kemudian anda copy kan seluruh file deb di folder tersebut
#perintah sudo mkdir DockbarX anda ganti menjadi sudo dpkg -i dockbarx/*.deb
sudo mkdir DockbarX
echo "# Install Dockbarx"
sleep .75
elif [ "$choicee" = "Gimp" ];
then
sudo mkdir Gimp
echo "# Install Gimp"
sleep .75
elif [ "$choicee" = "Gnomenu" ];
then
sudo mkdir Gnomenu
echo "# Install Gnomenu"
sleep .75
elif [ "$choicee" = "OpenOffice" ];
then
sudo mkdir OpenOffice
echo "# Install OpenOffice"
sleep .75
elif [ "$choicee" = "d4x" ];
then
sudo mkdir d4x
echo "# Install Downloader for X"
sleep .75
elif [ "$choicee" = "Audacious" ];
then
sudo mkdir Audacious
echo "# Install Audacious"
sleep .75
fi
done
IFS=""

else
if [ "$?" = "1" ]; then
/usr/bin/zenity --info --title="Batal" --text="Anda Membatalkan proses"
rm -f *.tmp
exit 0
fi
fi
) | zenity --width=400 --height=100 --progress --title="Proses instalasi" --text="" --percentage=0 --auto-close --pulsate
if [ "$?" = "1" ]; then
/usr/bin/zenity --info --title="Batal" --text="Anda Membatalkan proses"
rm -f *.tmp
exit 0
fi
zenity --info --title="Sukses" --text="$berhasil"
rm -f *.tmp

# menu untuk me-logout system
zenity --question --title="Logout" --ok-label="Ya" --cancel-label="Tidak" --text="Apakah akan me-Logout System Anda"

if [ "$?" = "0" ]; then
gnome-session-save --force-logout
fi

exit 0

sekian dulu, semoga bermanfaat

salam open source


Chung Chin

Read more

Script untuk install aplikasi di linux

script ini sebenarnya saya buat karena keinginan komunitas dalam menyebarkan aplikasi linux yang tanpa terkonek internet. kemudian sempat terpikir kalau kita gunakan dalam bentuk repo. rapi terkendala harus memasukkan repo. gimana kalau hanya 1 software atau hanya 2-5 software aja yang pengin di install user, kemudian user tanpa masuk masuk ke terminal. dari ide-ide itu maka aku coba mencxari referensi yang bisa di gunakan. sehingga muncullah script ini. berikut tampilan scriptnya:

#!/bin/bash
# Script-Installer
##########################################################################
# Install Program Jangkar #
##########################################################################
# #
# Created by Sodikin a.k.a Chung Chin #
# #
##########################################################################
cd "`dirname \"$0\"`"
# Deklarasi text yang akan di pakai
namaapp="Gambas2"
baca="readme.txt"
mintapass="Masukkan Passord untuk melanjutkan install"
lisensi="Install Software $namaapp, silahkan digunakan dengan baik. Software yang diinsall dengan program ini merupakan program berlisensi open source sehingga anda dapat menggunakan software dengan bebas dan dapat mengembangkan software tersebut.
Karena dalam lisensi GPL yang mana software dapat didistribusikan sesuai dengan lisensi pembuat program.
kirim saran dan kritik : admin@sodikin.co.cc
Apakah akan dilanjutkan?"
berhasil="Selamat anda Sukses Menginstall $namaapp.
Silahkan anda check, apabila belum ada berarti tadi pemasukkan password salah.
Ulangi lagi dalam setup program."

# pembuatan fungsi batal
function CHECKFORCANCEL {
# Cancel and Clean-up:
if [ "$?" = "1" ]; then
zenity --info --title="Batal" --text="Anda Membatalkan proses"
rm -f *.tmp
exit 0
fi
}
zenity --question --title="Install $namaapp" --text="$lisensi" --ok-label="Lanjutkan" --cancel-label="Batal"
CHECKFORCANCEL
zenity --text-info --title="Selamat datang" --width="560" --height="560" --filename="$baca"

(
# pemasukkan password pada user
echo "# Persiapan"
gksudo -m "$mintapass" "cp $baca install.tmp"
sleep .75
# melakukan install paket deb dengan metode dpkg
echo "# Install Program Aplikasi $namaapp, Silahkan di tunggu..."
sudo dpkg -i paket/*.deb
sleep .75
) | zenity --width=400 --height=100 --progress --title="Proses instalasi" --text="" --percentage=0 --auto-close --pulsate
CHECKFORCANCEL
zenity --info --title="Sukses" --text="$berhasil"
rm -f *.tmp

# menu untuk me-logout system
zenity --question --title="Logout" --ok-label="Ya" --cancel-label="Tidak" --text="Apakah akan me-Logout System Anda"

if [ "$?" = "0" ]; then
gnome-session-save --force-logout
fi

exit 0

dari script diatas anda copas aja ke gedit (text editor) kemudian anda simpan dengan nama "setup.sh" tanpa tanda kutip. kemudian anda berikan hak akses ke file anda dengan mengetik

chmod +x /[folder simpanan]/setup.sh

setelah itu anda coba jalankan dengan klik double kemudian pilih run

sekian dulu, semoga bermanfaat. saran dan kritik aku tunggu

Read more

Distro XuntuX-Lontong Edition

Rencana ke depan mau remaster distro linux mint helena 8 yang akan saya beri nama XuntuX dengan codename : Lontong Tuyuhan - Edition.
berikut wallpapernya


Mari kita canangkan Rembang Go Open Source (ReGOS)

Read more

Penghitungan Jumlah Hari kecuali hari libur

Kemarin ada teman yang nanya ke saya gimana sih caranya menghitung jumlah hari kecuali hari yang libur dan hari libur nasional. setelah sekian lama browsing ke mbah google akhirnya aku dapat menemukannya...

terima kasih telah melanjutkan
untuk source codenya akan aku upload setelah ada 15 komentar yang membangun.

salam

chung chin

Read more

Script Inno Setup untuk MYSQL dan AppServ

berikut aku buatkan script agar MYSQL yang berada di Appserv dapat terinstall kemudian adanya ODBC yang ddigunakan untuk menghubungkannya.
silahkan di baca seterusnya

; Script generated by the Inno Setup Script Wizard.
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!

#define MyAppName "Elearning"
#define MyAppVerName "Elearning 9.8"
#define MyAppPublisher "www.xwaja.co.nr"
#define MyAppURL "http://www.xwaja.co.nr/ & http://s0dikin.blogspot.com"
#define MyAppExeName "ElearningSMP.exe"

[Setup]
; NOTE: The value of AppId uniquely identifies this application.
; Do not use the same AppId value in installers for other applications.
; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)
AppId={{EDD1BECE-1CE1-4D32-84D0-B891642904AC}
AppName={#MyAppName}
AppVerName={#MyAppVerName}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
DefaultDirName={pf}\{#MyAppName}
DefaultGroupName={#MyAppName}
AllowNoIcons=yes
OutputDir=C:\InnoSetup\Elearning\Hasil
OutputBaseFilename=setup
ShowTasksTreeLines=yes
SetupIconFile=C:\InnoSetup\Elearning\conect.ico
Password=ELEARNING_2009
WizardImageFile=C:\InnoSetup\Elearning\setup5.bmp
WizardSmallImageFile=C:\InnoSetup\Elearning\setup4.bmp
Compression=lzma/max
SolidCompression=yes
LicenseFile=C:\InnoSetup\Elearning\Lisensi.txt
InfoBeforeFile=C:\InnoSetup\Elearning\Files\readme.txt
MinVersion=4.1.1998,4.00.1381

[Types]
Name: "full"; Description: "Full installation"
Name: "compact"; Description: "Compact installation"
Name: "custom"; Description: "Custom installation"; Flags: iscustom

[Components]
Name: "SERVER"; Description: "Untuk Server"; Types: full
Name: "CLIENT"; Description: "Untuk Client"; Types: full

[Languages]
Name: "id"; MessagesFile: "C:\InnoSetup\Elearning\Indonesian.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: "C:\InnoSetup\Elearning\Files\ElearningSMP.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\BuatDatabase.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\Silver.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\Aqua.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\Black.dll"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\APPSERV.EXE"; DestDir: "{app}"; Flags: ignoreversion; Components: SERVER
Source: "C:\InnoSetup\Elearning\Files\ODBC.exe"; DestDir: "{app}"; Flags: ignoreversion; Components: CLIENT
Source: "C:\InnoSetup\Elearning\Files\readme.txt"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\elearning.cc@"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\theme.cjstyles"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\cetak.cc@"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\pegawai.cc@"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\siswa.cc@"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\soal.cc@"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\msvbvm60.ocx"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\InnoSetup\Elearning\Files\VB6STKIT.DLL"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\COMCAT.DLL"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\stdole2.tlb"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\asycfilt.dll"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\olepro32.dll"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\oleaut32.dll"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\msvbvm60.dll"; DestDir: "{sys}"; Flags: uninsneveruninstall onlyifdoesntexist
Source: "C:\InnoSetup\Elearning\Files\TABCTL32.OCX"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace
Source: "C:\InnoSetup\Elearning\Files\MSDATGRD.OCX"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace
Source: "C:\InnoSetup\Elearning\Files\MSCOMCT2.OCX"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace
Source: "C:\InnoSetup\Elearning\Files\MSCOMCTL.OCX"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace
Source: "C:\InnoSetup\Elearning\Files\Codejock.CommandBars.v12.0.1.ocx"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace
Source: "C:\InnoSetup\Elearning\Files\Codejock.SkinFramework.v12.0.1.ocx"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace
Source: "C:\InnoSetup\Elearning\Files\arpro2.dll"; DestDir: "{sys}"; Flags: regserver sharedfile restartreplace


; NOTE: Don't use "Flags: ignoreversion" on any shared system files

[Icons]
Name: "{group}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"
Name: "{group}\{cm:UninstallProgram,{#MyAppName}}"; Filename: "{uninstallexe}"
Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; Tasks: desktopicon

[Run]
Filename: "{app}\APPSERV.EXE"; Description: "Menginstall MYSQL Server 5"
Filename: "{app}\ODBC.exe"; Description: "Menginstall MYSQL Connector ODBC 3.51"

silahkan di baca n di praktekan.

semoga bermanfaat.

salam

Chung Chin

Read more

Create file Cab dan Expand with VB6

jika kita akan merubah file setup windows jika file themeui.dll dibuat menjadi themeui.dl_
Program ini saya buat guna menyingkat waktu dalam mengekstrak file windows yang berektensi *.dl_ , *.cp_, *.ex_ dan lain-lainnya kemudian mengembalikan file tersebut ke bentuk semula.
Kenapa kog harus di ekstrak padahal file tersebut kan sudah ada di file windows yang sudah terinstall tinggal pakai ambil aja di c:\windows\system32 kan ga repot. He..he..
Tapi kalau anda pengin membuat modifikasi file windows tersebut dari file setup pada CD windows pasti anda akan kebingungan. Sebenarnya bisa pakai command prompt yang disediakan oleh windows tapi akan memperlama anda dalam mengetik di command prompt.
Kemudian karena aku terinspirasi dengan perintah-perintah di command prompt sehingga aku membuat program ini. Mungkin aja para master akan tertawa melihat source code yang saya kirim ini maklum newbie dalam penulisan bahasa program.

File terdiri dari
frmMain (4 label, 4 commandbutton)
modMakeFolder
CommonDialog (User Control)
Langsung aja ya. Kita tuliskan codenya
Untuk frmMain.frm
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = -1&
Dim FileNama As String
Private Sub ShellAndWait(ByVal program_name As String)
Dim process_id As Long
Dim process_handle As Long

process_id = Shell(program_name, vbHide)
DoEvents
' tunggu sampai program selesai
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
End Sub

Private Sub cmdAbout_Click()
MsgBox "Program dibuat oleh Sodikin" + Chr(13) + _
"Email : hack.chin@gmail.com" + Chr(13) + _
"Site :http://s0dikin.blogspot.com" + Chr(13) + _
"Thank for :" + Chr(13) + _
"------------------------------------------" + Chr(13) + _
"Allah SWT" + Chr(13) + _
"Bokap n Nyokap" + Chr(13) + _
"Istri Tercinta" + Chr(13) + _
"All Frinds" + Chr(13) + _
"------------------------------------------" + Chr(13) + _
"Forum : www.xcode.co.id; www.vb-bego.net", vbInformation + vbOKOnly, "About Me?"

End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdExpand_Click()
With CD
.Filter = "*.sy_, *.dl_, *.ex_, *.cp_|*.sy_;*.dl_;*.ex_;*.cp_|"
.DialogTitle = "Buka File Xwaja"
.ShowOpen
End With
txtSource.Text = CD.FileName
Label2.Caption = CD.FileTitle
txtHasil.Text = Left(CD.FileName, Len(txtSource.Text) - Len(Label2.Caption)) + "HasilExpand"
CreateDirectory txtHasil.Text, Keamanan
'buat file BAT untuk melakukan Expand
FileNama = GetSystemPath + "chungchin.bat"
Open FileNama For Output As #1
Print #1, Tab(1); "expand.exe -r " + txtSource.Text + " " + txtHasil.Text
Close #1
'Jalankan file BAT yang telah dibuat
ShellAndWait FileNama
'Hapus file BAT yang telah dibuat
Kill FileNama
MsgBox "expand file : " + txtSource.Text + Chr(13) + _
"silahkan di lihat di " + txtHasil.Text
End Sub

Private Sub cmdMakeCab_Click()
With CD
.Filter = "*.sys, *.dll, *.exe|*.sys;*.dll;*.exe|"
.DialogTitle = "Buka File BM@"
.ShowOpen
End With
txtSource.Text = CD.FileName
Label2.Caption = CD.FileTitle
Label3.Caption = Left(CD.FileName, Len(txtSource.Text) - Len(Label2.Caption)) + "HasilCab"
txtHasil.Text = Label3.Caption + "\" + Left(CD.FileTitle, Len(Label2.Caption) - 1) + "_"
CreateDirectory Label3.Caption, Keamanan
'buat file BAT untuk melakukan MakeCAB
FileNama = GetSystemPath + "chungchin.bat"
Open FileNama For Output As #1
Print #1, Tab(1); "makecab.exe " + txtSource.Text + " " + txtHasil.Text
Close #1
'Jalankan file BAT yang telah dibuat
ShellAndWait FileNama
'Hapus file BAT yang telah dibuat
Kill FileNama
MsgBox "MakeCAB file : " + txtSource.Text + Chr(13) + _
"silahkan di lihat di " + txtHasil.Text

End Sub

Kemudian anda ketikkan code ini untuk Module (modMakeFolder)
Option Explicit
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function NdamelAnak Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Keamanan As SECURITY_ATTRIBUTES
Public Sub GaweAnakManeh(Ibu As String, Anak As String)
NdamelAnak Ibu, Anak, 0
End Sub


Public Function GetSystemPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
x = GetSystemDirectory(Buffer, 255)
GetSystemPath = Left(Buffer, x) & "\"

End Function

Yang terakhir anda buat Usercontrol kemudian beri nama CommonDialog (sebernarnya bisa pakai comdlg.ocx yang sudah terinstall, tapi program ga akan portable karena harus menyertakan comdlg.ocx. tapi kalau kita buat sendiri maka program yang kita buat bisa di jalankan di semua komputer (tapi yang berbasis windows tentunya)
Langsung aja setelah buat UserControl langsung tuliskan code berikut:

Option Explicit
Private Declare Function GetOpenFileName Lib _
"COMDLG32.DLL" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib _
"COMDLG32.DLL" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

Private cdlg As OPENFILENAME
Private LastFileName As String

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10

Public Enum DialogFlags
ALLOWMULTISELECT = OFN_ALLOWMULTISELECT
CREATEPROMPT = OFN_CREATEPROMPT
ENABLEHOOK = OFN_ENABLEHOOK
ENABLETEMPLATE = OFN_ENABLETEMPLATE
ENABLETEMPLATEHANDLE = OFN_ENABLETEMPLATEHANDLE
EXPLORER = OFN_EXPLORER
EXTENSIONDIFFERENT = OFN_EXTENSIONDIFFERENT
FILEMUSTEXIST = OFN_FILEMUSTEXIST
HIDEREADONLY = OFN_HIDEREADONLY
LONGNAMES = OFN_LONGNAMES
NOCHANGEDIR = OFN_NOCHANGEDIR
NODEREFERENCELINKS = OFN_NODEREFERENCELINKS
NOLONGNAMES = OFN_NOLONGNAMES
NONETWORKBUTTON = OFN_NONETWORKBUTTON
NOREADONLYRETURN = OFN_NOREADONLYRETURN
NOTESTFILECREATE = OFN_NOTESTFILECREATE
NOVALIDATE = OFN_NOVALIDATE
OVERWRITEPROMPT = OFN_OVERWRITEPROMPT
PATHMUSTEXIST = OFN_PATHMUSTEXIST
ReadOnly = OFN_READONLY
SHAREAWARE = OFN_SHAREAWARE
SHAREFALLTHROUGH = OFN_SHAREFALLTHROUGH
SHARENOWARN = OFN_SHARENOWARN
SHAREWARN = OFN_SHAREWARN
ShowHelp = OFN_SHOWHELP
End Enum

Private CFm_CancelError As Boolean
Private CFm_DialogTitle As String
Private CFm_DefaultExt As String
Private CFm_FileName As String
Private CFm_FileTitle As String
Private CFm_Filter As String
Private CFm_Flags As DialogFlags
Private CFm_InitDir As String

Public Property Get CancelError() As Boolean
CancelError = CFm_CancelError
End Property

Public Property Let CancelError(PropVal As Boolean)
CFm_CancelError = PropVal
End Property

Public Property Get DialogTitle() As String
DialogTitle = CFm_DialogTitle
End Property

Public Property Let DialogTitle(PropVal As String)
CFm_DialogTitle = PropVal
End Property

Public Property Get DefaultExt() As String
DefaultExt = CFm_DefaultExt
End Property

Public Property Let DefaultExt(PropVal As String)
CFm_DefaultExt = PropVal
End Property

Public Property Get FileName() As String
FileName = CFm_FileName
End Property

Public Property Let FileName(PropVal As String)
CFm_FileName = PropVal
End Property

Public Property Get FileTitle() As String
FileTitle = CFm_FileTitle
End Property

Public Property Let FileTitle(PropVal As String)
CFm_FileTitle = PropVal
End Property

Public Property Get Filter() As String
Filter = CFm_Filter
End Property

Public Property Let Filter(PropVal As String)
CFm_Filter = PropVal
End Property

Public Property Get Flags() As DialogFlags
Flags = CFm_Flags
End Property

Public Property Let Flags(PropVal As DialogFlags)
CFm_Flags = PropVal
End Property

Public Property Get InitDir() As String
InitDir = CFm_InitDir
End Property

Public Property Let InitDir(PropVal As String)
CFm_InitDir = PropVal
End Property


Private Sub UserControl_Initialize()
UserControl.Height = 32 * 15
UserControl.Width = 32 * 15
End Sub

Private Sub UserControl_Resize()
UserControl.Height = 32 * 15
UserControl.Width = 32 * 15
End Sub

Public Sub ShowOpen()
Dim i As Integer
Dim flt As String, idir As String, trez As String
On Error Resume Next
flt = Replace(Filter, "|", Chr(0))

If Len(flt) = 0 Then flt = Replace("All Files (*.*)|*.*|", _
"|", Chr(0))
If Right(flt, 1) <> Chr(0) Then flt = flt & Chr(0)
If Len(InitDir) = 0 Then idir = FileName Else idir = InitDir

cdlg.hwndOwner = UserControl.Parent.hWnd
cdlg.hInstance = App.hInstance
cdlg.lpstrFilter = flt
cdlg.lpstrFile = FileName & String(255 - Len(FileName), _
Chr(0))
cdlg.nMaxFile = 256
cdlg.lpstrFileTitle = String(255, Chr(0))
cdlg.nMaxFileTitle = 256
cdlg.lpstrInitialDir = idir
cdlg.lpstrTitle = DialogTitle
cdlg.Flags = Flags
cdlg.lStructSize = Len(cdlg)
trez = IIf(GetOpenFileName(cdlg), Trim(cdlg.lpstrFile), "")

If Len(trez) > 0 Then FileName = trez: FileTitle = _
cdlg.lpstrFileTitle Else If CancelError Then _
Err.Raise -1, "CDL control", "Cancel"

End Sub

Public Sub ShowSave()

Dim i As Integer
Dim flt As String, idir As String, trez As String
On Error Resume Next
flt = Replace(Filter, "|", Chr(0))

If Len(flt) = 0 Then flt = Replace("All Files (*.*)|*.*|", _
"|", Chr(0))
If Right(flt, 1) <> Chr(0) Then flt = flt & Chr(0)
If Len(InitDir) = 0 Then idir = FileName Else idir = InitDir

cdlg.hwndOwner = UserControl.Parent.hWnd
cdlg.hInstance = App.hInstance
cdlg.lpstrFilter = flt
cdlg.lpstrFile = FileName & String(255 - Len(FileName), _
Chr(0))
cdlg.nMaxFile = 256
cdlg.lpstrFileTitle = String(255, Chr(0))
cdlg.nMaxFileTitle = 256
cdlg.lpstrInitialDir = idir
cdlg.lpstrTitle = DialogTitle
cdlg.Flags = Flags
cdlg.lStructSize = Len(cdlg)
trez = IIf(GetSaveFileName(cdlg), Trim(cdlg.lpstrFile), "")

If Len(trez) > 0 Then FileName = trez: FileTitle = _
cdlg.lpstrFileTitle Else If CancelError Then _
Err.Raise -1, "CDL control", "Cancel"

End Sub

Sudah selesai dalam penulisan silahkan aja di jalankan.
'|<<<<<<<<<<<<<..:: Programmer ::..>>>>>>>>>>>>>>|
'| Name : Sodikin |
'| site : http://s0dikin.blogspot.com |
'| email : hack.chin@gmail.com |
'| mr_hack77@yahoo.com |
'| chung_chin@joomlaku.info |
'| forum : www.xcode.or.id |
'| www.vb-bego.net |
'|<<<<<<<<<<<<<..:: End of File ::..>>>>>>>>>>>>>|

Read more

Backup mySQL dengan mysqldump

Kalau yang terdahulu saya bahas dengan membackup mysql dengan script di Visual basic sekarang akan saya bahas membackup database mysql dengan bantuan program mysqldump.exe yang merupakan bawaan dari mysql server. namun juga digabungkan dengan script2 di visual basic. Langsung aja anda kita bahas, anda harus menginstall mysql server (pati sudah terinstall kan udah punya database), kemudian anda cari program mySQLdump dan anda copykan ke folder tempat penyimpanan visual basic anda. kalau sudah langsung aja anda buat project nya.

project terdiri dari 1 project dan 1 form dan 1 commandbutton
silahkan anda copas nih kode

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = -1&
Dim FileNama As String
Sub BuatBAT()
Open App.Path + "\Backup.bat" For Output As #1
Print #1, Tab(1); "mysqldump.exe --user=root --password=dikosongi --host=localhost --databases kkpi --opt --quote-names --allow-keywords --complete-insert --add-drop-database --hex-blob> c:\kkpi.sql"
Close #1

End Sub
Private Sub ShellAndWait(ByVal program_name As String)
Dim process_id As Long
Dim process_handle As Long

process_id = Shell(program_name, vbHide)
DoEvents
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
' Reappear.
End Sub
Private Sub Command1_Click()
BuatBAT
ShellAndWait App.Path + "\Backup.bat"
kill App.Path + "\Backup.bat"
End Sub

sekian dulu semoga aja bermanfaat

chung chin

Read more

Backup dan Restore mySQL

ini merupakan source yang saya ambil dari www.pscode.com yang mana digunakan untuk membackup dan merestore database dengan mySQL sehingga bisa untuk memindahkan data mySQL. tentunya dengan visual basic juga.
silahkan lanjutkan aja

silahkan aja di copas ni kode pada module

Option Explicit

'Translate the literals if you want...
Const MSG_01 = "Dibuat Oleh: " 'created by
Const MSG_02 = "NamaDatabase: " 'database name
Const MSG_03 = "Tanggal/Waktu: " 'Data and time
Const MSG_04 = "DD/MM/YY HH:MM:SS" 'Your prefered format to display dates
Const MSG_05 = "DBMS: MySQL v"
Const MSG_06 = "Struktur Tabel " 'Table structure
Const MSG_07 = "Data Tabel " 'Table data
Const MSG_08 = "Akhir dari Backup: " 'End of backup
Public Sub MySQLBackup(ByVal strFileName As String, cnn As ADODB.Connection)
' strFileName contains the filename where you want to backup to go...
' It will overwrite the file if it exists...
' cnn is the current conection with the database...
On Error Resume Next

Dim rss As ADODB.Recordset
Dim rssAux As ADODB.Recordset

Dim X As Long, i As Integer

Dim strTableName As String
Dim strCurLine As String
Dim strBuffer As String
Dim strDBName As String

X = FreeFile
Open strFileName For Output As X

Print #X, ""
Print #X, "#"

Print #X, "# " & MSG_01 & App.Title & " v" & App.Major & "." & App.Minor & "." & App.Revision

'Looking for the database name
strDBName = Mid(cnn.ConnectionString, InStr(cnn.ConnectionString, "DATABASE=") + 9)
strDBName = Left(strDBName, InStr(strDBName, ";") - 1)
Print #X, "# " & MSG_02 & strDBName

Set rss = New ADODB.Recordset
Set rssAux = New ADODB.Recordset

'Looking for the version of MySQL
Print #X, "# " & MSG_03 & Format(Now, MSG_04)
rss.Open "show variables like 'version';", cnn
If Not rss.EOF Then
Print #X, "# " & MSG_05 & rss.Fields(1)
End If
rss.Close

'Preventing errors by foreign key violation during the restoring process
Print #X, "#"
Print #X, ""
Print #X, "SET FOREIGN_KEY_CHECKS=0;"
Print #X, ""

strTableName = ""

With rss
.Open "SHOW TABLE STATUS", cnn

'For each table...
Do While Not .EOF
strTableName = .Fields.Item("Name").Value
With rssAux
.Open "SELECT * FROM " & strTableName & "", cnn
If Not .EOF Then
Print #X, "INSERT INTO `" & strTableName & "` VALUES "

Do While Not .EOF
strCurLine = ""
For i = 0 To .Fields.Count - 1
strBuffer = .Fields.Item(i).Value

If .Fields.Item(i).Type = 131 Then
strBuffer = Replace(Format(strBuffer, "0.00"), ",", ".")
End If

'Some safe replacements...
strBuffer = Replace(strBuffer, "\", "\\")
strBuffer = Replace(strBuffer, "'", "\'")
strBuffer = Replace(strBuffer, Chr(10), "")
strBuffer = Replace(strBuffer, Chr(13), "\r\n")

If strCurLine <> "" Then
strCurLine = strCurLine & ", "
End If
strCurLine = strCurLine & "'" & strBuffer & "'"
Next i
.MoveNext

strCurLine = "(" & strCurLine & ")"
If .EOF Then
Print #X, strCurLine & ";"
Else
Print #X, strCurLine & ","
End If
Loop

End If

.Close
End With

Print #X, "unlock tables;"
Print #X, "#--------------------------------------------"

.MoveNext
Loop

'Setting the DB to its normal behavior...
Print #X, ""
Print #X, "SET FOREIGN_KEY_CHECKS=1;"
Print #X, ""
Print #X, "# " & MSG_08 & Format(Now, MSG_04)

.Close
End With

Close #X
End Sub
Public Sub MySQLRestore(ByVal strFileName As String, cnn As ADODB.Connection)
' strFileName contains the filename of the backup...
' cnn is the current conection with the database...

Dim lngTotalBytes As Long, lngCurrentBytes As Long
Dim X As Integer, strCurLine As String, strAux As String
Dim blnPassLines As Boolean
Dim blnAnalizeIt As Boolean

X = FreeFile

On Error GoTo ErrDrv

Open strFileName For Input As #X
lngTotalBytes = LOF(X)

blnPassLines = False
Do While Not EOF(X)
Line Input #X, strCurLine
lngCurrentBytes = lngCurrentBytes + Len(strCurLine)

'If you want to inform the user about the progress of the restoring process...
' do so with UpdateProgressBar (or whatever name you gave it to this function).
'Call UpdateProgressBar(lngTotalBytes, lngCurrentBytes)
'DoEvents

'Avoiding comments...
blnAnalizeIt = True
strCurLine = Trim(strCurLine)
If Not blnPassLines Then
If Left(strCurLine, 1) = "#" Then
blnAnalizeIt = False
ElseIf Left(strCurLine, 2) = "/*" Then
blnAnalizeIt = False
blnPassLines = True
End If
ElseIf Right(Trim(strCurLine), 2) = "*/" Then
blnPassLines = False
blnAnalizeIt = False
End If

'if the line should be proccessed...
If blnAnalizeIt And strCurLine <> "" Then

'Do it... Searching for a whole SQL statment
' (those with a trailing semicolon)
While Mid(strCurLine, Len(strCurLine), 1) <> ";"
strAux = strCurLine
Line Input #X, strCurLine
lngCurrentBytes = lngCurrentBytes + Len(strCurLine)
strCurLine = Trim(strCurLine)

'Call UpdateProgressBar(lngTotalBytes, lngCurrentBytes)
'DoEvents

strCurLine = strAux & strCurLine
Wend

'Execute the sentence...
cnn.Execute strCurLine
End If

'Call MyDoEvents
Loop

Close #X
'Call UpdateProgressBar(lngTotalBytes, lngTotalBytes)
HackPesan "Penambahan OK"
Exit Sub
ErrDrv:

Debug.Print "ERROR:" & Err.Number & vbNewLine & Err.Description & vbNewLine, vbCritical
Err.Clear

End Sub

nah kalau ini di taruh pada command

Call MySQLBackup(App.Path + "\Backup\backup" + Format(Now, "hhmmss") + ".sql", cn)

demikian semoga bermanfaat

Read more

Buat Program dengan tampilan pakai ribbon office2007

Udah lama ga posting karena ngoprek buat source code dengan aplikasi codejock, setelah sekian lama ngoprek akhirnya berhasil buat tampilan yang sesuai dengan keinginan.
berikut akan aku sertakan tampilannya biar semua lihat. dan untuk source codenya menyusul.



source code akan aku berikan jika ada min 10 komentar di posting ini
sebenernya nunggu sampai 10 komentar, tapi aku ga tega karena mungkin akan lama aku ga bisa OL karena sekolah udah liburan jadi ikutan libur deh. biar ga di uber2 utang ama temen-teman aku posting source codenya deh. lihat di bawah.
ni source code nya beserta ocxnya : klik disini

Read more

Buat DSN untuk database mySQL

Posting ini saya buat karena pada waktu aku buat suatu project kesulitan gimana cara memanggil database mySQL untuk di taruh report sehingga report bisa menggunakan database tersebut. akan tetapi pada waktu buat DSN di komputer langsung maka setelah aku pidah project kita di komputer lain maka DSN juga ga ikut sehingga report tidak bisa memanggil database kita.
DSN bisa dibuat dengan sendirinya. setelah gogling dan membongkar source code yang aku miliki sehingga mendapatkan source create DSn dengan fungsi API.
kali ini akan aku share source code yang telah aku buat.

pertama-tama buat dulu module yang berisi fungsi untuk menuliskan ke registry
ni sourcenya silahkan di copas

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Enum REG
HKEY_CURRENT_USER = &H80000001
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20

'Tipe Reg Key ROOT ...
Public Const ERROR_SUCCESS = 0
Public dsnDriver As String
Enum TypeStringValue
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_MULTI_SZ = 7
End Enum
Enum TypeBase
TypeHexadecimal
TypeDecimal
End Enum
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function NdamelAnak Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Public Keamanan As SECURITY_ATTRIBUTES
Public Sub GaweAnakManeh(Ibu As String, Anak As String)
NdamelAnak Ibu, Anak, 0
End Sub
Public Function NdamelTulisan(hKey As REG, Subkey As String, RTypeStringValue As TypeStringValue, strValueName As String, strData As String) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
NdamelTulisan = RegSetValueEx(ret, strValueName, 0, RTypeStringValue, ByVal strData, Len(strData))
RegCloseKey ret

End Function
Public Sub GaweDSN(dsnName As String, dsnServer As String, dsnPort As String, dsnUser As String, dsnPass As String)
If Not cekDrivermySQL(dsnDriver) Then
MsgBox "Tidak ada driver mySQL silahkan di install dulu", vbOKOnly + vbCritical, "Error.!!"
MsgBox "Program sementara di tutup", vbOKOnly + vbCritical, "Error.!!"
End
End If
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Description", "MySQL for Education"
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Database", dsnName
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Server", dsnServer
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Port", dsnPort
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "User", dsnUser
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Password", dsnPass
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Server", dsnServer
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Driver", dsnDriver
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Stmt", ""
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & dsnName, REG_SZ, "Option", ""
NdamelTulisan HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", REG_SZ, dsnName, "MySQL ODBC 3.51 Driver"
End Sub
Public Function AdaDriver(RegKeyPath As String, _
RegKeyName As String, _
ByRef RegKeyValue As String) As Boolean
Dim DoesIt As Boolean
Dim Result As Long
Dim hKey As Long
Result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, RegKeyPath, 0&, KEY_QUERY_VALUE, hKey)
If Result <> ERROR_SUCCESS Then
AdaDriver = False
Exit Function
End If
Result = RegQueryValueEx(hKey, RegKeyName, 0&, REG_SZ, ByVal RegKeyValue, Len(RegKeyValue))
RegCloseKey (hKey)


If Result <> ERROR_SUCCESS Then
AdaDriver = False
Exit Function
End If
AdaDriver = True
End Function


Public Function cekDrivermySQL(ByRef dsnDriver As String) As Boolean
Dim RegKeyPath As String
Dim RegKeyName As String
Dim RegKeyValue As String
Dim DoesIt As Boolean


DoesIt = False
'edit here to change the driver information
RegKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\MySQL ODBC 3.51 Driver"
RegKeyName = "Driver"
RegKeyValue = String(255, Chr(32))



If AdaDriver(RegKeyPath, RegKeyName, RegKeyValue) Then
dsnDriver = RegKeyValue
DoesIt = True
Else
DoesIt = False
End If

cekDrivermySQL = DoesIt
End Function

Read more

Cetak struk pakai printer star tipe cutter 2

Yang tadi ada source code yang aku buat, sekarang akan aku berikan source code dengan vb yang di buat oleh team support dari pembuat printernya (star). Silahkan di ikuti ya.... (lanjutkan aja)

source code ini di gabungkan dengan metode rawprinter yang pernah aku bahas di posting yang terdahulu. langsung aja ya ni sourcenya

Call StartPagePrinter(lhPrinter)
' Sending raw data to the printer
sWrittenData = Chr(&H1B) + Chr(&H1D) + Chr(&H61) + Chr(&H1) 'Center Alignment - Refer to Pg. 3-29
sWrittenData = sWrittenData + Chr(&H5B) + "If loaded.. Logo1 goes here" + Chr(&H5D) + vbCrLf
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H1C) + Chr(&H70) + Chr(&H1) + Chr(&H0) + vbCrLf 'Stored Logo Printing - Refer to Pg. 3-38
sWrittenData = sWrittenData + "Star Clothing Boutique" + vbCrLf
sWrittenData = sWrittenData + "1150 King Georges Post Rd." + vbCrLf
sWrittenData = sWrittenData + "Edison, NJ 08837" + vbCrLf
sWrittenData = sWrittenData + vbCrLf
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H1D) + Chr(&H61) + Chr(&H0) 'Left Alignment - Refer to Pg. 3-29
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H44) + Chr(&H2) + Chr(&H10) + Chr(&H22) + Chr(&H0) 'Setting Horizontal Tab - Pg. 3-27
sWrittenData = sWrittenData + "Date: 12/31/2008 " + Chr(&H9) + " Time: 9:10 PM" 'Moving Horizontal Tab - Pg. 3-26
sWrittenData = sWrittenData + "------------------------------------------------" + vbCrLf + vbCrLf
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H45) 'Select Emphasized Printing - Pg. 3-14
sWrittenData = sWrittenData + "SALE" + vbCrLf
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H46) 'Cencel Emphasized Printing - Pg. 3-14
sWrittenData = sWrittenData + "SKU " + Chr(&H9) + " Description " + Chr(&H9) + " Total" + vbCrLf
sWrittenData = sWrittenData + "300678566 " + Chr(&H9) + " PLAN T-SHIRT" + Chr(&H9) + " 10.99" + vbCrLf
sWrittenData = sWrittenData + "300692003 " + Chr(&H9) + " BLACK DENIM" + Chr(&H9) + " 29.99" + vbCrLf
sWrittenData = sWrittenData + "300651148 " + Chr(&H9) + " BLUE DENIM" + Chr(&H9) + " 29.99" + vbCrLf
sWrittenData = sWrittenData + "300642980 " + Chr(&H9) + " STRIPE DRESS" + Chr(&H9) + " 49.99" + vbCrLf
sWrittenData = sWrittenData + "300638471 " + Chr(&H9) + " BLACK BOOT" + Chr(&H9) + " 35.99" + vbCrLf
sWrittenData = sWrittenData + vbCrLf
sWrittenData = sWrittenData + "Subtotal " + Chr(&H9) + "" + Chr(&H9) + " 156.95" + vbCrLf
sWrittenData = sWrittenData + "Tax " + Chr(&H9) + "" + Chr(&H9) + " 00.00" + vbCrLf
sWrittenData = sWrittenData + "------------------------------------------------" + vbCrLf
sWrittenData = sWrittenData + "Total" + Chr(&H6) + "" + Chr(&H9) + Chr(&H1B) + Chr(&H69) + Chr(&H1) + Chr(&H1) + " $156.95" + vbCrLf 'Character Expansion - Pg. 3-10
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H69) + Chr(&H0) + Chr(&H0) 'Cancel Character Expansion - Pg. 3-10
sWrittenData = sWrittenData + "------------------------------------------------" + vbCrLf + vbCrLf
sWrittenData = sWrittenData + "Charge" + vbCrLf + "$159.95" + vbCrLf
sWrittenData = sWrittenData + "Visa XXXX-XXXX-XXXX-0123" + vbCrLf + vbCrLf
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H34) + "Refunds and Exchanges" + Chr(&H1B) + Chr(&H35) + vbNewLine 'Specify/Cencel White/Black Invert - Pg. 3-16
sWrittenData = sWrittenData + "Within " + Chr(&H1B) + Chr(&H2D) + Chr(&H1) + "30 days" + Chr(&H1B) + Chr(&H2D) + Chr(&H0) + " with receipt" + vbCrLf 'Specify/Cancel Underline Printing - Pg. 3-15
sWrittenData = sWrittenData + "And tags attached" + vbCrLf + vbCrLf
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H1D) + Chr(&H61) + Chr(&H1)
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H62) + Chr(&H6) + Chr(&H2) + Chr(&H2) + " 12ab34cd56" + Chr(&H1E) + vbCrLf 'Barcode - Pg. 3-39 - 3-40
sWrittenData = sWrittenData + Chr(&H1B) + Chr(&H64) + Chr(&O2) 'Cut - Pg. 3-41
sWrittenData = sWrittenData + Chr(&H7)

aku aja bngung tu untuk apa aja. hehe
buanyak kode untuk printer dot matrix
bagi yang bisa kasih komentar ya, buat sharing ilmu aja. maklum newbie tinggal copas

Read more

Cetak struk pakai printer star tipe cutter 1

Kemarin aku nyoba membuat program dengan memanfaatkan printer star aku lupa serinya tapi tipe kayak di market2 yang bisa langsung ada cutternya dan lebarnya cuma sekitar 6-8 cm. menggunakan kertas penggulung. Dulu pernah aku prosting gimana cara agar kertas berhenti sendiri dan tidak menggulung terus. tapi cara tersebut tidak bisa untuk mengatur besar kecilnya huruf. setelah browsing kesana-kemari dan mampir ke situs www.vb-bego.net di salam forumnya di bahas tapi akhirnya juga harus pakai ocx dan di komersilkan ya terpaksa sih cari-cari referensi yang lainnya. setelah cukup lama akhirnya aku menemukan gimana cara agar bisa membuat tulisannya tebal. dan aku gabungkan dengan source untuk tidak menggulung terus. silahkan di lanjutkan aja.

langsung aja aku berikan sourcenya aja ya

Open "Lpt1" For Output As #1

Print #1, Chr(27) & "@" 'mendekeksi printer
Print #1, Chr(27) & "A" & Chr(11)
Print #1, Chr(27) & "E" 'Membuat Tebal
Print #1, "Mencetak dengan ukuran 2 kali biasa"
Print #1, "Mencetak dengan ukuran 2 kali biasa"
Print #1, Chr(27) & "F" ' membuat normal kembali

Print #1, "Mencetak yang normal-normal saja"
Print #1, "Mencetak yang normal-normal saja"

Close #1

printer langsung mencetak sesuai dengan perintah dan akan berhenti sendiri deh.
source code ini aku dapat dari www.pscode.com. Terima kasih bagi yang buat.

semoga aja bermanfaat.

chung chin

Read more