VBForums - CodeBank - Visual Basic 6 and earlier

SECURE EMAIL - JACMail2 Companion Program

Making email secure is easier said than done. Some people are under the illusion that TLS (Transport Layer Security) provides protection, but nothing could be further from the truth. As the name suggests, TLS only provides protection during a single transport leg. It does not protect the message at the source or the destination, nor any of the MTA's in between. In one respect TLS is overkill because it encrypts everything, when in reality the only component that needs to be encrypted is the message itself. The body header does not need to be encrypted.

The only way to truly protect a message is to encrypt it at source, and decrypt it at the final destination. PGP does this and has been around for ages, but has not gained very wide acceptance. The difficulty is that it requires the use of Public/Private key pairs, and most non-technical users have difficulty managing keys.

I wrote my own email client program because of dissatisfaction with what was commercially available. I even went so far as to implement TLS, but abandoned it after I realized how little protection it offered. Then I wrote an algorithm that embedded the key within the encrypted message. However, I again abandoned that effort because I could not guarantee that some hacker would not decompile my program and discover the algorithm. The worst part is that like most encryption systems, you never know when the system has become compromised.

So I set out to design a system that would work with existing mail systems and did not require the use of Public/Private keys.

1. Sender creates Random Key (eg. EE F2 26 2A BF C1 BC 7A). Key can be any size up to 512 bits.

2. Sender hashes the key, derives a new key from the hash, encrypts the message (not including message header), and encodes the message using Base64 (eg. XLVWGcE6aiWA5y94Bw==).

3. Sender then forwards the encrypted/encoded message as text (not flagged as encoded). It then hashes the encrypted/encoded message, derives a key from the hash, and uses it to encrypt the Random Key (eg. EE F2 26 2A BF C1 BC 7A is encrypted to 37 98 D9 A1 25 6D 1D 49). The encrypted Random Key, as well as the numeric value from the Message-ID (eg 41827.5099189815) are saved in a database.

4. Receiver retrieves the message, sees that it is encoded, and initiates decryption.

5. Receiver app displays a list of known encryption sources using the domain name from the Message-ID (eg <41827.5099189815@key.domain.com>). If the incoming Message-ID Domain Name is not included in the list, the receiver is prompted to add it to the list with a warning. This step provides a degree of protection against phishing.

6. At this point, both the sender and the receiver possess the encrypted message and the sender possesses the encrypted key. The receiver then connects with the Message-ID Domain Name on a specified port, and sends the Message-ID to the Sender. The Message-ID server doesn't necessarily have to be the actual server that sent the message, but it must have access to the encrypted Random Key and the Message-ID.

7. The sender server looks up the Message-ID, and recovers the associated encrypted Random Key. It then sends the encrypted Random Key back to the receiver, and saves the IP address and date/time used to recover the key. This step provides protection against the contents of the message being modified. Subsequent requests from non-authorized addresses are ignored.

8. The receiver hashes the encrypted/encoded message, derives a key from the hash, and uses it to decrypt the Random Key. The receiver then decodes and decrypts the message, and saves the encrypted Random Key.

9. Subsequent requests to decrypt the message use the saved key.

10. The sender now knows when the message was read. Subsequent requests for the key would be highly suspicious and are blocked, with manual intervention required to unblock. If it is later discovered that an unauthorized request was made for the key from an unknown IP address, the contents of the message have probably been compromised, and appropriate measures should be taken. With most encryption systems, one never knows when or if the system has been compromised. For that reason, Asymmetric Encryption systems now require 2048 bit keys, and rather extreme security measures to protect the Private key.

J.A. Coutts

Note: The JACMailSvc program requires the Microsoft NT Service Control (NTSVC.ocx), which is readily available on the Net.

Attached Files

JACMailSvcD.zip (59.4 KB)

JACMail Version 2 is very similar to Version 1 on the surface. Under the hood however, there have been substantial changes. JACMail is an Email Client Program designed to allow fast and efficient recovery of email from a POP3 server, and the sending of email through an SMTP server. It is primarily oriented towards text based messaging with attachments, and does not directly support highly formatted HTML based email or embedded objects. It receives and stores both text/plain and text/html messages, and Web based emails (HTML) can be sent to your default browser for viewing. It also supports Plain Authentication based POP3 and multiple mailboxes. The mailboxes are stored in an Access database utilising ODBC.

The code uses IP Version independent system calls, so it will only work on Windows systems that actively support both IPv4 and IPv6. That more or less restricts it to Windows Vista or later. It has been tested on Windows Vista, Win 7, and Win 8.1, and utilises the following standard components and references: 
RICHED32.DLL 
RICHTX32.OCX 
COMDLG32.OCX 
MSSTDFMT.DLL 
MSBIND.DLL 
MSADODC.OCX 
MSDATGRD.OCX 
which the user must have available in order to compile the program.

Unlike Version 1, this version is Unicode comapatible. It is NOT Unicode compliant. Email still requires ASCII.

Version 2 supports message encryption. Although any JACMail2 Client can receive and decrypt messages sent by JACMail2, the sending of encrypted messages requires a server component (posted as a separate item).

J.A. Coutts

Attached Files

JACMail2D.zip (346.5 KB)

Registry Editor is a basic utility for editing the Windows registry. The user can view, create, modify, and delete keys and their values. It shows how the REG_BINARY data type can be handled by converting data to and from an escape sequence of hexadecimal characters. It can also detect which hive keys are present. You can see this by running the program in various compatibility modes such as those for Windows 98 and XP.

The program also demonstrates how to use registry related API functions such as RegCreateKeyEx, RegEnumKeyEx, RegEnumValue, RegQueryInfoKey, and RegQueryValueEx.

Attached Files

Registry Editor.zip (11.3 KB)

Hi guys,

I'm a newbie to this forum and to vb6.I just want to ask some help for my query.

I have a table prodmaster with fields pieceCode,dozenCode,caseCode, proddesc ,inventoryUnit.
example: pieceCode | dozenCode | caseCode | proddesc | inventoryUnit
110 111 112 Apple 72

note: inventory unit is constant and all code refers to one item only
I also have a flexgrid and a txtinvno.text

