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

[VB6] Lock ListView Columns

$
0
0
This code prevents the specified column(s) of a ListView control from being resized by the user. It does that by subclassing the ListView control and watching for the HDN_BEGINTRACK and HDN_DIVIDERDBLCLICK notification codes. Additionally, it also provides appropriate feedback to the user by displaying the "Unavailable" cursor when the mouse is over the locked column divider. That is done by subclassing the ListView's Header control and handling the WM_SETCURSOR message.


The modLockLVCols.bas file in the attached project below has been inspired by the codes in the following threads:

Preventing certain Listview columns from sizing...

[RESOLVED] Prevent User From Resizing Column Width in ListView


Also included in the attachment is frmLockLVColsDemo.frm:


Name:  Lock ListView Columns.png
Views: 127
Size:  14.0 KB
Attached Images
 
Attached Files

VB 6 Input Date format

$
0
0
Hi

I have a Date textfield, that describes to the user the format of the date (YYYY/MM) then I would use that date on my WHERE clause to update database. my Date in the database is also in the same format (YYYY/MM).

I need to write a code that will validate first if the input date is in the correct format before I can apply it on my WHERE clause. I have this code below, I need to extend it to cater for newly date column.

please help

If Len(txtSalary.Text) = 0 Or Len(txtmCover.Text) = 0 Or Len(txtMember.Text) = 0 Or Len(txtmRate.Text) = 0 Or Len(txtDate.Text) = 0 Then

MsgBox "Enter All The Fields Values"

Else
tsql = "UPDATE Hpacc4 SET SalaryBill = '" & txtSalary.Text & "', Rate = '" & txtmRate.Text & "', RateType = '" & comboRate.Text & "', Membership = '" & txtMember.Text & "', Cover = ' " & txtmCover & " ' Where Scheme = ' " & txtSCode & " ' AND RunMonth = ' " & txtDate & " ' AND AccCode = '110'"
MsgBox "Updated"

cnHPtest.Execute (tsql)

End If

Keeping VScroll Always At Bottom

Hmac

$
0
0
According to Wikipedia and verified with online HMAC routines, HMAC_SHA1("key", "The quick brown fox jumps over the lazy dog") should produce an HMAC of:
DE 7C 9B 85 B8 B7 8A A6 BC 8A 7A 36 F7 0A 90 70 1C 9D B4 D9
However, when I use the Example C Program: Creating an HMAC on MSDN:
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx
I get:
41 4E 4C 89 33 30 47 9B 9E F1 85 DF 40 6A 66 33 49 D6 3A C7

The problem seems to be in the derivation of the Key itself (TestHMAC1). Microsoft requires that the key be hashed before deriving an actual key. The Key produced can be replicated and works if both ends are using the same process, but unfortunately it can't be used to communicate with remote servers using standard HMAC. As I have demonstrated in TestHMAC3, the correct HMAC can be produced using the MS Crypto API if you import the key rather than deriving it.

In the process of determing what was wrong with the MS routine, I wrote my own HMAC routine without the use of the Crypto API (TestHMAC2). In my humble opinion, this routine is far simpler than using the API, but you can judge for yourself. The only drawback is that you need the actual unencrypted key, and not just the handle to it. For keys created by the API, that means declaring the key as CRYPT_EXPORTABLE and exporting and decrypting it.

The program uses RSA/Schannel in a custom Container. If no Exchange key pair is available for the Container, it will create them. Schannel does not support a Signature key pair, so it will not create them.

J.A. Coutts
Attached Files

Fade Picture in Picturebox from One Picture to Another

$
0
0
'Need 2 pictureboxes (Picture1 & Picture2)
'Set both pictureboxes AutoRedraw to True
'Set both pictureboxes ScaleMode to vbPixels
'Paste the following code in the Decs

Private Const AC_SRC_OVER = &H0

Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type

Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private BF As BLENDFUNCTION, lBF As Long, fade As Byte
Private FadeInProgress As Boolean

Public Function FadeThePicture(fromPicture As PictureBox, toPicture As PictureBox)
If FadeInProgress Then Exit Function

