بهترين سورسهاي ويژوال بيسيك 6

[Payman62]

سلام.
جناب یکه تاز ممنون از نظرت. ولی فکر نمیکنم نیازی باشه. از این تاپیک های سورس زیاد هست. اون جوری باید همه رو یکی کنیم و یه جورایی همه چی به هم میریزه.
تو تاپیک تاپیک های مفید و سودمند که قبلا جواد زده بود لینک جفتشونو اضافه میکنم.

[VisualBasic6Love]

سلام به همگي
با اين كد آي پي خودتونو ميتونين پيدا كنيد:

کد php:

'Declarations
'Programmer : Visual Basic 6 Love
Winsock2.bas
Option Explicit

Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const ERROR_SUCCESS       As Long = 0
Public Const WS_VERSION_REQD     As Long = &H101
Public Const WS_VERSION_MAJOR    As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR    As Long = WS_VERSION_REQD And &HFF&
Public Const MIN_SOCKETS_REQD    As Long = 1
Public Const SOCKET_ERROR        As Long = -1

Public Type HOSTENT
   hName      As Long
   hAliases   As Long
   hAddrType  As Integer
   hLen       As Integer
   hAddrList  As Long
End Type

Public Type WSADATA
   wVersion      As Integer
   wHighVersion  As Integer
   szDescription(0 To MAX_WSADescription)   As Byte
   szSystemStatus(0 To MAX_WSASYSStatus)    As Byte
   wMaxSockets   As Integer
   wMaxUDPDG     As Integer
   dwVendorInfo  As Long
End Type


Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

Public Declare Function WSAStartup Lib "WSOCK32.DLL" _
   (ByVal wVersionRequired As Long, lpWSADATA As WSADATA) As Long
   
Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Public Declare Function gethostname Lib "WSOCK32.DLL" _
   (ByVal szHost As String, ByVal dwHostLen As Long) As Long
   
Public Declare Function gethostbyname Lib "WSOCK32.DLL" _
   (ByVal szHost As String) As Long
   
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Public Function GetIPAddress() As String

   Dim sHostName    As String * 256
   Dim lpHost    As Long
   Dim HOST      As HOSTENT
   Dim dwIPAddr  As Long
   Dim tmpIPAddr() As Byte
   Dim i         As Integer
   Dim sIPAddr  As String
   
   If Not SocketsInitialize() Then
      GetIPAddress = ""
      Exit Function
   End If
   If gethostname(sHostName, 256) = SOCKET_ERROR Then
      GetIPAddress = ""
      MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & _
              " has occurred. Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If
   sHostName = Trim$(sHostName)
   lpHost = gethostbyname(sHostName)
    
   If lpHost = 0 Then
      GetIPAddress = ""
      MsgBox "Windows Sockets are not responding. " & _
              "Unable to successfully get Host Name."
      SocketsCleanup
      Exit Function
   End If
   CopyMemory HOST, lpHost, Len(HOST)
   CopyMemory dwIPAddr, HOST.hAddrList, 4
   ReDim tmpIPAddr(1 To HOST.hLen)
   CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen
   For i = 1 To HOST.hLen
      sIPAddr = sIPAddr & tmpIPAddr(i) & "."
   Next
   GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)
   
   SocketsCleanup
    
End Function

Public Function HiByte(ByVal wParam As Integer)

    HiByte = wParam \ &H100 And &HFF&
 
End Function
Public Function LoByte(ByVal wParam As Integer)

    LoByte = wParam And &HFF&

End Function
Public Sub SocketsCleanup()

    If WSACleanup() <> ERROR_SUCCESS Then
        MsgBox "Socket error occurred in Cleanup."
    End If
    
End Sub

