monster packet vb6 codes , various type v1

monster packet source want to share that i found in pc

tried to upload , gone past size limits so cant add attachment

i uploaded to sendspace
http://www.sendspace.com/file/lij39l

em this is must se and have by me + had it very long time and want to share +

i will share mega pack 2 /3/4

also got paid planet source and i will share with u all its my licence so i can share

Hi! :)

If your file is an archive (zip, rar, etc.), you could probably split it to multiple volumes so that each volume is within the attachment size limit. Anyway, thanks for sharing!

you welcome , yeh i have more and very nice stuff? here is 1 i like

Code:

---

Sub Form_Load()
    Text1.Text = "microsoft visual basic is a fun"
    Text1.Text = Text1.Text + " programming language."
    Text2.Text = CapAllWords(Text1.Text)
End Sub
Function CapAllWords(ByVal MyString As String) As String
    Dim PosSpc As Integer
    Mid(MyString, 1, 1) = UCase(Mid(MyString, 1, 1))
    PosSpc = InStr(MyString, " ")
    While PosSpc <> 0
        Mid(MyString, PosSpc + 1, 1) = UCase(Mid(MyString, PosSpc + 1, 1))
        PosSpc = InStr(PosSpc + 1, MyString, " ")
    Wend
    CapAllWords = MyString
End Function

---

:p

flip the pc monitor upside down

set formborder to 0

Code:

---

Private Declare Function GetDesktopWindow Lib "user32" () As Long 'This returns a window handle (hwnd)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long 'This returns a display context from a hWnd (hDC or DC)
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDestDc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal wSrc As Long, ByVal hSrc As Long, ByVal dwRop As Long) As Long
Const SRCCOPY = &HCC0020
Sub Capture(Frm As Form)
Dim rc As Long, Height As Long, Width As Long, dtHDC As Long
Dim Pic As New StdPicture
Width = Screen.Width / Screen.TwipsPerPixelX
Height = Screen.Height / Screen.TwipsPerPixelY
dtHDC = GetDC(GetDesktopWindow())
rc = BitBlt(GetDC(Pic.Handle), 0, 0, Width, Height, dtHDC, 0, 0, SRCCOPY)
rc = StretchBlt(Frm.hDC, Width, Height, -Width, -Height, GetDC(Pic.Handle), 0, 0, Width, Height, SRCCOPY)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
End
End Sub
Private Sub Form_Load()
Form1.Width = Screen.Width
Form1.Height = Screen.Height
Form1.AutoRedraw = True
Form1.WindowState = 2
Form1.BorderStyle = 0
Capture Me
End Sub

---

:p:p

Post #3 can be rewritten as:

Code:

---

Option Explicit

Private Sub Form_Load()
    Text1 = "microsoft visual basic is a fun programming language."
    Text2 = CapAllWords(Text1)
    Text3 = StrConv(Text1, vbProperCase) '<-- One-liner alternative
End Sub

Private Function CapAllWords(ByRef MyString As String) As String
    Dim PosSpc As Long

    CapAllWords = LCase$(MyString)

    Do:  Mid$(CapAllWords, PosSpc + 1&, 1&) = UCase$(Mid$(CapAllWords, PosSpc + 1&, 1&))
        PosSpc = InStr(PosSpc + 1&, CapAllWords, " ")
    Loop While PosSpc
End Function

---

sleeeeeek buttons + progress bars and others crome stuff

nice buttons i never seen these before cool:eek::eek::eek::eek::eek:

A new class implementation of Winsock API. By style close to the native Winsock control and other class implementations such as CSocket and CSocketMaster, so you don't need to learn or rewrite much of existing code. The new and cool part about this class is that it is just one class file. Also, it performs better (by speed) and handles errors a bit more cleanly (you aren't forced to close the socket each time an error occurs). Other speciality is transparent Unicode support: when you switch to text mode, you start receiving TextArrival event instead of DataArrival and start getting individual lines. These lines are automatically Unicode if received line is UTF-8 or UTF-16! ANSI lines require you to use StrConv to get an usable string, thus you have the power on what to do with the raw data before any conversion has affected



