monster list codes 2

Capturing audio Events

Code:

---

Dim WithEvents Encoder As WMEncoder

Private Sub Encoder_OnStateChange(ByVal enumState As WMEncoderLib.WMENC_ENCODER_STATE)
    ' Wait until the encoding process stops before
    ' exiting the application.
    If enumState = WMENC_ENCODER_RUNNING Then
        ' TODO: Handle running state.
    ElseIf enumState = WMENC_ENCODER_PAUSED Then
        ' TODO: Handle paused state.
    ElseIf enumState = WMENC_ENCODER_STOPPED Then
        ' End the application.
        End
    Else
        ' TODO: Handle other encoder states.
    End If
End Sub

Private Sub Form_Load()
    ' Create a WMEncoder object.
    Set Encoder = New WMEncoder
 
    ' Retrieve the source group collection and add a source group.
    Dim SrcGrpColl As IWMEncSourceGroupCollection
    Set SrcGrpColl = Encoder.SourceGroupCollection
    Dim SrcGrp As IWMEncSourceGroup2
    Set SrcGrp = SrcGrpColl.Add("SG_1")
   
    ' Add a video and audio source to the source group.
    Dim SrcVid As IWMEncVideoSource2
    Dim SrcAud As IWMEncAudioSource
    Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
    Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)
   
    ' Identify the source files to encode.
    SrcVid.SetInput "C:\\InputFile.mpg"
    SrcAud.SetInput "C:\\InputFile.mpg"
   
    ' Choose a profile from the collection.
    Dim ProColl As IWMEncProfileCollection
    Dim Pro As IWMEncProfile
    Dim i As Integer
    Dim lLength As Long
   
    Set ProColl = Encoder.ProfileCollection
    lLength = ProColl.Count
   
    For i = 0 To lLength - 1
        Set Pro = ProColl.Item(i)
        If Pro.Name = "Windows Media Video 8 for Local Area Network (384 Kbps)" Then
            SrcGrp.Profile = Pro
            Exit For
        End If
    Next
   
    ' Fill in the description object members.
    Dim Descr As IWMEncDisplayInfo
    Set Descr = Encoder.DisplayInfo
    Descr.Author = "Author name"
    Descr.Copyright = "Copyright information"
    Descr.Description = "Text description of encoded content"
    Descr.Rating = "Rating information"
    Descr.Title = "Title of encoded content"
     
    ' Specify a file object in which to save encoded content.
    Dim File As IWMEncFile
    Set File = Encoder.File
    File.LocalFileName = "C:\\OutputFile.wmv"
     
    ' Start the encoding process.
    Encoder.Start
End Sub

---

Broadcasting a Live Stream Using the Predefined UI

Code:

---

The following example shows how to create the predefined user interface and broadcast live multimedia content from the local computer. The audio and video sources are configured to use the default sound card and capture card. Use a blank form for this example.

' Create WMEncoderApp and WMEncoder objects.
  Dim Encoder As WMEncoder
  Dim EncoderApp As WMEncoderApp

Private Sub Form_Load()
  Set EncoderApp = New WMEncoderApp
  Set Encoder = EncoderApp.Encoder

' Display the predefined Encoder UI.
  EncoderApp.Visible = True

' Specify the source for the input stream.
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Dim SrcGrp As IWMEncSourceGroup
  Dim SrcVid As IWMEncSource
  Dim SrcAud As IWMEncSource

  Set SrcGrpColl = Encoder.SourceGroupCollection
  Set SrcGrp = SrcGrpColl.Add("SG_1")
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)

  SrcVid.SetInput "DEVICE://Default_Video_Device"
  SrcAud.SetInput "DEVICE://Default_Audio_Device"

' Specify a profile.
  Dim ProColl As IWMEncProfileCollection
  Dim Pro As IWMEncProfile
  Dim i As Integer

  Set ProColl = Encoder.ProfileCollection

  For i = 0 To ProColl.Count - 1
    Set Pro = ProColl.Item(i)
    If Pro.Name = "Windows Media Video 8 for Local Area Network (384 Kbps)" Then
        SrcGrp.Profile = Pro
        Exit For
    End If
  Next

' Create a broadcast.
  Dim BrdCst As IWMEncBroadcast
  Set BrdCst = Encoder.Broadcast
  BrdCst.PortNumber(WMENC_PROTOCOL_HTTP) = 8080

' Start the encoding process.
  Encoder.Start

End Sub

---

Configuring Multiple Source Groups

Code:

---

The following example shows how you can set up two source groups with audio and video content. The first source group uses a file (C:\InputFile.mpg), and the second source group uses the default sound card and capture card. The result is broadcasted from the local computer (http://computer_name:8080).

For information about enumerating the audio and video devices on your system, see the Listing All Devices (Visual Basic) example.

Sub Main()
' Create a Windows Media Encoder object.
  Dim Encoder As WMEncoder
  Set Encoder = New WMEncoder
 
' Create a source group collection object from the WMEncoder object.
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Set SrcGrpColl = Encoder.SourceGroupCollection
 
' Create a profile collection object from the WMEncoder object.
  Dim ProColl As IWMEncProfileCollection
  Set ProColl = Encoder.ProfileCollection
 
' Add a source group named SG1 to the collection.
' Create a source object for each type of multimedia content
' in the source group.
  Dim SrcGrp1 As IWMEncSourceGroup2
  Dim SrcAud1 As IWMEncAudioSource
  Dim SrcVid1 As IWMEncVideoSource2
  Set SrcGrp1 = SrcGrpColl.Add("SG1")
  Set SrcAud1 = SrcGrp1.AddSource(WMENC_AUDIO)
  Set SrcVid1 = SrcGrp1.AddSource(WMENC_VIDEO)
 
' Create a second source group named SG2, and two source objects.
  Dim SrcGrp2 As IWMEncSourceGroup2
  Dim SrcAud2 As IWMEncAudioSource
  Dim SrcVid2 As IWMEncVideoSource2
  Set SrcGrp2 = SrcGrpColl.Add("SG2")
  Set SrcAud2 = SrcGrp2.AddSource(WMENC_AUDIO)
  Set SrcVid2 = SrcGrp2.AddSource(WMENC_VIDEO)
 
' Create an IWMEncBroadcast object and specify a port and a protocol.
  Dim Brdcst As IWMEncBroadcast
  Set Brdcst = Encoder.Broadcast
  Brdcst.PortNumber(WMENC_PROTOCOL_HTTP) = 8080
 
' Specify the input for the sources in the first source group.
' For this example, source group 1 uses file sources.
  SrcAud1.SetInput "C:\InputFile.mpg"
  SrcVid1.SetInput "C:\InputFile.mpg"
 
' Create a profile object. For brevity, this example uses the first
' profile in the collection. Then specify this profile object as
' the profile to use in source group 1.
  Dim Pro As IWMEncProfile
  Set Pro = ProColl.Item(0)
  SrcGrp1.Profile = Pro
 
' Specify the input sources for source group 2. In this example,
' the sources are the default audio and video devices.
' Set the profile for source group 2 to the same profile object.
  SrcAud2.SetInput "DEVICE://Default_Audio_Device"
  SrcVid2.SetInput "DEVICE://Default_Video_Device"
  SrcGrp2.Profile = Pro
 
' Set source group 1 to roll over automatically to source group 2.
' -1 indicates that the rollover happens when source group 1
' has been encoded.
  SrcGrp1.SetAutoRollover -1, "SG2"
 
' Start encoding.
  Encoder.Start

' For this example, use a message box to stop the application when you
' have finished encoding.
  MsgBox "Click OK to stop encoding."

End Sub

---

Controlling a Digital Device (Visual Basic)

Code:

---

Controlling a Digital Device (Visual Basic)
This example shows how to:

Use a digital device as a source.
Use VCR-style buttons to forward, rewind, play, and stop the tape.
View the device output as you cue the tape before encoding.
Use events to monitor changes in state.
This example uses a pre-preview to display the stream before encoding begins, and a preview of the stream during encoding.

To use this example, you need:

A form (Form1).
A frame (PreviewFrame).
Four VCR-style buttons (btnREW, btnPLAY, btnFF, and btnSTOP).
A button to start the encoding process (btnEncode).
A label (Label1) for displaying the state of the device.
In addition to the Windows Media Encoder reference, you must also add the Windows Media Encoder Device Control and the Windows Media Encoder Preview Control references to your project.

It is also assumed that you have a digital device connected to the computer. The Windows Media Encoder SDK supports digital video (DV) devices connected to an IEEE 1394 digital video port, and video tape recorder (VTR) devices connected through a COM port using the Sony RS422 protocol.

Option Explicit

'Declare variables.
Dim WithEvents Encoder As WMEncoder
Dim SrcGrpColl As IWMEncSourceGroupCollection
Dim SrcGrp As IWMEncSourceGroup2
Dim SrcAud As IWMEncSource
Dim SrcVid As IWMEncVideoSource
Dim ProColl As IWMEncProfileCollection
Dim Pro As IWMEncProfile
Dim File As IWMEncFile
Dim DCPlugMgr As IWMEncDeviceControlPluginInfoManager
Dim PlugInfo As IWMEncPluginInfo
Dim DCColl As IWMEncDeviceControlCollection
Dim DControl As IWMEncDeviceControl
Dim DCPlugin As IWMEncDeviceControlPlugin
Dim DVColl_Preview As IWMEncDataViewCollection
Dim Preview As WMEncDataView
Dim PrePreview As WMEncPrepreview
Dim lPreviewStream As Integer
Dim sDeviceString As String
Dim i As Integer, j As Integer

Private Sub Form_Load()
' Create a WMEncoder object.
  Set Encoder = New WMEncoder

' Retrieve a device control plug-in info manager object from WMEncoder.
  Set DCPlugMgr = Encoder.DeviceControlPluginInfoManager

' Loop through the connected digital devices on the system such as DV cameras and VTRs.
  For i = 0 To DCPlugMgr.Count - 1

  ' Set the IWMEncPluginInfo object to the current plug-in.
    Set PlugInfo = DCPlugMgr.Item(i)
   
  ' Find the first device plug-in that supports resources.
    If PlugInfo.SchemeType = "DeviceControl" And PlugInfo.Resources = True Then
        sDeviceString = PlugInfo.Item(0)
        Exit For
    End If

  Next i
 
' Add the device as the audio source and video source.
  Set SrcGrpColl = Encoder.SourceGroupCollection
  Set SrcGrp = SrcGrpColl.Add("SG_1")
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  SrcAud.SetInput ("Device://" & sDeviceString)
  SrcVid.SetInput ("Device://" & sDeviceString)

' Encode to a file.
  Set File = Encoder.File
  File.LocalFileName = "C:\DeviceOutput.wmv"
   
' Select a profile from the collection and set it into the source group.
  Set ProColl = Encoder.ProfileCollection
  For i = 0 To ProColl.Count - 1
    Set Pro = ProColl.Item(i)
    If (Pro.Name = "Windows Media Video 8 for Local Area Network (384 Kbps)") Then
        SrcGrp.Profile = Pro
    End If
  Next i
   
' Retrieve the device control collection, then add a device to it.
  Set DCColl = SrcGrp.DeviceControlCollection
  Set DControl = DCColl.Add
  DControl.SetInput ("DeviceControl://" & sDeviceString)

  ' Initialize the encoding session.
  Encoder.PrepareToEncode True

  ' Get the plug-in from the device.
  Set DCPlugin = DControl.GetDeviceControlPlugin

  ' Get the source plug-in for the pre-preview and then display it in the frame.
  Set PrePreview = SrcVid.GetSourcePlugin
  PrePreview.SetCaptureParent PreviewFrame.hWnd

  ' Retrieve the preview collection and create a preview object.
  Set DVColl_Preview = SrcVid.PreviewCollection
  Set Preview = New WMEncDataView

End Sub
Private Sub btnEncode_Click()
  ' Specify the stream to preview.
  lPreviewStream = DVColl_Preview.Add(Preview)
 
  ' Disable the VCR buttons.
  btnREW.Enabled = False
  btnPLAY.Enabled = False
  btnFF.Enabled = False
  btnSTOP.Enabled = False
   
  ' Start encoding.
  Encoder.Start

  ' Display the preview in PreviewFrame.
  Preview.SetViewProperties lPreviewStream, PreviewFrame.hWnd
  Preview.StartView (lPreviewStream)
   
End Sub
Private Sub btnREW_Click()
  ' Rewind.
  DCPlugin.SetOperation (WMENC_DEVICE_REW)
End Sub
Private Sub btnPLAY_Click()
  ' Play.
  DCPlugin.SetOperation (WMENC_DEVICE_PLAY)
End Sub
Private Sub btnFF_Click()
  ' Forward.
  DCPlugin.SetOperation (WMENC_DEVICE_FF)
End Sub
Private Sub btnSTOP_Click()
  ' Stop.
  DCPlugin.SetOperation (WMENC_DEVICE_STOP)
End Sub

Private Sub Encoder_OnDeviceControlStateChange(ByVal EnumState As WMEncoderLib.WMENC_DEVICECONTROL_STATE, ByVal sName As String, ByVal sScheme As String)
' When the device state changes, display the state in Label1.
  Select Case EnumState:
        Case WMENC_DEVICECONTROL_PLAYING
        Label1.Caption = "Playing"
       
        Case WMENC_DEVICECONTROL_STOPPED
        Label1.Caption = "Stopped"
       
        Case WMENC_DEVICECONTROL_FASTFORWARDING
        Label1.Caption = "Forwarding"
       
        Case WMENC_DEVICECONTROL_REWINDING
        Label1.Caption = "Rewinding"
       
        Case WMENC_DEVICECONTROL_UNSTABLE
        Label1.Caption = "Unstable"
       
        Case WMENC_DEVICECONTROL_EJECT
        Label1.Caption = "Eject"
       
        Case WMENC_DEVICECONTROL_ENDOFTAPE
        Label1.Caption = "End of tape"
        bDone = True
       
    End Select
   
 End Sub

---

Creating a Multiple Bit Rate Profile

Code:

---

This example shows how to:

Create a multiple bit rate (MBR) profile with three audiences.
Change the settings that are applied by default.
Validate the settings.
Save the profile to a .prx file.
See the Listing All Codecs (Visual Basic) example for information about enumerating the codecs that you can use with profiles.

Sub main()
' Create a WMEncProfile2 object.
  Dim Pro As WMEncProfile2
  Set Pro = New WMEncProfile2
 
' Verify profile settings immediately as they are set.
  Pro.ValidateMode = True
 
' Provide a name and description.
  Pro.ProfileName = "Sample MBR Profile"
  Pro.ProfileDescription = "A video profile with three audiences."
 
' Specify video content.
  Pro.ContentType = 16
 
' Specify constant bit rate (CBR) mode.
  Pro.VBRMode(WMENC_VIDEO, 0) = WMENC_PVM_NONE
 
' Add audiences for 200, 400, and 600 Kbps.
  Pro.AddAudience 200000
  Pro.AddAudience 400000
  Pro.AddAudience 600000
 
' Create an audience object, then loop through all of the audiences
' in the current profile, making the same changes to each audience.
  Dim Audnc As IWMEncAudienceObj
  For x = 0 To Pro.AudienceCount - 1
    Set Audnc = Pro.Audience(x)
    ' The Windows Media 9 codec is used by default, but you can change
    ' it as follows. Be sure to make this change for each audience.
      Audnc.VideoCodec(0) = 5
   
    ' Make the video output size match the input size by setting
    ' height and width to 0.
      Audnc.VideoHeight(0) = 0
      Audnc.VideoWidth(0) = 0
     
    ' Change the buffer size to 5 seconds. By default, the end user's
    ' default setting is used. 
      Audnc.VideoBufferSize(0) = 5000
  Next x
 
' Change the video image sharpness for the first audience only.
  Set Audnc = Pro.Audience(0)
  Audnc.VideoImageSharpness(0) = 70
 
' Validate the settings to make sure the profile has no errors.
  Pro.Validate
 
' Save the profile to a .prx file.
  Pro.SaveToFile "C:\Program Files\Windows Media Components\Encoder\Profiles\MyProfile.prx"

End Sub

---

FileConversion MP3 to Wmf

Code:

---

Sub Main()
' Create a WMEncoder object.
  Dim Encoder As WMEncoder
  Set Encoder = New WMEncoder

' Retrieve the source group collection and add a source group.
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Set SrcGrpColl = Encoder.SourceGroupCollection
  Dim SrcGrp As IWMEncSourceGroup2
  Set SrcGrp = SrcGrpColl.Add("SG_1")

' Add a video and audio source to the source group.
  Dim SrcVid As IWMEncVideoSource2
  Dim SrcAud As IWMEncAudioSource
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)

