Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all 1518 articles
Browse latest View live
↧

How to Check the internet connections adapters list?

April 17, 2013, 2:01 am
$
0
0
Hello :wave:
I have 2 internet connection on my pc, where one is broad-band connection "Local Area Connection" and another is a dial-up connection "Idea Internet".

Now here I want to get the list of all the connection adapters. Along with that want to get which is the Active i mean which is being used.

I searched in google but din't found any proper solution instead of "InternetGetConnectedStateEx" API which only shows if the internet is Active or Disabled.

Is it possible in VB6.0 to get lists of all Internet Connections Adapters with ther Active status?

Thanks in advace,
with warm Regards,
↧
Search

Mozilla Control Error

April 18, 2013, 3:25 am
$
0
0
Hello everyone,
I have downloaded and installed the latest version of "Mozilla Active X control 1.7.12" from
Code:
http://www.iol.ie/~locka/mozilla/control.htm
Added it's component "mozctl.dll" in my vb6.0 project. It's browser is working fine and showing webpage.
But I am getting error "Automation error Library not registered." on getting the html source of the loaded webpage.
I am using codes

MozillaBrowser1.Document.body.innerHtml

I've searched about this error, but not getting any working solution. Which Library is not registered and how to register that? Where i am doing wrong. Please correct me and tell how to get webpage html source code by using Mozilla Control in vb6.

Thanks
Regards,
↧
↧

Cpu Utilization in vb6

April 18, 2013, 8:15 am
$
0
0
Attachment 99175


Code:
Private Wmi As Object, Locator As Object
Private PrevCpuTime As Long, SampleRate As Long


Private Sub Form_Load()
    SampleRate = 2 'in seconds
    Timer1.Interval = SampleRate * 1000
    Set Locator = CreateObject("WbemScripting.SWbemLocator")
    Set Wmi = Locator.ConnectServer
    Timer1_Timer
End Sub


Private Sub Timer1_Timer()
    Dim Procs As Object, Proc As Object
    Dim CpuTime, Utilization As Single
    Set Procs = Wmi.InstancesOf("Win32_Process")


    For Each Proc In Procs


        If Proc.ProcessID = 0 Then 'System Idle Process
            CpuTime = Proc.KernelModeTime / 10000000


            If PrevCpuTime <> 0 Then
                Utilization = 1 - (CpuTime - PrevCpuTime) / SampleRate
                Text1.Text = Format(Utilization, "0.0%")
            End If
            PrevCpuTime = CpuTime
        End If
    Next
End Sub
Attached Images
 
↧

VB6 - Zipper & ZipWriter, Zipping from VB programs

May 2, 2013, 10:55 am
$
0
0
Background

A lot of us find the need to create ZIP archives programmatically from time to time. There are a number of techniques we can use, from spawning external utility programs to 3rd party components to Shell automation.

Here is yet another way to accomplish this: using the free, open source zlibwapi.dll


Minizip

In addition to providing a STDCALL version of ZLib that we can call easily from VB6 programs zlibwapi.dll includes the Minizip project code as well.

Like a lot of open source hacked out by C coders this can be rough in many places, but it is widely used and well proven. It should have few if any bugs in the most recent version.

I'm using version 1.25 here. You can get this from:

Minizip: Zip and UnZip additionnal library

See the typo there? This is just one symptom of some of the issues, but fortunately the code at least seems to work fine even if its source is wonky with lots of flaws in comments and general documentation issues.

This DLL is not included in the attachment. You must download it yourself.

Quote:
In zlib125dll.zip there is the Win32 Windows DLL of my Windows DLL named Zlibwapi.dll that contains both zLib and Minilib.
The file you want from this ZIP archive is:

zlib125dll.zip\dll32\zlibwapi.dll


ZipWriter

ZipWriter is a VB6 Class that wraps zlibwapi.dll to provide you with a way to create a ZIP archive and actually write data into it as archived files with no intermediate disk I/O steps.

You can use this as-is in many cases without the other code offered here.


Zipper

