dcsimg
Results 1 to 13 of 13

Thread: monster list codes 2

  1. #1

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    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

  2. #2

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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

  3. #3

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Cool Re: monster list codes 2

    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>

  4. #4

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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

  5. #5

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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).

  6. #6

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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

  7. #7

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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.

  8. #8

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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.

  9. #9

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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.

  10. #10

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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

  11. #11

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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

  12. #12

    Thread Starter
    Banned
    Join Date
    Nov 2012
    Posts
    1,171

    Re: monster list codes 2

    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

  13. #13
    Default Member Bonnie West's Avatar
    Join Date
    Jun 2012
    Location
    InIDE
    Posts
    4,057

    Re: monster list codes 2

    Regarding FileExists, see The Optimum FileExists Function.
    On Local Error Resume Next: If Not Empty Is Nothing Then Do While Null: ReDim i(True To False) As Currency: Loop: Else Debug.Assert CCur(CLng(CInt(CBool(False Imp True Xor False Eqv True)))): Stop: On Local Error GoTo 0
    Declare Sub CrashVB Lib "msvbvm60" (Optional DontPassMe As Any)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width