If I put invoice number in the textbox say inv#00152
My flexgrid displays all the products issued in that invoice (inv#00152) and those products may be served in dozen,in piece or in case.

what I want to do now is if my flexgrid(2,1)=rs!pieceCode or flexgrid(2,1)=rs!dozenCode or flexgrid(2,1)=rs!caseCode then flexgrid(2,2)=flexgrid(2,2)/rs!inventoryUnit.

the value of flexgrid(2,1) piececode,dozencode,or casecode of the product issued since we serve some items in piece,dozen, or case.
the value of flexgrid(2,2) is the quantity issued.

.
can anybody out there help me? what should be my query for this.

I tried Select * from prodmaster where prodCode='"& flexgrid(2,1) &"' or dozenCode='"& flexgrid(2,1) &"' or caseCode='"& flexgrid(2,1) &"' ,

I know it can't be done this way,

help please.

Attached Files

scrollio3.zip (178.2 KB)

This is an example (the scrollio picture viewer that I convert to take dib) with new control LargeBar
Now I can open a 20 Mpixel photo and select zoom 2000%.

The code of scrollbar is small. Return from vertical to horizontal bar automatic (we can change manual if we want). No flickering and has tab stop so we can use keyboard, arrows and pageup and pagedown,

For history the original scrollio from dilettante is here http://www.vbforums.com/showthread.p...er-UserControl

New version of scrollio, a dilettante's simple picture viewer. But now can open jpg and rotate according the exif property.
ScrollBar updated to work perfect and with a good looking design. Now we can export and import from clipboard as DIB (without loosing dpi). Also i have a menu to see someone how the image can be with 300 dpi as 1:1 ratio (1 pixel of image for 1 pixel of screen). Also I put two pictureboxes, one grab and fit the scrollio image (the part we saw) and the other is using to print two axes on a small picture of the dib inside scrollio, marking the movement of pointer above viewer. As we move on the picture, or the picture, we see the exact coordinates in pixels, in any size and any scrolling position (pure mathematics).
Also I put a slider as a scale controller...and you can see how fast dib works. Also I put a drawing over the displayed image as a target...to demonstrate how we can print on the picturebox (the displayed part of scrollio).

scrollio.image is the picturebox
scrollio,dib is the cDibSection
When the image was ending from the painting send an event PaintEnd so we can draw on image or we can grab it
Also there is a new event, a mousemove, at the "paper" the picturebox inside scrollio, that fires in any state of button, and before processed in the command for hand scrolling. This is needed for taking the current x and y, when no action for redrawing needed..So with that I insert action to have a feedback;

Attached Files

scrollio3.zip (178.2 KB)
scrollio4_1.zip (186.3 KB)

Applying a mask to an IP address is relatively straight forward in "C". You simply do a bit wise "AND" between the two. Because Visual Basic does not do bit arithmetic very well, it is a little more complicated.

Both IPv4 and IPv6 drop leading zeros, so they are an inconsistent length. IPv4 uses four bytes (32 bits), displayed as decimal numbers separated by dots (eg. 192.168.1.2), whereas IPv6 uses 16 bytes (128 bits) displayed as hexadecimal numbers separated by colons (eg. 2001:0:53aa:64c:406:8e9d:934b:458d). IPv6 is even more difficult to work with, as a group of zero elements can be replaced with a double colon (eg. 2620:0:ccc::2). The easiest way to work with them is to convert them to byte arrays, but since they are almost always transmitted and displayed as text, I found the best way is to convert them both to hexadecimal strings and padd the leading zeros.

Classless Inter-Domain Routing (CIDR) representation is the same(eg. 192.168.1.2/32 & 2001:0:53aa:64c:406:8e9d:934b:458d/128) for both. The part behind the "/" is the number of significant bits. For example, 192.168.1.0/24 is the same as using 192.168.1.0 with a netmask of 255.255.255.0.

The attached program allows you to enter an IPv4 or IPv6 network using CIDR. The program then converts the network into a fixed length starting address and a fixed length netmask. For example, 2620:0:ccc::2/120 is converted to: 262000000ccc00000000000000000000/FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF00
Notice that the last 2 in the address has been dropped. That is because the last byte (8 bits) is insignificant, so the starting address is actually 2620:0:ccc::0.

Once you have defined the network, you can enter an address in the bottom text box to see if it belongs to the defined subnet.

J.A. Coutts

Attached Files

SubNet.zip (3.5 KB)

You probably know that GDI+ is useful for loading various image formats, but GDI+ also has issues with every format it loads. For TIFFs specifically, one of the compression options it won't support is JPEG compression. Well, GDI+ does support loading/writing JPEGs, so it isn't that difficult to get these JPEG pages loaded when all is said and done.

The attached txt file is a VB class. After you save it to disk, rename it to .cls
I've also included a JPEG encoded TIFF file for you to play with, but they aren't that hard to find on the web.

A note here. I did not attempt to handle JPEG-6 compression, just JPEG-7. The v6 is pretty old nowadays and if I find the time, maybe I'll play with it. Only have 1 example with v6 encoding, most you will find now is v7.

So, to play.
1) Download the txt file & rename it .cls
2) Create a new project and add that class to your project
3) On your form, add two controls: combobox and commandbutton
4) Set the combobox style to 2
5) Paste this code to your form & run project
6) Drag/drop a TIFF onto the form

Code:

Option Explicit



Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long

Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long

Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long

Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long

Private Type GdiplusStartupInput

    GdiplusVersion           As Long

    DebugEventCallback       As Long

    SuppressBackgroundThread As Long

    SuppressExternalCodecs   As Long

End Type



Private m_Token As Long

Private m_TIFF As cTIFFreader



Private Sub Form_Load()

    If Me.Combo1.Style <> 2 Then

        Me.Show

        DoEvents

        MsgBox "The combo box must be set to Style=2", vbExclamation + vbOKOnly

        Unload Me

        Exit Sub

    End If



    Call pvCreateToken

    If m_Token = 0 Or m_Token = -1 Then

        Me.Show

        DoEvents

        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly

        Unload Me

        Exit Sub

    End If

    Set m_TIFF = New cTIFFreader

    

    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585

    Me.ScaleMode = vbPixels

    Me.Combo1.Move 0, 0, Me.ScaleWidth \ 2

    Me.Command1.Move Me.Combo1.Width + 6, 0, Me.Command1.Width, Me.Combo1.Height

    Me.Command1.Caption = "Refresh"

    Me.OLEDropMode = vbOLEDropManual

End Sub



Private Sub Form_Unload(Cancel As Integer)

    Set m_TIFF = Nothing

    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken

End Sub



