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

[VB6, Vista+] Undocumented ListView feature: Groups in Virtual Mode

0
0

Well, this project has been a long time coming. Just when I thought I had it, a mysterious and difficult-to-trace crash reared its head. But that last issue has finally been resolved.

According to Microsoft, Group Mode can't be used when the ListView is in Virtual Mode-- when LVS_OWNERDATA is set. But they have confused 'can't be done' with 'undocumented and unsupported'. Through the use of undocumented interfaces, IListView and IOwnerDataCallback, I have brought grouping while in virtual mode to VB6 as a port of some excellent work by Timo Kunze. You can also thank LucasMKG here since if he hadn't kept on me to work on this and finally got me looking at OnCacheHint, this project might never have been completed.

How It Works

-A class module must implement the IOwnerDataCallback interface
-Then, the reference is set like this:
Set cLVODC = New cLVOwnerDataCB
Dim pILV As IListView
Call SendMessage(hLVVG, LVM_QUERYINTERFACE, VarPtr(IID_IListView), pILV)
pILV.SetOwnerDataCallback cLVODC

-After that, it's just a matter of creating the ListView.

Project Notes
-This project fully supports Unicode by responding to WM_NOTIFYFORMAT with NFR_UNICODE and responding to LVN_GETDISPINFOW. Currently I'm experiencing a problem with StrPtr that corrupts subitem text; I haven't had this problem before (as in, it was fine the other day with this same unchanged code) and it shouldn't effect anyone else, but if for some reason it does let me know; but when compiled the problem goes away.
-This project is mainly a proof of concept; information about the groups is hard-coded. In a real project you'll need to be careful to keep item numbers and information updated, including the .cItems LVGROUP member (which isn't read-only, it must be set), and to return the correct group information in cLVOwnerDataCB--- see below.
-You could probably apply this method to a Comctllib (5) ListView, but this project makes its own with CreateWindowEx.

Requirements
-Windows 7 or higher (for Vista, the typelib needs to be recompiled with a different IID for IListView; if anyone wants this let me know)
-lvundoc.tlb - Must be added as a reference. If you have a previous version, make sure to replace it with the one in this download.
-Common Controls 6.0 Manifest - Your project (and the IDE if you want to see groups) needs a manifest specifying 6.0 controls; see here. The demo project has a manifest built in.

Setting Group Callback Information
The demo project has these hardcoded for 99 items in 3 groups. You'll need to change that for real-world projects. Refer to the following information from Timo's project:
Quote:

/// \brief <em>Will be called to retrieve an item's zero-based control-wide index</em>
///
/// This method is called by the listview control to retrieve an item's zero-based control-wide index.
/// The item is identified by a zero-based group index, which identifies the listview group in which
/// the item is displayed, and a zero-based group-wide item index, which identifies the item within its
/// group.
///
/// \param[in] groupIndex The zero-based index of the listview group containing the item.
/// \param[in] groupWideItemIndex The item's zero-based group-wide index within the listview group
/// specified by \c groupIndex.
/// \param[out] pTotalItemIndex Receives the item's zero-based control-wide index.
///
/// \return An \c HRESULT error code.
virtual HRESULT STDMETHODCALLTYPE GetItemInGroup(int groupIndex, int groupWideItemIndex, PINT pTotalItemIndex) = 0;
/// \brief <em>Will be called to retrieve the group containing a specific occurrence of an item</em>
///
/// This method is called by the listview control to retrieve the listview group in which the specified
/// occurrence of the specified item is displayed.
///
/// \param[in] itemIndex The item's zero-based (control-wide) index.
/// \param[in] occurrenceIndex The zero-based index of the item's copy for which the group membership is
/// retrieved.
/// \param[out] pGroupIndex Receives the zero-based index of the listview group that shall contain the
/// specified copy of the specified item.
///
/// \return An \c HRESULT error code.
virtual HRESULT STDMETHODCALLTYPE GetItemGroup(int itemIndex, int occurenceIndex, PINT pGroupIndex) = 0;
/// \brief <em>Will be called to determine how often an item occurs in the listview control</em>
///
/// This method is called by the listview control to determine how often the specified item occurs in the
/// listview control.
///
/// \param[in] itemIndex The item's zero-based (control-wide) index.
/// \param[out] pOccurrencesCount Receives the number of occurrences of the item in the listview control.
///
/// \return An \c HRESULT error code.
virtual HRESULT STDMETHODCALLTYPE GetItemGroupCount(int itemIndex, PINT pOccurenceCount) = 0;
Attached Files

Rotation and scale in one routine (also for 32bit bitmaps)

0
0
This is an example on another example. I get the Tanner_H's code from there Color Management (ICC Profile) support in VB6: guide and sample project and I put a textbox where we can write the angle (0 is North) in degrees (I have specify 1.4 and 1.6 zoom factors). As we see the rotation is perfect for transparent png.
Also I made two options, one for 1:1 render and the other as fit to picturebox.
Pictureboxes are in non AutoRedraw mode, and that is for the ICC profile (for specific HDC). This was there as I found it in the code from Tanner_H.
The rotation and scale use single floating computation on a 2X2 pixels. Also canvas get bigger to hold any rotation.


NewOne.zip

George
Attached Files

VB6 - TLSSend Using CNG

0
0
Attached is a program called TLSSend. This Version uses MS CNG (Cryptography Next Generation), and sends email messages to:
1. Your ISP
2. Gmail
3. MS Live
using ports 25, 1025, 465, or 587. Port 25 is the standard SMTP port, port 1025 is the Plain Authentication port offered by some services, port 465 is for the standard "Secure" connection, and port 587 is for the "Secure" connection using STARTTLS. Port 465 negotiates a secure connection directly after the TCP connection is established, whereas port 587 starts the connection in text mode, but negotiates the secure connection before the transmission of the authentication information.

