JASA PEMBUATAN PROGRAM DAN SERVIS KOMPUTER LOKASI MALANG

-MENERIMA PEMBUATAN PROGRAM SEGALA JENIS SISTEM INFORMASI BAIK
UNTUK PERKANTORAN, AKUNTANSI, KOPERASI, SEKOLAH, UNTUK TUGAS TA, DLL
DENGAN MENGGUNAKAN VB, REPORT CRYSTAL REPORT 8.5 , DB MYSQL, ACCESS
dan SQL SERVER
-MENERIMA SEGALA JENIS DESAIN DAN CETAK FOTO KALENDER,BROSUR,KARTU
NAMA, KARTU UNDANGAN , DLL
-MENERIMA SERVIS KOMPUTER (INSTALL WINDOWS, PEMBERSIHAN DARI VIRUS,
PENYELAMATAN DATA) DAN INSTALASI JARINGAN KOMPUTER
-MENERIMA KONSULTASI PEMEROGRAMAN UNTUK TUGAS AKHIR
-MULAI TGL 25-06-2009 , KITA MENERIMA PEMBUATAN WEB DENGAN PHP DAN MYSQL


HARGA TERJANGKAU

HUB. HP : 085 646 471 914
HP : 081 334 406 283
MAIL : eko_matrix@yahoo.com
YM : eko_matrix



ANDA HUBUNGI KAMI DATANG

Readmore...

CREATE DSN LEWAT SCRIPT VB

Sub MakeDSN(ByVal sDSN As String, ByVal sDriver As String, _
ByVal sDBFile As String, ByVal lAction As Long)

Dim sAttributes As String
Dim sDBQ As String
Dim lngRet As Long

Dim hKey As Long
Dim regValue As String
Dim valueType As Long

' query the Registry to check whether the DSN is already installed
' open the key
If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\" & sDSN, 0, _
KEY_ALL_ACCESS, hKey) = 0 Then
' zero means no error => Retrieve value of "DBQ" key
regValue = String$(1024, 0)
' Allocate Variable Space
If RegQueryValueEx(hKey, "DBQ", 0, valueType, regValue, _
Len(regValue)) = 0 Then
' zero means OK, so we can retrieve the value
If valueType = REG_SZ Then
sDBQ = Left$(regValue, InStr(regValue, vbNullChar) - 1)
End If
End If
' close the key
RegCloseKey hKey
End If

' Perform the action only if we're adding a DSN that doesn't exist
' or removing and existing DSN
'If (sDBQ = "" And lAction = ODBC_ADD_DSN) Or (sDBQ <> "" And lAction = _
ODBC_REMOVE_DSN) Then

' check that the file actually exists
' If Len(Dir$(sDBFile)) = 0 Then
' MsgBox "Database file doesn't exist!", vbOKOnly + vbCritical
' 'Exit Sub
' End If
sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar & "PWD=" & "" & vbNullChar
lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
MDIMenu.Show
' End If
End Sub


'#########

' cara memanggilnya
'MakeDSN "Sekolah", "Microsoft Access Driver (*.mdb)", App.Path & "\database\" & "sekolah.mdb", 3 ' untuk menghapus
'MakeDSN "Sekolah", "Microsoft Access Driver (*.mdb)", App.Path & "\database\" & "sekolah.mdb", 1 ' untuk create dsn baru

Readmore...

Andai Masih ada Hari Esok

Pada suatu tempat, hiduplah seorang anak. Dia hidup dalam keluarga yang bahagia, dengan orang tua dan sanak keluarganya. Tetapi, dia selalu mengangap itu sesuatu yang wajar saja. Dia terus bermain, mengganggu adik dan kakaknya, membuat masalah bagi orang lain adalah kesukaannya. Ketika ia menyadari kesalahannya dan mau minta maaf,dia selalu berkata, "Tidak apa-apa, besok kan bisa". Ketika agak besar, sekolah sangat menyenangkan baginya. Dia belajar, mendapat teman, dan sangat bahagia.

Tetapi, dia anggap itu wajar-wajar aja.
Semua begitu saja dijalaninya sehingga dia anggap semua sudah sewajarnya. Suatu hari, dia berkelahi dengan teman baiknya. Walaupun dia tahu itu salah, tapi tidak pernah mengambil inisiatif untuk minta maaf dan berbaikan dengan teman baiknya. Alasannya, "Tidak apa-apa, besok kan bisa".

Ketika dia agak besar, teman baiknya tadi bukanlah temannya lagi.
Walaupun dia masih sering melihat temannya itu, tapi mereka tidak pernah saling tegur. Tapi itu bukanlah masalah, karena dia masih punya banyak teman baik yang lain. Dia dan teman-temannya melakukan segala sesuatu bersama-sama, main, kerjakan PR, dan jalan-jalan. Ya, mereka semua teman-temannya yang paling baik.

Setelah lulus, kerja membuatnya sibuk. Dia ketemu seorang cewek yang sangat cantik dan baik. Cewek ini kemudian menjadi pacarnya. Dia begitu sibuk dengan kerjanya, karena dia ingin dipromosikan ke posisi paling tinggi dalam waktu yang sesingkat mungkin.
Tentu, dia rindu untuk bertemu teman-temannya
Tapi dia tidak pernah lagi menghubungi mereka, bahkan lewat telepon. Dia selalu berkata, "Ah, aku capek, besok saja aku hubungin mereka". Ini tidak terlalu mengganggu dia karena dia punya teman-teman sekerja yang selalu mau diajak keluar. Jadi, waktu pun berlalu, dia lupa sama sekali untuk menelepon teman-temannya.

Setelah dia menikah dan punya anak, dia bekerja lebih keras dalam membahagiakan keluarganya. Dia tidak pernah lagi membeli bunga untuk istrinya, atau pun mengingat hari ulang tahun istrinya dan juga hari pernikahan mereka. Itu tidak masalah baginya, karena istrinya selalu mengerti dia, dan tidak pernah menyalahkannya.

Tentu, kadang-kadang dia merasa bersalah dan sangat ingin punya kesempatan untuk mengatakan pada istrinya "Aku cinta kamu", tapi dia tidak pernah melakukannya. Alasannya, "Tidak apa-apa, saya pasti besok akan mengatakannya". Dia tidak pernah sempat datang ke pesta ulang tahun anak-anaknya, tapi dia tidak tahu ini akan berpengaruh pada anak-anaknya.
Anak-anak mulai menjauhinya, dan tidak pernah benar-benar menghabiskan waktu mereka dengan ayahnya.

Suatu hari, kemalangan datang ketika istrinya tewas dalam kecelakaan, istrinya ditabrak lari. Ketika kejadian itu terjadi, dia sedang ada rapat.

Dia tidak sadar bahwa itu kecelakaan yang fatal, dia baru datang saat istrinya akan dijemput maut. Sebelum sempat berkata "Aku cintakamu..", istrinya telah meninggal dunia.

Laki-laki itu remuk hatinya dan mencoba menghibur diri melalui anak-anaknya setelah kematian istrinya. Tapi, dia baru sadar bahwa anak anaknya tidak pernah mau berkomunikasi dengannya.
Segera, anak-anaknya dewasa dan membangun keluarganya masing-masing.
Tidak ada yang peduli dengan orang tua ini, yang di masa lalunya tidak pernah meluangkan waktunya untuk mereka.

Saat mulai renta, dia pindah ke rumah jompo yang terbaik, yang menyediakan pelayanan sangat baik. Dia menggunakan uang yang semula disimpannya untuk perayaan ulang tahun pernikahan ke 50, 60, dan 70.
Semula uang itu akan dipakainya untuk pergi ke Hawaii , New Zealand ,dan negara-negara lain bersama istrinya, tapi kini dipakainya untuk membayar biaya tinggal di rumah Jompo tersebut.
Sejak itu sampai dia meninggal, hanya ada orang-orang tua dan suster yang merawatnya.Dia kini merasa sangat kesepian, perasaan yang tidak pernah dia rasakan sebelumnya.

Saat dia mau meninggal, dia memanggil seorang suster dan berkata kepadanya, "Ah, andai saja aku menyadari ini dari dulu...." Kemudian perlahan ia menghembuskan napas terakhir, dia meninggal dunia dengan airmata dipipinya.

--------------------- ^_^ ---------------------