' Identify the source files to encode.
  SrcVid.SetInput "C:\InputFile.mpg"
  SrcAud.SetInput "C:\InputFile.mpg"

' Choose a profile from the collection.
  Dim ProColl As IWMEncProfileCollection
  Dim Pro As IWMEncProfile
  Dim i As Integer
  Dim lLength As Long

  Set ProColl = Encoder.ProfileCollection
  lLength = ProColl.Count

  For i = 0 To lLength - 1
    Set Pro = ProColl.Item(i)
    If Pro.Name = "Windows Media Video 8 for Local Area Network (384 Kbps)" Then
        SrcGrp.Profile = Pro
        Exit For
    End If
  Next

' Fill in the description object members.
  Dim Descr As IWMEncDisplayInfo
  Set Descr = Encoder.DisplayInfo
  Descr.Author = "Author name"
  Descr.Copyright = "Copyright information"
  Descr.Description = "Text description of encoded content"
  Descr.Rating = "Rating information"
  Descr.Title = "Title of encoded content"

' Add an attribute to the collection.
  Dim Attr As IWMEncAttributes
  Set Attr = Encoder.Attributes
  Attr.Add "URL", "IP address"

' Specify a file object in which to save encoded content.
  Dim File As IWMEncFile
  Set File = Encoder.File
  File.LocalFileName = "C:\OutputFile.wmv"

' Crop 2 pixels from each edge of the video image.
  SrcVid.CroppingBottomMargin = 2
  SrcVid.CroppingTopMargin = 2
  SrcVid.CroppingLeftMargin = 2
  SrcVid.CroppingRightMargin = 2

' Start the encoding process.
  Encoder.Start

' Wait until the encoding process stops before exiting the application.
' You can do this by using the WMEncoder object to create an event sink.

' For this example, simply monitor the size of the output file and
' use a message box to indicate when to close the application.
  MsgBox ("Click OK when encoding has stopped.")

End Sub

---

Listing All Codecs

Code:

---

This example displays the available video and audio codecs for the variable bit rate (VBR) modes you select, and the available audio formats for the audio codec you select. You will need a form with five combo boxes (cboVidVBR, cboVideoCodec, cboAudVBR, cboAudioCodec, and cboAudioFormat).

' Declare global variables.
  Dim Pro As WMEncProfile2
  Dim x As Integer, y As Integer

Private Sub Form_Load()
  ' Create a WMEncProfile2 object.
    Set Pro = New WMEncProfile2
   
  ' Set the content type to audio and video.
    Pro.ContentType = 17
   
  ' Populate the cboVidVBR and cboAudVBR combo boxes with
  ' members of the WMENC_PROFILE_VBR_MODE enumeration type.
    cboVidVBR.AddItem "WMENC_PVM_NONE (CBR)", 0
    cboVidVBR.AddItem "WMENC_PVM_PEAK (Peak VBR)", 1
    cboVidVBR.AddItem "WMENC_PVM_UNCONSTRAINED (Quality VBR)", 2
    cboVidVBR.AddItem "WMENC_PVM_BITRATE_BASED (Bit Rate VBR)", 3
    cboAudVBR.AddItem "WMENC_PVM_NONE (CBR)", 0
    cboAudVBR.AddItem "WMENC_PVM_PEAK (Peak VBR)", 1
    cboAudVBR.AddItem "WMENC_PVM_UNCONSTRAINED (Quality VBR)", 2
    cboAudVBR.AddItem "WMENC_PVM_BITRATE_BASED (Bit Rate VBR)", 3
End Sub

' This procedure displays the video codecs that are available for
' the selected video VBR mode.
Private Sub cboVidVBR_Click()
  ' Set the video VBRMode to the selected WMENC_PROFILE_VBR_MODE enumeration type.
    Pro.VBRMode(WMENC_VIDEO, 0) = cboVidVBR.ListIndex + 1
 
  ' Populate the cboVideoCodec combo box with the names of the
  ' available video codecs.
    cboVideoCodec.Clear
    Dim vVidCodecName As Variant, lVid4cc  As Long
    For x = 0 To Pro.VideoCodecCount - 1
        lVid4cc = Pro.EnumVideoCodec(x, vVidCodecName)
        cboVideoCodec.AddItem vVidCodecName
    Next x
End Sub

' This procedure displays the audio codecs that are available for
' the selected audio VBR mode.
Private Sub cboAudVBR_Click()
  ' Set the audio VBRMode to the selected WMENC_PROFILE_VBR_MODE enumeration type.
    Pro.VBRMode(WMENC_AUDIO, 0) = cboAudVBR.ListIndex + 1
   
  ' Populate the cboAudioCodec combo box with the names of the
  ' available audio codecs.
    cboAudioCodec.Clear
    cboAudioFormat.Clear
    Dim vAudCodecName As Variant, lAud4cc  As Long
    For x = 0 To Pro.AudioCodecCount - 1
        lAud4cc = Pro.EnumAudioCodec(x, vAudCodecName)
        cboAudioCodec.AddItem vAudCodecName
    Next x
End Sub

' This procedure displays the audio formats that are available for
' the selected audio codec.
Private Sub cboAudioCodec_Click()
  ' Populate the cboAudioFormat combo box with the names of the
  ' available audio formats.
    cboAudioFormat.Clear
    Dim vAudFormatName As Variant, lAudBRate As Long
    Dim SRate As Variant, Channels As Variant, BperSample As Variant
    For y = 0 To Pro.AudioFormatCount(cboAudioCodec.ListIndex) - 1
        lAudBRate = Pro.EnumAudioFormat(cboAudioCodec.ListIndex, y, vAudFormatName, SRate, Channels, BperSample)
        cboAudioFormat.AddItem vAudFormatName
    Next y
End Sub

---

Listing All Devices

Code:

---

This example shows how to enumerate the audio and video sources on a computer, including external digital devices, and populate combo boxes with their resource names. You will need a form with three combo boxes (cboAudioSource, cboVideoSource, and cboDevices).

Private Sub Form_Load()
' Declare objects and variables.
  Dim Encoder As WMEncoder
  Dim SrcPlugMgr As IWMEncSourcePluginInfoManager
  Dim DCPlugMgr As IWMEncDeviceControlPluginInfoManager
  Dim PlugInfo As IWMEncPluginInfo
  Dim iPindex As Integer, iRindex As Integer
  Dim x As Integer, y As Integer, z As Integer

  Set Encoder = New WMEncoder
  Set SrcPlugMgr = Encoder.SourcePluginInfoManager
  Set DCPlugMgr = Encoder.DeviceControlPluginInfoManager

