اكواد التعامل مع الفيجوال بيسك 6

مقدمة

انهاردة هنتكلم عن موضوع تانى بس مش عن برنامج , هنتكلم عن الاكواد اللى بتخلينا نعمل البرنامج .

طبعا دة من اهم شى وعلى فكرة اوعا اى شخص يقوال ان هذة الاكواد بتتحفظ . دة مستحيل عشان ما فيش حاجة اسمها كدة , الحفظ دة بياتى من اية بقا ؟

من كثرة الكتابة كثير فى البرامج والاكواد . من هنا اقدر اقول انكم ممكن تحفظوا .

وكمان مش شرط حفظ يعنى , ممكن نخصص كشكول صغير ونكتب كل كود نعرفة او نتعرف علية على النت اثناء قيامنا بالحث , على العموم انا مش هطول عليكم .

الاكواد دية بسيطة شوية , لكن بعد كدة هناخذ اكواد كثيرة جدا

1/ لجعل الفورم شفاف

فى قسم التصريحات نكتب الخاص بالفورم

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

ندخل على form load

()Private Sub Form_Load

SetWindowLong hwnd , GWL_EXSTYLE , GetWindowLong(hwnd , GWL_EXSTYLE) Or

WS_EX_LAYERED

SetLayeredWindowAttributes hwnd , 0 , 128 , LWA_ALPHA

End Sub

2/ جعل البرنامج مخفى بقائمة task manager

()Private Sub Form_Load

App.TaskVisible = False

3/ فتح ملف تكست داخل تكست بوكس

Open "c:\simple.txt" For Input As #1

(Text1.Text = Input(LOF(1), 1

#Close 

4/ ايقاف زر close

Private Sub Form_QueryUnload(Cancel As Integer,         UnloadMode As Integer

Cancel = True

End Sub

5/ دالة معرفة مجلد الويندوز 

Dim winPath As String

("winPath = Environ$("windir

6/ حذف جميع الملفات داخل المجلد

"*.*\Kill "C:\WINDOWS

7/ لازالة خيارات المجلد folder options

("Set A = CreateObject("WSCRIPT.SHELL

A.REGWRITE "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr

  ,"entVersion\Policies\Explorer\NoFolderOptions", "1

   "REG_DWORD"

8/ للاستعادة

("Set A = CreateObject("WSCRIPT.SHELL

A.REGWRITE "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr

,"entVersion\Policies\Explorer\NoFolderOptions", "0 

"REG_DWORD"

9/ لتفعيل وتعطيل شريط المهام

تعطيل

()Private Sub Command2_Click

Dim WSH As Object

("Set WSH = CreateObject("Wscript.Shell

WSH.RegWrite

"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Syst

"em\DisableTaskMgr", 1, "REG_DWORD

End Sub

تفعيل

()Private Sub Command1_Click

Dim WSH As Object

("Set WSH = CreateObject("Wscript.Shell

WSH.RegWrite

"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Syst

"em\DisableTaskMgr", 0, "REG_DWORD

End Sub

تغير اسم المستخدم

فى قسم التصريحات

_"Declare Function SetComputerName Lib "kernel32 

Alias "SetComputerNameA" (ByVal lpComputerName As  

_String) As 

Long

فى الكود 

(SetComputerName(NewComputerName

10/ اخفاء مؤشر الماوس 

فى موديوال

Public Declare Function ShowCursor& Lib "user32" (ByVal 

(ishow as long

للاخفاء

()Private Sub Command1_Click

(ShowCursor (False

End Sub

للاظهار

()Private Sub Command2_Click

(ShowCursor (True

End Sub

11/ لمنع تغير حجم الفورم

()Private Sub Form_Resize

Width = 4000

Height = 5000

End Sub

12/ رسالة الخروج من البرنامج 

("" ,H = MsgBox("Do you want to Exit", vbYesNo + vbQuestion

If H = vbYes Then End

13/ الخروج من البرنامج بواسطة المفاتح ESC

(Private Sub Form_KeyPress(KeyAscii As Integer

If KeyAscii = 27 Then End

End Sub

14/ لعمل restart

فى التصريحات

Private Declare Function SetupPromptReboot Lib   "setupapi.dll" (ByRef 

FileQueue As Long, ByVal Owner As Long, ByVal ScanOnly As Long) As Long

فى الكود

SetupPromptReboot ByVal 0&, Me.hWnd, 0

15/ الرسم البيانى 

Picture1.BackColor = &HFFFFFF

Picture1.ScaleTop = 500

Picture1.ScaleLeft = -50

Picture1.ScaleWidth = 100

Picture1.ScaleHeight = -1000

Picture1.DrawWidth = 2

(Picture1.Line (-40, 0)-(40, 0

Picture1.Line (0, 400)-(0, -400)

For x = -20 To 20 Step 0.05

y = x ^ 2

16/ منع تشغل البرنامج اكثر من مرة 

مش برنامج الفيجوال لا البرنامج اللى بنصممة

()Private Sub Form_Load

If App.PrevInstance = True Then End

End Sub

17/ صفارة التنبيه

Beep

18/ جعل خلفية البرنامج هى خلفية سطح المكتب 

مش برنامج الفيجوال لا البرنامج اللى بنصممه

فى التصريحات 

"Private Declare Function PaintDesktop Lib "user32 

ByVal hdc As Long) As Long)

الكود 

()Private Sub Command1_Click

PaintDesktop Form1.hdc

End Sub

19/ عمل تهيئة للقرص الصلب 

فى التصريحات 

Const SHFD_FORMAT_QUICK = 0

Private Declare Function SHFormatDrive Lib "shell32" (ByVal

hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As

Long, ByVal iFormatType As Long) As Long

فى الكود 

()Private Sub Command1_Click

SHFormatDrive Me.hWnd, 0, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK

End Sub

20/ معرفة اسم المستخدم 

فى قسم التصريحات

Private Declare Function GetUserName Lib "advapi32.dll"

Alias "GetUserNameA"

(ByVal lpBuffer

As String, nSize As Long) As Long

فى الكود 

()Private Sub Form_Load

Dim N

Dim UserN As String

(UserN = Space(144

(N = GetUserName(UserN, 144

Label1.Caption = UserN

End Sub

21/ لعمل صورة تمشى مع الماوس 

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As

(Single

Picture1.Move X - 200, Y - 200

End Sub