Waktu itu nggak pernah berhenti. Kita terus maju dan maju, sebelum benar-benar menyadari, kita ternyata telah maju terlalu jauh.
Jika kita pernah bertengkar, segera berbaikanlah... !
Jika kita merasa ingin mendengar suara teman kita, jangan ragu-ragu untuk meneleponnya segera.

Terakhir, tapi ini yang paling penting, jika kita merasa kita ingin bilang sama seseorang bahwa kita sayang dan cinta dia, jangan tunggu sampai terlambat. Jika kita terus pikir bahwa kita lain hari, baru akan memberitahu dia, hari itu tidak pernah akan datang.

Jika kita selalu pikir bahwa besok akan datang, maka "besok" akan pergi begitu cepatnya hingga kita baru sadar bahwa waktu telah meninggalkan kita.

Readmore...

DUNIA PROGRAMMER FREELANCE

Tidak mudah untuk jadi programmer freelance.Lha iya tidak mudah, bagaimana mungkin suatu proyek bisa selesai on time, kalau hari-hari pengerjaan diisi dengan pergi mengantar istri ke sana, kesini, membeli ini, itu, dll. Kalau seorang istri melihat suami yang mengerjakan pekerjaan di rumahnya dan kelihatan seperti orang yang diam, tidak melakukan apa apa, hanya duduk memandangi layar komputer, dianggap sebagai objek yang bisa diminta tolong,ya dijamin deh pekerjaan tidak akan selesai selesai. Kepala sang programmer bakalan penuh dengan baris-baris program yang ditinggal sebelum berangkat mengantarkan istri. Isi kepala penuh dengan semua kondisi if-then-else yang belum ditutup, catch-exception yang masih berantakan,dll..Jangan sampai meleng di jalan, kalau melihat lampu merah seharusnya yang diinjak pedal rem tapi malah narik gas, bagaimana, bisa bikin repot kan, malah berbahaya euy..

Ada seorang teman yang menjalani hari-harinya sebagai programmer freelance. Hampir setiap hari ada di rumah, tentunya mengerjakan proyek – proyek yang harus diselesaikan sebelum batas deadline. Sepanjang hari ada di depan monitor, kecuali ya itu, kalau tidak makan, ya tidur atau sholat, atau mengantar istri/keluarga. Kemarin dia memberi tahu saya, ternyata dia dapat proyek yang harus dikerjakan on site, artinya dikerjakan di lokasi proyek. Bisa di perusahaan pemberi proyek, bisa di rumah bos proyek tsb, atau lokasi lain yang sudah disetujui antara mereka, yang jelas bukan di rumah. Teman saya itu bilang, ternyata bekerja di luar rumah bisa lebih fokus ke pekerjaan, full time mengerjakan proyek dari pagi sampai sore. Tidak ada yang ‘mengganggu’. Dan yang lebih enak lagi, komunikasi antara programmer dan user, bisa lebih cepat. Bisa lebih menghasilkan solusi yang lebih jitu untuk digunakan pada saat pembuatan program.

Selama ini saya merasa, kalau bekerja di rumah akan lebih enak daripada kerja di luar rumah. Salah satu alasan yang sering saya pakai, bisa lebih menyediakan waktu untuk keluarga. Keluarga adalah nomor satu dalam hidup saya, baru setelahnya adalah pekerjaan. Tapi, kalau kejadiannya seperti yang dialami teman saya itu, wah repot juga ya, bisa hilang deh kepercayaan antara programmer yang mengimplementasikan dan user yang berharap selesai sesuai waktunya. Jangankan teman saya, wong istri telepon mengabarkan kondisi badannya tidak enak badan saja, atmosfir di kantor jadi berubah seperti badai calamity yang memporak-porandakan seisi kota. Apalagi kalau saya ada di rumah dan langsung melihat raut muka istri/keluarga yang sakit, tidak perlu ada kata-kata, yang ada saya mungkin bisa langsung pergi ke rumah sakit mengantarkan berobat. Benar-benar bayangan yang ekstrim yang pernah saya bayangkan tentang bekerja secara freelance.

Kalau membayangkan yang buruk-buruk dahulu sebelum kita menjalaninya, biasanya hasilnya seperti yang dibayangkan itu, buruk hasil akhirnya. Tapi kalau penuh rasa optimis, tanpa kehilangan kaki yang berpijak pada realita, berani ambil resiko setelah ditimbang dengan matang untuk resiko paling kecil yang akan diambil, saya yakin apapun cita-cita kita/saya/anda semua, pasti bisa kita raih. Raih kemenangan atau kekalahan adalah sama saja. Karena orang bilang, kekalahan adalah kemenangan yang tertunda. Tapi koq rasa-rasanya saya belum siap menerima kekalahan. Masih belum bisa 100% ikhlas menerima keputusanNya.

Readmore...

PROGRAMMER FREELANCE

Dunia programmer lepas (freelance)? Ini serius! Saat ini banyak perusahaan yang membutuhkan programmer tetapi tidak ingin merekrutnya sebagai pegawai tetap. Sebenarnya fenomena ini bukan berkembang belakangan ini, tetapi sudah bertahun-tahun yang lalu. Tetapi memang kejadiannya banyak di negara maju. Dan fenomena ini kini sudah merasuk ke Indonesia.

Di negara maju tenaga ahli memang sangat mahal. Hitungannya per jam, bukan per bulan layaknya di Indonesia. Tahun kemarin rata-rata harga per jam programmer senior freelance kurang-lebih US$ 10 per jam. Sedangkan programmer junior antara US$ 5-8 per jam. Coba saja kalikan dengan 40 jam, maka Anda akan mendapatkan angka US$ 400. Ini kurang lebih Rp 3,6 juta jika kursnya Rp 9.000 per dolar. Mengapa saya kalikan dengan 40 jam? Anda yang berprofesi sebagai karyawan pasti tahu maksudnya angka 40 jam ini. Yap betul, ini adalah jam kerja karyawan Indonesia selama 1 minggu.

Artinya adalah bahwa Anda cukup bekerja full-day seminggu untuk mendapatkan honor Rp 3,6 juta. Angka yang besar? Tidak! Ini belum besar. Anda masih bisa memanfaatkan 3-4 minggu sisanya selama sebulan untuk meraup angka yang lebih banyak. Dan angka ini bisa menjadi berlipat kalau Anda dapat bekerja dengan efektif dan efisien. Misalnya jika Anda mendapatkan sebuah proyek membuat program yang jatahnya adalah 100 jam tetapi Anda dapat menyelesaikannya hanya dalam kurun waktu 50 jam, maka Anda tetap akan mendapatkan honor 100 jam. Dan Anda telah menghemat 50 jam dari jam kerja Anda.

Tertarik?

Readmore...

konversi angka biasa ke romawi (vb)

Function Romawi(roma As Integer) As String

Dim keluar As String

keluar = String(Int(roma / 1000), "M")
roma = roma - (Int(roma / 1000) * 1000)

If roma >= 900 Then
keluar = keluar & "CM"
ElseIf roma >= 500 And roma < 900 Then
keluar = keluar & "D" & String(Int((roma - 500) / 100), "C")
ElseIf roma >= 400 And roma < 500 Then
keluar = keluar & "CD"
Else
keluar = keluar & String(Int(roma / 100), "C")
End If
roma = roma - (Int(roma / 100) * 100)


If roma >= 90 Then
keluar = keluar & "XC"
ElseIf roma >= 50 And roma < 90 Then
keluar = keluar & "L" & String(Int((roma - 50) / 10), "X")
ElseIf roma >= 40 And roma < 50 Then
keluar = keluar & "XL"
Else
keluar = keluar & String(Int(roma / 10), "X")
End If
roma = roma - (Int(roma / 10) * 10)


If roma >= 9 Then
keluar = keluar & "IX"
ElseIf roma >= 5 And roma < 9 Then
keluar = keluar & "V" & String(Int((roma - 5) / 1), "I")
ElseIf roma >= 4 And roma < 5 Then
keluar = keluar & "IV"
Else
keluar = keluar & String(Int(roma / 1), "I")
End If
Romawi = keluar
End Function

Readmore...

Mendapatkan tanggal dan jam server

'***************************************************************************

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Const NERR_SUCCESS = 0&
Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2

Private Type TIME_OF_DAY_INFO
tod_elapsedt As Long
tod_msecs As Long
tod_hours As Long
tod_mins As Long
tod_secs As Long
tod_hunds As Long
tod_timezone As Long
tod_tinterval As Long
tod_day As Long
tod_month As Long
tod_year As Long
tod_weekday As Long
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
bias As Long
StandardName(0 To 63) As Byte 'unicode (0-based)
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(0 To 63) As Byte 'unicode (0-based)
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type