' Loop through all the audio and video devices on the system.
  For iPindex = 0 To SrcPlugMgr.Count - 1

  ' Set the IWMEncPluginInfo object to the current plug-in.
    Set PlugInfo = SrcPlugMgr.Item(iPindex)

  ' Find the device plug-ins that support resources.
    If PlugInfo.SchemeType = "DEVICE" And _
    PlugInfo.Resources = True Then

      ' Loop through the resources in the current plug-in.
        For iRindex = 0 To PlugInfo.Count - 1

          ' Add audio resources to the audio combo box.
            If PlugInfo.MediaType = 1 Then
                cboAudioSource.AddItem PlugInfo.Item(iRindex), x
                x = x + 1
            End If

          ' Add video resources to the video combo box.
            If PlugInfo.MediaType = 2 Then
                cboVideoSource.AddItem PlugInfo.Item(iRindex), y
                y = y + 1
            End If

          ' Add devices that support both audio and video resources to
          ' the audio and video combo boxes.
            If PlugInfo.MediaType = 3 Then
                cboAudioSource.AddItem PlugInfo.Item(iRindex), x
                cboVideoSource.AddItem PlugInfo.Item(iRindex), y
                x = x + 1
                y = y + 1
            End If
        Next
    End If
  Next

' This section shows how to enumerate digital devices such as DV cameras
' and VTRs.
' Loop through the connected digital devices on the system.
  For iPindex = 0 To DCPlugMgr.Count - 1
   
  ' Set the IWMEncPluginInfo object to the current plug-in.
    Set PlugInfo = DCPlugMgr.Item(iPindex)
   
  ' Find the device plug-ins that support resources.
    If PlugInfo.SchemeType = "DeviceControl" And _
    PlugInfo.Resources = True Then
       
      ' Loop through the resources in the current plug-in
      ' and add them to the cboDevices combo box.
        For iRindex = 0 To PlugInfo.Count - 1
            cboDevices.AddItem PlugInfo.Item(iRindex), z
            z = z + 1
        Next
    End If
  Next
End Sub

---

Retrieving Statistics from an Encoding Session

Code:

---

The two examples in this section show how to retrieve statistics while encoding. The first example shows how to retrieve statistics when encoding an input file to an output file. The second example shows how to retrieve statistics when encoding a live source and broadcasting it from the local computer.

Retrieving Statistics While Encoding from a File

For this example, create a form and add:

A button (Command1).
A timer (Timer1).
Three labels (Label1, Label2, and Label3).
You also need a source file (C:\InputFile.mpg).

' Declare global variables.
  Dim WithEvents Encoder As WMEncoder
  Dim bDone As Boolean

Private Sub Form_Load()
' Create a WMEncoder object.
  Set Encoder = New WMEncoder

' Make sure the timer is off.
  Timer1.Enabled = False

' Declare variables.
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Dim SrcGrp As IWMEncSourceGroup2
  Dim SrcVid As IWMEncVideoSource2
  Dim SrcAud As IWMEncAudioSource

' Add a source group to the collection.
  Set SrcGrpColl = Encoder.SourceGroupCollection
  Set SrcGrp = SrcGrpColl.Add("SG_1")

' Add a video and audio source to the source group.
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)

' Specify the source file.
  SrcVid.SetInput "C:\InputFile.mpg"
  SrcAud.SetInput "C:\InputFile.mpg"

' Choose a profile from the collection.
  Dim ProColl As IWMEncProfileCollection
  Dim Pro As IWMEncProfile
  Dim i As Integer

  Set ProColl = Encoder.ProfileCollection

  For i = 0 To ProColl.Count - 1
    Set Pro = ProColl.Item(i)
    If Pro.Name = "Windows Media Video 8 for Local Area Network (384 Kbps)" Then
        SrcGrp.Profile = Pro
        Exit For
    End If
  Next

' Specify an output file.
  Dim File As IWMEncFile
  Set File = Encoder.File
  File.LocalFileName = "C:\OutputFile.wmv"
 
' Initialize the encoding process.
  Encoder.PrepareToEncode (True)

End Sub
Private Sub Command1_Click()
' Start the encoding process.
  Encoder.Start
 
' Use a timer to get statistics once the encoding process has started.
  Timer1.Enabled = True
   
' Using events, check for the end of the encoding process.
  Do Until bDone = True
    DoEvents
  Loop
   
' Display a message when the process has finished.
  MsgBox "Done!"

End Sub

' This events procedure checks for the end of the encoding process.
Private Sub Encoder_OnStateChange(ByVal EnumState As _
WMEncoderLib.WMENC_ENCODER_STATE)
    If EnumState = WMENC_ENCODER_STOPPED Then bDone = True
End Sub

Private Sub Timer1_Timer()
' Retrieve an IWMEncStatistics object.
  Dim Stats As IWMEncStatistics
  Set Stats = Encoder.Statistics
 
' Retrieve an IWMEncFileArchiveStats object.
' Display the file size and file duration.
  Dim FileStats As IWMEncFileArchiveStats
  Set FileStats = Stats.FileArchiveStats
  Label1.Caption = "Size: " & CInt(FileStats.FileSize * 10) & " Kb"
  Label2.Caption = "Duration: " & CInt(FileStats.FileDuration * 10) & " s"

' Retrieve an IWMEncOutputStats object and display the current bit rate.
  Dim OutputStats As IWMEncOutputStats
  Set OutputStats = Stats.WMFOutputStats
  Label3.Caption = "Current bit rate: " & CInt(OutputStats.CurrentBitrate / 1000) & " Kbps"

End Sub

Retrieving Statistics While Broadcasting a Live Stream

For this example, create a form and add:

Two buttons (Command1 and Command2).
A timer (Timer1).
Four labels (Label1, Label2, Label3, and Label4).
' Declare global variables.
  Dim Encoder As WMEncoder

Private Sub Form_Load()
' Create a WMEncoder object.
  Set Encoder = New WMEncoder
 
' Make sure the timer is off.
  Timer1.Enabled = False

' Specify the source for the input stream.
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Dim SrcGrp As IWMEncSourceGroup2
  Dim SrcVid As IWMEncVideoSource2
  Dim SrcAud As IWMEncAudioSource

' Add a source group to the collection.
  Set SrcGrpColl = Encoder.SourceGroupCollection
  Set SrcGrp = SrcGrpColl.Add("SG_1")

' Add a video and audio source to the source group.
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)

' Identify the capture cards that will produce the content.
  SrcVid.SetInput "DEVICE://Default_Video_Device"
  SrcAud.SetInput "DEVICE://Default_Audio_Device"

' Choose a profile from the collection.
  Dim ProColl As IWMEncProfileCollection
  Dim Pro As IWMEncProfile
  Dim i As Integer

  Set ProColl = Encoder.ProfileCollection

  For i = 0 To ProColl.Count - 1
    Set Pro = ProColl.Item(i)
    If Pro.Name = "Windows Media Video 8 for Local Area Network (384 Kbps)" Then
        SrcGrp.Profile = Pro
        Exit For
    End If
  Next

' Create an IWMEncBroadcast object to specify a port and a protocol.
  Dim Brdcst As IWMEncBroadcast
  Set Brdcst = Encoder.Broadcast
  Brdcst.PortNumber(WMENC_PROTOCOL_HTTP) = 8080
 
' Initialize the encoding process.
  Encoder.PrepareToEncode (True)

End Sub

Private Sub Command1_Click()
' Start the encoding process.
  Encoder.Start

' Use a timer to get statistics once the encoding process has started.
  Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()
' Retrieve a WMEncStatistics object.
  Dim Stats As IWMEncStatistics
  Set Stats = Encoder.Statistics
 
' Display the elapsed encoding time.
  Label1.Caption = "Elapsed time: " & CInt(Stats.EncodingTime * 10) & " seconds"

' Retrieve two IWMEncOutputStats objects and
' display bit rate information about the output.
  Dim OutputStats1 As IWMEncOutputStats
  Set OutputStats1 = Stats.WMFOutputStats
  Label2.Caption = "Expected bit rate: " & CInt(OutputStats1.ExpectedBitrate / 1000) & " Kbps"
 
  Dim OutputStats2 As IWMEncOutputStats
  Set OutputStats2 = Stats.WMFOutputStats
  Label3.Caption = "Current bit rate: " & CInt(OutputStats2.CurrentBitrate / 1000) & " Kbps"

' Retrieve an IWMEncNetConnectionStats2 object.
  Dim NetStats As IWMEncNetConnectionStats2

' Display information about client connections.
  Set NetStats = Stats.NetConnectionStats
    Select Case NetStats.ClientCount:
        Case 0:
            Label4.Caption = "No viewers"
        Case 1:
            Label4.Caption = "1 viewer at " & NetStats.ClientInfo(0, WMENC_PROTOCOL_HTTP)
        Case Else:
            Label4.Caption = NetStats.ClientCount & " viewers"
    End Select
End Sub

Private Sub Command2_Click()
' Stop encoding and turn off the timer.
  Encoder.Stop
  Timer1.Enabled = False
End Sub

---

Streaming HTML Content

Code:

---

Streaming HTML Content (Visual Basic)
This example shows how to include simple HTML content in a stream. The three parts of the example show how to:

Create a profile for use with audio, video, and HTML content.
Configure the encoding session.
Create a sample Web page with an embedded player control.
To test the sample, create the profile and start the encoding session, and then open the Web page to view the presentation. Click a button on the Visual Basic form to send Web content.

Creating a Profile for HTML Content

This example creates a profile for use with audio, video, and HTML content. Save the profile in the custom profiles directory so that this profile is included in the profile collection. For more information about the custom profile directory, see Enumerating and Setting Profiles.

Sub main()
' Create a WMEncProfile2 object.
  Dim Pro2 As WMEncProfile2
  Dim Aud As IWMEncAudienceObj
  Set Pro2 = New WMEncProfile2

' Turn on validation, then specify the profile name and description.
  Pro2.ValidateMode = True
  Pro2.ProfileName = "HTML Profile"
  Pro2.ProfileDescription = "Use with audio, video, and HTML content."

' Set the content type to audio, video, and script.
  Pro2.ContentType = 4113

' Use CBR mode for the audio and video streams. By default, the
' Windows Media Audio 9 and Windows Media Video 9 codecs are used.
  Pro2.VBRMode(WMENC_AUDIO, 0) = WMENC_PVM_NONE
  Pro2.VBRMode(WMENC_VIDEO, 0) = WMENC_PVM_NONE

' Add an audience of 500 Kbps.
  Pro2.AddAudience 500000

' Retrieve the first (and only) audience, then specify the HTML
' stream bit rate (100 Kbps) and preroll (5 seconds).
  Set Aud = Pro2.Audience(0)
  Aud.StreamBitrate(WMENC_FILETRANSFER, 0) = 100000
  Aud.Property(WMENC_FILETRANSFER, 0, "BufferWindow") = 5000

' Validate settings, then save the profile.
  Pro2.Validate
  Pro2.SaveToFile "C:\Program Files\Windows Media Components\Encoder\Profiles\HTML.prx"

End Sub

Configuring an Encoding Session for HTML Content

For this example, you need a form with two buttons (Command1 and Command2). It is assumed you have a folder (C:\HTML) with two images (image1.jpg and image2.jpg).

' Declare variables.
  Dim Encoder As WMEncoder
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Dim SrcGrp As IWMEncSourceGroup2
  Dim SrcAud As IWMEncAudioSource
  Dim SrcVid As IWMEncVideoSource
  Dim SrcHTML As IWMEncSource
  Dim Pro As IWMEncProfile
  Dim ProColl As IWMEncProfileCollection
  Dim Brdcst As IWMEncBroadcast
  Dim pUnkFileSrcPlugin As IUnknown
  Dim FileSet As IWMEncFileSet
  Dim FileTransSrc As IWMEncFileTransferSource