When first run, TLSSend automatically activates the Setup form. There you will find the requirements for your ISP, Gmail, and MS Live(Outlook/Hotmail) accounts. Each one requires the name of the Outbound Server, the account name, the Password, and the ports utilized. Both Gmail and Live do not support non-secure connections, and MS Live does not support port 465. My own ISP accepts connections on all four ports, but unfortunately doesn't support TLS 1.2 on the secure connections. Strange part is that it requires SHA256 for the Hash algorithm when there are about 40% of servers that still use SHA1.

There is currently a problem with Gmail that does not stop it from working. A secure server will forward a Certificate chain that includes the RSA Key used and a Signature. The signature attached to the last Certificate is normally a Hash of the Server (first) Certificate encrypted with the RSA Private key from the last Certificate (Certificate Authority). For reasons unknown, Google uses a Certificate issued by Equifax that contains a 2048 bit/256 byte RSA Public Key, but the attached Signature is 1024 bit/128 byte. A 128 byte Signature cannot be created using a 256 byte Key, and 128 byte Keys have not been in use since the end of 2013. Since TLSSend does not support 128 Byte keys/signatures, it cannot verify the Server Certificate from Google.

J.A. Coutts
Attached Images
 
Attached Files

Directory Tree - Generates a list of subdirectories.

0
0
Directory Tree demonstrates how to list all subdirectories under a directory. Simply specify the "root" directory and output file.

This can be useful, for example, when writing a program that searches for files.
Attached Files

Here's how to make VB6 execute a program and then wait for it to close.

0
0
It's a VB6 sub called RunAndWait.
Code:

Private Const SYNCHRONIZE As Long = &H100000

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long