Zipper is a VB6 UserControl that wraps ZipWriter and a small helper ZipFile Class to give you the ability to create a ZIP archive (or add to an existing one) and add a list of disk files to it.

Zipper.Zip is an async operation and reports back progress, errors, and completion through several events. There is a Zipper.Cancel method if you need that.


ZipDemo

ZipDemo is a VB6 project that demonstrates use of the items described above.

You must download zlibwapi.dll and copy it into this project folder to run the program.

Much of the bulk of this attachment consists of the sample files in the "samples2" folder included.


There is a "ZipWriter" button that does a simple test of ZipWriter, creating a new ZIP archive "test.zip" with two files written to it. When that step completes the "Zipper" button is enabled.

The "Zipper" button tests Zipper, adding the files it finds in the "samples2" folder to the "test.zip" created in the first stage of the demo. While running a progressbar is updated and a "Cancel" button is enabled.

The "samples2" folder as supplied has just a few small files. Be sure to copy some larger files into it and rerun the program to see how things go with large files. The performance is fairly good.


Remarks

While you need to deploy zlibwapi.dll with your programs this is a standard DLL that you can feel free to place next to your EXE. No registration is required.

The results are better than those achieved using most other common techniques. Progress/Cancel/Complete can be really nice to have. There is no need for the shaky, convoluted, hackish window spelunking people often resort to when automating Shell objects.

There is a lot more you can do with zlibwapi.dll too. You can read from ZIP archives, unzip them, compress separate files outside of ZIP archives, compress/expand data in memory, etc. Even the huge-file Zip64 format is supported.

All you need is to write additional wrappers or just make the calls directly.
Attached Files
↧

[VB6] HotKeyW - Unicode Hot Key UserControl

May 11, 2013, 1:37 pm
$
0
0
A simple and lightweight Hot Key UserControl that "enables the user to enter a combination of keystrokes to be used as a hot key". This is a drop-in ready UserControl module that wraps the Hot Key control from Windows' Common Controls Library.


Name: Screenshot.png Views: 15 Size: 18.3 KB
Attached Images
 
Attached Files
↧
↧

Very Cheap Text/Voice Chat Application

May 13, 2013, 7:36 pm
↧

VB6 Crypto API

May 14, 2013, 11:48 pm
$
0
0
I cannot take credit for the cCrypt.cls used here, but I ran across it while searching for information on implementing TLS using the MS Crypto API. Unfortunately it did not help me with TLS, and I could not find who to give credit, but I was impressed with the quality of the code in the way that it encompassed most of the supported algorithms in the API. I am more interested in limited cryptography targeted to the TLS handshake, and I am having a great deal of difficulty finding relative information.

J.A. Coutts
Attached Files
↧

create ocx tutorial

May 16, 2013, 10:25 am
↧
Search

VB - LED simulator Simulating a LED light emitting diode

May 17, 2013, 11:04 am
$
0
0
Interesting way to present a process monitor, servers, control aplications ON/OFF, electronic kits etc.
Simulating a LED light emitting diode, add sound may be an improvement ...

I hear comments
Greetings from Mexico
Attached Files
↧
↧

monster list codes 2

May 19, 2013, 3:59 am
$
0
0
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
↧

How to read last two records in .txt file in VB?

May 22, 2013, 1:52 pm
$
0
0
Hi ,

I am very new to VB. Actually i am Mainframe resouce and i got an oppertunity to write hummingbird programming scrip which is equal to VB.

As i have tight deadlines, i am not able to spend much time on learning VB. Hence i am looking for quick help.

I got a situation to read the last two records in .TXT file for some comparision logic. So,

Can you please help on how to read the last two records in .TXT file?
How to read specific record in .TXT file?
how to write the record in beginning of the .txt file every time that we write (Append at first line)

Thanks a lot in advance for your in-time help. Look fwd for your valuable response. Thanks!

Regards
Agasthya
↧

VB6 - BmpGen Helper Class for WIA 2.0

June 13, 2013, 3:46 pm
$
0
0
Problem

While WIA 2.0 provides a lot of handy image capture and manipulation tools for VB, VBA, and VBScript one thing it isn't good at is creating a blank image.