Private Sub Form_Load()
' Create a WMEncoder object.
  Set Encoder = New WMEncoder

' Retrieve the source group collection and add a source group.
  Set SrcGrpColl = Encoder.SourceGroupCollection
  Set SrcGrp = SrcGrpColl.Add("SG_1")

' Add an audio, video, and HTML source to the source group.
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  Set SrcHTML = SrcGrp.AddSource(WMENC_FILETRANSFER)

' Use the default audio and video devices.
  SrcAud.SetInput ("Device://Default_Audio_Device")
  SrcVid.SetInput ("Device://Default_Video_Device")

' The HTML scheme is FileTransfer, and the resource string is not used.
  SrcHTML.SetInput ("FileTransfer://placeholdertext")

' Set the HTML stream to repeat.
  SrcHTML.Repeat = True

' Set up a pull broadcast from port 8080.
  Set Brdcst = Encoder.Broadcast
  Brdcst.PortNumber(WMENC_PROTOCOL_HTTP) = 8080

' Retrieve the profile you just created and set it into the source group.
  Set ProColl = Encoder.ProfileCollection
  Dim x As Integer
  For x = 0 To ProColl.Count - 1
    Set Pro = ProColl.Item(x)
    If Pro.Name = "HTML Profile" Then
      SrcGrp.Profile = Pro
      Exit For
    End If
  Next x

' Start encoding.
  Encoder.Start

' Retrieve the file transfer plug-in from the HTML source.
  Set pUnkFileSrcPlugin = SrcHTML.GetSourcePlugin
  Set FileTransSrc = pUnkFileSrcPlugin
End Sub

Private Sub Command1_Click()
' When you click this button, create a new file set, add HTML content to
' it, and then send it.
  Set FileSet = FileTransSrc.Add
  FileSet.Add "C:\HTML\image1.jpg", "image1.jpg"
  FileTransSrc.Send FileSet
End Sub

Private Sub Command2_Click()
' When you click this button, create a new file set, add HTML content to
' it, and then send it.
  Set FileSet = FileTransSrc.Add
  FileSet.Add "C:\HTML\image2.jpg", "image2.jpg"
  FileTransSrc.Send FileSet
End Sub

Creating a Web Page with an Embedded Player

The following HTML code is for a very simple Web page with an embedded player. The player control is set to display URLs in the same window (rather than launching new instances of the Web browser).

Replace the hard-coded URL in this page (HTTP://COMPUTER_NAME:8080) with the URL to your encoding broadcast.

<html>
<head>
<meta http-equiv="Content-Language" content="en-us">
<script Language="vbscript">
function init()
myMessage.InnerHTML = "Loading"
dshow.settings.invokeURLs = False
End function
</script>
<base target="Content">
</head>

<body onload="init()" bgcolor="#336699">

<script FOR="DSHOW" EVENT="Buffering(bStart)" LANGUAGE="vbScript">
myMessage.InnerHTML = "Loading...please wait." 
</script>
<script FOR="DSHOW" EVENT="scriptCommand(scType, Param)" LANGUAGE="VBScript">
Select Case scType
Case "URL"
  document.all.oTransContainer.SRC = Param
  myMessage.InnerHTML = Param
Case Else
  msgbox scType
End Select
</script>
<table border="0" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="31%" id="AutoNumber1" height="258">
  <tr>
    <td width="1%" height="175">&nbsp;</td>
    <td width="94%" height="175">
    <object ID="DSHOW" CLASSID="CLSID:6BF52A52-394A-11d3-B153-00C04F79FAA6" width="288" height="245">
      <param NAME="URL" VALUE="HTTP://COMPUTER_NAME:8080" ref>
      <param NAME="DefaultFrame" VALUE="Content">
      <param NAME="fullscreen" VALUE="0">
      <param NAME="rate" VALUE="1">
      <param NAME="balance" VALUE="0">
      <param NAME="currentPosition" VALUE="0">
      <param NAME="playCount" VALUE="1">
      <param NAME="autoStart" VALUE="-1">
      <param NAME="currentMarker" VALUE="0">
      <param NAME="invokeURLs" VALUE="-1">
      <param NAME="volume" VALUE="50">
      <param NAME="mute" VALUE="0">
      <param NAME="uiMode" VALUE="mini">
      <param NAME="stretchToFit" VALUE="0">
      <param NAME="windowlessVideo" VALUE="0">
      <param NAME="enabled" VALUE="0">
      <param NAME="enableContextMenu" VALUE="-1">
    </object>
    </td>
    <td width="34%" height="175">
    <iframe ID="oTransContainer" STYLE="position: absolute; top: 11; left: 350; width: 393; height: 278; filter: progidDXImageTransform.Microsoft.Fade(duration1.0,overlap1.0)">
    </iframe></td>
  </tr>
  <tr>
    <td width="1%" height="19">&nbsp;</td>
    <td width="94%" height="19">
    <div ID="myMessage">
    </div>
    </td>
    <td width="34%" height="19">&nbsp;</td>
  </tr>
</table>
</body>
</html>

---

Streaming to a Windows Media Server

Code:

---

This example shows how to set up a multicast push broadcast to a Windows Media server. It is assumed that you have set up the Windows Media server; for more information, see Pushing a Stream to a Windows Media Server. To test this sample, open the .asx file in a player.

' Declare variables.
  Dim Encoder As WMEncoder
  Dim SrcGrpColl As IWMEncSourceGroupCollection
  Dim SrcGrp As IWMEncSourceGroup2
  Dim SrcAud As IWMEncAudioSource
  Dim SrcVid As IWMEncVideoSource
  Dim ProColl As IWMEncProfileCollection
  Dim Pro As IWMEncProfile
  Dim PushDist As IWMEncPushDistribution
  Dim strServerName As String
  Dim strPubPoint As String
  Dim strPubTemplate As String
  Dim MyNSCFile As String
  Dim MyNSCURL As String
  Dim MyASXFile As String

Private Sub Main()
' Create a WMEncoder object.
  Set Encoder = New WMEncoder

' Retrieve the source group collection and add sources.
' Use the default devices for the audio and video sources.
  Set SrcGrpColl = Encoder.SourceGroupCollection
  Set SrcGrp = SrcGrpColl.Add("SG_1")
  Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)
  Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
  SrcAud.SetInput ("device://default_audio_device")
  SrcVid.SetInput ("device://default_video_device")

' Retrieve the profile collection. This example uses the 3rd profile.
  Set ProColl = Encoder.ProfileCollection
  Set Pro = ProColl.Item(2)
  SrcGrp.Profile = Pro

' Set up the push broadcast.
  Set PushDist = Encoder.Broadcast

' Specify the push distribution variables, including the Windows Media
' server name, publishing point, and announcement files.
' Provide real values for the following placeholders.
  strServerName = "MyWMServer:70"
  strPubPoint = "MyPubPoint"
  strPubTemplate = "AnotherPubPoint"
  MyNSCFile = "\\servername\share\MyPubPoint.nsc"
  MyNSCURL = "\\servername\share\MyPubPoint.nsc"
  MyASXFile = "\\MyComputer\MyPubPoint.asx"

' Remove the publishing point when the broadcast is over.
  PushDist.AutoRemovePublishingPoint = True

' Set the push distribution variables.
  PushDist.ServerName = strServerName
  PushDist.PublishingPoint = strPubPoint
  PushDist.Template = strPubTemplate
  Encoder.PrepareToEncode True

' Generate the announcement file.
  PushDist.GenerateMulticastInfoFile (MyNSCFile)
  PushDist.GenerateAnnouncementFile MyNSCURL, MyASXFile

' Start encoding.
  Encoder.Start
  MsgBox "Click OK to stop broadcasting."

End Sub

---

Sending a Click Event to a Command Button Control

Code:

---

In a Microsoft® Visual Basic® application, you can simulate a Click event to a Command Button control. This article explains how to send a BN_CLICKED notification message to a control.

Executing a BN_CLICKED Message
A user who wants to carry out a command in your Microsoft® Visual Basic® application usually clicks a Command Button control. The code in the Command Button's Click event is then executed.

There may be times, however, when you will want to initiate a Click event from within your Visual Basic program. You can use the Microsoft Windows® application programming interface (API) PostMessage function to send a BN_CLICKED notification message to the parent of the Command Button control. This will call the button's Click event.

As you can see from the example program below, the GetDlgCtrlID function retrieves the Command Button's handle. Next, a call is made to the GetParent function, which retrieves the handle of the window that the Command Button resides on. (In other words, we must retrieve the parent window's handle.)

The last step is to execute a PostMessage function. PostMessage sends a BN_CLICKED notification message to the parent window, which then processes the Click event for the Command Button.

When you run the example program below, the second Command Button's Click event is executed. However, the second Command Button does not receive the focus—only its code is executed.

Example Program
This program shows how to send a Command Button click to the Windows operating system.

Create a new project in Visual Basic. Form1 is created by default.
Add the following Constant and Declare statements to the General Declarations section of Form1 (note that each Declare statement must be typed as a single line of text):
Const BN_CLICKED = 0
Const WM_COMMAND = &H111
Private Declare Function GetDlgCtrlID Lib "User" (ByVal hWnd As Integer) As
  Integer
Private Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
Private Declare Function PostMessage Lib "User" (ByVal hWnd As Integer, ByVal
  wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Long) As Integer

Add a Command Button control to Form1. Command1 is created by default. Set its Caption property to "Send".
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    ClickButton Command2.hWnd
End Sub

Add a second Command Button control to Form1. Command2 is created by default. Set its Caption property to "Receive".
Add the following code to the Click event for Command2:
Private Sub Command2_Click()
    MsgBox "Command2 was CLICKED!"
End Sub

Create a new function called ClickButton. Add the following code to this function:
Sub ClickButton(ByVal hWnd As Integer)
    Dim Button As Integer
    Dim ParentHwnd As Integer
    Dim X As Integer
   
    Button = GetDlgCtrlID(hWnd)
    ParentHwnd = GetParent(hWnd)
    X = PostMessage(ParentHwnd, WM_COMMAND, Button, BN_CLICKED * &H10000 + hWnd)
End Sub

Run the example program by pressing F5. Click the Send Command Button. The Click event for the second Command Button control is immediately executed (the message box is displayed).

---

awsome

Capitalizing the first letter of each word
add multi line text1

Code:

---

Private Sub Command1_Click()
cr$ = Chr$(13) + Chr$(10)
  t$ = Text1.Text  'the string
  If t$ <> "" Then
  Mid$(t$, 1, 1) = UCase$(Mid$(t$, 1, 1))
  For i = 1 To Len(t$) - 1
    If Mid$(t$, i, 2) = cr$ Then Mid$(t$, i + 2, 1) = UCase$(Mid$(t$, i + 2, 1))
    If Mid$(t$, i, 1) = " " Then Mid$(t$, i + 1, 1) = UCase$(Mid$(t$, i + 1, 1))
  Next
  Text1.Text = t$
  End If
End Sub

---

Finding Whole Words in a Text Box Control

Code:

---

In the example program below, you use a FindMatch function to search the Text Box control for a specific word. A message box is displayed telling you whether or not the target word was found.

You can use the InStr function to isolate a specific piece of text within a larger piece of text. When the search finds a specific word match, the InStr function identifies the target text.

It is a simple task to direct the InStr function to search for a particular word in the Text Box control. Let's assume you want to see whether the word dog is in the string, "He owns a cat and a dog". To do this, you tell InStr to search for the target word by issuing a statement such as:

X = InStr("He owns a cat and a dog", "dog")

Because the word dog actually exists in the sentence, InStr will report where it found the string dog. In the example program below, you assume that a word is defined by a space character, both before and after the word. However, if the string ends with a period character, then the InStr function will not find the word dog. This is because that word is actually the characters d-o-g-period.

Therefore, you must take punctuation characters into account when you write a word-search function. In the example program below, you isolate each word that is surrounded by space characters. In addition, you isolate words that end with a linefeed, carriage return, comma, period, or space. This enables you to determine whether a word exists in the Text Box control, regardless of punctuation that may or may not be appended to the end of the word.

Example Program
This program shows how to search a Text Box control for whole words.

Create a new project in Visual Basic. Form1 is created by default.
Add a Text Box control to Form1. Text1 is created by default. Set its MultiLine property to True.
Add a Label control to Form1. Label1 is created by default. Set its Caption property to "Find word:".
Add a second Text Box control to Form1. Text2 is created by default.
Add a Command Button control to Form1. Command1 is created by default.
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    Dim X As Integer
    X = FindMatch(Text1.Text, Text2.Text)
    If X = 0 Then
        MsgBox "Word not found"
    Else
        MsgBox "Word found"
    End If
End Sub

Create a new function called FindMatch. Add the following code to this function:
Function FindMatch(Str1 As String, Str2 As String) As Integer
    Dim Match As Integer
    Dim Char1 As String
    Dim Char2 As String
   
    Match = InStr(Str1, Str2)
   
    If Match <> 0 Then
        Char1 = Mid$(Str1, Match - 1, 1)
            If Codes(Char1) Then
                Char2 = Mid$(Str1, Match + Len(Str2), 1)
                If Codes(Char2) Then
                    FindMatch = True: Exit Function
                End If
            End If
    End If
   
    FindMatch = False
End Function

Create a new function called Codes. Add the following code to this function:
Function Codes(PuncStr As String) As Integer
    If PuncStr = "," Or PuncStr = "." Or PuncStr = " " Or PuncStr = Chr(10) Or PuncStr = Chr(13) Or PuncStr = Chr(9) Then
        Codes = True
    Else
        Codes = False
    End If
End Function

Run the example program by pressing F5. Type some text in the first Text Box control. In the second Text Box control, type a word that you want to search for in the first Text Box. Click the command button to execute the search routine. A message box is displayed, telling you whether the target word (in Text2) was found in the Text Box (Text1).

---

Description: Get a line count for a Text Box

Code:

---

'Global Const WM_USER = &H400
'Global Const EM_GETLINECOUNT = WM_USER + 10

'Function TextBoxLinecount (TB As TextBox) As Integer
        If TB.MultiLine Then
                ret& = sendmessage(TB.hWnd, EM_GETLINECOUNT, 0, 0)
                TextBoxLinecount = CInt(ret&)
        Else
                TextBoxLinecount = 1
        End If
'End Function

---

Modifying a Text Box's Appearance at Run Time

Code:

---

The Text Box control in Microsoft® Visual Basic® is a mini-word-processing program that lets your user type either single or multiple lines of text. At design time, you set the MultiLine property either to False (single) or to True (multiline). This property cannot be changed at run time. However, during run time you can use Scroll Bar controls to give the impression that your Text Box can be made single or multiline at run time, regardless of the MultiLine property setting.

Changing a Control's Features at Run Time
When designing a Microsoft® Visual Basic® application, you can set the MultiLine property of a Text Box to True or False. If this property is set to False, only a single line of text can be typed in the Text Box control. If the MultiLine property is set to True, many lines of text can be typed in the control. In addition, if the ScrollBars property is set to 3-Both, you can scroll through the text both vertically and horizontally.

There's only one problem—the MultiLine property cannot be dynamically switched at run time, which means that the Text Box is set to what it was in the design phase of the program.

However, by using the Microsoft Windows® application programming interface (API) SetScrollRange function, you can add code to your Visual Basic application that will allow you to create a work-around solution. This enables you to change the Text Box's appearance from single to multiline at run time.

The SetScrollRange function lets you set the minimum and maximum indicator positions of a scroll bar. To use this function, add the following Declare statement to the General Declarations section of your form (note that the Declare statement must be typed as a single line of code):

Private Declare Sub SetScrollRange Lib "User" (ByVal hWnd As Integer, ByVal nBar
  As Integer, ByVal nMinPos As Integer, ByVal nMaxPos As Integer, ByVal
  bRedraw As Integer)

The SetScrollRange function requires five arguments, as follows.

hWnd An integer value containing the window or scroll bar's handle
nBar An integer value set to one of the following values:
  ESB_ENABLE_BOTH Both arrows enabled
  ESB_DISABLE_LTUP Left or Up arrow disabled
  ESB_DISABLE_RTDN Right or Down arrow disabled
  ESB_DISABLE_BOTH Both arrows disabled
nMinPos An integer value containing the minimum indicator position
nMaxPos An integer value containing the maximum indicator position
bRedraw An integer value, when set to True, to redraw the scroll bar

To disable the scroll bars in this Visual Basic program, you simply call SetScrollRange with the minimum and maximum position indicators set to the same value. When you want to enable the scroll bars again, you call SetScrollRange with the minimum and maximum position indicators set to 1 and 100, respectively. When you change the position indictors to 1 and 100, you can scroll through the contents of the Text Box control regardless of the MultiLine property setting. This gives the impression that the Text Box control is MultiLine when it is indeed set to single-line status.

Example Program
This program shows how to create a Text Box control that can be switched at run time from single-line to multiline status, with or without scroll bars.

Create a new project in Visual Basic. Form1 is created by default.
Add the following Constant and Declare statements to the General Declarations section of Form1 (note that the Declare statement must be typed as a single line of text):
Private Declare Sub SetScrollRange Lib "User" (ByVal hWnd As Integer,
  ByVal nBar As Integer, ByVal nMinPos As Integer,
  ByVal nMaxPos As Integer, ByVal  bRedraw As Integer)
Const ESB_DISABLE_BOTH = 3
Const ESB_ENABLE_BOTH = 1

Add a Text Box control to Form1. Text1 is created by default. Set its MultiLine property to True. Set its ScrollBars property to 3-Both.
Add a Command Button control to Form1. Command1 is created by default. Set its Caption property to "Disable".
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    Dim hWnd As Integer
    Dim Min As Integer
    Dim Max As Integer
    Min = 1
    Max = Min
    Call SetScrollRange(Text1.hWnd, ESB_DISABLE_BOTH, Min, Max, 1)
End Sub

Add a second Command Button control to Form1. Command2 is created by default. Set its Caption property to "Enable".
Add the following code to the Click event for Command2:
Private Sub Command2_Click()
    Dim hWnd As Integer
    Dim Min As Integer
    Dim Max As Integer
    Min = 1
    Max = 100
    Call SetScrollRange(Text1.hWnd, ESB_ENABLE_BOTH, Min, Max, 1)
End Sub

Run the example program by pressing F5. Click the Text Box control and type several lines of text. Notice that you can use the scroll bars to scroll through the text in the control. Click Disable. Now you cannot use the scroll bars to scroll through the Text Box control. To enable the scroll bars again, click Enable.

---

All File Operations. , delete,move,copy & more

Code:

---

Option Explicit
 Private Declare Function ShellExecute Lib "shell32.dll" Alias _
          "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _
          String, ByVal lpszFile As String, ByVal lpszParams As String, _
          ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
            Private Declare Function GetDesktopWindow Lib "user32" () As Long

          Const SW_SHOWNORMAL = 1

          Const SE_ERR_FNF = 2&
          Const SE_ERR_PNF = 3&
          Const SE_ERR_ACCESSDENIED = 5&
          Const SE_ERR_OOM = 8&
          Const SE_ERR_DLLNOTFOUND = 32&
          Const SE_ERR_SHARE = 26&
          Const SE_ERR_ASSOCINCOMPLETE = 27&
          Const SE_ERR_DDETIMEOUT = 28&
          Const SE_ERR_DDEFAIL = 29&
          Const SE_ERR_DDEBUSY = 30&
          Const SE_ERR_NOASSOC = 31&
          Const ERROR_BAD_FORMAT = 11&
Function StartDoc(DocName As String) As Long
                  Dim Scr_hDC As Long
                  Scr_hDC = GetDesktopWindow()
                  StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _
                  "", "C:\", SW_SHOWNORMAL)
End Function
   
Function File_Copy(strCopyFrom As String, strCopyTo As String)
      FileCopy strCopyFrom, strCopyTo
End Function

Function Current_Dir() As String
      Current_Dir = CurDir
End Function

Function Change_Dir(strChangeTo As String)
      ChDir strChangeTo
End Function
Function Change_Drive(strChangeTo As String) As String
      ChDrive (strChangeTo)
      Change_Drive = CurDir
End Function
Function File_Exists(strToCheck As String) As Integer
     
      Dim retval As String
     
      retval = Dir$(strToCheck)
     
      If retval = strToCheck Then
              File_Exists = 1
      Else
              File_Exists = 0
      End If

End Function
Function File_Rename(strOldName As String, strNewName As String)
      Name strOldName As strNewName
End Function
Function File_Delete(strToDelete As String)
      Kill strToDelete
End Function
Function Create_Dir(strToCreate)
      MkDir strToCreate
End Function
Function Remove_Dir(strToRemove As String)
      RmDir strToRemove
End Function
Function File_Move(strMoveFrom As String, strMoveTo As String)
              Kill strMoveTo
              FileCopy strMoveFrom, strMoveTo
End Function
Function File_ReadLine(strToRead As String, LineNum As Integer) As String

      Dim intCtr As Integer
      Dim strValue As String
      Dim intFNum As Integer
      Dim intMsg As Integer
 
     
      intFNum = FreeFile
      Open strToRead For Input As #intFNum
             
                intCtr = LineNum
                Input #intFNum, strValue
                File_ReadLine = strValue
                                         
      Close #intFNum
     
End Function
Function Run_Application(strPathOfFile As String)
      Dim r As Long, msg As String
                  r = StartDoc(strPathOfFile)
                  If r <= 32 Then
                          'There was an error
                          Select Case r
                                  Case SE_ERR_FNF
                                          msg = "File not found"
                                  Case SE_ERR_PNF
                                          msg = "Path not found"
                                  Case SE_ERR_ACCESSDENIED
                                          msg = "Access denied"
                                  Case SE_ERR_OOM
                                          msg = "Out of memory"
                                  Case SE_ERR_DLLNOTFOUND
                                          msg = "DLL not found"
                                  Case SE_ERR_SHARE
                                          msg = "A sharing violation occurred"
                                  Case SE_ERR_ASSOCINCOMPLETE
                                          msg = "Incomplete or invalid file association"
                                  Case SE_ERR_DDETIMEOUT
                                          msg = "DDE Time out"
                                  Case SE_ERR_DDEFAIL
                                          msg = "DDE transaction failed"
                                  Case SE_ERR_DDEBUSY
                                          msg = "DDE busy"
                                  Case SE_ERR_NOASSOC
                                          msg = "No association for file extension"
                                  Case ERROR_BAD_FORMAT
                                          msg = "Invalid EXE file or error in EXE image"
                                  Case Else
                                          msg = "Unknown error"
                          End Select
                         
                  End If
         
End Function
Function File_Time(strFileName As String) As String

      Dim strDate As String
      Dim intcount, intDateLen As Integer
     
      strDate = FileDateTime(strFileName)
      intcount = InStr(1, strDate, " ", vbTextCompare)
      intDateLen = Len(strDate)
      File_Time = Mid$(strDate, intcount + 1, intDateLen)
     