Public Sub RunAndWait(ByVal FileName As String, Optional ByVal Args As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus)
Dim ProcID As Long
Dim hProc As Long
ProcID = Shell("""" & FileName & """ " & Args, WindowStyle)
hProc = OpenProcess(SYNCHRONIZE, 0, ProcID)
WaitForSingleObject hProc, -1
CloseHandle hProc
End Sub

Just paste this code into a module and you will be able to call it from anywhere in your program.

Framework for making plugins

0
0
You know how a lot of software these days use plugins, whether it's a graphics program, or a web browser, that allows additional functionality that was not present in the base program? Well I figured out how to do this in VB6.

Here's 2 templates, one for a plugin host, and one for a plugin. These are commented enough that you will be able to see how to use them. They are intended to be placed in modules (BAS files).

First template is modPluginHost, and should be used when compiling your main program's EXE file.
Code:

Private Const SYNCHRONIZE As Long = &H100000

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Type InitStructType
    StructSize As Long
    'Define the structure's elements here.
End Type
Public InitStruct As InitStructType
' This plugin initialization structure will contain
' all data that must be passed from the host to the
' plugin. For example, in an image processing
' plugin, this would contain image dimensions and a
' pointer to pixel data.



Public Function CallPlugin(ByVal PluginFileName As String) As Boolean
' PluginFileName is the EXE file of the plugin.
' It can be a relative or absolute path.

Dim ProcID As Long
Dim hProc As Long

On Error Resume Next
ProcID = Shell("""" & PluginFileName & """ " & CStr(GetCurrentProcessId) & " " & CStr(VarPtr(InitStruct)), vbNormalFocus)
If Err.Number Then Err.Clear
If ProcID = 0 Then Exit Function
hProc = OpenProcess(SYNCHRONIZE, 0, ProcID)
WaitForSingleObject hProc, -1
If hProc = 0 Then Exit Function
CloseHandle hProc
CallPlugin = True
End Function

Second template is modPlugin, and should be used when compiling your plugin's EXE file.
Code:

Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000

Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long

Public Type InitStructType
    StructSize As Long
    'Define the structure's elements here.
End Type
Public InitStruct As InitStructType
' This plugin initialization structure will contain
' all data that must be passed from the host to the
' plugin. For example, in an image processing
' plugin, this would contain image dimensions and a
' pointer to pixel data.

Dim HostProcID As Long



Public Sub InitPlugin()
'This should be the very first thing called in your plugin.
'Preferably, call this in the Form_Load event of your plugin's main form.

Dim CmdLineArgs() As String
Dim HostInitStructAddr As Long
Dim hProc As Long

CmdLineArgs() = Split(Command, " ")
HostProcID = CmdLineArgs(0)
HostInitStructAddr = CmdLineArgs(1)

hProc = OpenProcess(GENERIC_READ, 0, HostProcID)
If hProc = 0 Then End
If ReadProcessMemory(hProc, HostInitStructAddr, InitStruct, 4) <> 0 Then
    CloseHandle hProc
    End
End If
If ReadProcessMemory(hProc, HostInitStructAddr, InitStruct, InitStruct.StructSize) <> 0 Then
    CloseHandle hProc
    End
End If
CloseHandle hProc
End Sub



Public Function ReadDataFromHost(ByVal LocalDataAddr As Long, ByVal HostDataAddr As Long, ByVal DataSize As Long) As Boolean
Dim hProc As Long

hProc = OpenProcess(GENERIC_READ, 0, HostProcID)
If hProc = 0 Then Exit Function
If ReadProcessMemory(hProc, HostDataAddr, ByVal LocalDataAddr, DataSize) <> 0 Then
    CloseHandle hProc
    Exit Function
End If
CloseHandle hProc
ReadDataFromHost = True
End Function



Public Function WriteDataToHost(ByVal LocalDataAddr As Long, ByVal HostDataAddr As Long, ByVal DataSize As Long) As Boolean
Dim hProc As Long

hProc = OpenProcess(GENERIC_WRITE, 0, HostProcID)
If hProc = 0 Then Exit Function
If WriteProcessMemory(hProc, HostDataAddr, ByVal LocalDataAddr, DataSize) <> 0 Then
    CloseHandle hProc
    Exit Function
End If
CloseHandle hProc
WriteDataToHost = True
End Function

Other than defining the elements of the InitStructType user defined type (which should match exactly between the host and the plugin), there's really nothing that needs to be edited in these templates.

VB6 - Grammatical Evolution

0
0
This is a small project inspired by Grammatical Evolution.

It's a Genetic Algorithm that evolves a Program-Code.
(in fact i'd prefer to call it Code-Evolution, since it involves even ROM and uses RAM, and since Grammatical Evolution is something more sophisticated)

The GA individuals-Structure is this:

-Inputs
-Outpus
-RAM
-ROM (Constants)
-Code

The Parts that evolve are ROM and CODE.

Public Sub INIT(PopulationSize As Long, Inputs As Long, Outputs As Long, Rams As Long, Roms As Long, NCodeLines As Long, _
EVOSonsPerc As Double, EVOChildMutationProb As Double, EVOMutationRate As Double)



At the Moment the CODE have this set of instructions:

R = A + B
R = A - B
R = A * B
R = A / B
R = A ^ B
R = IIf(A > B, A, B) Greater
R = IIf(A < B, A, B) Smaller
R = A

JUMP to line Code
Jump if A>B to line Code
Jump if A<B to line Code

Where A,B can be: Input,RAM,ROM
and R can be RAM,Output


One single line of code occupy 7 Values defined so:
1 - Main instruction
2 - Type of A
3 - Address of A (depending on its type)
4 - Type of B
5 - Address of B (depending on its type)
6 - Type of R
7 - Address of R (depending on its type)

(If 1 operand or jump,some of these are not used)



Launch the program and watch moving object learn to stay on "Green Circle"
In Test01 a set of Object move according to their Codes.
They have 2 imputs:
Difference of Angle to GreenCircle
Distance to GreenCircle
2 output:
Speed
Turn Angle



It has been written quickly and still a lot to improve.


By the way, I'd like to share this on Github or GitLab... cause I'd like to have contributors and new test tasks-designer.
I tried both, but both gives me error when I download the code and try to open it with VB6. Can someone tell me why?


If you have improvements or test-tasks designed.. Share!
Attached Files

Figures - experimenting with polygons

0
0
Figures is an experiment in generating and animating simple polygons. Instead of using horizontal and vertical coordinates for each element, the program uses the distances (radii?) as measured from the polygon's center. Because these distances are evenly distributed over a full circle, there's no need to define an angle. To, for example, define the following figures just specify:

3 equal "distances" for a triangle, 4 for a square, and 8 for an octagon.

Variable distances inside one polygon (think stars/sprockets) are allowed. There's also a rudimentary function which allows you to append one polygon to another polygon.

"Figures" is an old project which I decided to clean and upload here. It is, however, slow, has some stability issues, and, the terminology used in the code could use cleaning.
Attached Files

please delete

[VB6] Color surface and scatter charts with nice color maps

0
0
Dear all,

As heavy user of Excel 2007, I'm happy with the quick analysis available through pivot table. Unfortunately the default layout for the contour graph and the need for a regular grid reduce productivity.
So I created a macro call ColorThirdAxis (available in a separate tab in the example excel file) to improve that status. So the current macro works on surface and wireframe charts and on XYscatter charts. For the contour chart, you'll need to simply pick up a colormap in the user form. Then the macro will color categories following the map (for top view contours the bands will be flattened).
For scatter plots, in addition to the colormap, you'll have to pick a range of values defining the point colors. And you can set manually the bounds of the data range for colormap interpolation.

The picture shows a possible result of the macro on the example file.

I hope you'll find it useful.

Notes:
1. The macro uses JsonBag (search on this forum for it) to read colormaps.
2. Credits for the colormap go to the Palettable Python project.
Attached Images
 
Attached Files

[VB6] PicSave - Simple SavePicture as GIF, PNG, JPEG

0
0
Sometimes you need a better SavePicture() function. Not a lot better, just one that can save in some compressed format instead of just BMP format. Like JPEG usually, or PNG. Well this one does that, and throws in GIF as well though as usual (being based on GDI+) those tend to come out dithered and sort of crap in general.

What we have here is a simple preclared-instance Class with one method: SavePicture().

You give it a StdPiture, a file name (yes, it can save using Unicode paths), which format you want, and for JPEG you can add a "quality" in percent. It saves to disk, not to Byte arrays.

Nothing here people haven't seen before. This is just a "stripped to essentials" rendition of the well worn theme.


It only requires a version of Windows with IE 5 or later. It uses GDI+ but most systems with IE 5 or later cover that as well. In any case it should work on nearly anything you run anymore.

There are no 3rd party DLLs required, and not even any typelibs. Just add PicSave.cls to your Projects.


The attachment contains a simple demo. Its bulk is all source image data.


The StdPicture you pass to it must have a bitmap handle. In practical terms this means you may have to pass it the persistant-image property (.Image) if you have drawn your picture onto a Form, PictureBox, etc. and there is no provision for dealing with metafile vector images.


Notes:

New attachment incorporating feedback from discussion below to address issues encountered when GDI v. 1.1 is in play, running on 64-bit Windows, etc.

Also note that this makes no effort to handle transparency or alpha-channel translucency for GIF or PNG output. It saves simple "whole bitmap" images. If you load a picture with transparency into a StdPicture and save it back using this class the transparency is lost.
Attached Files

Analog Clock example

0
0
Analog Clock is a program that demonstrates how to create a user control that displays a clock on a form in Visual Basic. This started as a quick example about rotating graphics I wrote a while ago and I decided to make it into a compact program that should be fairly straightforward and easy to customize.
Attached Files

Sludge Tools - an old but, still interesting, and possibly useful project

0
0
Okay, how to start... A couple of years ago I tried to write my own adventure game using Hungry Software's Sludge scripting language. The tools that came with it were pretty good, but I felt it needed a few more features, and so I wrote a few of my own tools in Visual Basic.

Personally, I think the must useful one was "Sludge Screen Region Editor" - a program that generated the Sludge script code that defines "screen regions" (interactive rectangular areas on the screen (in a game made with Sludge script.)) Apparently other people using Sludge felt it was pretty useful too, judging from the responses I got after posting it.

The other tools are, in short:
-A source code viewer which allows the user to browse through stuff such as events, subroutines, and objects as defined in a Sludge script.
-A "calculator" that generates a line of script code that regulates game objects' apparent sizes based on a game screen's "horizon's" position.
-The original TGA loader (a version of which I uploaded to this forum) class is also part of the Screen Region Editor.

Screenshot:
Name:  Ssre.jpg
Views: 40
Size:  27.9 KB

I'm not sure how useful these tools still are, but I feel they are pretty well written and designed. They could probably be adapted for other purposes as well.
Attached Images
 
Attached Files

[VB6] Code Snippet: Open a folder and select multiple files in Explorer

0
0
So lots of applications these days can open a folder and highlight the target file or files, but it's not something that I've seen done in VB6 for multiple files; I guess because few people are familiar with pidls: you need to get the pidl of the parent folder, than relative pidls for each file you want selected. But after that, all you need is a single line API call to SHOpenFolderAndSelectItems. Using Shell on explorer.exe with /select limits you to one file.

This snippet goes a little further; instead of just asking for a parent folder and files, I've included code that will do the complicated parsing required to accept a list of full file paths, in multiple folders. One window per folder will open, and all files from the input list in that folder will be highlighted.

Requirements
-Windows XP or higher

Code
Code:

Public Type ResultFolder
    sPath As String
    sFiles() As String
End Type
Public Declare Function SHOpenFolderAndSelectItems Lib "shell32" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, ByVal dwFlags As Long) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Function ILFindLastID Lib "shell32" (ByVal pidl As Long) As Long
Public Declare Sub ILFree Lib "shell32" (ByVal pidl As Long)

Public Sub OpenFolders(sFiles() As String)

If sFiles(0) = "" Then Exit Sub 'caller is responsible for ensuring array has been dim'd and contains valid info

Dim tRes() As ResultFolder
Dim apidl() As Long
Dim ppidl As Long
Dim pidlFQ() As Long
Dim i As Long, j As Long

GetResultsByFolder sFiles, tRes

'Now each entry in tRes is a folder, and its .sFiles member contains every file
'in the original list that is in that folder. So for every folder, we now need to
'create a pidl for the folder itself, and an array of all the relative pidls for the
'files. Two helper APIs replace what used to be tons of pidl-related support
'code before XP. After we've got the pidls, they're handed off to the API
For i = 0 To UBound(tRes)
    ReDim apidl(UBound(tRes(i).sFiles))
    ReDim pidlFQ(UBound(tRes(i).sFiles))
    For j = 0 To UBound(tRes(i).sFiles)
        pidlFQ(j) = ILCreateFromPathW(StrPtr(tRes(i).sFiles(j))) 'ILCreateFromPathW gives us Unicode support
        apidl(j) = ILFindLastID(pidlFQ(j))
    Next
    ppidl = ILCreateFromPathW(StrPtr(tRes(i).sPath))

    Call SHOpenFolderAndSelectItems(ppidl, UBound(apidl) + 1, VarPtr(apidl(0)), 0&)
    'Vista+ has dwFlags to start renaming (single file) or select on desktop; there's no valid flags on XP

    'now we need to free all the pidls we created, otherwise it's a memory leak
    ILFree ppidl
    For j = 0 To UBound(pidlFQ)
        ILFree pidlFQ(j) 'per MSDN, child ids obtained w/ ILFindLastID don't need ILFree, so just free FQ
    Next
Next
       
End Sub

Private Sub GetResultsByFolder(sSelFullPath() As String, tResFolders() As ResultFolder)
Dim i As Long
Dim sPar As String
Dim k As Long, cn As Long, fc As Long
ReDim tResFolders(0)

For i = 0 To UBound(sSelFullPath)
    sPar = Left$(sSelFullPath(i), InStrRev(sSelFullPath(i), "\") - 1)
    k = RFExists(sPar, tResFolders)
    If k >= 0 Then 'there's already a file in this folder, so just add a new file to the folders list
        cn = UBound(tResFolders(k).sFiles)
        cn = cn + 1
        ReDim Preserve tResFolders(k).sFiles(cn)
        tResFolders(k).sFiles(cn) = sSelFullPath(i)
    Else 'create a new folder entry
        ReDim Preserve tResFolders(fc)
        ReDim tResFolders(fc).sFiles(0)
        tResFolders(fc).sPath = sPar
        tResFolders(fc).sFiles(0) = sSelFullPath(i)
        fc = fc + 1
    End If
Next
End Sub

Private Function RFExists(sPath As String, tResFolders() As ResultFolder) As Long
Dim i As Long
For i = 0 To UBound(tResFolders)
    If tResFolders(i).sPath = sPath Then
        RFExists = i
        Exit Function
    End If
Next
RFExists = -1
End Function

Data Insert Oracle Server

0
0
Please Help Me To Data Insert Oracle Server Using VB.NET .Just Share Code Structure .Oracle Is My First Time Use .

Copy to Clipboard as Unicode and Html Form

0
0
Working for M2000 Interpreter I found this https://support.microsoft.com/en-us/kb/274326
For copy text to Html, but without using utf-8 (but works for english because utf-8 has one byte for English language). So I do the job to make this to send text in utf-8 format, so it can be used for export colored text, or in other format, and we can paste this to an office application like Word or in a Blog (in blogspot, as I do for my Intertpeter, M2000)
Put this in a Module and call TestThis from Immediate Mode.
I also include two helpers, the SpellUnicode which get a string and give a string of parameters. These parameters are for ListenUnicode which convert back to unicode string. Is the only way to pass unicode strings in a Module file (without using external file or a resource like .res file).

Enjoy it

Code:

Private Declare Function RegisterClipboardFormat Lib "user32" Alias _
  "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private m_cfHTMLClipFormat As Long
Private Const Utf8CodePage As Long = 65001
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar& Lib "kernel32" (ByVal codepage&, ByVal dwFlags&, MultiBytes As Any, ByVal cBytes&, ByVal pWideChars&, ByVal cWideChars&)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' here is the sub for send text to clipboard as unicode and as Html Format -utf8
Public Sub TestThis()
Copy2Clipboard ListenUnicode(915, 953, 974, 961, 947, 959, 962, 32, 922, 945, 961, 961, 940, 962) + vbCrLf + "Greetings from George Karras from West Greece"
End Sub
Public Sub Copy2Clipboard(ByVal unicodetext As String)
Dim ph As String
Clipboard.Clear  ' always
DoEvents
Sleep 10
ph = PrepareHtml(unicodetext) ' here you have to prepare for html
SimpleHtmlData ph
SetTextData 13, unicodetext
End Sub
Function ReplaceStr(sStr As String, dStr As String, fromStr As String) As String
'' Sory but i like this one, with source first
  ReplaceStr = Replace$(fromStr, sStr, dStr)
End Function
Private Function PrepareHtml(neodata As String) As String
Dim A$
' WE DO SOME WORK TO PRESERVE FORMAT
' MAYBE IS NOT COMPLETE BUT IT IS A TRY
A$ = ReplaceStr("</", Chr$(1) + Chr$(2), neodata)
A$ = ReplaceStr("<", Chr$(3), A$)
A$ = ReplaceStr(">", Chr$(4), A$)
A$ = ReplaceStr("  ", Chr$(7) + Chr$(7), A$)
A$ = ReplaceStr(Chr$(7) + " ", Chr$(7) + Chr$(7), A$)
'' here you can process line by line and or embed tags
A$ = "<FONT COLOR=blue>" + A$ + "</FONT>"

A$ = ReplaceStr(Chr$(1) + Chr$(2), "&lt;⁄", A$)
A$ = ReplaceStr(Chr$(3), "&lt;", A$)
A$ = ReplaceStr(Chr$(4), "&gt;", A$)
' SO ALL SPACES ARE NOW NBSP IF ARE IN A SEQUENCE OF TWO OR MORE
A$ = ReplaceStr(Chr$(7), "&nbsp;", A$)

PrepareHtml = Replace(A$, vbCrLf, "<br>")  ' or you can use <p>
End Function

Public Function HTML(sText As String, _
Optional sContextStart As String = "<HTML><BODY>", _
Optional sContextEnd As String = "</BODY></HTML>") As Byte()
' part of this code from an example from Microsfot
    Dim m_sDescription As String
    m_sDescription = "Version:1.0" & vbCrLf & _
    "StartHTML:aaaaaaaaaa" & vbCrLf & _
    "EndHTML:bbbbbbbbbb" & vbCrLf & _
    "StartFragment:cccccccccc" & vbCrLf & _
    "EndFragment:dddddddddd" & vbCrLf
    Dim A() As Byte, b() As Byte, c() As Byte
    A() = Utf16toUtf8(sContextStart & "<!--StartFragment -->")
    b() = Utf16toUtf8(sText)
    c() = Utf16toUtf8("<!--EndFragment -->" & sContextEnd)
    Dim sData As String, mdata As Long, eData As Long, fData As Long
    eData = UBound(A()) - LBound(A()) + 1
    mdata = UBound(b()) - LBound(b()) + 1
    fData = UBound(c()) - LBound(c()) + 1
    m_sDescription = Replace(m_sDescription, "aaaaaaaaaa", Format(Len(m_sDescription), "0000000000"))
    m_sDescription = Replace(m_sDescription, "bbbbbbbbbb", Format(Len(m_sDescription) + eData + mdata + fData, "0000000000"))
    m_sDescription = Replace(m_sDescription, "cccccccccc", Format(Len(m_sDescription) + eData, "0000000000"))
    m_sDescription = Replace(m_sDescription, "dddddddddd", Format(Len(m_sDescription) + eData + mdata, "0000000000"))
    Dim all() As Byte, m() As Byte
    ReDim all(Len(m_sDescription) + eData + mdata + fData)
    m() = Utf16toUtf8(m_sDescription)
    CopyMemory all(0), m(0), Len(m_sDescription)
    CopyMemory all(Len(m_sDescription)), A(0), eData
    CopyMemory all(Len(m_sDescription) + eData), b(0), mdata
    CopyMemory all(Len(m_sDescription) + eData + mdata), c(0), fData
    HTML = all()
End Function
Function RegisterCF() As Long


  'Register the HTML clipboard format
  If (m_cfHTMLClipFormat = 0) Then
      m_cfHTMLClipFormat = RegisterClipboardFormat("HTML Format")
  End If
  RegisterCF = m_cfHTMLClipFormat
 
End Function
Public Function SimpleHtmlData(ByVal sText As String)
    Dim lFormatId As Long, bb() As Byte
    lFormatId = RegisterCF
    If lFormatId <> 0 Then
    If sText = "" Then Exit Function
    bb() = HTML(sText)
    If CBool(OpenClipboard(0)) Then
          Dim hMemHandle As Long, lpData As Long
          hMemHandle = GlobalAlloc(0, UBound(bb()) - LBound(bb()) + 10)
          If CBool(hMemHandle) Then
            lpData = GlobalLock(hMemHandle)
            If lpData <> 0 Then
                CopyMemory ByVal lpData, bb(0), UBound(bb()) - LBound(bb())
                GlobalUnlock hMemHandle
                EmptyClipboard
                SetClipboardData lFormatId, hMemHandle
            End If
          End If
          Call CloseClipboard
      End If
End If
End Function
Private Function SetTextData( _
        ByVal lFormatId As Long, _
        ByVal sText As String _
    ) As Boolean
    If lFormatId = 0 Then Exit Function
    Dim hMem As Long, lPtr As Long
    Dim lSize As Long
        lSize = LenB(sText)
    hMem = GlobalAlloc(0, lSize + 2)
If (hMem > 0) Then
        lPtr = GlobalLock(hMem)
        CopyMemory ByVal lPtr, ByVal StrPtr(sText), lSize + 1
        GlobalUnlock hMem
      If (OpenClipboard(0) <> 0) Then
    SetClipboardData lFormatId, hMem
      CloseClipboard
      Else
      GlobalFree hMem
      End If
    End If
End Function
Public Function Utf16toUtf8(s As String) As Byte()
    ' code from vbforum
    ' UTF-8 returned to VB6 as a byte array (zero based) because it's pretty useless to VB6 as anything else.
    Dim iLen As Long
    Dim bbBuf() As Byte
    '
    iLen = WideCharToMultiByte(Utf8CodePage, 0, StrPtr(s), Len(s), 0, 0, 0, 0)
    ReDim bbBuf(0 To iLen - 1) ' Will be initialized as all &h00.
    iLen = WideCharToMultiByte(Utf8CodePage, 0, StrPtr(s), Len(s), VarPtr(bbBuf(0)), iLen, 0, 0)
    Utf16toUtf8 = bbBuf
End Function
Public Function SpellUnicode(A$)
' use spellunicode to get numbers in Immediate Mode ? SpellUnicode("Γιώργος Καρράς") 'Greek Letters
' and make a ListenUnicode...with numbers for input text
' You can see that if you have Arial Greek
' ? ListenUnicode(915,953,974,961,947,959,962,32,922,945,961,961,940,962)
Dim b$, i As Long
For i = 1 To Len(A$) - 1
b$ = b$ & CStr(AscW(Mid$(A$, i, 1))) & ","
Next i
SpellUnicode = b$ & CStr(AscW(Right$(A$, 1)))
End Function
Public Function ListenUnicode(ParamArray aa() As Variant) As String
Dim all$, i As Long
For i = 0 To UBound(aa)
    all$ = all$ & ChrW(aa(i))
Next i
ListenUnicode = all$
End Function

[vb6]Yet Another CSV Parser

0
0
A fairly basic CSV parser, with a bit more user-control and a slight twist: Event driven by Record
The parser does handle quoted field data and delimiters, carriage returns, and other non-printable characters wtihin field data, assuming the field data is properly formatted.

The parser will raise an event for each record it has finished parsing. You would respond to this event to use/format the parsed field data. The event allows aborting further processing if the CSV appears corrupted. The event will inform you if the CSV file appears corrupt.

The class offers two ways of feeding it CSV information but only one method is called.
1) Entire file read into a string
2) Line by line from the CSV file, read from a loop or from a split string

As mentioned, an event is called for each record. This event has 3 states:
1) RecordParsed. A vbNullChar-delimited string is passed which contains the entire record
2) FieldNamesStatic. A vbNullChar-delimeted string containing field names from the CSV's first row of data
3) FieldNamesGeneric. A vbNullChar-delimited string containing default field names for CSVs without a header row
Each event has has three other parameters: HeaderCount, FieldDifferential, and RecordNumber
RecordNumber will be zero if processing field names else incrementing by 1 each time event is called
HeaderCount is the number of fields based from the 1st row of parsed data
FieldDifferential is basically an error if non-zero.
0 indicates that number of fields in the record equal number of field names
Negative indicates number of missing fields in the record. HeaderCount + FieldDifferential = number processed fields
Positive indicates number of extra fields in the record.
If you feel comfortable trying to handle any discrepancies between field count and header count, no need to reply to the event. However, if you want to abort processing any further records, you simply return the Record parameter as a null string.