For fade = 1 To 60 Step 2
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = fade
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
AlphaBlend toPicture.hdc, 0, 0, toPicture.ScaleWidth, toPicture.ScaleHeight, fromPicture.hdc, 0, 0, fromPicture.ScaleWidth, fromPicture.ScaleHeight, lBF
toPicture.Refresh
Sleep 25
Next fade

DoEvents
End Function

VB Export Project

$
0
0
Hi

I have a code below to export data from sql server db "Hpacc4" to Excel. my code just error at: rsHPData.MoveFirst, with error "Either BOF or EOF is True, or the current record has been deleted"

Please help

Code:


Private Sub btnRecon_Click() 'Export to Excel Button
 
  Dim tsql As String
 Dim oExcel As Object
 Dim oWB As Object
 Dim oWS As Object
 
  ' // ----------------------------------- //
  ' // Set up a connection to the DataBase //
  ' // ----------------------------------- //

  Set cnHPtest = New ADODB.Connection
  Set rsHPData = New ADODB.Recordset

  With cnHPtest
    .Provider = strDBProv
    .ConnectionString = strDBString
    .CommandTimeout = 1000
    .Open
  End With
 
 Screen.MousePointer = vbHourglass
    Dim x As Integer, numRecs As Integer

    Set oExcel = CreateObject("Excel.Application")
    Set oWB = oExcel.Workbooks.Add
    Set oWS = oWB.Worksheets("Sheet1")

        With rsHPData
            .CursorLocation = adUseClient
            .LockType = adLockReadOnly
            .Open "Select RunMonth, SalaryBill, Rate from Hpacc4 where Scheme = '" & frmLogin.MaskEdBox1.Text & "' AND RunMonth = '" & MaskEdDate.Text & "' AND AccCode = '110'", cnHPtest, adOpenForwardOnly, adLockReadOnly
        End With
       
        If rsHPData.EOF And rsHPData.BOF Then
       
        'Set rs = cmd.Execute()
        numRecs = rsHPData.RecordCount
        rsHPData.MoveFirst
       
        With oWS
          'SET THE TOP ROWS WITH TITLES--Change Font to Bold and Make The Font RED
            .Range("A1:C1").Font.Bold = True 'sets top row (stuff below) in bold print
            .Range("A1:C1").Font.ColorIndex = 3 'change font color to red
              .Cells(1, 1).Value = "STATE NAME"
              .Cells(1, 2).Value = "STATE ABBREVIATION"
              .Cells(1, 3).Value = "DATE ENTERED UNION"
        'Run through the RECORDSET, stating in ROW 2, until end of the RECORDSET
        For x = 2 To numRecs + 1  ' You can do this differently without using numRecs (do while not rs.eof)
              .Cells(x, 1).Value = Trim(rsHPData!RunMonth)  'State is a TEXT Field in my db
              .Cells(x, 2).Value = Trim(rsHPData!SalaryBill)      'St is a TEXT Field in my db
              .Cells(x, 3).Value = Trim(rsHPData!Rate)  'date_orig is a DATE Field in my db
        rsHPData.MoveNext  'Move through the RECORDSET
        Next x
        End With
        End If
        'This for-loop makes the columns just wide enough for the largest 'string' in each column
        For x = 1 To 3 'where 3, in my case is three columns  (State Name, State Abbreviation and Date Entered Union
              oWS.Columns(x).AutoFit
          Next x
        'close down the rs and connection
        rsHPData.Close
        cnHPtest.Close
        oExcel.Visible = True  'so you can see what you did
        'set up the active excel sheet
        Set oWS = oExcel.ActiveSheet
        Set oWB = oExcel.ActiveWorkbook
        oWB.SaveAs FileName:=App.Path + "\testfile.xlsx"  'use whatever name you want here
    Screen.MousePointer = vbDefault
End Sub

VB6 Date Validation

$
0
0
Hi