very good :phas many socket options:p

all the capture source lots enjoy , dont miss out

http://www.sendspace.com/file/lhh938

If you don't mind, I would like to share this code snippet that creates all the folders in the given path:

Code:

---

Attribute VB_Name = "modMkDirEx"
Option Explicit

Private Declare Function CreateDirectoryW Lib "kernel32.dll" (ByVal lpPathName As Long, Optional ByVal lpSecurityAttributes As Long) As Long

Public Sub MkDirEx(ByRef sPath As String)
    Dim Pos As Long, sDir As String

    Pos = InStr(sPath, ":\") + 1&
    sDir = Left$(sPath, Pos) & Replace(sPath, "\", vbNullChar, Pos + 1&)

    On Error Resume Next
    Do: MkDir sDir
        Pos = InStr(Pos, sDir, vbNullChar)
        If Pos Then Mid$(sDir, Pos) = "\" Else Exit Sub
    Loop
End Sub

Public Sub MkDirExW(ByRef sPath As String)
    Dim Pos As Long, sDir As String

    Pos = InStr(sPath, ":\") + 1&
    sDir = Left$(sPath, Pos) & Replace(sPath, "\", vbNullChar, Pos + 1&)

    Do: CreateDirectoryW StrPtr(sDir)
        Pos = InStr(Pos, sDir, vbNullChar)
        If Pos Then Mid$(sDir, Pos) = "\" Else Exit Sub
    Loop
End Sub

'Create Path Recursively as Needed (w/o APIs) by Brock Weaver
'http://www.freevbcode.com/ShowCode.asp?ID=257
Public Function CreateFolder(ByRef sFolder As String) As String
    Dim sPath As String

    sPath = Left$(sFolder, InStrRev(sFolder, "\") - 1&)
    On Error GoTo End_Function
    If LenB(Dir(sPath, vbDirectory)) = 0& Then MkDir CreateFolder(sPath)
    CreateFolder = sFolder
End_Function:
End Function

---

its ok add much as u can:) , i will post all source here too:pbonnie:p

Here's a simpler way of achieving the same effect in post #4:

Code:

---

'Paste into a blank Form
Option Explicit

Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function StretchBlt Lib "gdi32.dll" ( _
    ByVal hdcDest As Long, _
    ByVal nXOriginDest As Long, _
    ByVal nYOriginDest As Long, _
    ByVal nWidthDest As Long, _
    ByVal nHeightDest As Long, _
    ByVal hdcSrc As Long, _
    ByVal nXOriginSrc As Long, _
    ByVal nYOriginSrc As Long, _
    ByVal nWidthSrc As Long, _
    ByVal nHeightSrc As Long, _
    ByVal dwRop As RasterOpConstants _
) As Long

Private Sub InvertScreen(ByRef Frm As Form)
    Dim hDCDesk As Long, hWndDesk As Long
    Dim Width As Long, Height As Long

    Width = Screen.Width / Screen.TwipsPerPixelX
    Height = Screen.Height / Screen.TwipsPerPixelY
    hWndDesk = GetDesktopWindow
    hDCDesk = GetDC(hWndDesk)
    StretchBlt Frm.hDC, Width, Height, -Width, -Height, _
    hDCDesk, 0&, 0&, Width, Height, vbSrcCopy
    hDCDesk = ReleaseDC(hWndDesk, hDCDesk): Debug.Assert hDCDesk
End Sub

Private Sub Form_Click()
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    Unload Me
End Sub

Private Sub Form_Load()
    AutoRedraw = True
    BorderStyle = vbBSNone
    Caption = Caption
    WindowState = vbMaximized
    InvertScreen Me
End Sub

---