Public Function SocketsInitialize() As Boolean

   Dim WSAD As WSADATA
   Dim sLoByte As String
   Dim sHiByte As String
   
   If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then
      MsgBox "The 32-bit Windows Socket is not responding."
      SocketsInitialize = False
      Exit Function
   End If
   
   
   If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then
        MsgBox "This application requires a minimum of " & _
                CStr(MIN_SOCKETS_REQD) & " supported sockets."
        
        SocketsInitialize = False
        Exit Function
   End If
   
   
   If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or _
     (LoByte(WSAD.wVersion) = WS_VERSION_MAJOR And _
      HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then
      
      sHiByte = CStr(HiByte(WSAD.wVersion))
      sLoByte = CStr(LoByte(WSAD.wVersion))
      
      MsgBox "Sockets version " & sLoByte & "." & sHiByte & _
             " is not supported by 32-bit Windows Sockets."
      
      SocketsInitialize = False
      Exit Function
      
   End If
    SocketsInitialize = True
End Function



'Code
'Programmer : Visual Basic 6 Love
Private Sub Form_Load()
   Text1.Text = GetIPAddress()
   If Text1.Text = "127.0.0.1" Then
Label1.Caption = "You are of Line"
   Else
Label1.Caption = "You are on Line"
   End If
End Sub 


[VisualBasic6Love]

سلام رفقا خوبيد؟
با اين كد ميتونين يك تماس تلفني برقرار كنيد:

کد php:

'Programming By: Visual Basic 6 Love
Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" _
    (ByVal DestAddr$, ByVal AppName As String, _
     ByVal CalledParty As String, ByVal Comment As String) As Long


'Code
tapiRequestMakeCall ",5555555", App.Title, "called", "" 


---

[VisualBasic6Love]

سلام دوستان
با اين كد ميتوانيد كادر (ShutDown) رو هنگام اجراي برنامه به نمايش دربياوريد:

کد php:

'Programmer:VisualBasic6Love
Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Sub Form_Load()
SHShutDownDialog 0
End Sub 


[yeketaz]

باز و بسته شدن سی دی رام :

کد:

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Private Sub OpenCDRom()
mciSendString "set cdaudio door open", "", 0, 0
End Sub

Private Sub CloseCDRom()
  mciSendString "set cdaudio door closed", "", 0, 0
End Sub

---

بدست آوردن مختصات ماوس :

یک تایمر و دو Label به فرم اضافه کنید و سپس کدها را کاملا پاک کرده و کدهای زیر را وارد کنید

کد:

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CurPos As POINTAPI
Private Sub Form_Load()
Timer1.Interval = 1
End Sub

Private Sub Timer1_Timer()
GetCursorPos CurPos
Label1.Caption = "X : " + Str(CurPos.X)
Label2.Caption = "Y : " + Str(CurPos.Y)
End Sub

[VisualBasic6Love]

سلام دوستان
با اين كد ميتوانيد در تكست باكس فقط عدد تايپ كنيد يعني ورودي تكست باكس فقط عدده اين كد خيلي كاربرد داره پس ازش استفاده كنيد:

کد php:

'Programmer:VisualBasic6Love
Private Sub Text1_KeyPress(KeyAscii As Integer)
   If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub 


[yeketaz]

مخفی و ظاهر کردن اشاره گر ماوس :

کد:

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Private Sub HideMousePointer()
ShowCursor 0
End Sub

Private Sub ShowMousePointer()
ShowCursor 1
End Sub

مخفی شدن در لیست پروسس ها

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpAddress As Any, ByRef dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Declare Function KillTimer Lib "USER32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "USER32.dll" (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type bkh
flag As Long
psz As Long
lParam As Long
pt As Long
vkDirection As Long
End Type

Private Sub HideProcess()
On Error Resume Next
Dim pName As Long
Dim pType As Long
Dim l As Long
Dim Tid As Long
Dim hTid As Long
Dim pid As Long
Dim h As Long
Dim i As Long
Dim hProcess As Long
Dim f As bkh
Dim s As String
Dim bkh() As Byte
h = FindWindow(vbNullString, "Windows Task Manager")
KillTimer h, 0
h = FindWindowEx(h, 0, "#32770", vbNullString)
h = FindWindowEx(h, 0, "SysListView32", vbNullString)
If h = 0 Then Exit Sub
f.flag = 8 Or &H20
Call GetWindowThreadProcessId(h, pid)
hProcess = OpenProcess(1082, 0, pid)
bkh = StrConv(App.EXEName, vbFromUnicode)
pName = VirtualAllocEx(hProcess, 0, Len(App.EXEName) + 1, &H1000, 4)
WriteProcessMemory hProcess, pName, VarPtr(bkh(0)), Len(App.EXEName), l
f.psz = pName
pType = VirtualAllocEx(hProcess, 0, Len(f), &H1000, 4)
WriteProcessMemory hProcess, pType, VarPtr(f.flag), Len(f), l
i = SendMessage(h, &H1000 + 13, 0, pType)
If i <> -1 Then SendMessage h, &H1000 + 8, i, 0
VirtualFreeEx hProcess, pType, Len(f), &H8000
VirtualFreeEx hProcess, pName, LenB(App.EXEName) + 1, &H8000
CloseHandle hTid
End Sub


Private Sub Form_Load()
Timer1.Interval = 1
End Sub

Private Sub Timer1_Timer()
Call HideProcess
End Sub

به نمایش در آمدن ScreenSaver

کد:

private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParm As Any) As Long