I'm using maskEdBox to accept date from the user in this format yyyymmdd, Now I want to validate this date to be a valid date, (i.e the user might input 1234/12/12), and also the date shouldn't be any future date, either with a month or a year, max date should be the current date. please help.

convert numbers to words (SPANISH)

$
0
0
Here is a function to convert an integer to Spanish words. Maybe it will be of some use to somebody. There is probably a much more elegant way to do this but this worked for me and is correct as far as I can see.

Code:

Private Function ConvertToWords(ByRef Value As Integer) As String
Dim Strng As String    'holds string representation of Value
Strng = CStr(Value)
Dim Txt As String      'holds the word string as it is being built
Dim Curr As String      'holds the currency word
Curr = "Euros"
Dim Temp As String    'used to work on a single digit at a time

Dim Units(12) As String
Units(0) = "zero"
Units(1) = "uno"
Units(2) = "dos"
Units(3) = "tres"
Units(4) = "cuatro"
Units(5) = "cinco"
Units(6) = "seis"
Units(7) = "siete"
Units(8) = "ocho"
Units(9) = "nueve"
Units(10) = "nove"
Units(11) = "sete"
Units(12) = "quin"

Dim Tens(9) As String
Tens(0) = ""
Tens(1) = "diez"
Tens(2) = "veinte"
Tens(3) = "treinta"
Tens(4) = "cuarenta"
Tens(5) = "cincuenta"
Tens(6) = "sesenta"
Tens(7) = "setenta"
Tens(8) = "ochenta"
Tens(9) = "noventa"

Dim Teens(5)
Teens(1) = "once"
Teens(2) = "doce"
Teens(3) = "trece"
Teens(4) = "catorce"
Teens(5) = "quince"

  Txt = ""
'hundreds
  If Len(Strng) = 3 Then  'there are hundreds
      Temp = Left(Right(Strng, 3), 1)    'take the "hundreds" digit
      If Temp = "5" Then Temp = "12"      'set stem for 500s as "quin"
      If Temp = "7" Then Temp = "11"      'account for siete-sete change in 700's
      If Temp = "9" Then Temp = "10"      'account for nueve-nove change in 900's
      Txt = Units(CInt(Temp))            'set the hundreds word according to units list
      If Temp = "1" Then                  'the 100's is a special case. Only say "hundred" not "one hundred"
        If Right(Strng, 2) = "00" Then  'also exactly 100 is a special case.
            Txt = "Cien"
        Else
            Txt = "ciento"                'not exactly 100 so add correct "hundreds" word
        End If
      Else
        If Temp = "12" Then
            Txt = Txt & "ientos"          'add correct ending for 500's
        Else
            Txt = Txt & "cientos"            'more than 100 so make 200,300,400 etc
        End If
      End If
  End If
'tens
  If Len(Strng) <= 3 Then                'ignore numbers over 999
      Temp = Right(Strng, 2)              'take the tens and units
      If Temp >= "11" And Temp <= "15" Then
        Txt = Txt & " " & Teens(CInt(Temp) - 10) '11 to 15 are special words. Take them from Teens array
      Else
        'tens
        If Len(Temp) > 1 Then            'take the tens digit
            Txt = Txt & " " & Tens(CInt(Left(Temp, 1)))  'and add it to the word list
        End If
        'units
        If Len(Temp) > 1 Then            'deal if the value is 10 or more
            If CInt(Right(Temp, 1)) <> "0" Then
              If CInt(Left(Temp, 1)) = "1" Then    'if the tens begin with "1" need to change the spelling
                  Txt = Left(Txt, Len(Txt) - 1) & "ci" & Units(CInt(Right(Temp, 1)))
              ElseIf CInt(Left(Temp, 1)) = "2" Then  'if tens begins with "2" change spelling differently
                  Txt = Left(Txt, Len(Txt) - 1) & "i" & Units(CInt(Right(Temp, 1)))
              Else
                  If Left(Temp, 1) = "0" Then  'check for whole 10's
                    Txt = Txt & Units(CInt(Right(Temp, 1)))
                  Else
                    Txt = Txt & " y " & Units(CInt(Right(Temp, 1))) 'if not divisible by 10, add the units
                  End If
              End If
            End If
        Else
            Txt = Txt & Units(CInt(Temp))      'this adds units to the hundreds
        End If
      End If
  End If
  If Temp = "1" Then
      Txt = Txt & " " & Left(Curr, Len(Curr) - 1)  'remove the "s" for just a single Euro
  Else
      Txt = Txt & " " & Curr
  End If
  Txt = Trim(Txt)        'remove surplus spaces before and after string
  Txt = UCase(Left(Txt, 1)) & Right(Txt, (Len(Txt) - 1))  'capitalise the first letter
  ConvertToWords = Txt    'return the string