Let's talk about proper formatting
Delimiters come in various flavors with this class:
:: Record Delimiter defines when a record ends & a new record begins. Hard coded in the class a vbCr and/or vbLf
:: Field Delimiter defines when a field ends & a new field begins. This is user-defined & defaults to a comma
:: Quote/Text Delimiter defines start and end of text where any character (delimiter or not) is not specially handled
:: Escape Delimiter defines characters not specially handled. Escape delimited files are rare
Quote and Escape Delimiters are also used to delimit themselves as non-special characters

1) Every record in a CSV, including any header row, is delimited by a carriage return and/or line feed
-- Only exception is the final record. It does not require a record delimiter

2) Every field within a record must be delimited by a character you specify. This class does not process fixed-length field CSVs
-- Field delimiters never used before the 1st field and never after the final field

3) Quotes, i.e., ", are defaulted to be handled as text identifiers. This option can be turned off or changed to a different character
-- Quote delimiters allow non-printable characters and other delimiters to be treated as just any other character

4) If any field contains a record and/or field delimiter within the field's data, the delimiters must be identified as non-delimiters
-- Two options are provided in the class: quoted field data and escape characters

Delimiters. Let's say the field delimiter is a comma
:: If any character within a field contains any delimiter, then that delimiter must be escaped
:: Sample field: Hello, my name is LaVolpe
If Quote delimit character is " then should be saved to file as: "Hello, my name is LaVolpe"
If Escape delimit character is \ then should be saved to file as: Hello\, my name is LaVolpe

Delimiting the delimiters. Simple rule, replace each delimiter with a double delimiter
:: Sample field with Quote delimiter: Hello, my name is "LaVolpe"
Saved to file as: "Hello, my name is ""LaVolpe"""
:: Sample field with Escape delimiter: C:\My Documents
Saved to file as: C:\\My Documents
Note that the Quote & Escape delimiters are a tad different.
-- Quote delimiters are doubled only within the field data. The field data is written to file with a single quote both as a prefix & suffix
-- Any record or field delimiter within a field needs no special handling, when that field on disk begins & ends with a quote delimiter
-- Escape delimiters, if used, are required for every field, record and escape delimiter that exists within a field
-- Mixing Quote & Escape delimiters is not recommended, though can be used if you want to customize your CSV data
-- Quote and/or Escape delimiter characters must be defined by the user, both are optional


Quick examples of using the class, both for reading line by line & entire file
Code:

Private WithEvents CSVParser As ICSVParser

Private CSVParser_ProcessRecord(ByVal State As ProcessStateEnum, _
                                Record As String, _
                                ByVal FieldDifferential As Long, _
                                ByVal HeaderCount As Long, _
                                ByVal RecordNumber As Long)
        ' process parsed CSV record
        Dim sData() As String
        Select Case State
        Case csvRecordParsed
                If FieldDifferential Then
                        ' handle potentially corrupt CSV
                        ' to abort further processing: Record = vbNullString
                Else
                        sData = Split(Record, vbNullChar)
                        ' process data
                End If
        Case csvFieldNameStatic
                sData = Split(Record, vbNullChar)
                ' process field names
        Case csvFieldNameGeneric
                sData = Split(Record, vbNullChar)
                ' process field names, optionally, using your own names
        End Select
End Sub

Private Sub Command1_Click() ' Full file example
        If CSVParser Is Nothing Then Set CSVParser = New ICSVParser
        Dim fnr As Integer, sFile As string
        fnr = FreeFile()
        Open "C:\Temp\TestCSV.csv" For Binary As #fnr
        sFile = Space$(LOF(fnr))
        Get #fnr, 1, sFile
        Close #fnr
        CSVParser.InitializeParser True
        If CSVParser.ParseRecord(sFile) = False Then
                ' handle informing user of corrupt file
        End If
        If CSVParser.TerminateParser() = False Then
                ' handle informing user of corrupt file, final record
        End If
End Sub

Private Sub Command2_Click() ' Line by line example
        If CSVParser Is Nothing Then Set CSVParser = New ICSVParser
        Dim fnr As Integer, sLine As string
        fnr = FreeFile()
        Open "C:\Temp\TestCSV.csv" For Input As #fnr
        CSVParser.InitializeParser True
        Do Until EOF(fnr) = True
                Line Input #fnr, sLine
                If CSVParser.ParseRecord(sLine) = False Then
                        ' handle informing user of corrupt file
                        Exit Do
                End If
        Loop
        Close #fnr
        If CSVParser.TerminateParser() = False Then
                ' handle informing user of corrupt file, final record
        End If
End Sub

And, just for the heck of it, a real simple example of loading a CSV to a ListView. In the parser's event:
Code:

    Dim sData() As String, lItem As Long
    Select Case State
    Case csvRecordParsed
        If FieldDifferential > 0 Then
            Record = ""
        Else
            sData = Split(Record, vbNullChar)
            With ListView1.ListItems.Add(, , sData(0))
                For lItem = 1 To UBound(sData)
                    .SubItems(lItem) = sData(lItem)
                Next
            End With
        End If
               
    Case csvFieldNamesGeneric, csvFieldNamesStatic
        sData = Split(Record, vbNullChar)
        With ListView1
            .ListItems.Clear
            .ColumnHeaders.Clear
            For lItem = 0 To HeaderCount - 1
                .ColumnHeaders.Add , , sData(lItem)
            Next
        End With
    End Select

The attachment is a class file, remove the .txt extension after downloading
Attached Files

VB6 - Generate ECC Key DLL

0
0
Attached is a DLL program that generates an ECC (Elliptical Curve Cryptography) Key, and a sample program to utilize it. Each side in the exchange creates a Public/Private key, and sends the Public Key to the other side. Each side then uses its own Private Key, and the Public Key received from the other end to create a common Shared Secret that can be used as a Session Key.

A standard DLL is used because it can combine 12 different API calls into one common routine that can be used by a VB program. For this purpose, I used the Standard DLL AddIn from Dansoft Australia http://www.dansoftaustralia.net/developers/vb.htm

Like some of the BCrypt calls, the DLL will return different information, depending on what information was supplied. If both the Public Key and Private Key are empty, it will return the internal Public\Private Keys and a single byte "0" The Public Key is sent to the other end, and the Private Key is used in the second call. On the second pass, the user supplies the Private Key that it earlier created, and the Public Key that it received from the other end. It should return the 32 byte Shared Secret. If an error occurred, a single byte will be returned with the number of the call that failed.

I transferred the entire byte arrays because they are relatively small, but in theory you should be able to just use a pointer to the first element of the array. Of course, if you do that, you will also have to supply the length of the array.

What I really wanted was the raw shared secret, but Microsoft seems to want to hash it first. I have not found a way to get the raw secret by itself, and I am still looking. If anyone can offer a suggestion, I am certainly willing to listen.

J.A. Coutts
Attached Images
 
Attached Files

GDI+ Workaround: ICONs

0
0
Major caveat: The noted limitations apply to at least Vista and lower. Windows 7 and above may have corrected some of these limitations. Since Vista is still an active operating system, you may be interested. Also, the term "icon" used below is interchangeable with "cursor" and vice versa.

First a little background about icons within Windows. The icon structure is fairly straightforward and well documented, so won't spend any serious time on that. What people may not be aware of is how icons/cursors are rendered. Icons are drawn as a result of the combination of the icon color data (considered the XOR bits) and the icon mask (AND bits). With the exception of 32 bit icons, discussed in a bit, there are only 3 scenarios for each icon pixel rendered:

1. Icon pixel is transparent. The icon pixel must be black, the mask pixel must be white (value of 1 in a 1 bit mask)
2. Icon pixel is opaque. The mask pixel must be black (value of 0 in a 1 bit mask)
3. Icon pixel is inverted relative to its pixel color and the destination pixel color. Mask pixel must be white & icon pixel must not be black.

The formula is quite simple: ([destination pixel color] And [mask color value]) Xor [icon color value]
So looking at the 3 scenarios above, the icon pixel rendered in each scenario can be calculated. Just using one color channel for simplicity in the example.

D = destination color. M = mask color. S = icon source color