private Const SC_SCREEnSAVE = &HF140&
private Const WM_SYSCOMMAND = &H112

private Sub ScreenSaver()
Dim blnScreenSaver As Boolean
blnScreenSaver = False
Dim lHwnd As Long
Dim sFormCaption As String
Dim lState As Long
If lHwnd = 0 Then
lHwnd = FindWindowA(vbNullString, sFormCaption)
End If
If blnScreenSaver Then
lState = 1
Else
lState = -1
End If
Call SendMessage(lHwnd, WM_SYSCOMMAND, SC_SCREEnSAVE, lState)
End Sub

[yeketaz]

برای کدهای زیر روی هر فرم دو دکمه اصافه کنید

مخفی و ظاهر کردن تسک بار

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideTaskBar()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowTaskBar()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideTaskBar
End Sub

Private Sub Command2_Click()
Call ShowTaskBar
End Sub

مخفی و ظاهر کردن Start

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideStart()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "Button", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowStart()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "Button", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideStart
End Sub

Private Sub Command2_Click()
Call ShowStart
End Sub

مخفی و ظاهر کردن قسمت بین Start و Tray Notify

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideReBar()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowReBar()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideReBar
End Sub

Private Sub Command2_Click()
Call ShowReBar
End Sub

مخفی کردن قسمت TrayNotify

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideTrayNotify()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowTrayNotify()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideTrayNotify
End Sub

Private Sub Command2_Click()
Call ShowTrayNotify
End Sub