End Function


Command() - Unicode aware

$
0
0
Usually when you want to get the argument portion of the command line you use the intrinsic Command$() function.
But that function is not supporting unicode. In order to supply your .exe with a unicode command line it is necessary to use the "GetCommandLineW" and "PathGetArgsW" API.

Code:

Option Explicit
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As Long
Private Declare Function PathGetArgs Lib "shlwapi" Alias "PathGetArgsW" (ByVal lpszPath As Long) As Long
Private Declare Function SysReAllocString Lib "oleaut32" (ByVal pbString As Long, ByVal pszStrPtr As Long) As Long

' (VB-Overwrite)
Public Function Command() As String
If InIDE() = False Then
    SysReAllocString VarPtr(Command), PathGetArgs(GetCommandLine())
    Command = LTrim$(Command)
Else
    Command = VBA.Command$()
End If
End Function

Public Function InIDE(Optional ByRef B As Boolean = True) As Boolean
If B = True Then Debug.Assert Not InIDE(InIDE) Else B = True
End Function

[VB6] SNTPClient UserControl

$
0
0
This is a basic Simple Network Time Protocol (SNTP) client UserControl based on a Winsock control that can be used to retrieve time from NIST Internet Time Servers or local NTP servers on your LAN.

It includes a 4 second "delay" to prevent overuse (minimum of 4.1 seconds between Query method calls) with an Unblock event to signal when another request can be made. See the NIST page linked above.

Since NTP servers return UTC (GMT) time, there is also a method to convert the UTC result returned through the Response event to local time. Response also returns the Source of the time as reported by the time server (if any). Typical values are listed in RFC 5905 as:

Code:

    +------+----------------------------------------------------------+
    | ID  | Clock Source                                            |
    +------+----------------------------------------------------------+
    | GOES | Geosynchronous Orbit Environment Satellite              |
    | GPS  | Global Position System                                  |
    | GAL  | Galileo Positioning System                              |
    | PPS  | Generic pulse-per-second                                |
    | IRIG | Inter-Range Instrumentation Group                        |
    | WWVB | LF Radio WWVB Ft. Collins, CO 60 kHz                    |
    | DCF  | LF Radio DCF77 Mainflingen, DE 77.5 kHz                  |
    | HBG  | LF Radio HBG Prangins, HB 75 kHz                        |
    | MSF  | LF Radio MSF Anthorn, UK 60 kHz                          |
    | JJY  | LF Radio JJY Fukushima, JP 40 kHz, Saga, JP 60 kHz      |
    | LORC | MF Radio LORAN C station, 100 kHz                        |
    | TDF  | MF Radio Allouis, FR 162 kHz                            |
    | CHU  | HF Radio CHU Ottawa, Ontario                            |
    | WWV  | HF Radio WWV Ft. Collins, CO                            |
    | WWVH | HF Radio WWVH Kauai, HI                                  |
    | NIST | NIST telephone modem                                    |
    | ACTS | NIST telephone modem                                    |
    | USNO | USNO telephone modem                                    |
    | PTB  | European telephone modem                                |
    +------+----------------------------------------------------------+

These are not particularly useful in most programs though.


The attached demo shows use of the SNTPClient control, which is included in the attached archive.

Name:  sshot sntp demo.png
Views: 48
Size:  9.6 KB

To use the control in your own programs just copy SNTPClient.ctl and SNTPClient.ctx to your Project folder and add the module to your Project.
Attached Images
 
