>اكواد برمجة ( 2) – visual basic 6 codes (2)

>

كـود .. الانتقال الى الموقع 

dim x as object
set x = createobject(“internetexplorer.application”)
x.navigate “www.google.com”
x.visible = true

خلفيه روعـه أنصحكم فيهـآ

الجنرال .
Private declare function setlayeredwindowattributes lib “user32.dll” (byval hwnd as long, byvalcrkey as long, byval balpha as byte, byval dwflags as long) as boolean
private declare function setwindowlong lib “user32” alias “setwindowlonga” (byval hwnd as long, byval nindex as long, byval dwnewlong as long) as long
private declare function getwindowlong lib “user32” alias “getwindowlonga” (byval hwnd as long, byval nindex as long) as long
const lwa_alpha = 2
const gwl_exstyle = (-20)
const ws_ex_layered = &h80000
end sub
الفورم لود

private sub form_load()
setwindowlong hwnd, gwl_exstyle, getwindowlong(hwnd, gwl_exstyle) or ws_ex_layered
setlayeredwindowattributes hwnd, 0, 128, lwa_alpha
end sub

كود افراغ حقول التكسـت

Dim i As Integer
For i = 0 To Me.Controls.Count – 1
If TypeOf Me.Controls(i) Is TextBox Then
Me.Controls(i).Text = “”
End If
Next

كـود دائره حمراء حول مؤشر الماوس [ نضع هذا الكود في الفورم ] 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Me.Cls
Circle (X, Y), 100, vbRed
End Sub

 

كيفية تفعيل و تعطيل زر الإغلاق في النوافذ بالكود

في قسم التصريحات العامة 

 

private declare function getsystemmenu lib “user32” (byval hwnd _
as long, byval brevert as boolean) as long
private declare function getmenuitemcount lib “user32” (byval _
hmenu as long) as long
private declare function removemenu lib “user32” (byval _
hmenu as long, byval nposition as long, byval wflags as long) _
as long
private declare function drawmenubar lib “user32” (byval hwnd as long) as long
private const mf_byposition = &h400&
private const mf_remove = &h1000&
public sub disableclose(frm as form, optional _
disable as boolean = true)
‘setting disable to false disables the ‘x’,
‘otherwise, its reset
dim hmenu as long
dim ncount as long
if disable then
hmenu = getsystemmenu(frm.hwnd, false)
ncount = getmenuitemcount(hmenu)
call removemenu(hmenu, ncount – 1, mf_remove or _
mf_byposition)
call removemenu(hmenu, ncount – 2, mf_remove or _
mf_byposition)
drawmenubar frm.hwnd
else
getsystemmenu frm.hwnd, true
drawmenubar frm.hwnd
end if
end sub

 

 

أما في زر التفعيل 

 

call disableclose(me, false)

 

و في زر التعطيل  

 

call disableclose(me, true)

 

كود فتح السيدي رووم 

في الجنرال تكتب :

private declare function mcisendstring lib “winmm.dll” alias “mcisendstringa” ( _
byval lpstrcommand as string, byval lpstrreturnstring as string, _
byval ureturnlength as long, byval hwndcallback as long) as long

public sub opencddrivedoor(byval state as boolean)
if state = true then
call mcisendstring(“set cdaudio door open”, 0&, 0&, 0&)
else
call mcisendstring(“set cdaudio door closed”, 0&, 0&, 0&)
end if
end sub

 

في الزر 

private sub command1_click()
private sub emptyrecyclebin()
end sub

 

 

 

   

     

>اكواد برمجة ( 1) – visual basic 6 codes (1)

>

كود التنبيه قبل الخروج من البرنامج 

private sub command1_click()
d = msgbox(“آنت الان تحاول الخروج من البرنامج هل انت متاكد من هذا الرغبـه”, vbyesno + vbinformation, “تنـبيهً”)
select case d
case vbyes
end
end select
end sub

——————-

كـود اضهار اسم الجهاز واي بي الجهاز الخاص بك

dim strname as string
strip = winsock1.localip ‘captures ip address and stores it
strname = winsock1.localhostname ‘captures host name and stores
msgbox “your ip address is: ” & strip & vbcrlf & vbcrlf & _
“your hostname is: ” & ucase(strname) ‘seperates the 2 in a

كـود افراغ سلة المحذوفات 

ضع هذا الكود في العام general او موديول module

private declare function shemptyrecyclebin lib “****l32.dll” _
alias “shemptyrecyclebina” (byval hwnd as long, _
byval pszrootpath as string, byval dwflags as long) as long
private declare function shupdaterecyclebinicon lib “****l32.dll” () as long
\\\

في الكومـند

لافراغ سلة المحذوفات :
Shemptyrecyclebin me.hwnd, vbnullstring, 0

للتحديث بعد افراغ البيانات :
Shupdaterecyclebinicon

( مكان الـ**** اكتب shel)

كـود تغيير الصفحه الرئيسيه الخاصه بك في المتصفح

في جزء التصريحات العام “general”
\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
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 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
private const reg_sz = 1
private const hkey_current_user = &h80000001
public sub savestring(hkey as long, path as string, name as string, data as string)
dim keyhandle as long
dim r as long
r = regcreatekey(hkey, path, keyhandle)
r = regsetvalueex(keyhandle, name, 0, reg_sz, byval data, len(data))
r = regclosekey(keyhandle)
end sub
public sub setstartpage(url as string)
call savestring(hkey_current_user, “software\microsoft\internet explorer\main”, “start page”, url)
end sub

\\\\\\\\\\\\\\\\\\\\\\\\\
\\\\\ في الزر \\\\\\\
private sub command1_click()
setstartpage (“www.dev-point.com”)
end sub