End Function
Function File_Date(strFileName As String) As String

      Dim strDate As String
      Dim intcount As Integer
     
      strDate = FileDateTime(strFileName)
      intcount = InStr(1, strDate, " ", vbTextCompare)
      File_Date = CDate(Mid$(strDate, 1, intcount))
     
End Function

---

Calculating the Number of Bytes Used by Files Stored in a Directory

Code:

---

This article explains how you can use the Visual Basic® Dir$, FileName, and FileLen functions to calculate the space used by files in a directory.

When DiskSpaceFree Is Not Enough
The DiskSpaceFree function found in SETUPKIT.DLL can tell you the amount of free space available on the specified disk drive. However, if you need to determine how much space is occupied by the files stored in a single directory, you will not be able to use this function.

How, then, can you find out how much space is used by the files? One solution is to open each file in the directory and move the files pointer to the end of the file. Then you can find out how many bytes are stored in the file. This method, however, is far too slow because each file must be individually opened and closed.

A better solution is to use the Dir$, FileName, and FileLen functions in Visual Basic® to scan the directory and keep a running total of the number of bytes in each file:

The Dir$ function retrieves the name of a file from a disk. To begin a search for all files in a directory, pass the name of the directory as the first argument to Dir$ and the filename pattern to search for as the second argument to Dir$. Because we want to retrieve the length of each individual file stored in the directory, we use a wildcard (*.*) filename. As each name is retrieved from disk, the file's length is added to the variable (in our example program below) FileSize. When no more files exist in the directory, Dir$ will return an empty (NULL) string
The FileLen function returns the total number of bytes used by the specified file. Using a Do-While loop to retrieve the name and length of each file found in the directory is quicker and less prone to disk errors than the other method described above.
Example Program
The program below shows how you can use a Do-While loop to calculate how many bytes are occupied by all the files stored in a directory. The Directory variable is set to the path of the directory you want to work with. After the program has determined the length of all files stored in the directory, it displays the result in the Text Box.

Create a new project in Visual Basic. Form1 is created by default.
Add a Text Box control to Form1. Text1 is created by default.
Add the following code to the Form_Load event for Form1:
Sub Form_Load()
    Dim FileName As String
    Dim FileSize As Currency
    Dim Directory As String

    Directory = "c:\windows\system\"
    FileName = Dir$(Directory & "*.*")
    FileSize = 0

    Do While FileName <> ""
            FileSize = FileSize + FileLen(Directory & FileName)
            FileName = Dir$
    Loop

    Text1.Text = "Total bytes used = " + Str$(FileSize)
End Sub

---

Copying Files from One Directory to Another

Code:

---

This article explains how to copy files from one directory to another in a Microsoft® Visual Basic® application.

Using the FileCopy Statement
In a Microsoft® Visual Basic® application, you can use the FileCopy statement to copy a file to a different directory and/or disk drive. The FileCopy statement requires two arguments: the name of the file you want to copy, and the name to be given to the new file. The target name can include the path of a directory or a specific disk drive. However, note that the FileCopy statement does not generate any warning errors if the target file already exists. In such situations, the target file overwrites the existing file.

Unfortunately, the FileCopy statement does not allow you to specify a wildcard source filename. Using MS-DOS®, you could copy a group of files by issuing a command such as:

COPY *.* C:\NEWFILES

This command tells MS-DOS to copy all the files in the current directory to the NEWFILES directory on drive C.

To accomplish this same task in Visual Basic, you must use the Dir$ function to retrieve the name of each individual file in the source directory. Then you use the FileCopy statement to copy that individual file to the target directory.

A While-Wend routine can be used to quickly retrieve the names of all files in the target directory. As shown in the CopyFile subroutine in the example program below, the Dir$ function returns the name of each file it finds. When Dir$ returns an empty text string (""), you know that all files have been processed.

Example Program
This program shows how to copy all files from the source directory to the destination directory.

Create a new project in Visual Basic. Form1 is created by default.
Add the following code to the Form_Load event for Form1:
Private Sub Form_Load()
    text1.Text = ""
    text2.Text = ""
End Sub

Add a Label control to Form1. Label1 is created by default. Set its Caption property to "Source directory:".
Add a second Label control to Form1. Label2 is created by default. Set its Caption property to "Destination directory:". Position this Label control just below Label1.
Add a Text Box control to Form1. Text1 is created by default. Position the Text Box control so that it is directly adjacent to the first Label control.
Add a second Text Box control to Form1. Text2 is created by default. Position the Text Box control so that it is directly adjacent to the second Label control.
Add a Command Button control to Form1. Command1 is created by default. Set its Caption property to "Copy Files".
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    Dim SourceDir As String
    Dim TargetDir As String
    Dim X As Integer
    Dim P As Integer

    SourceDir = text1.Text
    TargetDir = text2.Text
    CopyFile SourceDir, TargetDir, P
    MsgBox "Number of files copied = " & Str$(P)
End Sub

Create a new subroutine called CopyFile. Add the following code to this subroutine:
Sub CopyFile(SrcDir As String, TrgtDir As String, NumFiles As Integer)
    Dim OldDir As String  'source dir name
    Dim NewDir As String 'target dir name
    Dim FileName As String 'source filename
    Dim sType As String 'file type (extension)

    OldDir = SrcDir
    If Right$(OldDir, 1) <> "\" Then
        OldDir = OldDir & "\"
    End If

    NewDir = TrgtDir
    If Right$(NewDir, 1) <> "\" Then
        NewDir = NewDir & "\"
    End If

    NumFiles = 0      'returns # files copied

    FileName = Dir$(OldDir & "*.*")
    While FileName <> ""
        On Error Resume Next
            FileCopy (OldDir & FileName), (NewDir & FileName)
            If Err = 0 Then
                NumFiles = NumFiles + 1
            Else
                Beep
                MsgBox Error$, MB_ICONEXCLAMATION, ("Error copying file "
                                                    & FileName)
            End If
        On Error GoTo 0

        FileName = Dir$        'get next matching file

        DoEvents            'allow processes to occur
    Wend
End Sub

Run the example program by pressing F5. Type the name of the source directory (the directory containing the files you want to copy) in the first Text Box control. Type the name of the destination directory in the second Text Box control. Click the Copy Files Command Button control. All files stored in the source directory are copied to the destination directory. A message box then appears indicating how many files were actually copied.

---

Creating Temporary Files

Code:

---

When developing an application in Visual Basic®, you may need to create a temporary file on disk. This article explains how to use the Windows® application programming interface (API) GetTempFileName function to create temporary files.

Managing Temporary Files
The Windows® application programming interface (API) GetTempFileName function can be used to create a temporary file on a floppy or hard disk. Files created by this function are not automatically deleted when your Visual Basic® application terminates—you must do this using Visual Basic's Kill statement.

To create a temporary file in Visual Basic, you use the GetTempFileName function. The Declare statement for this function is as follows (note that it must be typed as a single line of code):

Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer,
  ByVal lpPrefixString As String, ByVal wUnique As Integer, ByVal
  lpTempFileName As String) As Integer

GetTempFileName requires four arguments, as follows:

cDriveLetter An integer value containing the disk drive letter.
lpPrefixString A string containing the filename prefix. This is a standard DOS filename, except that it should be less than eight characters long, because it will be padded with the wUnique value when the file is created.
wUnique An integer value containing the number to use to append to the eight-character filename prefix. If a value of zero is specified, the function generates its own random number from the system's current time stamp.
lpTempFileName A string that will hold the name of the newly created temporary file. This string should be initialized to a length of at least 144 characters.

The GetTempFileName function will create the temporary file on the first hard disk or on the disk specified by the TEMP environment variable. You can set the TF_FORCEDRIVE bit of the cDriveLetter argument to tell the GetTempFileName function to create the file in the current directory of the specified disk. In all other cases, the temporary file will be created on the disk specified in the cDriveLetter argument.

After you call the GetTempFileName function, the file will have been created on the specified disk. The lpTempFileName buffer will contain the file's complete path, terminated by the number specified by the wUnique argument.

Once you have successfully created the temporary file from within your application, you can isolate the actual filename by issuing these two statements:

TempFileName = Left(TempFileName, InStr(TempFileName, Chr(0)) - 1)
TempFileName = Trim(Right(TempFileName, Len(TempFileName) - 3))

The first statement uses the InStr function to strip off the last character returned in the buffer used to hold the filename. This byte is the value used in the wUnique argument. The second statement removes the preceding "C:\" drive specifier characters from the filename.

You should be aware that temporary files created by the GetTempFileName function remain on the disk until you actually delete them.

Example Program
The following program shows how you can create temporary files from within your Visual Basic application. Each time you execute this program, a new temporary file is created. Be sure to delete these temporary files from your disk when finished with this program.

Create a new project in Visual Basic. Form1 is created by default.
Add the following Constant and Declare statements to the General Declarations section of Form1 (note that the Declare statement must be typed as a single line of code):
Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer,
  ByVal lpPrefixString As String, ByVal wUnique As Integer, ByVal
  lpTempFileName As String) As Integer
Const TF_FORCEDRIVE = &H80

Add the following code to the Form_Load event for Form1:
Sub Form_Load()
    Dim X As Integer
    Dim Drive As Integer
    Dim Prefix As String
    Dim Unique As Integer
    Dim TempFileName As String
    Dim PathName As String
   
    TempFileName = Space$(144)
    NewFileName = Space$(144)
   
    PathName = "C:\WINDOWS"
    Drive = Asc(UCase(Left(PathName, 1))) + TF_FORCEDRIVE
    Prefix = "DATA"
    Unique = 0
   
    ChDir PathName
    X = GetTempFileName(Drive, Prefix, Unique, TempFileName)
    TempFileName = Left(TempFileName, InStr(TempFileName, Chr(0)) - 1)
    TempFileName = Trim(Right(TempFileName, Len(TempFileName) - 3))
    Text1.Text = TempFileName
End Sub

Add a Text Box control to Form1. Text1 is created by default.

---

Deleting Sections from .INI Files

Code:

---

Microsoft® Windows® and other Windows-based applications use initialization (.INI) files. These special files contain information about the Windows operating environment or configuration information used by a specific application.

There are several Windows application programming interface (API) functions that can be used to create or modify .INI files. One of the more confusing tasks is using the WritePrivateProfileString() function to delete an entire section from an .INI file.

This article explains how you can delete a specific entry from an .INI file. For a detailed description of Windows initialization files and the API functions you can use to modify them, see the "Additional References" section at the end of this article.

Deleting a Section from an .INI File
An initialization (.INI) file is an ASCII text file that follows a specific format. The file is divided into sections where the name of the section is enclosed in brackets. Directly below the section headings are one or more entries. Each entry (or key name) is the name you want to set a value for. This is followed by an equal sign. Next, the value to be assigned to the key name is specified.

To modify an .INI file, you use the Windows WritePrivateProfileString() and WriteProfileString() functions. The WriteProfileString() function is used to modify the Windows WIN.INI initialization file, while all other .INI files are modified by calling the WritePrivateProfileString() function.

The following is an example of an .INI file's contents:

[progsetup]
Date=10/10/95
Datafile=c:\temp.dat

In this example, the section name is "progsetup", the key names are Date and Datafile, and the values to be given to the key names are 10/10/95 and c:\temp.dat.

To delete a specific entry from an initialization file, call the WritePrivateProfileString() function with the statement:

x = WritePrivateProfileString(lpAppName, 0&, 0&, FileName)

specifying the following parameters:

lpAppName  \The name of the section you want to remove from the INI file
lpKeyName  \The entry you want to delete. This must be set to a NULL string
            \to delete the entire section.
