تشخیص نوع درایو (drive type in visual basic (by api function

شاید برای شما پیش امده که بخواهید دستیابی به یک درایو را مسدود کنید.برای این کار ابتدا باید نوع درایو را تشخیص دهید.کدی که در زیر آورده شده است این کار را برای شما در ویژوال بیسیک انجام میدهد و می تواند ۳ نوع درایو زیر را مشخص کند.این جادوی توابع api است.

 

۱- هارد fixed disk

۲- سی دی رام cd rom

۳-فلش دیسکremovable disk

البته  یک timer با interval=100 را باید روی فرم قرار داد.

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Drive1_Change()
Me.AutoRedraw = True
  Select Case GetDriveType(Drive1.Drive)
     Case Is = 1
        Me.Print "Do not Exists"
     Case Is = 2
        Me.Print "Removable"
     Case Is = 3
        Me.Print "Drive Fixed"
     Case Is = 4
        Me.Print "Remote or Network"
     Case Is = 5
        Me.Print "Cd-Rom"
     Case Is = 6
        Me.Print "Ram disk"
     Case Else
        Me.Print "Unrecognized"
 End Select
End Sub

Private Sub Form_Load()

End Sub

دانلود فایل اجرایی

دانلود سورس برنامه

 

تغییر کرسر ماوس ویندوز

با سلام خدمت برنامه نویسان حرفه ای از جمله visual basic نویسان.

برنامه ای که در زیر آمده است می تواند windows curser mouse را تغییر دهد.این کار توسط توابع api در visual basic انجام می شود.  

Private Const OCR_NORMAL = 32512

Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long

Dim hCurOld As Long
Dim hCurNew As Long

Private Sub Command1_Click()
  hCurOld = GetCursor()
  hCurNew = CopyIcon(Picture1.Picture)
  SetSystemCursor hCurNew, OCR_NORMAL
End Sub

Private Sub Form_Load()

End Sub

دانلود

 

بدست آوردن ورژن ویندوز (windows version)

شاید شما به برنامه هایی برخورده باشید که فقط بر روی یک ورژن خاص windows اجرا شوند.برای اعمال این محدودیت در برنامه هایی که  visual basic نوشته می شوند می توان از تابع api زیر استفاده کرد.به این صورت که ابتدا با این تابع نسخه یا ویرایش windows را پیدا کرده و سپس با یک شرط در برنامه می توان ورژن ویندوز را چک کرده و از اجرا برنامه در یک نسخه خاص windows جلوگیری کرد. 

 Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Load()
  Dim Info As OSVERSIONINFO, strOs As String
  Dim Retval As Long, Result As String
 
  Me.AutoRedraw = True
  Info.dwOSVersionInfoSize = Len(Info)
  Retval = GetVersionEx(Info)
  If Retval = 0 Then MsgBox "Error": Exit Sub
  Select Case Info.dwPlatformId
     Case 0
        strOs = "Windows 3.x"
     Case 1
       If (Info.dwMinorVersion = 0) Then
         strOs = "Windows 95"
       End If
       If (Info.dwMinorVersion = 10) Then
         strOs = "Windows 98"
       End If
       If (Info.dwMinorVersion = 90) Then
         strOs = "Windows ME"
       End If
     Case 2
       If (Info.dwMajorVersion < 5) Then
         strOs = "Windows NT"
       End If
       If (Info.dwMajorVersion = 5 And Info.dwMinorVersion = 0) Then
         strOs = "Windows 2K"
       End If
       If (Info.dwMajorVersion = 5 And Info.dwMinorVersion = 1) Then
         strOs = "Windows XP"
       End If
  End Select
  Text1.Text = strOs
  Result = Str$(Info.dwMajorVersion) + "." + LTrim(Str(Info.dwMinorVersion))
  Text2.Text = Result
End Sub

 

 

دانلود 

 

hibernet کردن سیستم

امروز تابع api زیر رو برای هایبرنت کردن سیستم در وی بی براتون می گزارم.امیدوارم مورد استفاده صحیح قرار گیرد. دانلود

Private Declare Function SetSuspendState Lib "Powrprof" (ByVal Hibernate As Long, ByVal ForceCritical As Long, ByVal DisableWakeEvent As Long) As Long

 ()Private Sub Form_Load

  SetSuspendState 1, 0, 0
End Sub

حذف فایل بدون دادن اخطار

با تابع ای پی آی که در ویژوال بیسیک نوشته شده و در زیر لینک آن قرار داده شده است می توان یک فایل را حذف نمود بدون آنکه یوزر متوجه حذف فایل شود فقط کافیست کدهای زیر را در فرم visual basic وارد کنید.

دانلود

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

( )Private Sub Form_Load

   DeleteFile "C:\hossein.ini"End Sub

به همین سادگی

n وزير (n queen)

n وزير يكي از مسائلي است كه به دليل فضاي حالت زياد در حوضه طراحي الگوريتم و هوش مصنوعي مطرح مي گردد.در اين مساله بايد n وزير را در يك صفحه شطرنج n*n به گونه اي چيد كه هيچ وزيري يكديگر را تحديد نكنند.برنامه اي كه لينك آن براي دانلود گذاشته شده با زبان c نوشته شده و حدودا تا ۲۵ وزير در صفحه ۲۵*۲۵ كار ميكند.دانلود

tic tac toe هوش مصنوعي

تيك تك تو  يك بازي فكري دو نفري ۹ خانه اي است.هر نفر يك مهره در اين بازي دارد.o ,x .هر بازیکن باید سعی کند سه مهره را در یک سطر یا یک ستون یا یک قطر بچیند. (همان بازی دوز خودمون)این بازی معمولا در قالب پروژه درس هوش مصنوعی ارائه می گردد.کامپیوتر برای پیدا کردن بهترین گزینه برای قرار دادن مهره از درخت max min استفاده مي كند.در انتهابايد خاطر نشان كرد كه اين بازي به زبان وي بي اسكريپت نوشته شده و فقط با مرورگر ie قابل اجراست.دانلود

به دست آوردن فضای آزاد و فضای مصرفی رم

ابتدا دو text box بر روي فرم در ويژوال بيسيك بسازيد سپس در پنجره كد نويسي كد زير را وارد كنيد.

Private Type MEMORYSTATUS
  dwLength As Long
  dwMemoryLoad As Long
  dwTotalPhys As Long
  dwAvailPhys As Long
  dwTotalPageFile As Long
  dwAvailPageFile As Long
  dwTotalVirtual As Long
  dwAvailVirtual As Long
End Type

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)

Private Sub Form_Load()
  Dim Info As MEMORYSTATUS
 
  Info.dwLength = Len(MEMORYSTATUS)
  GlobalMemoryStatus Info
  Text1.Text = Info.dwTotalPhys & "== ALL RAM"
  Text2.Text = Info.dwAvailPhys & "== Used RAM"
End Sub

برنامه كامل اين تابع api در ويژوال بيسيك براي دانلود قرار داده شده است.دانلود

نمایش پنجره فرمت درایو

اين هم يك برنامه حرفه اي در ويژوال بيسيك!!!

برای تعیین درایو پارامتر دوم تابع یعنی iDrive را تغییر می دهیم ۰و۱ برای درایو A , B و اعداد بعدي براي تعيين درايو هاي بعدي براي فرمت مي باشند.اين هم لينك دانلود

ری استارت سیستم برای اعمال تغییرات در برنامه

برای این منظور کدهای زیر را در قسمت کدنویسی در ویژوال بیسیک وارد می کنیم.

Private Const SPFILEQ_FILE_IN_USE = &H1
Private Const SPFILEQ_REBOOT_IN_PROGRESS = &H4

Private Declare Function SetupPromptReboot Lib "setupapi.dll" (ByRef FileQueue As Long, ByVal Owner As Long, ByVal ScanOnly As Long) As Long

Private Sub Form_Load()
  SetupPromptReboot ByVal 0&, Me.hWnd, ByVal 0&
End Sub

پس از اجراي برنامه پنجره اي باز شده و از شما سوال مي كند آيا مي خواهيد كامپيوتر شما براي اعمال تغييرات ري استارت شود.در صورت تمايل دكمه yes را انتخاب کنید.کامپیوتر شما برای اعمال تغییرات   ری استارت میشود.