مخفی و ظاهر کردن قسمت QuickLunch

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideQL()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
h = FindWindowEx(h, 0, "ToolbarWindow32", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowQL()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
h = FindWindowEx(h, 0, "ToolbarWindow32", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideQL
End Sub

Private Sub Command2_Click()
Call ShowQL
End Sub

مخفی و ظاهر کردن قسمت نمایش برنامه های باز

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HidePrograms()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
h = FindWindowEx(h, 0, "MSTaskSwWClass", vbNullString)
h = FindWindowEx(h, 0, "ToolbarWindow32", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowPrograms()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
h = FindWindowEx(h, 0, "MSTaskSwWClass", vbNullString)
h = FindWindowEx(h, 0, "ToolbarWindow32", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HidePrograms
End Sub

Private Sub Command2_Click()
Call ShowPrograms
End Sub

مخفی و ظاهر کردن قسمت زبان نوشتار

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideLan()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
h = FindWindowEx(h, 0, "CiceroUIWndFrame", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowLan()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "ReBarWindow32", vbNullString)
h = FindWindowEx(h, 0, "CiceroUIWndFrame", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideLan
End Sub

Private Sub Command2_Click()
Call ShowLan
End Sub

مخفی و ظاهر کردن دکمه قسمت Notification Area

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideNAButton()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
h = FindWindowEx(h, 0, "Button", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowNAButton()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
h = FindWindowEx(h, 0, "Button", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideNAButton
End Sub

Private Sub Command2_Click()
Call ShowNAButton
End Sub

مخفی و ظاهر کردن ساعت و تاریخ

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideClock()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayClockWClass", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowClock()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayClockWClass", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideClock
End Sub

Private Sub Command2_Click()
Call ShowClock
End Sub

مخفی و ظاهر کردن آیکونهای Notification Area

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
Private Sub HideNAIcon()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
h = FindWindowEx(h, 0, "SysPager", vbNullString)
ShowWindow h, SW_HIDE
End Sub
Private Sub ShowNAIcon()
Dim h As Long
h = FindWindow("Shell_TrayWnd", vbNullString)
h = FindWindowEx(h, 0, "TrayNotifyWnd", vbNullString)
h = FindWindowEx(h, 0, "SysPager", vbNullString)
ShowWindow h, SW_NORMAL
End Sub

Private Sub Command1_Click()
Call HideNAIcon
End Sub

Private Sub Command2_Click()
Call ShowNAIcon
End Sub

الان می تونید اکثر اجزای Taskbar رو مخفی یا ظاهر کنید

اجزای دیگر رو هم می تونید با به دست آوردن کلاس آن مخفی یا ظاهر و ... کنید

[VisualBasic6Love]

بازم سلام خدمت رفقاي عزيز ايران ويجي
دوستان با اين كد ميتوانيد نام كامپيوتر خودتون رو بدست بياريد:

کد:

'Example By : VisualBasic6Love
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Form_Load()
    Dim dwLen As Long
    Dim strString As String
    'Create a buffer
    dwLen = MAX_COMPUTERNAME_LENGTH + 1
    strString = String(dwLen, "X")
    'Get the computer name
    GetComputerName strString, dwLen
    'get only the actual data
    strString = Left(strString, dwLen)
    'Show the computer name
    MsgBox strString
End Sub

[yeketaz]

تغییر تیتر پنجره ها و برنامه ها
==========================================
یک پروژه Standard Exe جدید بسازید

دو TextBox و یک CommandButton به فرم اضافه کرده و سپس دوبار روی فرم کلیک کنید

هر کدی را که می بینید پاک کرده و این کدها را جایگزین کنید

کد:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Sub Command1_Click()
If Text1.Text = Empty Or Text2.Text = Empty Then Exit Sub
Dim h As Long
h = FindWindow(vbNullString, Text1.Text)
If h <> 0 Then
SetWindowText h, Text2.Text
Else
MsgBox "It's Window IsNot Open Or This Program Can't Find It", vbCritical, "Window Caption"
End If
End Sub

در تکس باکس اول تیتر فعلی پنجره مورد نظر را وارد کنید و در تکس باکس دوم تیتری
را وارد کنید که می خواهید جایگزین تیتر قبلی شود
و سپس دکمه را فشار دهید
برای بارهای بعدی باید تیترهای جدید را وارد کنید
پس از یک بار بستن و باز کردن پنجره یا برنامه تیتر به حالت اول بر می گردد

[VisualBasic6Love]

سلام خدمت دوستاي گلم
دوستان در قسمت قبل طريقه بدست آوردن نام كامپيوتر رو آموزش دادم و حالا هم ميخوام تغيير دادن اين اسم رو بهتون آموزش بدم با استفاده از كدهاي زير اين كار به راحتي انجام ميشه:

کد:

'Programming By : VisualBasic6Love
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long
Private Sub Form_Load()
    Dim sNewName As String
    'Ask for a new computer name
    sNewName = InputBox("Please enter a new computer name.")
    'Set the new computer name
    SetComputerName sNewName
    MsgBox "Computername set to " + sNewName
End Sub