lpString    \The string to be written to the entry. When set to an empty string,
            \this causes the lpKeyName entry to be deleted.
lpFileName  \The name of the INI file to modify.

In our example above, we would set lpAppName to "progsetup", lpFileName to "C:\DEMO.INI", and both lpKeyName and lpString to 0& (zero). After you call this function, the entire "progsetup" section of the DEMO.INI file will be deleted.

The lpKeyName and lpString variables are of type Any. If you use the type String, the function may or may not work properly, so be sure to specify these as type Any when deleting entries from initialization files. The same rule applies when using the WriteProfileString() function.

Example Program
The following program shows how to delete an entire section from an initialization file:

Using the Windows Notepad application, create a new text file called DEMO.INI. Save the file to the root directory on drive C. Add the following lines to this text file:
[progsetup]
Date=10/10/95
Datafile=c:\temp.dat
[colors]
Background=red
Foreground=white

Start a new project in Visual Basic. Form1 is created by default.
In the general declarations section of Form1, type the following Declare statement (note that this should be typed as a single line of text):
Declare Function WritePrivateProfileString% Lib "Kernel" (ByVal lpAppName
  As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName
  As String)

Add the following code to Form1_Load():
Sub Form_Load()
    crlf$ = Chr(13) & Chr(10)
    Text1.Text = ""
    Open "c:\demo.ini" For Input As #1
    While Not EOF(1)
        Line Input #1, file_data$
        Text1.Text = Text1.Text & file_data$ & crlf$
    Wend
    Close #1
   
End Sub

Add a text box control to Form1. Set its MultiLine property to True and its ScrollBars property to 3-Both. Adjust the size of the text box so that the contents of the C:\DEMO.INI file can be displayed in it.
Add a command button control to Form1. Command1 is created by default. Set its Caption property to "Modify DEMO.INI".
Add the following code to the Click event of Command1:
Sub Command1_Click()
    FileName = "c:\demo.ini"
    lpAppName = "progsetup"
    x = WritePrivateProfileString(lpAppName, 0&, 0&, FileName)
End Sub

When you execute this sample program, the current contents of the file C::\DEMO.INI are displayed in the text box. Click once on the "Modify DEMO.INI" command button. The program has now deleted the entire "progsetup" section from the DEMO.INI file. You can verify that the file's contents were changed by running the demonstration program a second time.

---

Determining a Program's Name Path

Code:

---

You can determine the name of your application as well as the directory where the program is stored on your disk. This is useful when a user has renamed your application or when you want to determine where your application can store its own temporary files.

How to Determine a Program Name or Path
You can find out the name of your application by retrieving the EXEName property of the App object. In the same manner, the Path property of App can be used to retrieve the directory your program is stored in. App can only be used while the application is running and only if that application is the currently active program.

You can use the App.EXEName property to determine if a user has renamed your application program. App.EXEName can also be used to provide information needed to call some Windows® application programming interface (API) functions.

The App.Path property can be used by applications that store configuration information within their own .EXE files. If you modify such an application, and need to save a new copy of the program to disk, the App.EXEName and App.Path can tell you where to save the new version of your application.

Example Program
The program below shows how you can retrieve an application's filename and path in Visual Basic®.

Start a new project in Visual Basic. Form1 is created by default.
Add a command button control to Form1. Command1 is created by default. Set the command button's Caption property to "Execute Notepad".
Add the following code to the Click event of the Command1 command button:
Sub Command1_Click()
        ProgName$ = "C:\WINDOWS\NOTEPAD.EXE AUTOEXEC.BAT"
        x = Shell(ProgName$, 2)
        AppActivate "Notepad - AUTOEXEC.BAT"
    SendKeys "%{ }X", -1   
        p$ = App.Path
        j$ = App.EXEName
        SendKeys "%{ }C", -1   
        AppActivate "Form1"
        Text1.Text = p$ & j$
End Sub

Directly below the Command1 command button, draw a Text Box on Form1. Text1 is created by default. Set the text box's Text property to a NULL (empty) string.
Add a second command button control to Form1. Command2 is created by default. Set the command button's Caption property to "Exit".
Add the following code to the Click event of the Command2 command button:
Sub Command2_Click()
    End
End Sub

Save the project to disk using the filename TEXT.MAK. Create an .EXE program file in the root directory of drive C (C:\TEST.EXE).
To execute this program, exit Visual Basic. Next, from Program Manager, click on File/Run. Type the name of the program to run as C:\TEST.EXE and click the OK command button.
After Windows launches TEST.EXE, you can click the "Execute Notepad" command button. The Windows Notepad application will be executed and will load your AUTOEXEC.BAT file. Next, TEST sends the ALT+SPACE+X keystroke combination to Notepad to maximize that application's window. TEST's program name and path are then stored in two string variables and, when the ALT+SPACE+C keystrokes are sent to Notepad to terminate that program, TEST displays the full path of TEST.EXE in its Text Box. Clicking the "Exit" command button terminates the demonstration program.

---

Determining Whether a File Exists

Code:

---

This article explains how to determine whether a file exists on a disk drive in a Microsoft® Visual Basic® application.

Using the OpenFile Function
You can use the Microsoft® Windows® application programming interface (API) OpenFile function in a Microsoft Visual Basic® application to determine whether a file actually exists on a disk drive. To use this function, the following Declare statement should be included in your project:

Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String,
  lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long

The OpenFile function requires three arguments. The first argument is a string containing the full path of the file to test. The second argument is an OFSTRUCT structure, which contains information about the file after the OpenFile function is called. The third argument is the action you want the OpenFile function to take.

The third argument, wStyle, tells the OpenFile function the action that the function is to perform. Because you want to find out whether a given file exists, you call the OpenFile function with the wStyle argument set to OF_EXIST. If the file does not exist, the OpenFile function will return an error code of 2—File Not Found.

When the OpenFile function is run, it writes information about the file to the OFSTRUCT structure. Therefore, if an error occurs, you must retrieve the actual error code from the OFSTRUCT structure itself. In the example program below, you use the statement:

If OpenFileStructure.nErrCode = FILE_NOT_FOUND Then

After testing for the "File Not Found" error, you can indicate to the user whether or not the file exists.

Example Program
This program shows how to determine whether a file already exists on the disk drive.

Create a new project in Visual Basic. Form1 is created by default.
Add the following Declare statement to the General Declarations section of Form1 (note that this Declare statement must be typed as a single line of text):
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String,
  lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long

Add a Command Button control to Form1. Command1 is created by default.
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    Dim TestFile As String
    Dim Ret As Integer

    TestFile = "c:\auto.bat"
    Ret = FileExists(TestFile)

    If Ret Then
        MsgBox "File already exists"
    Else
        MsgBox "File does not exist"
    End If
End Sub

Create a new function called FileExists. Add the following code to this function:
Function FileExists(FileName As String) As Integer
    Dim RetCode As Integer
    Dim OpenFileStructure As OFSTRUCT

    Const OF_EXIST = &H4000
    Const FILE_NOT_FOUND = 2

    RetCode = OpenFile(FileName$, OpenFileStructure, OF_EXIST)
    If OpenFileStructure.nErrCode = FILE_NOT_FOUND Then
        FileExists = False
    Else
        FileExists = True
    End If
End Function

From the Visual Basic Insert menu, select Module to create a new module. Module1.Bas is created by default.
Add the following Type and Constant statements to Module1.Bas:
Public Const OFS_MAXPATHNAME = 128

Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

Run the example program by pressing F5. Click the Command Button control. A message box appears. If the file "C:\AUTO.BAT" exists on drive C, the message box indicates that the target file does exist. If the file was not found on the disk, however, the message box indicates that the file does not exist.

---

Compares the content of two files

Code:

---

Open "file1" For Binary As #1
Open "file2" For Binary As #2
issame% = True
If LOF(1) <> LOF(2) Then
        issame% = False
Else
        whole& = LOF(1) \ 10000        'number of whole 10,000 byte chunks
        part& = LOF(1) Mod 10000        'remaining bytes at end of file
        buffer1$ = String$(10000, 0)
        buffer2$ = String$(10000, 0)
        start& = 1
        For x& = 1 To whole&            'this for-next loop will get 10,000
        Get #1, start&, buffer1$      'byte chunks at a time.
        Get #2, start&, buffer2$
        If buffer1$ <> buffer2$ Then
                issame% = False
                Exit For
        End If
        start& = start& + 10000
        Next
        buffer1$ = String$(part&, 0)
        buffer2$ = String$(part&, 0)
        Get #1, start&, buffer1$        'get the remaining bytes at the end
        Get #2, start&, buffer2$        'get the remaining bytes at the end
        If buffer1$ <> buffer2$ Then issame% = False
        End If
        Close
        If issame% Then
                MsgBox "Files are identical", 64, "Info"
        Else
                MsgBox "Files are NOT identical", 16, "Info"
        End If

---

Moves or Copies a file using API

Code:

---

'Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
'Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long


'Place the following code in under a command button or in a menu, etc...

source = "C:\myfile.txt"
target = "C:\Windows\myfile.txt"


'Copy File
A = CopyFile(Trim$(Source), Trim(Target), False)
If A Then
        MsgBox "File copied!"
Else
        MsgBox "Error. File not moved!"
End If



'Move File
A = MoveFile(Trim$(Source), Trim(Target))
If A Then
        MsgBox "File moved!"
Else
        MsgBox "Error. File not moved!"
End If

---

Detects if a file exists.

Code:

---

'Function FileExists (filename As String) As Integer
        On Error Resume Next
        x% = Len(Dir$(filename))
        If Err Or x% = 0 Then FileExists = False Else FileExists = True
'End Function

---

Determining If a File Already Exists

Code:

---

eclare Function OpenFile% Lib "Kernel" (ByVal lpFileName$, lpReOpenBuff
    As OFSTRUCT, ByVal wStyle%)

Note that this Declare statement must be typed as one single line of text.

The OpenFile function takes the following arguments, described as follows:

Argument Description
lpFileName A string containing the name, which may or may not include a path name, to test.
lpReOpenBuff An OFSTRUCT structure that will contain information about the file after the OpenFile function has been called.
wStyle This combination of one or more flags specifies the type of operation that is to be performed on the file.

In our demonstration program, we need only specify wStyle as the constant OF_EXIST.

After calling the OpenFile function, an integer value is returned. If a negative number is returned, the nErrCode value in the OFSTRUCT structure can be examined to find out if the file exists already.

Example Program
The following program demonstrates how to determine if a file already exists.

Start a new project in Visual Basic. Form1 is created by default.
Add the following code to the Global Module:
'OFSTRUCT structure used by the OpenFile API function
Type OFSTRUCT            '136 bytes in length
    cBytes As String * 1
    fFixedDisk As String * 1
    nErrCode As Integer
    reserved As String * 4
    szPathName As String * 128
End Type

Within the Global Declaration section of Form1, add the following Windows function declaration (note that this Declare statement must be typed as one single line of text):
Declare Function OpenFile% Lib "Kernel" (ByVal lpFileName$, lpReOpenBuff As OFSTRUCT, ByVal wStyle%)

Next, add the following lines of code to the Global Declaration section of Form1:
Dim wStyle As Integer
Dim Buffer As OFSTRUCT
Dim IsThere As Integer
Dim TestFile As String

Add the following code to the Form_Load() event procedure:
Sub Form_Load()
    TestFile = "c:\testfile.dat"
    IsThere = OpenFile(TestFile, Buffer, OF_EXIST)
    If  IsThere < 0 Then
        GoTo CheckForError
        Else
        Debug.Print "This file already exists"
    End If
    CheckForError:
    IsThere = Buffer.nErrCode
    If  IsThere = 3 Then
        Debug.Print "Pathname not found"
    End If