Private Function pvCreateToken() As Boolean

    Dim GSI As GdiplusStartupInput

    On Error Resume Next

    If Not m_Token = -1 Then

        GSI.GdiplusVersion = 1&

        Call GdiplusStartup(m_Token, GSI)

        If m_Token = 0 Then

            m_Token = -1&

        Else

            pvCreateToken = True

        End If

    End If

End Function



Private Sub pvDestroyToken()

    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token

    m_Token = 0&

End Sub



Private Sub Command1_Click()

    Call Combo1_Click

End Sub



Private Sub Combo1_Click()

    If Not m_TIFF.ImageCount = 0& Then

        

        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single

        Dim x As Long, Y As Long, cx As Long, cy As Long

        Const UnitPixel As Long = 2&

        

        m_TIFF.Index = Combo1.ListIndex + 1

        w = m_TIFF.Width

        h = m_TIFF.Height

        cy = Me.ScaleHeight - Combo1.Height

        If Me.ScaleWidth / w > cy / h Then

            sngRatio = cy / h

        Else

            sngRatio = Me.ScaleWidth / w

        End If

        If sngRatio > 1! Then sngRatio = 1&

        cx = w * sngRatio

        cy = h * sngRatio

        x = (Me.ScaleWidth - cx) \ 2

        Y = ((Me.ScaleHeight - Combo1.Height) - cy) \ 2 + Combo1.Height

        

        Me.Cls

        GdipCreateFromHDC Me.hDC, hGraphics

        GdipDrawImageRectRectI hGraphics, m_TIFF.Handle, x, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0

        GdipDeleteGraphics hGraphics

    End If

End Sub



Private Sub pvReset()

    Dim t As Long, sItem As String

    Combo1.Clear

    For t = 1 To m_TIFF.ImageCount

        sItem = t & ". " & m_TIFF.Width(t) & " x " & m_TIFF.Height(t)

        sItem = sItem & "  DPI: " & CLng(m_TIFF.DPI_Horizontal(t)) & " x " & CLng(m_TIFF.DPI_Vertical(t))

        Combo1.AddItem sItem

    Next

    If Combo1.ListCount Then

        Combo1.ListIndex = 0

    Else

        MsgBox "No images were loaded"

    End If

End Sub



Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)

    If Data.Files.Count Then

        m_TIFF.FileName = Data.Files.Item(1)

        Call pvReset

    End If

End Sub

Edited: If interested how the class works, please spend some time and review the numerous comments throughout the attached class

Attached Files

cTIFFreader.txt (62.3 KB)
TIFFsample.zip (218.5 KB)

What is the Query Assistant?
A complete application that makes connecting to databases, executing and executing queries easier.

What can it do?
1. Connect to database using Microsoft ADO as specified by a connection string in a settings file.
2. If required, request the user for a password and/or user name and fill in the respective place holders in the connection string.
3. Load a query specified as a command line argument or as selected by the user from inside the program's interface.
4. Display input boxes for controlled input as specified by input place holders inside, if present, a query.
5. Execute a series of queries in a batch.
6. Export a query's results to a text file or Microsoft Excel spreadsheet.
7. Attach the file with the query's results to an e-mail, fill in the sender, recipient, subject, and body as specified in a settings file and then send it.
8. Insert data such the date, time, an operating system environment variable's value, an input box's value into a query or e-mail.

It also comes with an extensive help file describing:
1. What the program does.
2. The supported settings.
3. The supported command line arguments.
4. The supported file types for exported query results.
5. How to define input place holders in a query.
6. How to insert data into an e-mail or query.
7. How create a tiny example database, query and, settings file.
8. How to view a description for each control inside the interface.

An image showing the program's main interface, Microsoft Excel and Outlook:
Name: qa.jpg
Views: 63
Size: 49.4 KB

Attached Images

Attached Files

qa.v1.61.zip (82.5 KB)

I did a search here but couldn't find an existing implementation. There are several out there in the wild, dating back to an old Randy Birch example base on an even older MS KB item on sorting by date columns. So clearly people have been doing this since the early VB5 days, 1997-1998 or so.

ListViewCustomSort .cls and its companion ListViewCustomSortStatic.bas attempt to do the same thing written from scratch based on the Windows SDK. Since I wanted to make something more readily reusable it made sense to start writing anew based on the Common Controls ListView documentation.

This should be quicker with a better user experience than other techniques, for example creating extra "hidden" (width = 0) columns to sort on. However that's a perfectly viable solution as well. It just eats more memory.

What it Does

ListViewCustomSort works with both ActiveX ListView controls, the one in COMCTL32.OCX and the one in MSCOMCTL.OCX.

While you can use the existing sorting properies exposed by both ListViews for simple text sorts in ascending or descending order, there isn't a "custom sort" option and Compare Event like that provided by other controls such as the MSHFlexGrid.

ListViewCustomSort works in parallel with a ListView to provide such an event for custom sorting. While this version only handles single-column sorts you could enhance it to provide more than one column's text to the Compare Event handler.

In your Compare Event handler you get the column text of two rows to compare and you return a comparison result. In order to do something like a date or numeric compare you must compare ItemText1 and ItemText2 returning a numeric result:

Code:

'Return values:

'

'   -1 = Less Than

'    0 = Equal

'    1 = Greater Than

This usually requires some data conversion and conditional logic.

Using ListViewCustomSort

You must add ListViewCustomSortStatic.bas and ListViewCustomSort.cls to your project that uses ListViews. ListViewCustomSortStatic.bas is needed in order to implement the required API callback function.

Then in Forms with ListView controls where you want to do custom sorting, you add a separate instance of the ListViewCustomSort Class WithEvents in order to get a custom-sort Compare Event for each ListView. If your ListViews have identical sets of columns you can get by with a single ListViewCustomSort instance.

Then you write your Compare Event handler(s) to perform the custom sort comparisons.

To perform the custom sort you set ListViewCustomSort's .Ascending (Boolean) and .SortKey (Long: ListView column index, base 0) properties, and optionally its .TextMax (Long: max text width, default 256). Then you call the .Sort() method passing the ListView control reference.

The Demo

ListViewCustomSort is included in the attached archive which includes a self-contained demonstration project. This demo creates three columns of random data: a String, a Date, and a Single column.

ListViewCustomSort isn't need for the first column's data, but it is used for the other two which require some extra effort to make sorting work properly.

The source code of Form1.frm may help make usage a little clearer:

Code:

Option Explicit



Private WithEvents ListViewCustomSort As ListViewCustomSort