1. Transparent: M=255, S=0, D=any color. (D And M) Xor S = D
2. Opaque: M=0, S=any color, D=any color. (D And M) Xor S = S
3. Inverted. Icon color cannot be black else icon pixel becomes transparent when mask pixel is white
a) white icon color produces pure inverted color: M=255, S=255, D=222. (D And M) Xor S = 33
b) non-black/white produces relative inversion: M=255, S=111, D=222. (D And M) Xor S = 177

Inverted pixel colors are typically used for 1 bit cursors only. This allows a cursor to invert its color over any background to prevent it from visually disappearing over a background of same color as the cursor. Technically, this is not restricted to 1 bit icons/cursors. However, a 32 bit icon using the alpha channel will never invert pixels because the icon mask (which dictates inversion) is ignored when the alpha channel is used.

So, where does GDI+ break? With icons, nearly everywhere. Here are specific limitations with GDI+

- GDI+ won't load cursors from handle nor file/stream
- All icons. Ignores any inverted pixels and they are treated as transparent. GDI+ has no XOR ability.
- PNG embedded icon. Cannot load it as an icon file/stream
- 1 bit icon: Cannot load it by handle, but can load it by file/stream
- 16,24 bit icon: Cannot load it by file/stream, but can load it by handle
- 32 bit icon. Well, Windows uses the mask only in this case: every icon alpha channel value is zero. Otherwise, the mask will be ignored. GDI+ will not properly render a 32 bit icon when the mask should be ignored. GDI+ never ignores the mask but ignores the alpha channel. Go figure.

Workarounds. Everything except the XOR limitation can be worked around relatively easily; but lots more code.

- 32 bit icons with alpha channel usage. Whether by handle or by file, doesn't matter. Transfer the icon color pixel data + alpha channel to a GDI+ hImage created with GdipCreateBitmapFromScan0 and pixel format declared as ARGB. Use GdipBitmapLockBits to transfer. Rest of comments below exclude 32 bit icons

- Cursors and 1 bit icons loaded by handle. Use GetIconInfo & GetDIBits APIs to convert 1 bit to 32 bit. Use existing mask. Then use CreateIconFromResourceEx to create hIcon, not cursor. Destroy original icon/cursor. Assuming 32 bit icons are processed separately, then since no alpha channel is used here, we can use any bit depth other than 1. Internally, GDI+ converts icons to 32 bit bitmaps.

- 16,24 bit icons loaded from file/stream. You can load these via LoadImage API and then let GDI+ load via handle. Destroy icon.

- PNG encoded icon/cursor loaded from file. PNG-icons loaded by handle are hIcon. If from icon file, the entire PNG-file format starts at the icon offset within the icon file format. Load those PNG bytes at that offset, no other icon header info.

In the next couple of replies, I'll address some workarounds, specifically, regarding loading by handle or stream/file.

See also:
GDI+ Workaround: JPG > Zero-Length App Markers
GDI+ Workaround: TIFF > JPEG-compressed images
GDI+ Workaround: BMP > Alpha Channels + JPG/PNG Encoded
GDI+ Workaround: PNG > adding/removing metadata


A really simple example project is added that can highlight whether or not your system's version of GDI+ is loading icons correctly.
Attached Files

[VB6] Look up Enum value names

0
0
We see this question as well as very similar ones every so often:

"I want to be able to have users pick values by name from a list of Enum value names. Is there a way to do this without manually creating my own lists?"

I'm not sure we've seen many good responses to these, and I don't see one here so I thought I'd post one.

The only place your programs might look to find this information is inside type libraries. And we have a nice tool for doing this without a ton of effort.


The TLI

Quoting its help file:

Quote:

The TypeLib Information object library (TLI for short, implemented in TlbInf32.dll) is a set of COM objects designed to make type library browsing functionality easily accessible to both Visual Basic and C++ programmers.
Of course using it can take some study. But there is a wealth of functionality there, probably more than most programmers will ever need.


Requirements

You need the TLI, but since the VB6 IDE uses it you certainly have it. You may or may not have the help file for it, which was once distributed as TlbInf32.exe (a self-extractor). I don't have a current Microsoft link for that file though.

You also need type libraries for the Enums you want to do lookups on. These are often embedded within DLLs and OCXs, or may be in separate TLB files. In many cases it can be more conventient to access these by type library ID (GUID values), version, and locale (since there are such things as localized type libraries).


How To

So here is an example:

Code:

Option Explicit

Private Sub cboAdoTypes_Click()
    With cboAdoTypes
        lblDataType.Caption = CStr(.ItemData(.ListIndex))
        MsgBox .List(.ListIndex) & " = " & lblDataType.Caption
    End With
End Sub

Private Sub cboSysColors_Click()
    With cboSysColors
        BackColor = .ItemData(.ListIndex)
    End With
End Sub

Private Sub Form_Load()
    Const ADO_GUID As String = "{00000205-0000-0010-8000-00AA006D2EA4}"
    Dim DataTypeEnums As TLI.Members
    Dim SystemColorConsts As TLI.Members
    Dim Item As TLI.MemberInfo

    With New TLI.TLIApplication
        With .TypeLibInfoFromRegistry(ADO_GUID, 2, 5, 0).Constants
            Set DataTypeEnums = .NamedItem("DataTypeEnum").Members
        End With
        With .TypeLibInfoFromFile("msvbvm60.dll\3").Constants
            Set SystemColorConsts = .NamedItem("SystemColorConstants").Members
        End With
    End With
    With cboAdoTypes
        For Each Item In DataTypeEnums
            .AddItem Item.Name
            .ItemData(.NewIndex) = Item.Value
        Next
    End With
    With cboSysColors
        For Each Item In SystemColorConsts
            .AddItem Item.Name
            .ItemData(.NewIndex) = Item.Value
        Next
    End With
End Sub


Name:  sshot1.png
Views: 46
Size:  13.2 KB


Name:  sshot2.png
Views: 37
Size:  9.1 KB


Name:  sshot3.png
Views: 38
Size:  19.0 KB
Attached Images
   
Attached Files
Viewing all 1304 articles
Browse latest View live




Latest Images