Private Declare Function NetRemoteTOD Lib "Netapi32" _
(UncServerName As Byte, _
BufferPtr As Long) As Long

Private Declare Function NetApiBufferFree Lib "Netapi32" _
(ByVal lpBuffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, _
ByVal lSize As Long)

Private Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION, _
lpUniversalTime As SYSTEMTIME, _
lpLocalTime As SYSTEMTIME) As Long
Function GetDateTimeServer(Server As String) As String
Dim server_date As TIME_OF_DAY_INFO
Dim sServer As String, NewTime As String
server_date = GetRemoteTOD("\\" & Server)
NewTime = DateAdd("s", server_date.tod_elapsedt, #1/1/1970#)
NewTime = DateAdd("n", -server_date.tod_timezone, NewTime)
GetDateTimeServer = NewTime

'DisplayData server_date
End Function
Private Function GetRemoteTOD(ByVal sServer As String) As TIME_OF_DAY_INFO

Dim success As Long
Dim bServer() As Byte
Dim tod As TIME_OF_DAY_INFO
Dim systime_utc As SYSTEMTIME
Dim systime_local As SYSTEMTIME
Dim tzi As TIME_ZONE_INFORMATION
Dim bufptr As Long

If sServer <> vbNullChar Then
If Left$(sServer, 2) <> "\\" Then
bServer = "\\" & sServer & vbNullChar
Else: bServer = sServer & vbNullChar
End If

Else

bServer = sServer & vbNullChar

End If

If NetRemoteTOD(bServer(0), bufptr) = NERR_SUCCESS Then

CopyMemory tod, ByVal bufptr, LenB(tod)
Call GetTimeZoneInformation(tzi)

With systime_utc
.wDay = tod.tod_day
.wDayOfWeek = tod.tod_weekday
.wMonth = tod.tod_month
.wYear = tod.tod_year
.wHour = tod.tod_hours
.wMinute = tod.tod_mins
.wSecond = tod.tod_secs
End With

Call SystemTimeToTzSpecificLocalTime(tzi, systime_utc, systime_local)

With tod
.tod_mins = systime_local.wMinute
.tod_hours = systime_local.wHour
.tod_secs = systime_local.wSecond
.tod_day = systime_local.wDay
.tod_month = systime_local.wMonth
.tod_year = systime_local.wYear
.tod_weekday = systime_local.wDayOfWeek
End With

End If

Call NetApiBufferFree(bufptr)
GetRemoteTOD = tod

End Function

Function GetCom() As String ' untuk mendaptakan nama komputer lokal
Dim dwLen As Long
Dim strString As String
dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, "X")
GetComputerName strString, dwLen
strString = Left(strString, dwLen)
GetCom = strString
End Function


Private Sub Form_Load()
MsgBox GetDateTimeServer("ekoaja") ' bisa diganti sesuai dengan nama/ip komputer server
End Sub

Readmore...

Mengurangi Kelemahan SQL (Sql Injection)

Kali ini kami akan memberitahukan rekan-rekan, khusunya yang baru belajar pemograman yang ada sangkut-
pautnya dengan penggunaan database dan Query.

Penggunaan query sangatlah memudahkan para programmer untuk menampilkan informasi apapun, disertai
dengan berbagai macam kriteria didalamnya guna menunjang kebutuhan. Tapi hal ini tidak dapat berlangsung
lama, dikarenakan beberapa waktu lalu penggunaan query sempat digunakan para hacker maupun cracker
untuk masuk ke dalam sebuah system. Kenapa bisa demikian?

Pasti anda ingat! setiap kali kita menuliskan sebuah kriteria pada baris perintah SQL selalu ditambahkan
tanda kutip ('), sebagai contoh:

SELECT Users.Login, Users.Password From Users Where (Users.Login='eko') And (Users.Password='123')

Kalo anda perhatikan perintah diatas, biasanya script tsb digunakan untuk memeriksa nama login dan
password pada tabel. jika tersedia maka kita dapat masuk ke sebuah aplikasi ataupun situs.
Bagaimana kalo kita bukan member dan ingin masuk ke sebuah system?

Sebelum masalah ini ditemukan dan dibahas oleh para pakar, Untuk masuk kesebuah system walupun
bukan user ataupun member, kita dapat memanfaatkan kelemahan system dengan cara memasukan beberapa
perintah SQL kedalam aplikasi tsb atau istilah kerennya sering disebut SQL Injection.
SQL Injection ini sering digunakan pada salah satu system yang menggunakan database, seperti
Ms.SQL, Oracle, Ms.Access dlll.

sebagai contoh biasanya untuk masuk ke sebuah situs tertentu, kita sering diminta memasukan nama user
dan password.

varlogin = "eko"
varPwd = "123"

sql= "SELECT Users.Login, Users.Password From Users Where (Users.Login='" & varlogin & "') And " & _
(Users.Password='" & varPwd & "')"

Kalo baris perintah diatas dieksekusi maka akan berjalan normal dan apabila user dan passwordnya
tersedia maka dapat masuk ke sistem. Dan akan ditolak apabila salah.
Beda halnya dengan script berikut:

varlogin = "eko' OR 'A'='A"
varPwd = "123' OR 'B'='B"

sql= "SELECT Users.Login, Users.Password From Users Where (Users.Login='" & varlogin & "') And " & _
(Users.Password='" & varPwd & "')"

Jika di eksekusi script tersebut maka kita dapat masuk ke sebuah system, walaupun user dan password
yang kita masukan salah. Kenapa bisa demikian? coba lihat nama login dan password yang dimasukan:
==> eko' OR 'A'='A
==> 123' OR 'B'='B

kalo kita gabungkan dengan script yang dibuat maka akan menjadi:
SELECT Users.Login, Users.Password From Users Where (Users.Login='eko' OR 'A'='A') And
(Users.Password='123' OR 'B'='B')

Karena telah ditambahkan script SQL melalui inputan maka kita dapat masuk kapanpun pada system
tersebut. Masih banyak script yang dapat dikombinasikan seperti UNION, HAVING dll...

Untuk menghindari kejadian diatas kita harus membuat fungsi untuk mengindari SQL Injection tersebut
salah satu contoh fungsi tersebut ialah:

Function AllowChar(SQLStr As String) As String
Dim I As Integer, splitStr,NotAllowCharSet as string
NotAllowCharSet= " ' UNION SELECT ; -- | OR AND "
splitStr = Split(NotAllowCharSet, " ")
For I = 0 To UBound(splitStr)
If splitStr(I) = "'" Then
SQLStr = Replace(SQLStr, splitStr(I), "`")
Else
SQLStr = Replace(SQLStr, splitStr(I), "")
End If
Next I
AllowChar = SQLStr
End Function

Anda bisa mengembangkan fungsi diatas sesuai kebutuhan.
Semoga dapat menambah pengetahuan rekan-rekan, khususnya bagi yang baru belajar visual basic

Salam,....

Readmore...

MENYEMBUNYIKAN APLIKASI ANDA DARI JENDELA TASK MANAGER, (cocok bgi yng mo bikin virus, hueheheheh..)

DECLARATIONS :

Option Explicit
Private Const RSP_SIMPLE_SERVICE = 1
Private Const RSP_UNREGISTER_SERVICE = 0

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

KODE


Private Sub HideApp(lbValue As Boolean)
Dim lngProcessID As Long
Dim lngReturn As Long
lngProcessID = GetCurrentProcessId()
If lbValue Then
lngReturn = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
Else
lngReturn = RegisterServiceProcess(pid, RSP_UNREGISTER_SERVICE)
End If
End Sub

Readmore...

Pencarian data dalam combo secara cepat (Script Vb)

'// membutuhkan 1 Combobox
'By: eko cahyono Ym:eko_matrix
Private cekKey As Boolean

Private Sub Combo1_Change()
Static ChangeFlag As Boolean
Dim cboText As String
Dim lencboText As Integer
Dim tmpLen As Integer
Dim tmp As Integer

If Not ChangeFlag Then
cboText = Combo1.Text
lencboText = Len(Combo1.Text)
If Not cekKey Then
For tmp = 0 To Combo1.ListCount - 1
If UCase(Left(Combo1.Text, Combo1.SelStart)) = UCase _
(Combo1.List(tmp)) Then
ChangeFlag = True
Combo1.Text = Combo1.List(tmp)
Combo1.SelStart = Len(Combo1.Text)
ChangeFlag = False
cekKey = False
Exit Sub
End If
Next tmp

If lencboText > 0 Then
For tmp = 0 To Combo1.ListCount - 1
If UCase(Left(Combo1.List(tmp), _
lencboText)) = UCase(cboText) Then
tmpLen = lencboText
ChangeFlag = True
Combo1.Text = Combo1.List(tmp)
Combo1.SelStart = tmpLen
Combo1.SelLength = Len(Combo1.List( _
tmp)) - tmpLen
ChangeFlag = False
Exit For
End If
Next tmp
End If
End If
cekKey = False
End If
End Sub

Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyDelete) Or (KeyCode = vbKeyBack) Then
cekKey = True
End If
End Sub