Private Function MakeName() As String

    Const LETTERS As String = "abcdefghijklmnopqrstuvwxyz"

    Dim I As Long

    Dim IMax As Long

    Dim J As Long

    Dim Words() As String



    IMax = Int(3 * Rnd()) + 1

    ReDim Words(IMax)

    For I = 0 To IMax

        For J = 1 To Int(8 * Rnd()) + 2

            Words(I) = Words(I) & Mid$(LETTERS, Int(26 * Rnd()) + 1, 1)

        Next

        Words(I) = StrConv(Words(I), vbProperCase)

    Next

    MakeName = Join$(Words, " ")

End Function



Private Sub cmdSortBy_Click(Index As Integer)

    Select Case Index

        Case 0

            With ListView1

                .SortKey = 0

                .SortOrder = IIf(chkAscending.Value = vbChecked, lvwAscending, lvwDescending)

                .Sorted = True

            End With



        Case 1, 2

            ListViewCustomSort.Sort ListView1, Index, chkAscending.Value = vbChecked

    End Select

End Sub



Private Sub Form_Load()

    Dim I As Long



    Randomize



    Set ListViewCustomSort = New ListViewCustomSort



    With ListView1.ColumnHeaders

        .Add , , "Col 0", 3600, lvwColumnLeft

        .Add , , "Col 1", 1080, lvwColumnRight

        .Add , , "Col 2", 1080, lvwColumnRight

    End With

    With ListView1

        With .ListItems

            For I = 1 To 1000

                With .Add(, , MakeName()) 'String.

                    .SubItems(1) = Format$(DateAdd("d", -Int(1000 * Rnd()), Date), "m/d/yyyy") 'Date.

                    .SubItems(2) = CStr(20000! * Rnd() - 10000!) 'Single.

                End With

            Next

        End With

        Set .SelectedItem = Nothing

    End With

End Sub



Private Sub Form_Resize()

    If WindowState <> vbMinimized Then

        With Picture1

            .Move 0, ScaleHeight - .Height

            ListView1.Move 0, 0, ScaleWidth, .Top

        End With

    End If

End Sub



Private Sub ListViewCustomSort_Compare( _

    ByVal SortKey As Long, _

    ByVal Ascending As Boolean, _

    ItemText1 As String, _

    ItemText2 As String, _

    Cmp As Long)



    Dim Parts() As String

    Dim Date1 As Date

    Dim Date2 As Date

    Dim Single1 As Single

    Dim Single2 As Single



    Select Case SortKey

        Case 1

            Parts = Split(ItemText1, "/")

            Date1 = DateSerial(CInt(Parts(2)), CInt(Parts(0)), CInt(Parts(1)))

            Parts = Split(ItemText2, "/")

            Date2 = DateSerial(CInt(Parts(2)), CInt(Parts(0)), CInt(Parts(1)))

            

            Cmp = Sgn(CLng(Date1) - CLng(Date2))



        Case 2

            Single1 = CSng(ItemText1)

            Single2 = CSng(ItemText2)



            Cmp = Sgn(Single1 - Single2)

    End Select

    If Not Ascending Then Cmp = -Cmp

End Sub

Attached Images

Attached Files

ListView Custom Sort.zip (6.7 KB)

Note: Tests of successful loading of the image without applying the workaround have been done on various O/S. This patch may not be required on Win7 and above

You probably know that GDI+ is useful for loading various image formats, but GDI+ also has issues with every format it loads. For TIFFs specifically, one of the compression options it won't support is JPEG compression. Well, GDI+ does support loading/writing JPEGs, so it isn't that difficult to get these JPEG pages loaded when all is said and done.

The attached txt file is a VB class. After you save it to disk, rename it to .cls
I've also included a JPEG encoded TIFF file for you to play with, but they aren't that hard to find on the web.

A note here. I did not attempt to handle JPEG-6 compression, just JPEG-7. The v6 is pretty old nowadays and if I find the time, maybe I'll play with it. Only have 1 example with v6 encoding, most you will find now is v7.

So, to play.
1) Download the txt file & rename it .cls
2) Create a new project and add that class to your project
3) On your form, add two controls: combobox and commandbutton
4) Set the combobox style to 2
5) Paste this code to your form & run project
6) Drag/drop a TIFF onto the form

Code:

Option Explicit



Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long

Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long

Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long

Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long

Private Type GdiplusStartupInput

    GdiplusVersion           As Long

    DebugEventCallback       As Long

    SuppressBackgroundThread As Long

    SuppressExternalCodecs   As Long

End Type



Private m_Token As Long

Private m_TIFF As cTIFFreader



Private Sub Form_Load()

    If Me.Combo1.Style <> 2 Then

        Me.Show

        DoEvents

        MsgBox "The combo box must be set to Style=2", vbExclamation + vbOKOnly

        Unload Me

        Exit Sub

    End If



    Call pvCreateToken

    If m_Token = 0 Or m_Token = -1 Then

        Me.Show

        DoEvents

        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly

        Unload Me

        Exit Sub

    End If

    Set m_TIFF = New cTIFFreader

    

    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585

    Me.ScaleMode = vbPixels

    Me.Combo1.Move 0, 0, Me.ScaleWidth \ 2

    Me.Command1.Move Me.Combo1.Width + 6, 0, Me.Command1.Width, Me.Combo1.Height

    Me.Command1.Caption = "Refresh"

    Me.OLEDropMode = vbOLEDropManual

End Sub



Private Sub Form_Unload(Cancel As Integer)

    Set m_TIFF = Nothing

    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken

End Sub



Private Function pvCreateToken() As Boolean

    Dim GSI As GdiplusStartupInput

    On Error Resume Next

    If Not m_Token = -1 Then

        GSI.GdiplusVersion = 1&

        Call GdiplusStartup(m_Token, GSI)

        If m_Token = 0 Then

            m_Token = -1&

        Else

            pvCreateToken = True

        End If

    End If

End Function



Private Sub pvDestroyToken()

    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token

    m_Token = 0&

End Sub



Private Sub Command1_Click()

    Call Combo1_Click

End Sub