Attached Files

VB6 - Web Service Calls via WinHTTP POST

$
0
0
This is a simple example of using the WinHTTPRequest object to make calls to a simple REST-like web service that processes database queries.

In order to make it a standalone demonstration, the attached archive includes both the client Project and a matching server Project. The server accepts HTTP requests from port 8080 and requires fixed credentials using Basic Authentication. It uses a small Jet 4.0 database as its data store (included).


Requirements

To build and run this demo you will need Windows 2000 SP3, Windows XP SP1, or a later version of Windows. You will also need the VB6 development system, of course.

There are no special CPU, disk, or memory requirements.

Even a network isn't needed, since the client is hard-coded to query "localhost."


Real World

In the real world you would not used fixed credentials. You would not use Basic Authentication over HTTP, opting for more secure authentication or at least forcing the use of HTTPS. Since the embedded web server used here is based on the Winsock control though we don't have the option of using HTTPS here.

This is just a demo.

It is also more likely that your "server" would be a more robust web server hosted remotely. It might be something like Node.JS, or ASP scripts, PHP, etc.

You would also be more likely to use a more compact serialization format than the ADO XML used here. This is convenient in many ways, but you can do better.

One enhancement would be to use ADO's ADTG binary format instead of its XML format, but that is a little tougher for debugging. XML is easier to eyeball.

Another might be to use a more compact XML format of your own invention. More work at both the client and the server but you might radically reduce the response payload size.

Or you might choose an even more compact format such as JSON.


Building and Running the Demo

If TCP port 8080 is already in use you may have to change it in the client Project since it is hard-coded there.

Open the server Project (GossServer.vbp) and do a Make on it. Open the client Project (Client.vbp) and do a make on that.

You can also open both in the VB6 IDE separately and run them from there.

To run the server, which should come first, make sure to keep GossServer.exe, the GossServerVDir folder, and the two database files together so that GossServer can find the other items. You may have to deal with a firewall prompt, but it is fine to allow the firewall to "keep blocking" GossServer.

Once the server is running change the port as needed and click on the Start button.

Name:  GossServer Sshot.png
Views: 56
Size:  31.6 KB

Run the client, set your query criteria, and click the Go button.

Name:  Client Sshot.png
Views: 44
Size:  17.8 KB


Changes

There are lots of possible changes.

You might use a more practical database with multiple tables, relations, views, etc. You might implement adds, deletes, and updates.

The attached archive is big because of the preloaded database files included. There isn't a lot of data there but the .MDW file isn't very compressible.
Attached Images
  
Attached Files

image bingo

$
0
0
hi guys welcome to my first post ,i am just learning Vb and i am trying to create a form that randomly selects images from a file of 16 images and places them on a grid, it must check from the image file that the image hasnt been selected before like a bigo machine ! Problem 1 :so i need the random generator to generate the images whilst checking that there is no duplicates. Problem 2 : i then need to place the images on allocated table or grid..please help....

64 bit Integer

$
0
0
There is the odd time that you need a 64 bit integer when interfacing with library files. This is easy to do with C++. You simply create a 64 bit unsigned integer. But VB6 does not offer such as service. The only thing that comes close is a Double Precision number, but there are lots of complications using that. No problem, we will just use 2 long integers (32 bit) to make up a single 64 bit integer. But VB6 only allows us to use 31 bits, as the high order bit is used for negative numbers. Drat! We can however utilize 3 long integers, using 24 bits from the first one, 24 bits from the second, and 16 from the third. The following example demonstrates how the 3 integers can be converted into a single string, as well as how the variable would be incremented. If the variable is to be modified in some other fashion, further logic will be required.

J.A. Coutts
Code:

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

    Dim N%
    Dim bTmp(1 To 8) As Byte
    Dim sTmp As String
    Dim TestNum(2) As Long