Readmore...

Membuat semua control di form menjadi flat (Scrip VB)

Option Explicit
'By : Eko cahyono Ym: eko_matrix
Const GWL_EXSTYLE = (-20)
Const WS_EX_CLIENTEDGE = &H200
Const WS_EX_STATICEDGE = &H20000
Const SWP_FRAMECHANGED = &H20
Const SWP_NOZORDER = &H4

Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40

Private Declare Sub SetWindowPos Lib "user32" (ByVal HWND As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As _
Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal HWND As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal HWND As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long


Public Sub FlatStyle(ByVal HWND As Long)
Dim oStyle As Long
oStyle = GetWindowLong(HWND, GWL_EXSTYLE)
oStyle = oStyle And Not WS_EX_CLIENTEDGE Or WS_EX_STATICEDGE
SetWindowLong HWND, GWL_EXSTYLE, oStyle
SetWindowPos HWND, 0, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOZORDER Or _
SWP_FRAMECHANGED Or SWP_NOSIZE Or SWP_NOMOVE
End Sub

Private Sub Form_Load()
'Sediakan beberapa objek spt (Picture1,List1,Text1,Command1, dll...)
'Panggil fungsi seperti ini dengan parameter HWND setiap objek
'########################
'FlatStyle Form1.HWND
'FlatStyle Command1.HWND
'FlatStyle List1.HWND
'FlatStyle Picture1.HWND
'FlatStyle Text1.HWND





'apabila ingin otomatis untuk semua objek di form
'bisa pake fungsi berikut:
'#####################
On Error Resume Next
Dim cc As Control
For Each cc In Me.Controls
FlatStyle cc.HWND
Next

End Sub

Readmore...

Update antivirus Symantec Terbaru

Download di link ini:
http://securityresponse.symantec.com/avcenter/download/pages/US-N95.html

MENERIMA JASA PEMBUATAN PROGRAM SISTEM INFORMASI DENGAN VISUAL BASIC

Readmore...

Peryataan yang membunuh (killer statement)

Suatu ketika saya kursus menyetir mobil agar mampu berkendara. saya mengambil waktu hanya untuk 6 jam , melihat lambatnya saya belajar, sang instruktur berucap "walaupun sampai 20 jam , anda nggak akan terampil menyetir ". andai saya terpengaruh oleh Killer statment(peryataan yang membunuh) seperti itu . saya yakin sampai sekarang saya tidak akan duduk di kursi pengemudi mobil.untung saja ketajaman peryataan itu tidak terlalu menggangu pikiran saya.
Apa itu killer sttement? gampangnya, killer statment itu adalah segala bentuk peryataan yang diucap,yang sadar or tidak , akan melukai dan merusak mental maupun semangat orang lain.

Readmore...

Mematikan Monitor Dengan Fungsi SendMessage

'siapkan form dengan nama form1
' Command dengan nama Command1
' timer dengan nama timer1

Option Explicit

Private Const MONITOR_ON = -1&
Private Const MONITOR_LOWPOWER = 1&
Private Const MONITOR_OFF = 2&
Private Const SC_MONITORPOWER = &HF170&
Private Const WM_SYSCOMMAND = &H112

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long


Private Sub Form_Load()
Command1.Caption = "Turn off monitors"
End Sub


Private Sub Command1_Click()
Call SendMessage(Me.hWnd, WM_SYSCOMMAND, _
SC_MONITORPOWER, ByVal MONITOR_OFF)
With Timer1
.Interval = 8000
.Enabled = True
End With
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
Call SendMessage(Me.hWnd, WM_SYSCOMMAND, _
SC_MONITORPOWER, ByVal MONITOR_ON)
End Sub


Readmore...

mendapatkan nama komputer(Script VB)

Option Explicit
'BY Eko cahyono (YM: eko_matrix)
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&

Private Const SV_TYPE_WORKSTATION As Long = &H1
Private Const SV_TYPE_SERVER As Long = &H2
Private Const SV_TYPE_SQLSERVER As Long = &H4
Private Const SV_TYPE_DOMAIN_CTRL As Long = &H8
Private Const SV_TYPE_DOMAIN_BAKCTRL As Long = &H10
Private Const SV_TYPE_TIME_SOURCE As Long = &H20
Private Const SV_TYPE_AFP As Long = &H40
Private Const SV_TYPE_NOVELL As Long = &H80
Private Const SV_TYPE_DOMAIN_MEMBER As Long = &H100
Private Const SV_TYPE_PRINTQ_SERVER As Long = &H200
Private Const SV_TYPE_DIALIN_SERVER As Long = &H400
Private Const SV_TYPE_XENIX_SERVER As Long = &H800
Private Const SV_TYPE_SERVER_UNIX As Long = SV_TYPE_XENIX_SERVER
Private Const SV_TYPE_NT As Long = &H1000
Private Const SV_TYPE_WFW As Long = &H2000
Private Const SV_TYPE_SERVER_MFPN As Long = &H4000
Private Const SV_TYPE_SERVER_NT As Long = &H8000
Private Const SV_TYPE_POTENTIAL_BROWSER As Long = &H10000
Private Const SV_TYPE_BACKUP_BROWSER As Long = &H20000
Private Const SV_TYPE_MASTER_BROWSER As Long = &H40000
Private Const SV_TYPE_DOMAIN_MASTER As Long = &H80000
Private Const SV_TYPE_SERVER_OSF As Long = &H100000
Private Const SV_TYPE_SERVER_VMS As Long = &H200000
Private Const SV_TYPE_WINDOWS As Long = &H400000 'Windows95 and above
Private Const SV_TYPE_DFS As Long = &H800000 'Root of a DFS tree
Private Const SV_TYPE_CLUSTER_NT As Long = &H1000000 'NT Cluster
Private Const SV_TYPE_TERMINALSERVER As Long = &H2000000 'Terminal Server
Private Const SV_TYPE_DCE As Long = &H10000000 'IBM DSS
Private Const SV_TYPE_ALTERNATE_XPORT As Long = &H20000000 'rtn alternate transport
Private Const SV_TYPE_LOCAL_LIST_ONLY As Long = &H40000000 'rtn local only
Private Const SV_TYPE_DOMAIN_ENUM As Long = &H80000000
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF

Private Const SV_PLATFORM_ID_OS2 As Long = 400
Private Const SV_PLATFORM_ID_NT As Long = 500

'Mask applied to svX_version_major in
'order to obtain the major version number.
Private Const MAJOR_VERSION_MASK As Long = &HF

Private Type SERVER_INFO_100
sv100_platform_id As Long
sv100_name As Long
End Type

Private Declare Function NetServerEnum Lib "netapi32" _
(ByVal servername As Long, _
ByVal level As Long, _
buf As Any, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal servertype As Long, _
ByVal domain As Long, _
resume_handle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32" _
(ByVal Buffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, _
ByVal lSize As Long)

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long


Private Function GetServers() As Long
Dim bufptr As Long
Dim dwEntriesread As Long
Dim dwTotalentries As Long
Dim dwResumehandle As Long
Dim se100 As SERVER_INFO_100
Dim success As Long
Dim nStructSize As Long
Dim cnt As Long
Dim hslNm As String
nStructSize = LenB(se100)
success = NetServerEnum(0&, _
100, _
bufptr, _
MAX_PREFERRED_LENGTH, _
dwEntriesread, _
dwTotalentries, _
SV_TYPE_ALL, _
0&, _
dwResumehandle)

If success = NERR_SUCCESS And _
success <> ERROR_MORE_DATA Then
For cnt = 0 To dwEntriesread - 1
CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
hslNm = hslNm & GetPointerToByteStringW(se100.sv100_name) & vbNewLine
Next
End If
Call NetApiBufferFree(bufptr)

GetServers = dwEntriesread
MsgBox hslNm

End Function

Public Function GetPointerToByteStringW(ByVal dwData As Long) As String

Dim tmp() As Byte
Dim tmplen As Long

If dwData <> 0 Then

tmplen = lstrlenW(dwData) * 2

If tmplen <> 0 Then

ReDim tmp(0 To (tmplen - 1)) As Byte
CopyMemory tmp(0), ByVal dwData, tmplen
GetPointerToByteStringW = tmp

End If

End If

End Function

Private Sub Form_Load()
Call GetServers
End Sub

Readmore...

Membersihkan TextBox secara cepat di visual basic


Public Sub ClearTextBoxes(frmClearMe As Form)
Dim txt As Control
For Each txt In frmClearMe
If TypeOf txt Is TextBox Then txt.Text = ""
Next
End Sub

Untuk penggunaan dapat dilakukan sbb:

ClearTextBoxes Form1

Readmore...

Menganti passwordXP (Script VB)

Sub GantiPasswXp(NmKom As String, xUser As String, NewPasw As String)
Dim nu As String
Dim pass As String
Dim nk As String

winfolder = Environ$("windir")
nk = NmKom ' nama komputer
nu = xUser ' user yg ingin passwoenya d ganti
pass = NewPasw ' password baru

vbsevil = winfolder & "\change.vbs"

f = FreeFile
Open vbsevil For Output As #f
Print #f, "Change_Password()"
Print #f, "sub Change_Password()"
Print #f, "Dim usern, compn, Z, npassword"
Print #f, "compn = " & Chr(34) & nk & Chr(34)
Print #f, "usern = " & Chr(34) & nu & Chr(34)
Print #f, "If Err.Number = 0 Then"
Print #f, "Set Z=GetObject(" & Chr(34) & "WinNT://" & Chr(34) & "&compn&" & _
Chr(34) & "/" & Chr(34) & "&usern&" & Chr(34) & Chr(34) & ",Z)"
Print #f, "End If"
Print #f, "npassword = " & Chr(34) & pass & Chr(34)
Print #f, "If Err.Number = 0 Then"
Print #f, "Call Z.SetPassword(npassword)"
Print #f, "End If"
Print #f, "End Sub"
Print #f,
Close #f

Shell "C:\Windows\System32\WScript.exe " & vbsevil

MsgBox "Password user " + Chr(34) + nu + Chr(34) + vbCrLf + _
"Berhasil diganti dengan " + Chr(34) + pass + Chr(34), _
vbInformation, "[k]reZeK - XP Password Changer"

Kill vbsevil
End Sub

Readmore...

Jebol password MYOB ( Script VB)

'uji coba hanya pada MYob ver 10.5
Option Explicit

Private Sub Form_Load()
Dim pwd As String
pwd = GetMyOBPWD("E:\vbBego\myob\test.dat")'ganti dengan alamat path MYob yg
' ada passwx
If pwd <> "" Then
MsgBox "Password: " & pwd, 64, "vbBego"
Else
MsgBox "Tidak ber Password", 16, "vbBego"
End If
End Sub


Function GetMyOBPWD(hFile As String) As String
Dim Head
Dim I As Integer
Dim PosKey As String
Dim inFile As Long
Dim nLoop As Long
Dim isiDok As String * 1000
Dim Pos1 As Long
Dim posChar As String
Dim resPwd As String
Dim tmpPWD As String

Head = Split("8D 96 9D 95 8D 96 9D 95 8D 96 9D", " ")
PosKey = Chr(&H0) & Chr(&H1C) & Chr(&H0) & Chr(&H1) & _
String(9, Chr(0)) & Chr(1) & Chr(0)
inFile = FileLen(hFile)
Open hFile For Binary Access Read As #1
For nLoop = 1 To inFile Step 1024
Get #1, nLoop, isiDok
DoEvents
Pos1 = InStr(1, isiDok, PosKey, vbBinaryCompare)
If Pos1 Then
Dim H As String * 11
Get #1, nLoop + Pos1 + 68, H
For I = 1 To Len(H)
posChar = Mid(H, I, 1)
If Asc(posChar) > 0 Then
If Asc(posChar) > "&H" & Head(I - 1) Then
resPwd = resPwd & Chr(Asc(posChar) - Val( _
"&H" & Head(I - 1)))
Else
resPwd = resPwd & Chr(Asc(posChar) + (255 - Val( _
"&H" & Head(I - 1))))
End If
End If
Next I
tmpPWD = resPwd
resPwd = ""
End If
isiDok = ""
Next nLoop
Close #1
GetMyOBPWD = tmpPWD
End Function

Readmore...

Bisnis mendapatkan dolar dengan memanfaakan online di internet

Gabung dengan indoptc, dengan gabung dengan indoptc anda akan mendapatkan account dan daftar iklan(di menu Surf Ads) yang harus anda klik untuk mendapatkan dolar.dolar yang anda dapatkan akan dapat ditransfer ke rekening bank anda. dan untuk daftar situs ini ada tidak perlu mengelurkan uang sedikitpun(gratis)
Link daftar http://www.indoptc.com/?r=eko_bisnis84

SELAMAT BERGABUNG DAN BERBISNIS DI INTERNET

Readmore...

Script crack Passw MS access

Option Explicit
'by Eko cahyono (mail : eko_matrix)
Function GetMs97(Filename As String) As String ' Filename=alamt pathnya
'di procedure ini kita akan mencoba mengetahui password untuk
'ms.access 97 terlebih dahulu

'kita buat variable array sebanyak 20 dengan tipe byte.
'kenapa harus 20? Ini disebabkan panjang maximal password
'access adalah 20.

Dim data(0 To 19) As Byte, Pwd As String
Dim hasil As String
'Sekarang kita buka dan ambil data dari file yang akan di crack
'passwordnya.
Open Filename For Binary As #1
'Kita ambil data mulai dari posisi 67.
'kenapa harus pd posisi 67? Ini dikarenakan password yang disimpan
'oleh ms.access ada pada posisi tersebut
Get #1, 67, data
Close #1

Dim MaxSize, I As Integer, TempPwd
Dim EncDec As String, nKey
'untuk enskripsi dibawah ini, saya tidak bisa menjelaskannya.
'Karena terlalu panjang utk dijelaskan. Enskripsi ini hasil penelitian saya
'jadi anda tinggal pake aja OK!

'Panjang keseluruhan enskripsi ini tentunya sama dengan panjang max password (20).
'Kemudian kita split ke variable nKey.
EncDec = "86 FB EC 37 5D 44 9C FA C6 5E 28 E6 13 B6 8A 60 54 94 7B 36"
nKey = Split(EncDec, " ")


Dim spos As Integer
'Nah sekarang kita gunakan metode/fungsi XOR untuk mendapatkan password aslinya
'Nilai yang ada pada variable data, dibandingkan dengan nilai enskripsinya.
For I = 0 To 19
TempPwd = TempPwd & Chr(data(I) Xor ("&H" & nKey(spos)))
'var ini digunakan untuk mengetahui panjang password yang ada pd file yang dicrack.
spos = spos + 1
Next I


'hasilnya kita cetak ke Hasil
Dim inLen As Integer
inLen = InStr(1, TempPwd, Chr(0))
hasil = "Nama File: " & Filename & vbCrLf & _
"Ukuran : " & FileLen(Filename) & " bytes" & vbCrLf & _
"Panjang password: " & IIf(inLen = 0, 20, inLen - 1) & vbCrLf & _
"---------------------" & vbCrLf & _
TempPwd
GetMs97 = hasil
End Function

'Nah sekarang kita coba untuk access 2000/xp
Function GetMs2000XP(Filename As String) As String ' Filename=alamt pathnya
'kita buat variable array sebanyak 40 dengan tipe byte.
'kenapa harus 40? Ini disebabkan panjang maximal password
'access adalah 20, kemudian dikalikan 2 maka hasilnya 40.

Dim data(39) As Byte, cek As Byte, hasil As String
Open Filename For Binary As #1
'Kita ambil data mulai dari posisi 67.
'kenapa harus pd posisi 67? Ini dikarenakan password yang disimpan
'oleh ms.access ada pada posisi tersebut
Get #1, 67, data
Get #1, 151, cek
Close #1

'Sebelum melanjutkan mecrack 2000, kita periksa dahulu versi dari file tersebut
'jika versinya 97 maka kita panggil prosedur GetMs97 dan keluar dari rutin 2000
If cek = 0 Then
GetMs2000XP = GetMs97(Filename)
Exit Function
End If
'Kita buat var2 pendukung
Dim EncDec As String
Dim I As Integer
Dim H As Integer, nKey
Dim nHex As String
Dim Pwd As String

'untuk enskripsi dibawah ini, saya tidak bisa menjelaskannya.
'Karena terlalu panjang utk dijelaskan. Enskripsi ini hasil penelitian saya
'jadi anda tinggal pake aja OK!

'Tentunya enskripsi berikut berbeda dengan enskripsi untuk msa97
EncDec = "00 EC DB 9C 40 28 95 8A D2 7B 73 DF F1 13 49 B1 B2 79 14 7C"
nKey = Split(EncDec, " ")

'Kita cari tau panjang passwordnya, dengan metode XOR
Dim inLen As Integer
For H = 0 To UBound(nKey)
If H Mod 2 <> 0 Then
If (data(H * 2) Xor ("&H" & nKey(H))) = 0 Then
inLen = H
Exit For
End If
End If
Next H

'Hasil pencariannya kita cetak Hasil
hasil = "Nama File: " & Filename & vbCrLf & _
"Ukuran : " & FileLen(Filename) & " bytes" & vbCrLf & _
"Panjang password: " & IIf(inLen = 0, 20, inLen) & vbCrLf & _
"---------------------" & vbCrLf

'Nah disini kita cari tau passwordnya
'Kita gunakan looping sampai dengan 255 kali
'ini dilakukan karena kita akan membadingkan
'mulai karakter pertama sampai karakter terakhir(255)
'Kelemahan proses ini ialah, belum bisa menampilkan dengan tepat
'password yang panjangnya sampai 20 karakter
'jika passwordnya >= 20 maka kesuluruhan kemungkinan akan
'ditampilkan.

For I = 0 To 255
'looping kedua berfungsi untuk membandingkan nilai asli dari file
'dengan nilai enskripsi
For H = 0 To UBound(nKey)
If H Mod 2 = 0 Then
'membandingkan nilai
nHex = Hex((("&H" & nKey(H)) Xor I))
Else
nHex = nKey(H)
End If
'membandingkan nilai
Pwd = Pwd & Chr((data(H * 2) Xor ("&H" & nHex)))
Next H
'Cetak hasil enskripsi yang didapat HASIL
If InStr(1, Pwd, String(20 - inLen, Chr(0))) Then
If InStr(1, Pwd, String(20, Chr(0))) Then
hasil = hasil & "nggak ada passwordnya" & vbCrLf
Else
hasil = hasil & Pwd & vbCrLf
End If
ElseIf InStr(1, Pwd, Chr(0)) = 0 Then
hasil = hasil & Pwd & vbCrLf
End If
Pwd = ""
Next I
GetMs2000XP = hasil

End Function

Readmore...

membuat Jam analog

-buat satu form namanya form1
-copykan code dibawah ini ke form

Dim Ymouse, Xmouse, dy(30), dx(30), Da(30), Mo(30)
Dim Split1, Day1, Year1, Todaysdate, h, m, d, S, Face, Speed, n, scrll
Dim Dsplit, HandHeight, Handwidth, HandX, HandY, Step, currStep
Dim Test, ClockHeight, ClockWidth, ClockFromMouseY, ClockFromMouseX
Dim Fcol, Mcol, Scol, Hcol, Dcol
'############
'By:eko cahyono (Ym: eko_matrix)
'############

Private Type FL
T(30) As Long
Le(30) As Long
End Type
Dim FL As FL
Private Type HL
T(30) As Long
Le(30) As Long
End Type
Dim HL As HL
Private Type SL
T(30) As Long
Le(30) As Long
End Type
Dim SL As SL
Private Type ML
T(30) As Long
Le(30) As Long
End Type
Dim ML As ML
Private Type DL
T(30) As Long
Le(30) As Long
End Type
Dim DL As DL
Const PI = 3.1415

Private Declare Function GetActiveWindow Lib "user32" () As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Const SW_SHOWNORMAL = 1

Private Sub Timer1_Timer()
dy(0) = dy(0) + (Ymouse - dy(0)) * Speed
dy(0) = Fix(dy(0))
dx(0) = dx(0) + (Xmouse - dx(0)) * Speed
dx(0) = Fix(dx(0))
For i = 1 To Len(d) - 1
dy(i) = dy(i) + (dy(i - 1) - dy(i)) * Speed
dy(i) = Fix(dy(i))
dx(i) = dx(i) + (dx(i - 1) - dx(i)) * Speed
dx(i) = Fix(dx(i))

Next i

secs = Second(Now)
sec = -1.57 + PI * secs / 30
Mins = Minute(Now)
Min = -1.57 + PI * Mins / 30
hr = Hour(Now)
hrs = -1.575 + PI * hr / 6 + PI * Int(Minute(Now)) / 360
For i = 0 To n - 2
FL.T(i) = dy(i) + ClockHeight * Sin(-1.0471 + i * Split1 * PI / 180) + scrll
FL.Le(i) = dx(i) + ClockWidth * Cos(-1.0471 + i * Split1 * PI / 180)

Next i

For i = 0 To Len(h) - 1
HL.T(i) = dy(i) + HandY + (i * HandHeight) * Sin(hrs) + scrll
HL.Le(i) = dx(i) + HandX + (i * Handwidth) * Cos(hrs)

Next i

For i = 0 To Len(m) - 1
ML.T(i) = dy(i) + HandY + (i * HandHeight) * Sin(Min) + scrll
ML.Le(i) = dx(i) + HandX + (i * Handwidth) * Cos(Min)

Next i

For i = 0 To Len(S) - 1
SL.T(i) = dy(i) + HandY + (i * HandHeight) * Sin(sec) + scrll
SL.Le(i) = dx(i) + HandX + (i * Handwidth) * Cos(sec)

Next i

For i = 0 To Len(d) - 1
DL.T(i) = dy(i) + ClockHeight * 1.5 * Sin(currStep + i * Dsplit * PI / 180) + scrll
DL.Le(i) = dx(i) + ClockWidth * 1.5 * Cos(currStep + i * Dsplit * PI / 180)

Next i

currStep = currStep - Step
P
End Sub

Private Function SP(ByVal ST As String, ByVal Nu As Integer, Optional K As Byte = 1) As String
SP = Mid(ST, Nu + 1, K)
End Function

Private Sub P()
Cls
With Form1 'Nama Form
.FontBold = False
.ForeColor = Dcol
For i = 0 To Len(d) - 1
.CurrentY = DL.T(i)
.CurrentX = DL.Le(i)
Print SP(d, i)
Next i
.ForeColor = Fcol
For i = 0 To n - 1
.CurrentY = FL.T(i)
.CurrentX = FL.Le(i)
If (i = 18 Or i = 20 Or i = 22) Then
Print SP(Face, i, 2)
i = i + 1
Else
Print SP(Face, i, 1)
End If
Next i
.FontBold = True
.ForeColor = Scol
For i = 0 To Len(S) - 1
.CurrentY = SL.T(i)
.CurrentX = SL.Le(i)
Print SP(S, i)
Next i
.ForeColor = Mcol
For i = 0 To Len(m) - 1
.CurrentY = ML.T(i)
.CurrentX = ML.Le(i)
Print SP(m, i)
Next i
.ForeColor = Hcol
For i = 0 To Len(h) - 1
.CurrentY = HL.T(i)
.CurrentX = HL.Le(i)
Print SP(h, i)
Next i
End With
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Ymouse = Y + ClockFromMouseY ':event.y+ClockFromMouseY;
Xmouse = X + ClockFromMouseX ':event.x+ClockFromMouseX;
End Sub

Private Sub Form_Load()
Timer1.Interval = 15
Me.BackColor = &H808080
Dcol = vbWhite
Fcol = vbGreen
Scol = vbWhite
Mcol = vbRed
Hcol = vbYellow
ClockHeight = 600
ClockWidth = 600
ClockFromMouseY = 1200
ClockFromMouseX = 600
Da(1) = "SUNDAY": Da(2) = "MONDAY": Da(3) = "TUESDAY": Da(4) = "WEDNESDAY"
Da(5) = "THURSDAY": Da(6) = "FRIDAY": Da(7) = "SATURDAY"
Mo(1) = "JANUARY": Mo(2) = "FEBRUARY": Mo(3) = "MARCH"
Mo(4) = "APRIL": Mo(5) = "MAY": Mo(6) = "JUNE": Mo(7) = "JULY"
Mo(8) = "AUGUST": Mo(9) = "SEPTEMBER": Mo(10) = "OCTOBER"
Mo(11) = "NOVEMBER": Mo(12) = "DECEMBER"
Day1 = Day(Now)
Year1 = Year(Now)

If (Year1 < 2000) Then Year1 = Year1 + 1900
Todaysdate = " " + Da(Weekday(Now)) + " " + Str(Day1) + " " + Mo(Month(Now)) + " " + Str(Year1)
d = Todaysdate
h = "..."
m = "...."
S = "....."
Face = "1 2 3 4 5 6 7 8 9 101112 "
Form1.Font = "Arial"
Form1.FontSize = 9
Speed = 0.6
n = Len(Face) - 2
Ymouse = 0
Xmouse = 0
scrll = 0
Split1 = 360 / n
Dsplit = 360 / Len(d)
HandHeight = ClockHeight / 4.5
Handwidth = ClockWidth / 4.5
HandY = -7
HandX = -2.5
scrll = 0 '2 * ClockHeight
Step = 0.06
currStep = 0
End Sub

Readmore...

Konversi angka ke huruf

copykan code ini ke form


Dim baca As String
Private Sub Form_Load()
KONVERSI ("2000")
MsgBox baca
End Sub

'###############3
'by eko cahyono (Ym: eko_matrix)
'mail eko_matrix@yahoo.com
'###################
Sub KONVERSI(INPUTAN As String)
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency
Dim ribu As Currency
Dim satu As Currency
Dim sen As Currency
baca = ""
If Not IsNumeric(INPUTAN) Then MsgBox "masukan angka", vbInformation: Text1.Text = "0": Text1.SetFocus: Exit Sub
x = INPUTAN
'Jika x adalah 0, maka dibaca sebagai 0
If x = 0 Then
baca = angka(0, 1)
Else
'Pisah masing-masing bagian untuk triliun, milyar, juta, ribu, rupiah, dan sen
triliun = Int(x * 0.001 ^ 4)
milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
sen = Int((x - Int(x)) * 100)
'Baca bagian triliun dan ditambah akhiran triliun
If triliun > 0 Then
baca = ratus(triliun, 5) + "triliun "
End If
'Baca bagian milyar dan ditambah akhiran milyar
If milyar > 0 Then
baca = ratus(milyar, 4) + "milyar "
End If
'Baca bagian juta dan ditambah akhiran juta
If juta > 0 Then
baca = baca + ratus(juta, 3) + "juta "
End If
'Baca bagian ribu dan ditambah akhiran ribu
If ribu > 0 Then
baca = baca + ratus(ribu, 2) + "ribu "
End If
'Baca bagian rupiah dan ditambah akhiran rupiah
If satu > 0 Then
baca = baca + ratus(satu, 1) '+ "rupiah "
End If
'Baca bagian sen dan ditambah akhiran sen
If sen > 0 Then
baca = baca + ratus(sen, 0) + "sen"
End If
End If
If Right(Trim(UCase(Left(baca, 1)) & LCase(Mid(baca, 2))), 4) = "ribu" Then
terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) + "rupiah"
Else
terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2)) + "rupiah"
End If
End Sub
Function ratus(x As Currency, posisi As Integer) As String
Dim a100 As Integer, a10 As Integer, a1 As Integer
Dim baca As String
a100 = Int(x * 0.01)
a10 = Int((x - a100 * 100) * 0.1)
a1 = Int(x - a100 * 100 - a10 * 10)
'Baca Bagian Ratus
If a100 = 1 Then
baca = "Seratus "
Else
If a100 > 0 Then
baca = angka(a100, 2) + "ratus "
End If
End If
'Baca Bagian Puluh dan Satuan
If a10 = 1 Then
baca = baca + angka(a10 * 10 + a1, 2)
Else
If a10 > 0 Then
baca = baca + angka(a10, 2) + "puluh "
End If
If a1 > 0 Then
If posisi = 2 And a100 = 0 And a10 = 0 Then
baca = baca + angka(a1, 1)
Else
baca = baca + angka(a1, 2)
End If
End If
End If
ratus = baca
End Function