Private Sub Combo1_Click()

    If Not m_TIFF.ImageCount = 0& Then

        

        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single

        Dim x As Long, Y As Long, cx As Long, cy As Long

        Const UnitPixel As Long = 2&

        

        m_TIFF.Index = Combo1.ListIndex + 1

        w = m_TIFF.Width

        h = m_TIFF.Height

        cy = Me.ScaleHeight - Combo1.Height

        If Me.ScaleWidth / w > cy / h Then

            sngRatio = cy / h

        Else

            sngRatio = Me.ScaleWidth / w

        End If

        If sngRatio > 1! Then sngRatio = 1&

        cx = w * sngRatio

        cy = h * sngRatio

        x = (Me.ScaleWidth - cx) \ 2

        Y = ((Me.ScaleHeight - Combo1.Height) - cy) \ 2 + Combo1.Height

        

        Me.Cls

        GdipCreateFromHDC Me.hDC, hGraphics

        GdipDrawImageRectRectI hGraphics, m_TIFF.Handle, x, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0

        GdipDeleteGraphics hGraphics

    End If

End Sub



Private Sub pvReset()

    Dim t As Long, sItem As String

    Combo1.Clear

    For t = 1 To m_TIFF.ImageCount

        sItem = t & ". " & m_TIFF.Width(t) & " x " & m_TIFF.Height(t)

        sItem = sItem & "  DPI: " & CLng(m_TIFF.DPI_Horizontal(t)) & " x " & CLng(m_TIFF.DPI_Vertical(t))

        Combo1.AddItem sItem

    Next

    If Combo1.ListCount Then

        Combo1.ListIndex = 0

    Else

        MsgBox "No images were loaded"

    End If

End Sub



Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)

    If Data.Files.Count Then

        m_TIFF.FileName = Data.Files.Item(1)

        Call pvReset

    End If

End Sub

See Also:
GDI+ Workaround: JPG > Zero-Length APP Markers
GDI+ Workaround: BMP > Alpha Channels + JPG/PNG Encoded

Edited: If interested how the class works, please spend some time and review the numerous comments throughout the attached class

Attached Files

cTIFFreader.txt (62.3 KB)
TIFFsample.zip (218.5 KB)

Code:

Option Explicit



Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long

Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long

Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long

Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long

Private Type GdiplusStartupInput

    GdiplusVersion           As Long

    DebugEventCallback       As Long

    SuppressBackgroundThread As Long

    SuppressExternalCodecs   As Long

End Type



Private m_Token As Long

Private m_JPG As cJPGreader



Private Sub Form_Load()

    

    Call pvCreateToken

    If m_Token = 0 Or m_Token = -1 Then

        Me.Show

        DoEvents

        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly

        Unload Me

        Exit Sub

    End If

    Set m_JPG = New cJPGreader

    

    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585

    Me.ScaleMode = vbPixels

    Me.Command1.Move 0, 0

    Me.Command1.Caption = "Refresh"

    Me.OLEDropMode = vbOLEDropManual

End Sub



Private Sub Form_Unload(Cancel As Integer)

    Set m_JPG = Nothing

    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken

End Sub



Private Function pvCreateToken() As Boolean

    Dim GSI As GdiplusStartupInput

    On Error Resume Next

    If Not m_Token = -1 Then

        GSI.GdiplusVersion = 1&

        Call GdiplusStartup(m_Token, GSI)

        If m_Token = 0 Then

            m_Token = -1&

        Else

            pvCreateToken = True

        End If

    End If

End Function



Private Sub pvDestroyToken()

    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token

    m_Token = 0&

End Sub



Private Sub Command1_Click()

    Call pvRenderImage

End Sub



Private Sub pvRenderImage()

    If Not m_JPG.Handle = 0& Then

        

        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single

        Dim x As Long, Y As Long, cx As Long, cy As Long

        Const UnitPixel As Long = 2&

        

        w = m_JPG.Width

        h = m_JPG.Height

        cy = Me.ScaleHeight - Command1.Height

        If Me.ScaleWidth / w > cy / h Then

            sngRatio = cy / h

        Else

            sngRatio = Me.ScaleWidth / w

        End If

        If sngRatio > 1! Then sngRatio = 1&

        cx = w * sngRatio

        cy = h * sngRatio

        x = (Me.ScaleWidth - cx) \ 2

        Y = ((Me.ScaleHeight - Command1.Height) - cy) \ 2 + Command1.Height

        

        Me.Cls

        GdipCreateFromHDC Me.hDC, hGraphics

        GdipDrawImageRectRectI hGraphics, m_JPG.Handle, x, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0

        GdipDeleteGraphics hGraphics

    End If



End Sub



Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)

    If Data.Files.Count Then

        m_JPG.FileName = Data.Files.Item(1)

        Call pvRenderImage

    End If

End Sub

Attached Files

cJPGreader.txt (13.4 KB)
sampleJPG.zip (181.1 KB)

Note: Tests of successful loading of the image without applying the workaround have been done on various O/S. This patch appears to be required on Win7 and lower. Win8 not yet tested

You probably know that GDI+ is useful for loading various image formats, but GDI+ also has issues with every format it loads. For BMPs specifically, GDI+ has 1 major flaw in my opinion and another minor one:

a) Translucent bitmaps. 32 bit, 4 bytes per pixel, bitmaps can contain transparency just like other modern image formats. However, when GDI+ loads these, it reports back that the image format does not use the alpha channel even when the image actually does use it. This issue presents itself whether the RGB components are premultiplied against the alpha channel or not.

b) PNG/JPG embedded bitmaps. Huh? If you aren't aware these are possible, then that's probably why GDI+ doesn't directly support them. Besides, they weren't intended for display anyway, they were intended for printers. Anyway, a JPG or PNG file can be placed in a bitmap as the bitmap's pixel data. The only real change to the bitmap file format is that the bitmap's BitCount property must be zero, its SizeImage property must be the size of the JPG/PNG embedded file and that its Compression property be BI_PNG or BI_JPG as appropriate.

The attached txt file is a VB class. After you save it to disk, rename it to .cls
I've also included 4 bitmaps to play with:
1) One that uses semi-transparency
2) One that uses semi-transparency, but pixels are premultiplied against the alpha channel
3) One that has a JPG embedded into it
4) One that has a PNG embedded into it

So, to play.
1) Download the txt file & rename it .cls
2) Create a new project and add that class to your project
3) On the form, add a commandbutton
4) Paste this code to your form & run project
5) Drag/drop a BMP onto the form

Code:

Option Explicit



Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long

Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long

Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long

Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long

Private Type GdiplusStartupInput

    GdiplusVersion           As Long

    DebugEventCallback       As Long

    SuppressBackgroundThread As Long

    SuppressExternalCodecs   As Long

End Type



Private m_Token As Long

Private m_BMP As cBMPreader