There is a standard way to do this and it is even described in the code samples within the WIA 2.0 documentation. The bad news is that for anything but tiny images this can be impractically slow because of the way the WIA.Vector's .Add() method works for creating ARGB bitmaps.


Solution

You can load an image into a WIA.ImageFile object from a disk file in any of several image file formats. This works well for some applications, especially if you need a fairly complex background image to stamp other things onto. The downsides are that (a.) you need to carry along this extra image file with your program, and (b.) it doesn't address cases where you need to deal with images of sizes unknown until runtime.

However you do have the option of loading an image file "image" from a Byte array into a WIA.Vector through its .BinaryData property, and from there you can create an ImageFile object or a StdPicture object. This means you could store such a serialized "image file" as a resource and use it, or you might build one on the fly.

This is what the BmpGen object does with its single .MakeMono() method: create and return a monochrome BMP file image as a Byte array, with the dimensions and background color you specify. This addresses the dynamic dimensions issue.


Demo

The BmpGen class is packaged along with a demo Project in the attached archive.

The purpose of the demo is to show how you might make use of BmpGen.MakeMono() along with WIA to create "blank" solid color backdrop images to manipulate further. It also helps compare the performance of this technique with the standard wa of making a blank image with WIA, which gets much slower as the image dimensions increase.

Each of the three test cases creates a background and then stamps two transparent GIF "screen beans" characters onto it and displays the result in a VB6 Image control.

Name: sshot.png Views: 122 Size: 14.7 KB

The "fancy" test case loads an included PNG file from disk as the background. This works well enough and might be better for cases where you don't want a simple solid color backdrop, but has the limitations already described above.

The timings cover just the creation of the backdrop image prior to the stamping steps. They're rough timings based on Timer() but this should be accurate enough to illustrate the difference in performance.


Requirements

BmpGen has no dependencies that aren't included in Windows 95 or later. The demo itself requires WIA 2.0 which is part of Windows Vista and subsequent versions of Windows, and can also be installed into Windows XP SP1 or later if you grabbed the download before Microsoft removed it in preparation for XP's impending retirement.

To use the demo as-is you need VB6, but you could also do the same kind of thing in VBA applications making use of BmpGen which has no VB6-specific features in it.

VBScript is not supported, but you could create an VB6 ActiveX DLL containing BmpGen and make use of that in VBScript.
Attached Images
 
Attached Files
↧

VB6 - Print StdPicture Objects

June 19, 2013, 10:38 am
$
0
0
I'm sure this has been covered lots of times already, but here's another take.

The basic idea is to use the Printer object's PaintPicture method to crop and scale a StdPicture as you print it. The only wrinkle here is making a few API calls to the spooler to get lists of paper sizes and printer resolutions. The user picks those things and thenwe have the metrics we need to calculate our cropping and scaling.

This demo uses a fixed StdPicture that it loads from a sample image file included in the attached archive. You could just as easily use StdPictures from a PictureBox, a WIA object, or from somewhere else. It scales the picture to fit centered within the bounds of some fixed-size margins within a chosen paper size and orientation:

Name: Illustration.png Views: 64 Size: 131.0 KB

You could add cropping, you could use user-chosen margins, you could fit the image into some smaller region of the paper, etc. Here I just show how you'd go about it. To make those changes you'd just modify the calculations to fit your needs.

