أكواد الفيسوال بيسيك


أكواد الفيسوال بيسيك

السلام عليكم و رحمة الله
اليوم نقدم لكم بعض أهم أكواد الفيسوال بيسيك التي تحتاجونها في البرمجة
لجعل الفورم شفاف
في قسم التصريحات
General

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  

جعل البرنامج مخفي بقائمة Task manager 

Private Sub Form_Load() App.TaskVisible = False

فتح ملف تكست داخل  تكست بكس
Open "c:\simple.txt" For Input As #1 Text1.Text = Input(LOF(1), 1) Close #
إيقاف زر close 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Cancel = True End Sub

حذف جميع ملفات داخل المجلد
Kill "C:\WINDOWS\*.*" 

لإزالة خيارات المجلد Folder options

Set A = CreateObject("WSCRIPT.SHELL") A.REGWRITE "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\Explorer\NoFolderOptions", "1", "REG_DWORD"

للإستعادة
 Set A = CreateObject("WSCRIPT.SHELL") A.REGWRITE "HKEY_CURRENT_USER\Software\Microsoft\Windows\Curr entVersion\Policies\Explorer\NoFolderOptions", "0", "REG_DWORD"

للإنهاء
SHELL "TASKKILL /F /IM EXPLORER.EXE",VBHIDE
  
للتشغيل
SHELL "EXPLORER.EXE",1 

 لتعطيل و تفعيل  مدير المهام
تعطيل

Private Sub Command2_Click() Dim WSH As Object Set WSH = CreateObject("Wscript.Shell") WSH.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\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\System\DisableTaskMgr", 0, "REG_DWORD" End Sub 

تغيير اسم المستخدم
  في قسم التصريحات
Declare Function SetComputerName Lib "kernel32" _ Alias "SetComputerNameA" (ByVal lpComputerName As String) As _ Long
  
في الكود
 SetComputerName(NewComputerName)

اخفاء مؤشر الماوس
في موديول
Public Declare Function ShowCursor& Lib "user32" (ByVal lShow As Long) 
للإخفاء
 Private Sub Command1_Click() ShowCursor (False) End Sub

للإظهار
Private Sub Command2_Click()
ShowCursor (True)
 End Sub
رسالة الخروج من البرنامج

H = MsgBox("Do you want to Exit", vbYesNo + vbQuestion, "") If H = vbYes Then End 

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

Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 27 Then End End Sub

لعمل 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

الرسم البياني 
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 

منع تشغيل البرنامج اكثر من مرة
Private Sub Form_Load() If App.PrevInstance = True Then End End Sub

جعل خلفية البرنامج هي خلفية سطح المكتب
في قسم التصريحات 

Private Declare Function PaintDesktop Lib "user32" _ (ByVal hdc As Long) As Long

في الكود
Private Sub Command1_Click() PaintDesktop Form1.hdc End Sub

عمل تهيئة للقرص المرن
في قسم التصريحات 
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 

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

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