Private Sub Form_Load()

    

    Call pvCreateToken

    If m_Token = 0 Or m_Token = -1 Then

        Me.Show

        DoEvents

        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly

        Unload Me

        Exit Sub

    End If

    Set m_BMP = New cBMPreader

    

    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585

    Me.ScaleMode = vbPixels

    Me.Command1.Move 0, 0

    Me.Command1.Caption = "Refresh"

    Me.OLEDropMode = vbOLEDropManual

End Sub



Private Sub Form_Unload(Cancel As Integer)

    Set m_BMP = Nothing

    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken

End Sub



Private Function pvCreateToken() As Boolean

    Dim GSI As GdiplusStartupInput

    On Error Resume Next

    If Not m_Token = -1 Then

        GSI.GdiplusVersion = 1&

        Call GdiplusStartup(m_Token, GSI)

        If m_Token = 0 Then

            m_Token = -1&

        Else

            pvCreateToken = True

        End If

    End If

End Function



Private Sub pvDestroyToken()

    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token

    m_Token = 0&

End Sub



Private Sub Command1_Click()

    Call pvRenderImage

End Sub



Private Sub pvRenderImage()

    If Not m_BMP.Handle = 0& Then

        

        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single

        Dim X As Long, Y As Long, cx As Long, cy As Long

        Const UnitPixel As Long = 2&

        

        w = m_BMP.Width

        h = m_BMP.Height

        cy = Me.ScaleHeight - Command1.Height

        If Me.ScaleWidth / w > cy / h Then

            sngRatio = cy / h

        Else

            sngRatio = Me.ScaleWidth / w

        End If

        If sngRatio > 1! Then sngRatio = 1&

        cx = w * sngRatio

        cy = h * sngRatio

        X = (Me.ScaleWidth - cx) \ 2

        Y = ((Me.ScaleHeight - Command1.Height) - cy) \ 2 + Command1.Height

        

        Me.Cls

        GdipCreateFromHDC Me.hDC, hGraphics

        GdipDrawImageRectRectI hGraphics, m_BMP.Handle, X, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0

        GdipDeleteGraphics hGraphics

    End If



End Sub



Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)

    If Data.Files.Count Then

        m_BMP.FileName = Data.Files.Item(1)

        Call pvRenderImage

    End If

End Sub

Attached Files

cBMPreader.txt (22.3 KB)
sampleBMPs.zip (102.8 KB)

This is a simple Viewer for Zooming big images, and an example for scrollio control, LargeBar, dib processing and an example of how to search files in folder tree recursively and asynchronously.

We going a step ahead with this example. Now we can open a folder and we can search in that folder and all folders under that for a list of file types, and saved in a list sorted by time modified, for each folder. This was done with a class using WithEvents.

Also we have an advanced scrollio and an advance largebar. Now with up arrow and down arrow we can zoom the scrollio using equal step of zooming. Now the LargeBar can modified to use for clicking a smallchange as a logarithmic one. LargeChange change as before.
Scrollio now can hide mouse pointer so can display in code in the form (out of scrollio) our drawing as mouse pointer. Also I found the solution for a previously problem, of how with only a mouse move event can simulate the mouse down..So now we can scroll the scrollio in reverse without the starting jump... So now we can move the pointer in any point in the image, with auto scrolling, as we move it. Use shift + control to use the other way of moving, pushing (this is the default is scrollio control and the scrolling at the direction of pointer is out of scrollio, in code in the form and translate the X,Y to the default method. One method for two...). Also shift only or control only... make the move to one axis only.
I use ISHF_Ex.tlb for opening folders dialog.

The new file Viewer2.zip has some minor things changed..

I want this program to run wuth WINE in linux...so i foun a way to reduce the entering to mousemove event.
In xp there isn't problem (i run it in a virtualbox) but in linux the time slicing is different.

Code:

Private Sub paper_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)

Static timestamp As Double

If timestamp = 0 Then timestamp = Timer

If (timestamp + 0.05) > Timer Then Exit Sub

timestamp = Timer

My last proble is the dir function in linux...from wine return the name of file in small letters...(isn't case sensitive). But the paths are ok...

Attached Files

Viewer3.zip (72.6 KB)

This is a simple Viewer for Zooming big images, and an example for scrollio control, LargeBar, dib processing and an example of how to search files in folder tree recursively and asynchronously.

We going a step ahead with this example. Now we can open a folder and we can search in that folder and all folders under that for a list of file types, and saved in a list sorted by time modified, for each folder. This was done with a class using WithEvents.

Also we have an advanced scrollio and an advance largebar. Now with up arrow and down arrow we can zoom the scrollio using equal step of zooming. Now the LargeBar can modified to use for clicking a smallchange as a logarithmic one. LargeChange change as before.
Scrollio now can hide mouse pointer so can display in code in the form (out of scrollio) our drawing as mouse pointer. Also I found the solution for a previously problem, of how with only a mouse move event can simulate the mouse down..So now we can scroll the scrollio in reverse without the starting jump... So now we can move the pointer in any point in the image, with auto scrolling, as we move it. Use shift + control to use the other way of moving, pushing (this is the default is scrollio control and the scrolling at the direction of pointer is out of scrollio, in code in the form and translate the X,Y to the default method. One method for two...). Also shift only or control only... make the move to one axis only.
I use ISHF_Ex.tlb for opening folders dialog.

I want this program to run wuth WINE in linux...so I found a way to reduce the entering to mousemove event.
In xp there isn't problem (i run it in a virtualbox) but in linux the time slicing is different.

Code:

Private Sub paper_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)

Static timestamp As Double

If timestamp = 0 Then timestamp = Timer

If (timestamp + 0.05) > Timer Then Exit Sub

timestamp = Timer

My last problem is the dir function in linux...from wine return the name of file in small letters...(isn't case sensitive). But the paths are ok...l found that some files are readed and other not even they have capital letters both.

Version 4 arrive..
You can crop to the viewport, you can crop and copy to clipboard, you can paint with a brush (left button green and right button white ) (use shift and contol for paint horizntal or vertical lines, use both to move to any place in the image without painting). Sliders for opacity and size of brush.
The new for painting is that we can paint with auto scrolling (version 3 has auto scrolling too but not so good and not with painting procedure. )

Attached Files

Viewer3.zip (72.6 KB)
Viewer4.zip (74.9 KB)

Just a small example, how to use the ICM-API (hosted in msvfw32.dll), to decode
YUV-RawData-Blobs as they may come in from Web- or other Cam-Drivers...

These APIs are still supported also on Win8/Win8.1 - and are wrapped here in a
small Class (cICMDecode.cls).

Two example-RawDataBlobs are contained in the Zip-File ...
- one representing a 640x480 12Bit 4:2:0 Input (460800 Bytes)
- the other a 640x480 16Bit 4:2:2 Input (614400 Bytes)

Some Background-Infos about YUV-ColorSpaces and -Decoding can be found here:
http://msdn.microsoft.com/en-us/libr...5%29.aspx#yv12
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

The Video-Compression-Manager-API is described here:
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

The Form-Code of the small Demo in the Zip depends on vbRichClient5 (downloadable from http://vbRichClient.com),
but the cICMDecode.cls itself has no RC5-dependency - so if you have your own
24Bit-RGB-DIB-Class-encapsulation at hand, you can adapt the Form-Code to your
own destination-buffer-handling - and achieve the same results...

The Form-Code is not very large:

Code:

Option Explicit



Private SrcBytes420_12Bit() As Byte, DecIYUV As New cICMDecode

Private SrcBytes422_16Bit() As Byte, DecYUY2 As New cICMDecode

 

Private DstDC As cDC, DstDIB As cDIB '<- to provide the RGB24-decoding-buffer for both cases



Private Sub Form_Load()

  'try to open the two different ICM-Decoders first

  If Not DecIYUV.OpenDecoder(640, 480, DecIYUV.Make4CC("IYUV"), 12, 24) Then

    MsgBox "Couldn't open the IYUV(4:2:0) decoder": Unload Me: Exit Sub

  End If

  If Not DecYUY2.OpenDecoder(640, 480, DecYUY2.Make4CC("YUY2"), 16, 24) Then

    MsgBox "Couldn't open the YUY2(4:2:2) decoder": Unload Me: Exit Sub

  End If

  

  SrcBytes420_12Bit = New_c.FSO.ReadByteContent(App.Path & "\Planar YUV420.dat")

  SrcBytes422_16Bit = New_c.FSO.ReadByteContent(App.Path & "\Interleaved YUV422.dat")

  

  Set DstDIB = New_c.DIB(640, 480) 'allocate RGB24 decoding-memory in DstDIB

  Set DstDC = New_c.DC(DstDIB) 'select the DIB into a DC, to be able to perform some overlays

      DstDC.SetTextColor vbGreen

      DstDC.SetFont "Arial", 10, True

End Sub

 

Private Sub cmd420_Click()

  New_c.Timing True

     DecIYUV.Decode VarPtr(SrcBytes420_12Bit(0)), UBound(SrcBytes420_12Bit) + 1, DstDIB.pDIB, chkVerticalFlip

     

     DstDC.TextOut "IYUV(4:2:0) decoder", 10, 10 'draw an additional TextOverlay onto the Frame

     DstDIB.DrawTo picVidImg.hDC

  Caption = New_c.Timing

End Sub



Private Sub cmd422_Click()

  New_c.Timing True

     DecYUY2.Decode VarPtr(SrcBytes422_16Bit(0)), UBound(SrcBytes422_16Bit) + 1, DstDIB.pDIB, chkVerticalFlip

     

     DstDC.TextOut "YUY2(4:2:2) decoder", 10, 10 'draw an additional TextOverlay onto the Frame

     DstDIB.DrawTo picVidImg.hDC

  Caption = New_c.Timing

End Sub

Here's the Download-Link for the Zip-File (Code and Raw-Data-Files):
http://vbRichClient.com/Downloads/ICMDecoding.zip

And here a ScreenShot:

Edit: Added an optional Param for a Vertical-Flip already at the decoding-stage into cICMDecode.cls
. also adjusted the Timing, to measure the decoding *and* rendering to the Screen (including a Textoverlay on the Decoded Frame)
. the whole thing is with about 2msec decoding+rendering-time still good for about 500FPS

Olaf

Description :
This script will display three messages box with 3 different languages with Google Voice Speech.
1. English
2. French
3. Arabic

Code:

Option Explicit

Call Ip_Publique()

'***********************************************************************************************************************************************************

Sub Ip_Publique()

        Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public,IP

        Dim MessageEN,MessageFR,MessageAR,URLEN,URLFR,URLAR,Copyright

        Copyright = "(2014 © Hackoo)"

        MessageEN = "You are connected to the internet !" & VbCrlf & "Your Public IP Adress is "

        MessageFR = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est "

        MessageAR = ChrW(1571)&ChrW(1606)&ChrW(1578)&ChrW(32)&ChrW(1605)&ChrW(1578)&ChrW(1589)&ChrW(1604)&_

        ChrW(32)&ChrW(1576)&ChrW(1588)&ChrW(1576)&ChrW(1603)&ChrW(1577)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1573)&_

        ChrW(1606)&ChrW(1578)&ChrW(1585)&ChrW(1606)&ChrW(1578)& VbCrlf & "IP "

        URLEN = "http://translate.google.com/translate_tts?tl=en&q=" & MessageEN

        URLFR = "http://translate.google.com/translate_tts?tl=fr&q=" & MessageFR

        URLAR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" & MessageAR

        Titre = "Adresse IP Publique " & Copyright

        URL = "http://monip.org"

        If OnLine("smtp.gmail.com") = True Then 

                Set ie = CreateObject("InternetExplorer.Application")

                Set objFSO = CreateObject("Scripting.FileSystemObject")

                ie.Navigate (URL)

                ie.Visible=False

                DO WHILE ie.busy

                        Wscript.Sleep 100

                Loop

                Data = ie.document.documentElement.innertext

                Set objRegex = new RegExp

                objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"

                objRegex.Global = False

                objRegex.IgnoreCase = True

                Set Matches = objRegex.Execute(Data)

                For Each Match in Matches

                        IP =  Match.Value

                        Call NavigateIE(URLEN & IP)

                        MsgBox MessageEN & IP,64,Titre

                        Call NavigateIE(URLFR & IP)

                        MsgBox MessageFR & IP,64,Titre

                        Call NavigateIE(URLAR & IP)

                        MsgBox MessageAR & IP,64,Titre

                Next

                ie.Quit

                Set ie = Nothing

        Else

                MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre

                Exit Sub

        End If

End Sub

'************************************************************************************************************************************************************

Function OnLine(strHost)

        Dim objPing,z,objRetStatus,PingStatus

        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")

        z = 0

        Do   

                z = z + 1

                For Each objRetStatus In objPing

                        If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then

                                PingStatus = False

                        Else

                                PingStatus = True

                        End If     

                Next   

                Call Pause(1)

                If z = 4 Then Exit Do

        Loop until PingStatus = True

        If PingStatus = True Then

                OnLine = True

        Else

                OnLine = False

        End If

End Function

'*********************************************************************************************

'Fonction pour ajouter les doubles quotes dans une variable

Function DblQuote(Str)

        DblQuote = Chr(34) & Str & Chr(34)

End Function

'**********************************************************************************************

Sub Pause(NSeconds)

        Wscript.Sleep(NSeconds*1000)

End Sub

'**********************************************************************************************

Sub NavigateIE(URL)

Dim objExplorer 

Set objExplorer = CreateObject("InternetExplorer.Application")

        with objExplorer

                        .Navigate(URL)

                        .Visible = False

        end with

End Sub

'**********************************************************************************************

Attached Images

Attached Files

newdir.zip (20.4 KB)

This is a small program, based on gEditBox. I made this for gEditBox because I have some customize..custom controls and I want to find the differences.
It is a fast coding (one day) so...I do the basics...Two edit boxes, on with auto colorizing vb6 code (my way), and the other to put by three way code for testing similarity.

There is also a small gEditbox for searching.
No word wrapping enabled here for clarity. Also form isn't sizable (you can arrange controls better if you like).
From left there are buttons for:
1. Clear Up (clear "up" textbox - ctrl a and delete is the same but slower). "Up" is the name of up textbox...

- We want to find from Up textbox the similarities with the "Down" textbox. (You may think that these are the same....but the Up textbox..colorize the code, and the searching is like a moving in chess...we going forward but we looking from the other side to our side. This is my first such a search routine...Any idea for to help for a better code is appreciated.

2. Load Up (we load from a temporary test.doc file in %temp%.

3. Copy Down...(copy from Up to Down)

Under Search Box, Buttons up (search in UP editbox), and down (search in DOWN editbox) Searching means also moving to next. In search box we write something to be "like" not equal (also automatic embedded asterisks in fron and behind the searching string). Another way to search is by automatic select word, or you can select a part of a line and perform search in this or the other editbox (from any of these).

4. Clear Mark
This colorize the code "again" the color in Up editbox and colorize with one "neutral" color the down editbox. Because when we do a search (our scope) both editboxes changes colors.

There is a frame named Down Text with these buttons:
5. Clear Down - Same as for UP.
6. Mark new or changed lines of code (our goal)
7.Move Top Line (because searching done from cursor, we set cursor to top, first line)
8. Move to change. All changes lines are colored, so this is very helping
9. Move Up as Down. Moving up to same line in number. Maybe not the same line as content.

10. Save down. AS you see we load Up but we save Down. This is for making at the down the merging...So we need to feed data to Up and export only from Down. We can copy to clipboard, or we can drag (7941 lines has the gEditBox code...end perform good), and we can save to test.doc as unicode utf16 with doc extension (open with Word).
Name: tester.jpg
Views: 220
Size: 87.4 KB

Name: tester.jpg
Views: 220
Size: 87.4 KB

Attached Images

Attached Files

tester.zip (54.4 KB)
tester2_1.zip (54.5 KB)

This is a work on my glist and myDir class (this class expanded here, but I use it in scrolliodo 4).
The good news
We bit Android...Yes we can scroll up down (not with super fast move, but with an accelerated move) bu pushing the list item up or down. If we select to hide scroll bar, when we push the list, the scroll bar be visible and we can operate it until we choose an item...and scroll bar hide.
Glist is updated to work with no data inside (as an option). So we take the data in myDir class and use that data without copy in the list. Because tehe list expose hdc, and the rect to draw...we can do a lot of things in code ind the form and not in the glist. This glist has inside merged in code a largebar control, so we can put a lot of items (no integer, but long for indexing)
We can display a folder, with or without files, and a folder and all folders under with or without files. Also we can sort files and folders (using the quicksort), by timestamp, by name or by type(for folders type is equal to name). We can select the multiselect option and we do a clik in the left area of an item, and as many as we like, but no on folders, that we define in a event routine out of glist.

I don't use dir, in myDir class but an advanced code to read in unicode.
Any suggestion is welcome

***********Glist4 is finished***************
I have in the last zip all the examples to master the glist4.
Glist4 is not only a listbox. It is a text viewer, a menu, a dropdown menu or list, a file selector, a control container, a floating control. Has header multiline with custom wrapping (break at spaces and slash, and can break big words). For menu we can have radio buttons, or just checked, or all of them, plus lines to separate items. We can enabled or disable menu items, and we can move with arrow keys, home/end, page up and down. In all situations scroll bar auto hide when we didn't need it. Except checked, radio buttons, enabled/disabled, we have multiselect listbox with a box in every item to select or not.

There are classes to subclassing the glist4 with just using WithEvents and the right object references.

So for a file selector:

Code:

Public WithEvents mySelector As FileSelector



in form load event.............................................

Set mySelector = New FileSelector

With mySelector

Set .glistN = gList4

Set .Text1 = Text2

.FileTypesToDisplay = "TXT"

.SortType = 1   ' 0 timestamp - 1 name - 2 type

.FilePath = "C:\"

End With

.............................



Private Sub mySelector_DoubleClick(file As String)

myTextViewer.Title = file

myTextViewer.filename = file

End Sub

Attached Images

Attached Files

glis4.zip (23.1 KB)
3rdtry.zip (23.8 KB)
Try4.zip (34.6 KB)
finalglist4_1.zip (39.3 KB)

VB6-JACMail Crypto Service

VB6-JACMail2 Email Client

Registry Editor - demonstrates how to use various registry related API functions.

Select query in visual basic 6

Scroll Bar with LONG value...

Scroll Bar with LONG value...updated

VB6-SubNet representation

[VB6] JPEG-compressed TIFF File Reader (GDI+)

Query Assistant - connect to databases and execute queries.

[VB6] ListViewCustomSort Helper Class

[VB6] GDI+ Workaround: TIFF > JPEG-compressed images

[VB6] GDI+ Workaround: JPG > Zero-Length APP Markers

[VB6] GDI+ Workaround: BMP > Alpha Channels + JPG/PNG Encoded

Search files in folder tree recursively and asynchronously (New Scrollio also)

Search files in folder tree recursively and asynchronously (New Scrollio Ver 4)

Video-Decompression with the VCM (ICM-Win32-API)

[VBS] IP Adress with Google Speech

First attempt for a new compact file selector

Test two vb codes for changes

glist4 as file selector, menu and other things