|
-
May 19th, 2013, 05:59 AM
#1
Thread Starter
Banned
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
-
May 19th, 2013, 06:01 AM
#2
Thread Starter
Banned
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
-
May 19th, 2013, 06:06 AM
#3
Thread Starter
Banned
 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"> </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"> </td>
<td width="94%" height="19">
<div ID="myMessage">
</div>
</td>
<td width="34%" height="19"> </td>
</tr>
</table>
</body>
</html>
-
May 19th, 2013, 06:06 AM
#4
Thread Starter
Banned
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
-
May 19th, 2013, 06:10 AM
#5
Thread Starter
Banned
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).
-
May 19th, 2013, 06:13 AM
#6
Thread Starter
Banned
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
-
May 19th, 2013, 06:17 AM
#7
Thread Starter
Banned
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.
-
May 19th, 2013, 06:21 AM
#8
Thread Starter
Banned
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.
-
May 19th, 2013, 06:23 AM
#9
Thread Starter
Banned
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.
-
May 19th, 2013, 06:25 AM
#10
Thread Starter
Banned
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
-
May 19th, 2013, 06:29 AM
#11
Thread Starter
Banned
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
-
May 19th, 2013, 06:33 AM
#12
Thread Starter
Banned
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
-
May 19th, 2013, 11:25 AM
#13
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote
