جعل البرنامج يعمل مع بدء تشغيل وندوز

Private Declare function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(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 Declare function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Sub Form_Load()
Dim lRegKey As Long
Dim sApp As String
sApp = App.Path + IIf(Right(App.Path, 1) <> "\", "\", "") + App.EXEName + ".exe"
If RegOpenKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", lRegKey) = 0 Then
If RegSetValueEx(lRegKey, "My Program", 0, 1, ByVal sApp, Len(sApp)) Then
MsgBox "There was a Problem Adding This Program to the Registry", vbExclamation, "Error"
End If
Call RegCloseKey(lRegKey)
end If
end Sub

إفراغ سلة المحذوفات


Private Declare function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long 
Private Declare function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long 

Private Sub Form_Load() 
'الإفراغ 
SHEmptyRecycleBin Me.hwnd, vbNullString, 0 
'التحديث 
SHUpdateRecycleBinIcon 
end Sub

تغيير الكتابة من العربي إلى الإنجليزي وبالعكس
أضف زر أمر وأضف أداة نص

Private Declare function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long

Private Sub Command1_Click()
ActivateKeyboardLayout hkl_next, klf_reorder
end Sub
كل ضغطة على زر الأمر تغير اللغة 


Private Declare function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long

Private Sub Command1_Click()
ActivateKeyboardLayout hkl_next, klf_reorder
end Sub
كل ضغطة على زر الأمر تغير اللغة 


كود يقوم بحماية برنامجك حيث يعمل عدد من المرات (تحددها بنفسك) ثم يتوقف نهائيا عن العمل ، وهو يشبه طريقة عمل الـ(register) في البرامج المشهورة 



Private Sub Form_Load() 
retvalue = GetSetting("A", "0", "Runcount") 
GD$ = Val(retvalue) + 1 
SaveSetting "A", "0", "RunCount", GD$ 
If GD$ > 3 Then ' الرقم (3) يحدد عدد مرات التشغيل 
MsgBox "انتهت مدة تشغيل البرنامج .. عليك بشراء النسخة الاصلية" 
Unload FRM ' 
End If 
End Sub 
عرض صندوق حوار Open With 



Private Sub Command1_Click() 
Dim x As Long 
x = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL C:\vbzoom.log") 
End Sub 
لإنهاء صلاحيات برنامجك التجريبي بعد30 يوماً فقط 


 
Dim startdate As String 
Dim differenceofdate 
Dim TRACEDATE As String 
Dim newdate 
Dim chk 

If GetSetting(App.Title, "Startup", "counter", "") = "" Then 
SaveSetting App.Title, "Startup", "counter", 1 
SaveSetting App.Title, "Startup", "Started", Format(Date, "mm dd yyyy") 
SaveSetting App.Title, "Startup", "Last Used", Format(Date, "mm dd yyyy") 
lblcnt.Caption = "1" 

ElseIf GetSetting(App.Title, "Startup", "counter", "") = "31" Then 

MsgBox "شكراً لستخدامك هذا البرنامج " & Chr(10) + Chr(1) & "الرجاء إيقاف عمل هذا البرنامج او سيتم فقدان كل المعلومات التي قمت بإدخالها ", vbCritical, "شكراً لك " 

End 

Else 
TRACEDATE = GetSetting(App.Title, "Startup", "Last Used", "") 
chk = DateDiff("d", CDate(TRACEDATE), Now) 
If chk < 0 Then 'CHECK IF THE DATE WAS CHANGE which is lesser than the PREVIOUS DATE WHERE THE SYSTEM USED. 

MsgBox "لم يتم العثور على تاريخ النظام لديك !! " & Chr(10) + Chr(13) & " الرجاء تغييرة الأن وإلا لن يكون بإمكانك إستخدام هذا البرنامج لاحقاً", vbCritical, "تاريخ مفقود" 

End 
Else 
startdate = GetSetting(App.Title, "Startup", "Started", "") 
differenceofdate = DateDiff("d", startdate, Now) 
If differenceofdate <> 0 Then 
lblcnt.Caption = differenceofdate + 1 
SaveSetting App.Title, "Startup", "Last Used", Format(Now, "MM DD YYYY") 
SaveSetting App.Title, "Startup", "counter", differenceofdate + 1 
End If 
If differenceofdate = 0 Then 
lblcnt.Caption = GetSetting(App.Title, "Startup", "Counter", "") 
End If 
End If 
End If 
End Sub