Code:
Private Sub cmdPrint_Click()
    'Print the StdPicture Pic centered on the selected rrinter (Pr)
    'with the selected paper (lstPapers) at the selected quality
    '(lngResolutions) within set margins.
    Dim MarginsLR As Single
    Dim MarginsTB As Single
    Dim PrintableWidth As Single
    Dim PrintableHeight As Single
    Dim ScaleFactor As Double
    Dim ScaledWidth As Double
    Dim ScaledHeight As Double

    Set Printer = Pr
    With Printer
        'Set up paper:
        .PaperSize = intPaperIds(lstPapers.ListIndex)
        .PrintQuality = lngResolutions(2 * lstResolutions.ListIndex) 'We can only set one
                                                                    'value DPI value, just
                                                                    'use X here.
        If optOrientation(1).Value Then
            .Orientation = vbPRORLandscape
        Else
            .Orientation = vbPRORPortrait
        End If

        'Scale to paper, using 0.5" margins all around.  Could also crop
        'the image here:
        MarginsLR = .ScaleX(0.5, vbInches, .ScaleMode)
        MarginsTB = .ScaleY(0.5, vbInches, .ScaleMode)
        PrintableWidth = .Width - 2 * MarginsLR
        PrintableHeight = .Height - 2 * MarginsTB

        ScaleFactor = PrintableWidth / .ScaleX(Pic.Width, vbHimetric, .ScaleMode)
        If ScaleFactor * .ScaleY(Pic.Height, vbHimetric, .ScaleMode) > PrintableHeight Then
            ScaleFactor = PrintableHeight / .ScaleY(Pic.Height, vbHimetric, .ScaleMode)
        End If

        ScaledWidth = ScaleFactor * .ScaleX(Pic.Width, vbHimetric, .ScaleMode)
        ScaledHeight = ScaleFactor * .ScaleY(Pic.Height, vbHimetric, .ScaleMode)

        'Paint (print) the image, scaled.  Could also do the actual cropping
        'here if any were desired by specifying additional arguments:
        .PaintPicture Pic, _
                      (.Width - ScaledWidth) / 2, _
                      (.Height - ScaledHeight) / 2, _
                      ScaledWidth, _
                      ScaledHeight
        .NewPage
        .EndDoc
    End With
End Sub
The demo application looks like this:

Name: sshot.png Views: 66 Size: 29.4 KB

You could show the paper sizes in mm or inches instead of 1/10 mm by doing the calculations. Those are just the units returned by the print spooler so to keep code complexity down I used them as is.

The code involved is fairly brief and the Project files are small. The attached archive is only so large because of the included sample image.
Attached Images
  
Attached Files
↧
↧

VB6 MiniMP3 (Standalone)

June 21, 2013, 4:31 am
$
0
0
Hi,

I have converted my Mini MP3 Player which was using Window Media Player available here to a standalone version. Any comments and suggests welcome.

Nightwalker
Attached Files
↧

WAV Player with Simulated Real-Time Sine Wave Display

June 22, 2013, 7:37 pm
$
0
0
Plays .wav files and displays the sine wave. The sine wave appears to be created in real time but it is not. The sound is captured first in a buffer then converted to it's sine wave. A Picturebox holds the graphics of the sine wave while a 2nd Picture which sits on top of the this Picturebox moves horizontally across the graphical Picturebox thus revealing the sine wave as though it was being displayed in real time
Attached Images
 
Attached Files
↧
Search

VB6 Tools: VB6 Rapihken Kabeh (Code Formatter)

June 29, 2013, 11:20 pm
$
0
0
This VB6 Add-Ins tools will format your code easy, based on Bobo Code Formatter.

How to use:

  1. Compile
  2. Double click install.bat
  3. Open your project click Add-Ins >> Rapikan Kode.
  4. Simply click Button Rapihken Wawarehan for formatting single (current) Code Module or check Rapihken Kabehanana for formatting all Code Module, please wait while VB6 Rapihken Kabeh working.


Warning!
Please backup your code before use this tools.
Attached Files
↧

VB6 - SQL Parameters Example

July 3, 2013, 4:44 am
$
0
0
Background

I'll start with a quote:

Why Parameters are a Best Practice
Quote:
Perhaps the single most important SQL Server application development Best Practice is the consistent use of parameters in application code. Parameterized database calls are more secure, easier to program and promote query plan reuse. Yet I continue to see code with SQL statements constructed by concatenating literal strings with variable values. I think this is largely out of ignorance rather than design so I decided to show how easy it is for .NET application developers to use parameters and peek into the internals to show why parameters are so important.
The same applies to VB6 just as well. However Dan's examples don't help us much since we're using ADO rather than any of the .Net data connector technologies.

So here is a simplified demo showing how to do similar things in VB6 with ADO.