Function angka(x As Integer, posisi As Integer)
Select Case x
Case 0: angka = "Nol"
Case 1:
If posisi = 2 Then
angka = "Satu "
Else
angka = "Se"
End If
Case 2: angka = "Dua "
Case 3: angka = "Tiga "
Case 4: angka = "Empat "
Case 5: angka = "Lima "
Case 6: angka = "Enam "
Case 7: angka = "Tujuh "
Case 8: angka = "Delapan "
Case 9: angka = "Sembilan "
Case 10: angka = "Sepuluh "
Case 11: angka = "Sebelas "
Case 12: angka = "Duabelas "
Case 13: angka = "Tigabelas "
Case 14: angka = "Empatbelas "
Case 15: angka = "Limabelas "
Case 16: angka = "Enambelas "
Case 17: angka = "Tujuhbelas "
Case 18: angka = "Delapanbelas "
Case 19: angka = "Sembilanbelas "
End Select
End Function

Readmore...

Pengertian Hacker dan Cracker

Apa sih hacker ?
Hacker adalah seseorang yang mengerti sebuah sistem, bagaimana caranya sistem tersebut bekerja, dan mengetahui jawaban dari pertanyaan seperti ini : " Jika saya menambahkan, meng edit, atau menghapus bagian ..... , maka yang terjadi adalah .....

Misalnya saja, anda mengerti bagaimana cara membuat mobil, mengerti bagian-bagian mesinnya, dan mengetahui komponen apa saja yang di butuhkan sebuah mobil agar mobil tersebut bisa berjalan dengan baik.

Karena anda mengetahui sistem "Mobil" tersebut, maka Anda juga mengetahui bagaimana cara membuat mobil tersebut tidak bisa berjalan.

Pada prinsipnya, Jika anda mengerti konsep dari logika program, "Jika dan maka" , Jika lakukan ini, maka...., dan mengerti bagaimana sistem tersebut di buat, mengetahui bagian-bagian pentingnya, anda juga pasti mengetahui apa yang harus di lakukan untuk membuat sistem tersebut tidak berjalan.

Kenali dulu sistem yang akan di tembus, lalu ajukan pertanyaan, "Apa , dan Bagaimana, lalu Apabila ??"

Sebagai studi, anggap saja Anda ingin melakukan hacking terhadap situs semuabisnis.com, maka anda perlu mencari jawaban dari pertanyaan-pertanyaan " apa ? , bagaimana ? dan apabila.

Mari kita mulai dengan pertanyaan pertama.

1. kita mulai dengan pertanyaan "Apa... "

Apa sistem yang di pakai semuabisnis.com ?
- situs ini menggunakan sistem aplikasi PHP, dan Apache sistem sebagai servernya.