'    TestNum(0) = 16777215
'    TestNum(1) = 16777215
    Do Until TestNum(2) > 65535
        CopyMemory bTmp(1), TestNum(0), 3
        CopyMemory bTmp(4), TestNum(1), 3
        CopyMemory bTmp(7), TestNum(2), 2
        Debug.Print TestNum(2), TestNum(1), TestNum(0)
        sTmp = StrReverse(StrConv(bTmp, vbUnicode))
        For N% = 1 To Len(sTmp)
            Debug.Print Right$("0" & Hex$(Asc(Mid$(sTmp, N%, 1))), 2) & " ";
        Next N%
        Debug.Print
        If TestNum(0) < 16777215 Then '256 ^ 3 - 1
            TestNum(0) = TestNum(0) + 1
        ElseIf TestNum(1) < 16777215 Then
            TestNum(1) = TestNum(1) + 1
            TestNum(0) = 0
        ElseIf TestNum(2) < 65535 Then '256 ^ 2 - 1
            TestNum(2) = TestNum(2) + 1
            TestNum(1) = 0
        Else
            TestNum(0) = 0
            TestNum(1) = 0
            TestNum(2) = 0
        End If
    Loop

How To Move An Image Using BitBlt

$
0
0
This simple example shows you how to move an image across a canvas using BitBlt API. This example uses a Picturebox control where you move the image using the command buttons or the up, down, left, and right keyboard keys.

The basic steps to move an image are:

1) Save the rectangle area from the Picturebox the size of the rectangle of the original image.

2) BitBlt the original image from it's source to that area on the Picturebox. It is better to use TransparentBlt instead of BitBlt because it does not require that you use masking to make image transparent.

3) Restore the area that was saved

4) Set next position

5) Save the area that represents the next position you want to move the image to

6) BitBlt image to next position

Repeat at Step 3

The attached project use this method.
Attached Files

RPG Game using BitBlt

$
0
0
The filesize of this RPG Game is around 20MB, so I put it here: http://www.udontknowtech.com/rpgGame.zip

Screenshots
Name:  g12ss1.jpg
Views: 30
Size:  307.0 KB

Name:  g12ss2.jpg
Views: 35
Size:  255.8 KB

Name:  g12ss3.jpg
Views: 21
Size:  237.4 KB

Name:  g12ss4.jpg
Views: 26
Size:  260.2 KB

This example uses BitBlt and On-The-Fly Masking so you don't have to mask the character beforehand. It's not perfect, but it's good to learn from. I don't care for criticism but ways to improve are welcome, as I have only done Windows programming and have just recently got into gaming.

The characters were created with "Poser Debut". The 'Shop' icons are from a designer from deviantart.com. The 'Shop' background is one I found online, and so is Lord Bern, except for his eyes, which I had to create in Poser Debut so that he was looking at you, as the original image had him looking down and to the left... which would have been awkward. The music is from "Lord Of Ultima". The sound files are from some random sound pack I got a long time ago. All of the sound files, with the exception of 'walk.wav' are in the resource file (.res). The walk.wav file I couldn't put in the resource file because I needed to call it quickly and repeatedly and I guess it wouldn't load and play that fast because there was just silence, so that's why it's the only .wav file you'll see in the .zip. The map was designed using a map maker I created in VB6 utilizing tiles I found online. The numbers at the top of the Form are x,y coordinates that helped me figure out where to mark some of the objects for collision-detection and so on. Oh... and that dark-looking creature you see in the first and second screenshot is a female troll. She walks and breathes at random intervals randomly bidirectional (east & west).

And many thanks to the members here on VBForums who helped me along the way. You know who you are! Looking forward to learning more and creating something even better.
Attached Images
    

VB6 Simple EMF-based FlexPrint-Reporting (incl. Print-Preview)

$
0
0
Both of the MS FlexGrids which come with VB6 (also the hierarchical one), support the VP_FORMATRANGE command,
and this allows a relative simple interaction with regards to printer- (and multi-page-) related rendering per SendMessage.

So, people who are already familiar with the quite capable Formatting-Options of the (MS-, VideoSoft-, or now ComponentOne-) FlexGrids
can use these Grids as an Object-Model, to build-up simple, nice looking Reports based on a Grid-Layout -
but of course also to just "print out a bunch of Records" over multiple pages.