The Demo

This is a simple demo showing the use of named ADO Command objects to perform parameter queries. It also shows how to store photos in the database as BLOB fields, retrieve them, display them, and update them.

While the demo uses Jet 4.0 to make it quick and easy to "unzip and play" the demo, these same concepts apply to other databases that you can use ADO with.


What It Does

When the program runs it begins by looking for an existing database. If found, it asks whether to delete it and create a new one or not.

If it creates a new database it then:

  • Removes any existing database.
  • Creates an empty database with one table [PicTable] with three fields:
    • [ID] an autonumber "identity" field set as the primary key.
    • [Description] a variable length (0-255 character) text field.
    • [Picture] a variable length (0-20000 byte)) long binary (BLOB) field.
  • Closes the empty database.
  • Reopens the database defining commands InsertPic and UpdatePic on the Connection.
  • Populates the table with three sample records based on information in a provided text file and JPEG images in a subfolder.


Else it then:

  • Opens the existing database defining the command UpdatePic (since it won't need InsertPic).


Finally, it:

  • Displays the first record, showing all three fields.


The user interface has three buttons:

  • "Back" and "Next" to step through records and display them.
  • "Replace Photo" to replace the photo of the current record by a provided fixed replacement JPEG and redisplay the updated record.


The Command objects are used to do a SQL INSERT and a SQL UPDATE. They are invoked as dynamic methods of the open Connection object.


Running the Demo

Just unzip into a folder and open the Project in the VB6 IDE. Then go ahead and run it.

Step through the records. When you see the "wrong" picture you can click Replace Photo to update with a hard-coded replacement photo.

Name: sshot1.jpg Views: 99 Size: 16.9 KB

Name: sshot2.jpg Views: 85 Size: 16.2 KB


Close the program. Run it again and when prompted to create a new empty database click the "No" button.

Step through the records to see that the update was permanent.


Defining Named ADO Command Objects

By creating named Command objects you can use them dynamic methods of the Connection object until they are destroyed or disconnected. Here is what the demo does when connecting to the database after it has been created:

Code:
Public Sub OpenDbDefineCommands(ByVal NewDb As Boolean)
    Set conDB = New ADODB.Connection
    conDB.Open strConn

    If NewDb Then
        Set cmndInsert = New ADODB.Command
        With cmndInsert
            .Name = "InsertPic"
            .CommandType = adCmdText
            .CommandText = "INSERT INTO [PicTable] " _
                        & "([Description], [Picture]) " _
                        & "VALUES (?, ?)"
            .Parameters.Append .CreateParameter(, adVarWChar, adParamInput, 255)
            .Parameters.Append .CreateParameter(, adLongVarBinary, adParamInput, MAX_PHOTO_BYTES)
            .Prepared = True
            Set .ActiveConnection = conDB
        End With
    End If

    Set cmndUpdate = New ADODB.Command
    With cmndUpdate
        .Name = "UpdatePic"
        .CommandType = adCmdText
        .CommandText = "UPDATE [PicTable] " _
                    & "SET [Picture] = ? " _
                    & "WHERE [ID] = ?"
        .Parameters.Append .CreateParameter(, adLongVarBinary, adParamInput, MAX_PHOTO_BYTES)
        .Parameters.Append .CreateParameter(, adInteger, adParamInput)
        .Prepared = True
        Set .ActiveConnection = conDB
    End With
End Sub
ADO will actually create entries in the Parameters collection itself on first use of a Command if you do not Create/Append them yourself. However it has to "guess" at things like the data type and length 9for variable length types).

In the cases here, those "guesses" are fine... until they aren't.

Let's say when you populate the new, empty database your first image is 4000 bytes. This will cause ADO to set the maximum length of the 2nd Parameter to 4000. And if you use the Command again passing an image larger than 4000 bytes you will get a runtime error!


Calling Named ADO Command Objects

You can call the Execute method on these Command objects, or you can also use them as dynamic methods of the Connection:

Code:
Public Function UpdatePic(ByVal PicFileName As String, ByVal ID As Long) As Boolean
    'Returns True if the operation fails.

    On Error Resume Next
    conDB.UpdatePic LoadPicBlob(PicFileName), ID
    If Err Then
        conDB.Errors.Clear
        Err.Clear
        UpdatePic = True
    End If
End Function

Private Function LoadPicBlob(ByVal PicFileName As String) As Byte()
    Dim PicFile As Integer
    Dim PicBlob() As Byte

    PicFile = FreeFile(0)
    Open PHOTOS_FOLDER & PicFileName For Binary Access Read As #PicFile
    ReDim PicBlob(LOF(PicFile) - 1)
    Get #PicFile, , PicBlob
    Close #PicFile
    LoadPicBlob = PicBlob
End Function
Attached Images
  
Attached Files
↧
↧

VB6 SQLite DB-Demos (based on the RichClient-Framework)

July 4, 2013, 12:03 am
$
0
0
SQLite (http://sqlite.org/)

...is the worlds most widely deployed DB-engine (running on nearly every mobile-device or tablet - but it is also "strong on the Desktop",
being the Default-App-DB for Firefox or WebKit or Thunderbird - and many other vendors/applications.

The (SingleFile-DB-) Format is unicode-capable and interchangeable among operating-systems (no matter if little-endian or big-endian-based).
Means, if you copy an SQLite-DB from your iPhone (or Linux-Server) onto your Win-Desktop, you will have no problem accessing it there (and vice versa).

It still has a pretty small footprint, but other than the name may suggest, it is by no means "Lite" in the technical sense anymore...
So, if there is a strong competitor for the very often used JET-engine, VB5/6-users so far prefer as their "typical App-DB", SQLite is it...

Features (not found in JET-*.mdbs)
- Triggers
- FullText-Search (FTS4)
- true InMemory-DBs (for "LINQ-like" query-scenarios in your VB6-App, using cMemDB and cRecordset)
- strong (and compared with JET "unhackable") encryption on the whole DB (only 10-15% performance-decrease)
- userdefinable Collations (String-Comparisons for Sorts)
- userdefinable SQL-Functions (calling back into easy codable, native compilable VB6-code)
- UTF8-String-storage by default (resulting in typically smaller DBs, compared with JET, which preferrably stores in UTF-16)

Performance (compared with JET)
- typically 2-3 times as fast in read-direction (Rs-retrieval, complex Selects)
- typically 10 times as fast in write-direction (Bulk-Inserts/Updates/Deletes wrapped in transactions, import-scenarios with typically 200000 new inserted Records per second)

VB6-access per DAO/ADO...
Over ODBC ... a well-written SQLite-ODBC-driver can be found here:
http://www.ch-werner.de/sqliteodbc/

VB6-access without any MS-(DAO/ADO) dependencies...
per builtin (ADO-like) cConnection/cRecordset/cCommand-Classes in vbRichClient5:
http://www.vbRichClient.com/#/en/Downloads.htm

These wrapper-classes work faster than the above mentioned ADO/ODBC-combination.

Ok, Demo-Apps:

First a simple one, still using the normal GUI-controls of VB6, to not "alienate" anybody ...(as said, the usage of the DB-related classes is pretty much comparable to ADO)... ;-)

Thanks to dilettante for the nice Original, which can be found (as an ADO/JET-version) here:
http://www.vbforums.com/showthread.p...meters-Example

The version below is not that much different (aside from the AddNew and Delete-Buttons - and the SQLite-engine of course).
http://www.vbRichClient.com/Download...DemoSQLite.zip




Finally an SQLite-Demo, which does not only replace ADO/JET, but also the VB6-GUI-controls ...
There isn't any Common-Controls involved, only the Widget-engine of the RichClient-library comes into play here
(in conjunction with the vbWidgets.dll, which is hosted on GitHub: https://github.com/vbRichClient/vbWidgets).

The Original to this still simple Demo is also based on ADO/JET, and can be found on PSC:
http://www.planet-source-code.com/vb...35601&lngWId=1

There's one thing "special" (aside from the vbWidgets) in this demo - and that's the regfree-deployment-feature,
which is supported (without manifests and SxS-services) by the Frameworks smallest lib, the DirectCOM.dll.

So the archive below comes as "a RealWorld-DeployPackage", and is therefore a bit larger (it contains,
beside the VB6-source, also the 3 Base-Dlls of the RC5-Framework in a SubFolder \RC5Bin\).

This way the Application is directly startable from e.g. an USB-Stick, without the need to register anything -
the deploymentsize for such a RC5-based "regfree Package" starts from about 1.6MB (when LZMA-compressed,
e.g. with InnoSetup ... or, as the download here, in a 7z-archive):
http://www.vbRichClient.com/Downloads/SQLiteTree.7z (about 1.7MB)

Another thing which is different from the first demo above (which provides its new generated DB, directly from imported Text-file-snippets),
is the fact, that this Demo is using the exact same ADO-JET-*.mdb as the original on PSC as its Import-Source for the new created SQLite-DB.
So this example also covers a simple "Convert-From-JET-DB-to-SQLite"-scenario - and shows, how to use the builtin cCOnvert-Class for that task...





Well, have fun with it.

Olaf
↧

BSpline-based "Bezier-Art"

July 17, 2013, 8:46 am
$
0
0
A small Graphics-Demo for VB6, which shows the nice effects one can produce, when Anti-Aliasing in conjunction with Color-Alpha-settings is combined with "curved Line-Output".

Here's the ~90 lines of code, to put into a single VB-Form:
Code:
'needs a reference to the free vbRichClient5-lib, which is located and available on:
'http://www.vbRichClient.com/#/en/Downloads.htm
Option Explicit
 
Private Srf As cCairoSurface, NumPoints As Single
Private pntX() As Single, pntY() As Single, sgnX() As Single, sgnY() As Single
Private WithEvents tmrRefresh As cTimer

Private Sub Form_Load()
Dim i As Long
'    Rnd -1 'uncomment, if you want to always start from the same "randomness"

    Me.ScaleMode = vbPixels
    Me.Caption = "Left-Click for Start/Stop, Right-Click to clear"
   
    NumPoints = 7
    ReDim pntX(1 To NumPoints): ReDim pntY(1 To NumPoints)
    ReDim sgnX(1 To NumPoints): ReDim sgnY(1 To NumPoints)
 
    For i = 1 To NumPoints
      pntX(i) = ScaleWidth * Rnd
      pntY(i) = ScaleHeight * Rnd
      sgnX(i) = IIf(i Mod 2, 1, -1)
      sgnY(i) = IIf(i Mod 2, -1, 1)
    Next i
   
    Set tmrRefresh = New_c.Timer(10, True)
End Sub
 
Private Sub Form_DblClick()
  tmrRefresh.Enabled = Not tmrRefresh.Enabled
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = 1 Then tmrRefresh.Enabled = Not tmrRefresh.Enabled
  If Button = 2 Then Set Srf = Cairo.CreateSurface(ScaleWidth, ScaleHeight) 'reset the surface
End Sub

Private Sub Form_Resize()
  Set Srf = Cairo.CreateSurface(ScaleWidth, ScaleHeight)
End Sub

Private Sub Form_Terminate()
  If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub

Private Sub tmrRefresh_Timer()
Dim i As Integer, cc As Long

  For cc = 1 To 100 'just to perform some more operations within a single timer-event

    For i = 1 To NumPoints 'the next two lines influence the erratic point-movement (just play around)
      pntX(i) = pntX(i) + sgnX(i) * 0.0004 * Abs(pntY(i) - pntX(i))
      pntY(i) = pntY(i) + sgnY(i) * 0.1 / Abs((33 - pntY(i)) / (77 + pntX(i)))
     
      If pntX(i) < ScaleLeft Then pntX(i) = ScaleLeft: sgnX(i) = 1
      If pntX(i) > ScaleLeft + ScaleWidth Then pntX(i) = ScaleLeft + ScaleWidth: sgnX(i) = -1
      If pntY(i) < ScaleTop Then pntY(i) = ScaleTop: sgnY(i) = 1
      If pntY(i) > ScaleHeight + ScaleTop Then pntY(i) = ScaleHeight + ScaleTop: sgnY(i) = -1
    Next i
 
    Static j As Long, k As Single
    k = k + 0.34: If k > 255 Then k = 0: j = j + 1: If j > 5 Then j = 0
    Select Case j
      Case 0: draw RGB(k, 255 - k, 255)
      Case 1: draw RGB(255, k, 255 - k)
      Case 2: draw RGB(255 - k, 255, k)
      Case 3: draw RGB(0, 255 - k, k)
      Case 4: draw RGB(0, 0, 255 - k)
      Case 5: draw RGB(255 - k, k, 0)
    End Select
   
    If cc Mod 10 = 0 Then Srf.DrawToDC hDC
 
  Next cc
End Sub
 
Private Sub draw(ByVal Color As Long)
Dim i As Long, PolyArr() As Single
  ReDim PolyArr(0 To (NumPoints + 3) * 2 - 1)
  For i = 0 To NumPoints - 1 'this is just a normal copy-over
    PolyArr(2 * i) = pntX(i + 1) 'the dst-array has x at even indexes...
    PolyArr(2 * i + 1) = pntY(i + 1) 'and the y-coord at the uneven ones
  Next i
  For i = 0 To 2 'now we add 3 additional points, to "close the circle" (so to say)
    PolyArr(2 * (NumPoints + i)) = PolyArr(2 * i) 'those extra-points are copies ...
    PolyArr(2 * (NumPoints + i) + 1) = PolyArr(2 * i + 1) '...of the first 3 points
  Next i
 
  With Srf.CreateContext 'once we have filled our PolyArr, the rest is pretty simple
    .SetSourceColor Color, 0.05
    .SetLineWidth 0.5
      .PolygonSingle PolyArr, False, splNormal '... using the powerful Poly-call
    .Stroke
  End With
End Sub
The example starts out producing something like that (all Screenshots were reduced in their Pixel-dimensions for smaller upload/download-size - they look even a bit better when directly rendered):



Then, as long as not resetted continues adding more and more alpha-curves (still the same "set" as above, just some more rendered lines on it):



But one can reset the whole thing with the right Mouse and start with a fresh image, ending up with something like this:



Just play around with it (and maybe manipulate the PolyArray-xy-Coords with your own random move-formulas or parameters) ...
Have fun... :-)

Olaf
↧

VB6-TLS1 Simulation

July 21, 2013, 10:44 pm
$
0
0
This program was written to simulate a TLS1 handshake connection, with the long term goal being to implement TLS with email. TLS1 (Transport Layer Security) is only slightly different from SSL3 (Secure Sockets Layer) developed by Netscape. TLS was what the IETF adopted based upon SSL3. This evident in the version number used within the actual protocols. SSL3 is version 3.0 and TLS1 is version 3.1. If you examine the Wikipedia Page on the subject (http://en.wikipedia.org/wiki/Transport_Layer_Security), you will see that virtually all major servers and browsers support TLS 1.0. The same cannot be said for SSL, and the IETF has been strongly recommending that support for fallback to SSL2 be dropped as insecure.

To understand how it all works, you should understand a little bit about Cryptography in general. Cryptography is not really that difficult, but it is very convoluted. There are many competing implementations, and not all of them work together. And the standards don't help that much, as they deal with the issues at the lowest level. Working at that level with VB would be a difficult undertaking and probably not work that well. We could purchase a library/control with all the built-in functions for all or most of the standards, and that would have made life simpler. But then we would have been tied to that control for any fixes or updates. The newer Microsoft Operating Systems come complete with several Crypto Libraries built in, called Cryptographic Service Providers (or CSP's). The one we are interested in is the RSA/Schannel Cryptographic Provider, which provides support for TLS. Microsoft discourages applications from using this CSP directly, choosing instead to limit their support to CSP developers and vendors. But that does not mean it cannot be done. It simply means that information on most of the calls is limited.

J.A. Coutts
Attached Files
↧
Viewing all 1518 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>