Apa versi dari php dan apache yang di gunakan ?
- Versi PHP yang di gunakan adalah versi php .. ( edit yee :P ) , dan apache versi ... ( di edit juga yah )

Apa kah dari versi tersebut terdapat bug / kelemahan ?
- kelemahan dari versi tersebut adalah ...... ( di edit ah.. :D )

Apa yang di akibatkan dari bug / kelemahan tersebut ?
- Kelemahan tersebut bisa mengakibatkan .....

2. Pertanyaan yang di mulai dengan " Bagaimana... "
Anggap saja anda sudah mengetahui versi nya, dan juga mengetahui kelemahan dari versi tersebut. lalu....

Bagaimana memanfaatkan kelemahan tersebut ?

Bagaimana cara mengeksekusi kelemahan tersebut ?


3. Pertanyaan yang di mulai dengan " Apabila... "

Pertanyaan khusus jika anda sudah mengetahui kelemahan-kelemahan yang terdapat di PHP dan apache server.

- Saya melihat di semuabisnis.com ada halaman member area, lalu apabila saya memasukkan kode 'or"=' di bagian username dan password apakah saya bisa masuk ke halaman member area ?

- Saya juga melihat semua bisnis menggunakan mysql, lalu apabila saya memasukkan perintah sql di salah satu form, apa yang terjadi ?

Kira-kira proses nya seperti itu, mengetahui suatu system sama saja mengetahui bagaimana membuat sistem tersebut tidak berjalan, atau memanipulasi system tersebut.

Oh ya, walaupun pada contoh di atas adalah menggunakan situs semuabisnis.com bukan berarti saya meminta anda untuk melakukan hacking di situs ini, bila anda lakukan, wah... saya bakal kerepotan. Anda lebih pintar dari saya, silahkan cari situs lain untuk pembelajaran.

Apa sih Cracker ?

- Cracker adalah seorang yang kegiatannya hanyalah merusak, menembus dan mengganti halaman suatu situs adalah menjadi hobi dengan alasan untuk uji coba kemampuannya. ataupun hanya untuk mengasah ilmu yang sudah di dapatnya.

Apa bedanya antara hacker dan cracker ?

- Perbedaannya sangat tipis, hanya karena satu alasan saja, seorang hacker bisa menjadi cracker dan melakukan tindakan pengerusakan. atau seorang cracker bisa juga menjadi hacker.

Sekedar contoh saja, di awal tahun 2000 an, ketika Cracker dari Italia menyusup ke komputer portugis, lalu dari komputer negara Portugis mereka melakukan serangan ke Indonesia. 3 orang hacker Indonesia yang mengetahui serangan ini, melakukan tindakan balasan.

Singkat cerita 3 orang ini berhasil menghilangkan domain yang berakhiran .pt , sehingga situs portugis yang berakhiran .pt tidak bisa di akses. untuk indonesia domain ID nya adalah co.id , sedangkan portugis .pt.

Pembicaraan pun di gelar di komunitas hacker portugis, setelah di lakukan penyelidikan, baru di ketahui asal serangan tersebut berasal dari Negara Italia.

Anda lihat bukan ?, Melakukan tindakan balasan, artinya melakukan serangan, melakukan serangan artinya melakukan pengerusakan, yang melakukan pengerusakan di sebut cracker.

Atau sebut saja seseorang yang menggunakan nickname Tarjo, hanya karena australia menduduki timor-timor, sebagai bentuk protes, lebih 1000 situs Australia dalam waktu 1 malam di rusak, dan dalam 1 malam juga Tarjo berubah gelar menjadi Cracker.

Yang terbaru adalah kasus dengan malaysia ( ambalat ), banyak juga hacker yang dalam 1 malam berganti gelar menjadi cracker,dengan melakukan tindakan pengerusakan di situs-situs malaysia.

Readmore...

Merubah Settingan Regional dengan Script VB

Option Explicit
'By: eko cahyono (idym: eko_matrix)
Const LOCALE_SDECIMAL = &HE ' decimal separator
Const LOCALE_STHOUSAND = &HF ' thousand separator
Const LOCALE_SGROUPING = &H10 ' digit grouping
Const LOCALE_IDIGITS = &H11 ' number of fractional digits
Const LOCALE_ILZERO = &H12 ' leading zeros for decimal
Const LOCALE_SNATIVEDIGITS = &H13 ' native ascii 0-9

Const LOCALE_SCURRENCY = &H14 ' local monetary symbol
Const LOCALE_SINTLSYMBOL = &H15 ' intl monetary symbol
Const LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator
Const LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator
Const LOCALE_SMONGROUPING = &H18 ' monetary grouping
Const LOCALE_ICURRDIGITS = &H19 ' # local monetary digits
Const LOCALE_IINTLCURRDIGITS = &H1A ' # intl monetary digits
Const LOCALE_ICURRENCY = &H1B ' positive currency mode
Const LOCALE_INEGCURR = &H1C ' negative currency mode

Const LOCALE_SDATE = &H1D ' date separator
Const LOCALE_STIME = &H1E ' time separator
Const LOCALE_SSHORTDATE = &H1F ' short date format string
Const LOCALE_SLONGDATE = &H20 ' long date format string
Const LOCALE_STIMEFORMAT = &H1003 ' time format string
Const LOCALE_IDATE = &H21 ' short date format ordering
Const LOCALE_ILDATE = &H22 ' long date format ordering
Const LOCALE_ITIME = &H23 ' time format specifier
Const LOCALE_ICENTURY = &H24 ' century format specifier

Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, _
ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" _
(ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long

Function GetRegional(nFormat As Long, Optional SetValue As String = -1) As String
Dim vNilai As String, vLcid As Long, Ret As Long
vLcid = GetUserDefaultLCID()
vNilai = Space$(vLcid)
Ret = GetLocaleInfo(vLcid, nFormat, vNilai, Len(vNilai))
If Ret Then
If SetValue <> "-1" Then
Call SetLocaleInfo(vLcid, nFormat, CStr(SetValue))
End If
GetRegional = Left$(vNilai, Ret - 1)
End If
End Function


Private Sub Command1_Click()
'Ganti mata uang
MsgBox "Format Lama Mata Uang: " & GetRegional(LOCALE_SCURRENCY)
Call GetRegional(LOCALE_SCURRENCY, "vb")
MsgBox "Format Baru Mata Uang: " & GetRegional(LOCALE_SCURRENCY)

'Ganti mata Decimal
MsgBox "Format Decimal Lama: " & GetRegional(LOCALE_SDECIMAL)
Call GetRegional(LOCALE_SDECIMAL, ".")
MsgBox "Format Decimal Lama: " & GetRegional(LOCALE_SDECIMAL)

'Untuk mengganti yg lain bisa pake nilai konstanta diatas _
(disesuaikan dgn kebutuhan)

End Sub

Readmore...

Lowongan IT

Segera Dibutuhkan 2 Staff IT
1.Dapat bekerja dibawah tekanan dan mampu bekerja secara team atau individu
2.menguasai instalasi server windos family server,jaringan komputer,maintenance hardware
3.menguasai pemograman SQL server dan asp
4.fresh graduate atau yang sudah berpengalaman minimal 2 th
5.Supel dan dapat berkomunikasi dengan baik

Silahkan kirimkan cv lengkap beserta foto melalui email
miskembang88@gmail.com subject :lowongan IT

batas waktu pentupan sampai minggu ke-3 dibulan november 2008

email yang dikirimkan akan diseleksi, lalu segera dihubungi untuk interview hari itu juga

Terima kasih.

Readmore...

Membuat Control Baru dengan script

Public Function LoadControl(oForm As Object, _
CtlType As String, CtlName As String, nTop As Double, nLeft As Double) As Object
'by : eko cahyono(idym : eko_matrix)
Dim oCtl As Object

On Error Resume Next

If IsObject(oForm.Controls) Then
Set oCtl = oForm.Controls.Add(CtlType, CtlName)
If Not oCtl Is Nothing Then Set LoadControl = oCtl
oCtl.Top = nTop
oCtl.Left = nLeft
oCtl.Visible = True

End If

End Function

Private Sub Command1_Click()
LoadControl Form1, "vb.textbox", "text1", 100, 1000
LoadControl Form1, "VB.CommandButton", "Tombol", 1000, 1000
LoadControl Form1, "VB.pictureBox", "Pic", 2200, 1000
End Sub

Readmore...

Connectionstring ke database access,sqlserver dan mysql

'ini code Connectionstring ke database access,sqlserver dan mysql
'copykan code ini d module setelah itu bisa untuk koneksi bisa panggil nama rocedurenya
'Koneksidb(1) '

Public con As New ADODB.Connection
Public ConString As String

Public Sub Koneksidb(inxCon As Integer)
'by : eko cahyono (eko_matrix@yahoo.com)
' ID YM eko_matrix
If con.State = adStateOpen Then con.Close
con.CursorLocation = adUseClient

Select Case inxCon

Case 1 ''***koneksi ke access tanpa password melalui path directory **************
ConString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & _
"\database\salon.mdb;Persist Security Info=False"

Case 2 ''***koneksi ke access dengan password melalui path directory **************
ConString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & _
"\database\salon.mdb;Jet OLEDB:Database Password=MyDbPassword;"

Case 3 '***koneksi sql server *****************
ConString = "Provider=SQLOLEDB.1;Password=" & "" & ";" & _
"Persist Security Info=True;User ID=" & "sa" & _
";Initial Catalog=sirsmojosari" & ";Data Source=" & "127.0.0.1"


Case 4 '***koneksi mysql (harus diinstal driver mysqlOdbc 3.51) *****************
ConString = "DRIVER={mysql ODBC 3.51 driver};SERVER=" & svr & ";" & _
" PORT=3306;DATABASE= " & db & ";" & _
"USER=" & user & ";PASSWORD=" & pws & ";OPTION=3;"
End Select

con.ConnectionString = ConString
con.Open
End Sub

Readmore...