The Demo is not printing directly to VBs Printer-Object (though this can be done in a second step) - no -
the primary purpose of the relatively small cFlexPrint-Class is, to internally render the Content of a formatted
FlexGrid, into multiple Enhanced-Meta-Files (each EMF-Page of such a multipage-rendering-job will end up as
a serialized ByteArray, stored within a publically reachable VB.Collection (EMFPages As VB.Collection).

This way the generated Report (the Page-Bytearrays within the VB.Collection) could be stored within a DB,
or in the FileSystem, to call-up the Report at a later time (e.g. for a Preview or "Printing it for real").

So, if your reporting-requirements are not all that complex - and when you plan to deploy already one of the FlexGrids
in your App anyways, then this little engine might well be an alternative to larger (not as easy to distribute or "affordable")
Reporting-Engines.

Have fun with it... (and feel free to enhance it on your own, maybe post-back your additions here into the thread)...

Here's the Download-Link: http://vbRichClient.com/Downloads/FlexPrint.zip

And here a ScreenShot (interacting with Tables of NWind.mdb):


Olaf

[VB6] Extract JPEG EXIF Data with WIA 2.0

$
0
0
The attached program is meant to show how to use WIA 2.0 to extract many extended attributes from JPEG photos. It is not a "finished" program but more of a code sample and a testbed for working out the necessary details.

WIA 2.0 ships in Windows Vista and later, and programs that use it will run as far back as Windows XP SP1 as long as you deploy the redistributable version of wiaaut.dll (no longer hosted at Microsoft's download site).

As attached here, the program extracts and decodes many of the more commonly used properties including the embedded thumbnail image.

Those that the program doesn't "know about" are dumped when of a simple type (String, a number type) and described when of a more complex type (Byte array, Integer array, etc.).

A few sample photos are included (thus the large size of the archive) that demonstrate some of the possible items they may contain.


Name:  sshot.png
Views: 107
Size:  57.9 KB
Attached Images
 
Attached Files

VB6 TLSCrypto

$
0
0
SSLClient and SSLServer are companion programs designed to demonstrate Transport Layer Security (TLS) Version 1.0. At the present time, they only support 2 cipher suites:
TLS_RSA_WITH_RC4_128_MD5 (0x00,0x04)
TLS_RSA_WITH_RC4_128_SHA (0x00,0x05)
These 2 suites are supported by virtually all modern browsers and servers, although SHA is more commonly preferred. In addition, 2048 bit asymmetric keys are utilized for the session handshake, since these are strongly recommended by the Internet Engineering Task Force (IETF) since the end of 2013.

In order to support TLS without the use of third party controls or libraries, Microsoft's RSA/SChannel (schannel.dll) is utilized. This library is shipped with all modern Windows Operating Systems. As well, my own cSocket2 Class and accompanying Module (mWinsock2) are utilized. These 2 modules will support IPv6 when it becomes universally available. Although the Cryptography routines will work on most Windows Operating Systems, cSocket2 will only work on systems that support dual stack (IPv4/IPv6). This more or less restricts it to Windows Vista or better.

Originally, I planned on developing only the Client program without Certificates. But the severe lack of detailed information on TLS using SChannel made troubleshooting difficult if not impossible, and I could not connect with remote servers. So I decided to develop a Server program as well. Several months later, I had 2 programs that would communicate with each other, but I still could not communicate with external servers, and online assistance was virtually non-existent. So I then decided to test the server program using my local browser. That meant providing support for Certificates and a whole new level of complexity. But at least the browser provided a little more troubleshooting information than a remote server. This particular project has by far been the most challanging I have ever attempted. The programming itself was not all that difficult, but the lack of information, and the conflict between information that I did manage to find, made it a struggle. Troubleshooting was very difficult because Cryptographers basically strive to eliminate repeatability. Repeatability facilitates hacking.

The included ReadMe file contains the necessary setup instructions.

J.A. Coutts
Attached Files

Accessing MS Access 2003 from VB6

$
0
0
It has been a long time since I wrote any code so please excuse the naming conventions and the novice coding.
In VB6 I have successfully opened an MS Access 2003 database with the following code
Public Sub OpenDatabase()
Dim Msg As String

DbOpened = True
MyFile = App.Path & "\PrintDir.MDB" ' Define name of database.
On Error GoTo OpenDatabase_eh
Set MyWorkspace = Workspaces(0)

' Open database.
Set MyDatabase = MyWorkspace.OpenDatabase(MyFile)
Exit Sub
Later on I successfully update the database with the following code
Public Function UpdateDatabase(strFileName As String)
Dim intErrNbr As Integer
Dim Msg As String
Dim strErr As String
Dim a As Integer
On Error GoTo UpdateDatabase_eh

If strFileName = "" Then
Exit Function
End If
BeginTrans
Set MyTable = MyDatabase.OpenRecordset("FileInfo", dbOpenDynaset)

MyTable.AddNew
MyTable![FileName] = strFileName
.
.
.
MyTable.Update

gstrFileName = ""
glngFileSize = 0
gvarFileDateCreated = ""
gstrFileComments = ""

CommitTrans
MyTable.Close

Exit Function

UpdateDatabase_eh:

intErrNbr = Err
strErr = Error
Msg = "Err = " & intErrNbr & ", Error = " & strErr & vbCrLf & vbCrLf
Msg = Msg & " " & gstrFileName
MsgBox Msg, vbCritical
Rollback
On Error GoTo 0

End Function
However, when I try to delete the table entries, not the table, before I update the table I get error 2075, "The operation requires an open database".
Private Function DeleteTableContents()
Dim strMsg As String
Dim intAns As Integer
Dim DSQL As String
Dim intDCount As Integer
Dim xclSQL As String

On Error GoTo DeleteTableContents_eh
Set MyTable = MyDatabase.OpenRecordset("FileInfo", dbOpenDynaset)
DSQL = "DELETE * FileInfo.FileName FROM FileInfo "
DSQL = DSQL & "WHERE Not FileInfo.FileName = Xtest.jpg" '& "isnull"
'doCmd.SetWarnings False
DoCmd.RunSQL DSQL
'doCmd.SetWarnings True
MyTable.Close
Exit_DeleteTableContents:
Exit Function
DeleteTableContents_eh:
MsgBox "DeleteTableContents - Error Number = " & Err.Number & ", Error Description = " & Err.Description
Resume Exit_DeleteTableContents

End Function


Can anyone see what I am missing?
Thanks

1 or 2 Player Score Four Game + Chat

$
0
0
This is a game of Score Four that you can play against yourself or go online and play your opponent. It also includes a chat window. This VB6 project was written and tested on Windows XP only. I cannot guarantee how it will perform on any other Window's OS.

The zip file contains two folders named Player 1 and Player 2. Only folder Player 1 has the VB project. You need to copy everything from folder Player 1 over to folder Player 2 except the text file named GameInputData.txt. Folder Player 2 already has this file and it is different from the same name file in folder Player 1 so do not copy this file.

Edit the two GameInputData.txt files and put in the information that pertains to you.

The game is folder Player 2 is the one that you will give to your friend.

Open the VB project in folder Player 1 and run it. After it loads right click anywhere on the game board to show the option panel. Select New Game so you can play a game against yourself. To play a two person game open the project in folder Player 2 and run it. On either game click on Connect to Other Player to play a 2-person game.

To play the game left mouse click on any ball you see that is scattered around the front part of the game board. The ball will be highlighted to indicated it has bees selected. Now move your mouse pointer to the top area around any pole and left click. The selected ball will fall down the pole. If you are playing a 1-person game you will see the scattered balls switch colors from one move to another. If you are playing a 2-person game (online with your friend or with yourself using two game boards) the balls do not switch colors but remain on the game. As each ball is selected it is removed showing only the balls remaining to select from.
Attached Images
 
Attached Files
Viewing all 1480 articles
Browse latest View live


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>