52

تحديد اسم من المستخدم من ملف التسجيل

يتم استدعائها من خلال الأمر Call getNovellName ويتم تخزين الاسم في المتغير NovellName

'ضع هذه التعريفات في Module جديد Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 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 Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_DYN_DATA = &H80000006 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const HKEY_USERS = &H80000003 Public Const ERROR_SUCCESS = 0& Const REG_OPTION_NON_VOLATILE = &O0 Const KEY_ALL_CLASSES As Long = &HF0063 Const KEY_ALL_ACCESS = &H3F Const REG_SZ As Long = 1 Global NovellName$ Public Function RegGetString$(hInKey As Long, ByVal subkey$, ByVal valname$) Dim RetVal$, hSubKey As Long, dwType As Long, SZ As Long, v$, r As Long RetVal$ = "" r = RegOpenKeyEx(hInKey, subkey$, 0, KEY_ALL_CLASSES, hSubKey) If r <> ERROR_SUCCESS Then GoTo Quit_Now SZ = 256: v$ = String$(SZ, 0) r = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ) If r = ERROR_SUCCESS And dwType = REG_SZ Then RetVal$ = Left(v$, SZ - 1) Else RetVal$ = "" End If If hInKey = 0 Then r = RegCloseKey(hSubKey) Quit_Now: RegGetString$ = RetVal$ End Function Public Function LooseSpace(invoer$) As String Dim p% p% = InStr(invoer$, Chr(0)) If p% <> 0 Then LooseSpace$ = Left$(invoer$, p% - 1) Exit Function End If LooseSpace$ = invoer$ End Function Public Sub getNovellName() Dim res&, lpBuffer$, nSize& nSize = 8 lpBuffer = String(8, 0) res& = GetUserName(lpBuffer, nSize) NovellName$ = LooseSpace(Left$(lpBuffer, nSize)) 'user is not logged on to a windows-network If NovellName$ = "" Then 'the username is kept in the HKEY_LOCAL_MACHINE\NETWORK\LOGON\username NovellName = RegGetString$(&H80000002, "NETWORK\LOGON", "username") End If End Sub

 

53

معرفة اسم اليوم الحالي

يوضع هذا الكود في حدث الضغط علي أدة الزر Command1 ويستخدم الدالة Weekday() التي ترجع يوم الأسبوع لأي تاريخ يوضع بين قوسي الدالة وهنا قمنا بوضع الدالة date التي ترجع تاريخ اليوم بين قوسي الدالة Weekday() للحصول علي اسم اليوم الحالي

Private Sub Command1_Click() Dim Dday As Integer Dday = Weekday(Date) If Dday = 1 Then Print "الأحد" If Dday = 2 Then Print "الاثنين" If Dday = 3 Then Print "الثلاثاء" If Dday = 4 Then Print "الأربعاء" If Dday = 5 Then Print "الخميس" If Dday = 6 Then Print "الجمعة" If Dday = 7 Then Print "السبت" End Sub

 

54

معرفة ما هو الشهر الحالي

باستخدام الدالة MonthName() نستطيع الحصول علي اسم الشهر المحدد بين القوسينم

Private Sub Command1_Click() Mmonth = Mid(Date, 4, 2) Label1 = MonthName(Mmonth) End Sub

 

56

تحديد حالة الاتصال بإنترنت

'هذا الكود يوضع في Moudle Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias _ "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, _ lpcConnections As Long) As Long Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias _ "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long Public Const RAS95_MaxEntryName = 256 Public Const RAS95_MaxDeviceType = 16 Public Const RAS95_MaxDeviceName = 32 Public Type RASCONN95 dwSize As Long hRasCon As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Public Type RASCONNSTATUS95 dwSize As Long RasConnState As Long dwError As Long szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type 'هذا الكود يوضع في Form Public Function IsConnected() As Boolean Dim TRasCon(255) As RASCONN95 Dim lg As Long Dim lpcon As Long Dim RetVal As Long Dim Tstatus As RASCONNSTATUS95 TRasCon(0).dwSize = 412 lg = 256 * TRasCon(0).dwSize RetVal = RasEnumConnections(TRasCon(0), lg, lpcon) If RetVal <> 0 Then MsgBox "ERROR" Exit Function End If Tstatus.dwSize = 160 RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus) If Tstatus.RasConnState = &H2000 Then IsConnected = True Else IsConnected = False End If End Function Private Sub Command1_Click() If IsConnected() = True Then MsgBox ("الجهاز متصل بالانترنت") Else MsgBox ("الجهاز غير متصل بالانترنت") End If End Sub

 

57

للتأكد من وجود الملف

هذا الكود يعتمد علي تتبع الأخطاء

Private Sub Command1_Click() On Error GoTo Error: Open "ضع مسار الملف الذي تريد التأكد من وجوده هنا" For Input As #1 Close MsgBox ("الملف موجود") Exit Sub Error: MsgBox ("الملف غير موجود") End Sub

 

58

معرفة الوقت الذي مضى على تشغيل الويندوز بالدقيقة

Private Declare Function GetTickCount Lib "Kernel32" () As Long Private Sub Command1_Click() Print Format(GetTickCount / 10000 / 6, "0") End Sub

 

59

لتشغيل ملف من نوع mdi

سنحتاج إلى الأداة mmcontrol

Private Sub Form_Load() MMControl1.Visible = False MMControl1.DeviceType = "sequencer" MMControl1.FileName = ("c:\FileName.mid") MMControl1.Command = "open" MMControl1.Command = "play" End Sub

 

60

لتشغيل ملف فيديو في Picture

سنحتاج إلى الأداة mmcontrol

Private Sub Form_Load() MMControl1.FileName = ("c:\FileName.dat") MMControl1.Command = "open" MMControl1.hWndDisplay = Picture1.hWnd End Sub

 

61

لحذف أي ملف

Private Sub Command1_Click() Kill ("C:\FileName.fnm") End Sub

 

62

لمعرفة الفرق ما بين تاريخين باليوم

Private Sub Command1_Click() On Error GoTo 1 Dim Form1Date As Date Dim Form2Date As Date Form1Date = Text1.Text Form2Date = Text2.Text Text3.Text = DateDiff("d", Text1.Text, Text2.Text) & " يوم" Exit Sub 1 MsgBox ("من فضلك أدخل التاريخ بشكل صحيح") End Sub