---

File System - Files launching based on file extension

Code:

---

'Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'Private Declare Function GetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long

'Function StartDoc (DocName As String) as long
Dim Scr_hDC as long
Scr_hDC = GetDesktopWindow ()
'change "Open" to "Explore" to bring up file explorer
StartDoc = ShellExecute (Scr_hDC, "Open", DocName, "", "C:\", 1)
'end function

'Place the following code in under a command button or in a menu, etc...

dim r as long
r = startdoc ("C:\windows\arcade.bmp")

---

Files total API manipulation with visual dialogs

Code:

---

Gives access to File Explorer capabilities and shows
'            progress dialog and / or error dialogs

'Place the following code in a Module

'Public Const FO_MOVE As Long = &H1
'Public Const FO_COPY As Long = &H2
'Public Const FO_DELETE As Long = &H3
'Public Const FO_RENAME As Long = &H4
'Public Const FOF_MULTIDESTFILES As Long = &H1
'Public Const FOF_CONFIRMMOUSE As Long = &H2
'Public Const FOF_SILENT As Long = &H4
'Public Const FOF_RENAMEONCOLLISION As Long = &H8
'Public Const FOF_NOCONFIRMATION As Long = &H10
'Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
'Public Const FOF_CREATEPROGRESSDLG As Long =&H0
'Public Const FOF_ALLOWUNDO As Long = &H40
'Public Const FOF_FILESONLY As Long = &H80
'Public Const FOF_SIMPLEPROGRESS As Long = &H100
'Public Const FOF_NOCONFIRMMKDIR As Long = &H200

'Type SHFILEOPSTRUCT
'    hwnd As Long
'    wFunc As Long
'    pFrom As String
'    pTo As String
'    fFlags As Long
'    fAnyOperationsAborted As Long
'    hNameMappings As Long
'    lpszProgressTitle As String
'End Type

'Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long



'Place the following code under a command button or in a menu, etc...

Dim result As Long, fileop As SHFILEOPSTRUCT
With fileop
        .hwnd = Me.hwnd
        .wFunc = FO_COPY
        .pFrom = "C:\PROGRAM FILES\MICROSOFT VISUAL BASIC\VB.HLP" & vbNullChar & "C:\PROGRAM FILES\MICROSOFT VISUAL BASIC\README.HLP" & vbNullChar & vbNullChar
'      .pFrom = "C:\*.*" & vbNullChar & vbNullChar
        .pTo = "C:\testfolder" & vbNullChar & vbNullChar
        .fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
End With
result = SHFileOperation(fileop)
If result <> 0 Then
        ' Operation failed
        MsgBox Err.LastDllError
Else
        If fileop.fAnyOperationsAborted <> 0 Then
                      MsgBox "Operation Failed"
        End If
End If

---

Searching PATH for Specific Files

Code:

---

The MS-DOS® PATH statement tells the operating system to look for files in specific directories on your disk. This article explains how to find out whether a specific file exists in one of the PATH directories.

Searching for Files
When you write a program in Microsoft® Visual Basic®, you may need to determine if a specific file exists on a disk drive. At installation time, many software packages modify the MS-DOS® PATH statement in the AUOTOEXEC.BAT file by adding a new directory to the existing PATH directories. This allows an application to find its own system or data files that it requires to run successfully. You can add a search routine to your program to search these directories for an individual file.

The first step is to retrieve the entire path for the specified disk drive. The Visual Basic CurDir$ function returns the current disk drive's path.

Next, you need to call two Microsoft Windows® application programming interface (API) functions, GetWindowsDirectory and GetSystemDirectory. The GetWindowsDirectory function retrieves the path of the Windows directory. Windows stores its initialization files, help files, application files, and other files in this directory. The GetSystemDiectory function retrieves the path of the Windows system directory. Windows stores library, font, drive, and other system files in this directory.

In the example program below, you use all three functions mentioned above to build a string (PathStr) that contains the directory names. The IsFileInPath function simply uses the InStr function to extract each individual directory name from PathStr. Then you use the Dir$ function to determine whether the target file exists in that directory.

Example Program
This program shows how to determine whether a specific file exists in one of the directories in the PATH statement.

Create a new project in Visual Basic. Form1 is created by default.
Add the following Declare statements to the General Declarations section of Form1 (note that each Declare statement must be typed as a single line of code):
Private Declare Function GetSystemDirectory Lib "kernel32" Alias
  "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long)
  As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias
  "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long)
  As Long

Add a Text Box control to Form1. Text1 is created by default.
Add a Command Button control to Form1. Command1 is created by default.
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    Dim DirStr As String
    Dim FileToFind As String
    Dim Flag As Integer
   
    FileToFind = Text1.Text
    Flag = IsFileInPath(FileToFind, DirStr)
    If Flag Then
        MsgBox "File Exists in: " & DirStr
    Else
        MsgBox "File does not exist in PATH"
    End If
End Sub

Create a new function called BuildSearchPath. Add the following code to this function:
Sub BuildSearchPath(PathStr As String)
    Dim RetVal As Integer
    Dim Buffer As String * 128
   
    PathStr = CurDir$
    RetVal = GetWindowsDirectory(Buffer, 128)
    PathStr = PathStr & ";" & Mid$(Buffer, 1, RetVal)
    Buffer = Space(128)
    RetVal = GetSystemDirectory(Buffer, 128)
    PathStr = PathStr & ";" & Mid$(Buffer, 1, RetVal)
    PathStr = PathStr & ";" & App.Path
    PathStr = PathStr & ";" & Environ$("PATH")
End Sub

Create a new function called IsFileInPath. Add the following code to this function:
Function IsFileInPath(TheFile As String, DirName As String) As Integer
    Dim Separator As Integer
    Dim SearchStr As String
    Dim Results As String
   
    Call BuildSearchPath(SearchStr)
   
    While Len(SearchStr) <> 0
        Separator = InStr(SearchStr, ";")
        If Separator <> 0 Then
            DirName = Mid$(SearchStr, 1, Separator - 1)
            SearchStr = Mid$(SearchStr, Separator + 1)
        Else
            DirName = SearchStr
            SearchStr = ""
        End If
       
        Results = Dir$(DirName & "\" & TheFile)
        If Results <> "" Then
            IsFileInPath = True
            Exit Function
        End If
    Wend
    IsFileInPath = False
End Function

Run the example program by pressing F5. Type the name of a file that you want to find in the Text Box control. Click the command button. A message box will be displayed, telling you whether the file was found in one of the PATH directories.

---

Sending Files to the Recycle Bin in Visual Basic

Code:

---

When using the Microsoft® Windows® 95 operating system, you can delete a file from disk by dragging the file or sending the file to the Recycle Bin. The file is not actually removed from disk but is only marked for deletion by the system. When the Recycle Bin is emptied, however, the file is physically removed from the disk. This article explains how to send files to the Recycle Bin in a Microsoft Visual Basic® version 4.0 application.

Using the SHFileOperation Function to Delete Files
When you use the Microsoft® Windows® 95 operating system, any files that you delete are stored in the Recycle Bin. The files are not physically removed from the disk, but they appear to have been deleted. If you want, the files (or directories) that you have moved to the Recycle Bin can be restored and thus again be made available. However, if you want to physically remove the files stored in the Recycle Bin from your hard disk, you must empty the Recycle Bin. After the Recycle Bin has been emptied, you cannot recover the deleted files. The space occupied by the deleted files is also freed.

In a Microsoft Visual Basic® version 4.0 application, you can send files to the Recycle Bin by calling the Windows application programming interface (API) SHFileOperation function. This function lets you manipulate files by moving, copying, renaming, or deleting them.

The SHFileOperation function requires a pointer to a SHFILEOPSTRUCT structure that contains the name(s) of the file(s) you want to perform an operation on, as well as the type of operation (for example, deleting a file) you want to carry out.

When deleting multiple filenames, each filename specified in the SHFILEOPSTRUCT structure must be separated by a NULL character. The entire list of filenames must be terminated by two consecutive NULL characters.

The fFlags field in the SHFILEOPSTRUCT structure must be set to the operation you want to perform on the selected file(s). In this case, set this field to FO_DELETE, which tells the operating system that you want to delete the file by sending it to the Recycle Bin. In addition, because you are sending the file to the Recycle Bin, use the FOF_ALLOWUNDO flag. This flag preserves the information required to undelete a file should you later decide not to physically remove the file from the hard disk.

Example Program
This program shows how to send files to the Recycle Bin in Windows 95.

Create a new project in Visual Basic. Form1 is created by default.
Add the following code to the General Declarations section of Form1 (note that the Declare statement must be typed as a single line of code):
Public Const FO_DELETE = &H3
    Public Const FOF_ALLOWUNDO = &H40
Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA"
  (lpFileOp As SHFILEOPSTRUCT) As Long

Create a new function called ShellDelete. Add the following code to this function:
Public Function ShellDelete(ParamArray vntFileName() As Variant)

    Dim I As Integer
    Dim sFileNames As String
    Dim SHFileOp As SHFILEOPSTRUCT

For I = LBound(vntFileName) To UBound(vntFileName)
        sFileNames = sFileNames & vntFileName(I) & vbNullChar
    Next
sFileNames = sFileNames & vbNullChar

    With SHFileOp
        .wFunc = FO_DELETE
        .pFrom = sFileNames
        .fFlags = FOF_ALLOWUNDO
    End With

    ShellDelete = SHFileOperation(SHFileOp)

    End Function

Add a Command Button control to Form1. Command1 is created by default.
Add the following code to the Click event for Command1:
Private Sub Command1_Click()
    Dim FileToKill As String

    FileToKill = "c:\test*.txt"
    ShellDelete FileToKill
    MsgBox "File(s) deleted"
End Sub

From the Visual Basic Insert menu, select Module to create a new module. MODULE1.BAS is created by default.
Add the following TYPE structure to MODULE1.BAS:
Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Boolean
    hNameMaps As Long
    sProgress As String
End Type

Run the example program by pressing F5. Click the Command Button control. A dialog box appears, asking whether you really want to delete the selected files. (All files with the name TEST*.TXT stored in the root directory of the hard drive will be deleted.) Click the Yes button to confirm the delete request.

---

Show the windows property box for any file

Code:

---

Option Explicit

Private Const SW_SHOW = 5
Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    ' optional fields
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type

Private Declare Function ShellExecuteEx Lib "shell32.dll" (ByRef s As SHELLEXECUTEINFO) As Long

Public Sub DisplayFileProperties(ByVal sFullFileAndPathName As String)
    Dim shInfo As SHELLEXECUTEINFO
   
    With shInfo
        .cbSize = LenB(shInfo)
        .lpFile = sFullFileAndPathName
        .nShow = SW_SHOW
        .fMask = SEE_MASK_INVOKEIDLIST
        .lpVerb = "properties"
    End With
   
    ShellExecuteEx shInfo
End Sub

Private Sub Command1_Click()
On Error GoTo Error_Handler
    Dim sFileName As String
   
    sFileName = InputBox("Enter Full Path/Name of file to view Properties for :", "Show File Properties", "c:\autoexec.bat")
    If Len(sFileName) = 0 Then
        MsgBox "You must enter a filename"
        Exit Sub
    End If
   
    If Len(Dir(sFileName)) = 0 Then
        MsgBox "File : " & sFileName & " cannot be found"
        Exit Sub
    End If
   
    DisplayFileProperties sFileName
Exit Sub
Error_Handler:
'othewise "if structure" doesn't work properly.
Resume Next
End Sub

---

Regarding FileExists, see The Optimum FileExists Function.