Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all 21394 articles
Browse latest View live

Zip file batching with built-in Dir function

$
0
0
With this app I tried making a batch of zip files on a loop like this, but it only zips one. The code attached does work and zips a single file.

Code:

Dim ssczip As ZipClass
 Dim sFile As String
 sFile$ = Dir(App.Path & "\")
 While Len(sFile$) > 0
      Set ssczip = New ZipClass
      ssczip.AddFile App.Path & "\" & sFile$
      ssczip.WriteZip App.Path & "\" & sFile$ & ".zip", True
      Set ssczip = Nothing
      sFile$ = Dir$
 Wend


Attachment 177575
Attached Files

Hello I have an old project that I was working on and need some help

$
0
0
Hi, I'm trying to register some dll and ocx file. I registered them and it was successful the only thin is that I cant get this dlls registered.
COMCAT.DLL
ieframe.dll
MSDXM.OCX
Im running windows 10 64bit

https://gyazo.com/89085795c4f573a17547ddd317c008c6

https://gyazo.com/fdaaf464f9e1c9d141666990faaffe1d

https://gyazo.com/89085795c4f573a17547ddd317c008c6

And when I rest the computer and open the project I still get these error. please help I need these dlls and ocxs or my project wont work. even though I registered the dlls and ocxs vb 6.0 still cant find it.
https://gyazo.com/b32441fff304229f762552504f01af91
If you have any Ideas let me know.

I have not opend this project in years so I dont remmber how to register dlls and ocxs for vb 6.0 Thank you very much

Get the number of instances of a Class

$
0
0
Hi,

Code:

Private Sub Class_Initialize()
    Debug.Print "Number of Class1 Instances is : "  & ??
End Sub

Is there a way of retrieving the number of instances of a vba class from within the Class itself ?
Code:

Set Instance1 = New Class1 '<=== Class Init event will return 1
Set Instance2 = New Class1 '<=== Class Init event will return 2
Set Instance3 = New Class1 '<=== Class Init event will return 3

One could store an instance counter in a Public variable in a bas module but I want to know if it can all be done from within the class module.

Thanks.

[RESOLVED] Zip file batching with built-in Dir function

$
0
0
With this app I tried making a batch of zip files on a loop like this, but it only zips one. The code attached does work and zips a single file.

Code:

Dim ssczip As ZipClass
 Dim sFile As String
 sFile$ = Dir(App.Path & "\")
 While Len(sFile$) > 0
      Set ssczip = New ZipClass
      ssczip.AddFile App.Path & "\" & sFile$
      ssczip.WriteZip App.Path & "\" & sFile$ & ".zip", True
      Set ssczip = Nothing
      sFile$ = Dir$
 Wend


Attachment 177575
Attached Files

A popup menu has disruptive effects on the KeyUp method

$
0
0
I have an application that shows the thumbnails of video files.
Then the user can navigate them by keyboard (or simply select one by a mouse click).

Once a thumbnail is selected (whether by keyboard or mouse) the user can press certain keys to do different things.
This is done via the KeyUp method of the picturebox

Aside from that, the user can either right-click on the thumbnail or press the Menu key on the keyboard to bring on a popup menu.
From within that popup menu, there are quite a number of different menu items that the user can select.
Some of those menu items if selected will open other VB6 forms, allowing the user to do additional processes.
Some other menu items in that same popup menu allow the user to play the video by specific video players (as opposed to the main video player that Windows associates with that video type)
Some other menu items do other things.

The management of all of that is done by two methods of the picturebox: The KeyUp method and the MouseUp method.
Here is the code (I have removed a whole lot of unrelated code in here so that we can focus on the main issue):
Code:

Private Sub picFileThumbnail_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)

  If KeyCode = 27 Then                                  '  Esc key
      txtFileName(Index).SetFocus
      KeyCode = 0
      Shift = 0
  ElseIf KeyCode = 32 Then                            '  Spacebar
      txtFileName(Index).SetFocus
      KeyCode = 0
      Shift = 0
  ElseIf (KeyCode = 13) And (Shift = 0) Then          '  Enter key
      ......                                                          '  Playing the video by its Windows associated video player
      KeyCode = 0
      Shift = 0
  ElseIf (KeyCode = 93) And (Shift = 0) Then          '  Menu key
     
      Me.PopupMenu mnuVidMain, vbPopupMenuLeftAlign, picFileThumbnail(Index).Left + (picFileThumbnail(Index).Width \ 3), picFileThumbnail(Index).Top + (picFileThumbnail(Index).Height \ 2)
     
      KeyCode = 0
      Shift = 0
  End If
 
End Sub

Code:

Private Sub picFileThumbnail_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  If Button = vbRightButton Then
      Me.PopupMenu mnuVidMain
  End If
End Sub

The problem is that when the user brings on the popup menu, and then presses Enter to select one of its menu items, the functionality under that menu item (for example opening a new VB6 form) is executed properly, but that "Enter" key pressed on that menu item is ALSO passed to the picFileThumbnail_KeyUp function, resulting in an additional process being fired!
In this case the "Enter" key passed to picFileThumbnail_KeyUp causes the video to be played by its associated video player.

So, when the user intends to open the subsidiary form for some specific process, that subsidiary form opens properly, but the video also starts playing in Windows Media Player.
So, TWO things happen instead of one thing.

Or another example:
The user selects a thumbnail, then presses the menu key to bring on the popup menu, then changes his mind and presses the Escape key to dismiss the popup menu.
In that case the popup menu is properly dismissed as intended, but the Escape key is ALSO passed to the picFileThumbnail_KeyUp function and that causes the functionality for pressing Escape key on the thumbnail itself (within the picFileThumbnail_KeyUp function) be invoked as well.
So, again, TWO things happen instead of one thing.

I have tried everything to fix this, but nothing works.

Please help.
Thanks.

tearing at "circular dependencies between modules" in ActiveX project

$
0
0
I changed a new PC, but my old ActiveX project can't compile any more with error "circular dependencies between modules". I have changed the VBP Reference to right path (C:\windows\system32 to c:\windows\syswow64), but still got such error.

This ActiveX combines few other internal controls. I noticed those controls turned into picturebox already. I have to add those internal controls one by one again? any trick is available?

How to add mouse scroll to pop up list

$
0
0
i am writing my own comb box , don't know much about API's.
Can anybody modify these codes to add mouse wheel scrolling and mouse over list item (that i tried) to this control.
Attached Files

VB6 running a project on the fly

$
0
0
Is it possible to restart a project whilst is running . l've tried the approach

Unload form
set form=nothing
Load form
form.show

as l have done on noumerous projects but i won't work

any other way l can try . Thanks

VBRichclient - Cairo.Createsurface (Loading BLOB Sqlite to Image)... Error

$
0
0
Hi guys

I am trying to load image file from BLOB Sqlite,
Saving it was not a problem, but retrieving the image from BLOB.

One form ,the code worked well. But on another form with same lines, gave me error..
Really confusing..

Code:

If Not IsEmpty(TempRS!fpic) Then
                Afot.Picture = Cairo.CreateSurface(320, 240, , TempRS!fpic.Value).Picture
                Call sPic.SavePicture(Afot, App.path & "/tmpimg/pic1.jpg", fmtJPEG)
                txtpic.text = App.path & "/tmpimg/pic1.jpg"
End If

The error line in Cairo.Createsurface and give me error number 9, subscript out of range,

Strange, since on other form, this same line give no error and worked. Well..the picture not same.

Help..thanks

UPDATE : I found out the issue, you can save any picture from Std Control (Image Control) to BLOB Sqlite (ICO, JPG, BMP) but retrieving part is the tricky one. if you use JPG, using Cairo.Createsurface gave no error, but if your BLOB is ICO file, then error occured when loading .

WHy ??

VB6 & Access 2003 - Shoudl I move to Access 2007 or other to improve security?

$
0
0
Hi Team,
I currently have a complex VB6 application which uses several local Access 2003 Jet mdb databases (~25 tables). I have enjoyed programming VB6 over the years and it all works very well. I use the standard VB6 Packaging and Distribution and have sent it to a few dozen users who have installed it on everything from Windows XP (SP3) to the latest Windows 10 64bit with all combinations of Office etc. Access has been super reliable with no issues (fingers crossed). So far so good.

I have written a new version of the VB6 application with new databases(still Access 2003 Jet mdb), I have put a lot of late nights into the new databases and I started to think about security. I have taken all the recommend steps to secure the Access 2003 databases, User Based password, no Admin etc, but a quick Google shows how easy it is to hack an Access 2003 database with it's exposed passwords, regardless of how locked down you think it is.

This is a concern. I am thinking of moving from Access 2003 Jet to 2007 ACE which I understand has improved security (?), although maybe not as good as SQL Server Express/LocalDB. I am happy to do the work moving from Jet to ACE if that helps, but I have read comments that distribution can be an issue where 32bit ACE clashes with 64bit ACE on a Windows PC that has Office 64bit etc.

I am hoping that the learned folks here may have suggestions/experience of how to move to a new combination of VB6 and Access or something else (or stay where I am) that has a good level of security but also has reliable distribution/installation on 32bit and 64bit Windows. Translate: It would be pain if it fails to install on some combinations of Windows / Office / 32bit / 64bit and I have unhappy users.
I have also looked into using SQL Server Express/LocalDB and I may be mistaken but it looks like there is a separate exercise to install an SQL Server database subsystem on a user's PC in order for the VB6 app to use SQL Server databases on the PC. That would be an order of magnitude more complex than the simple installation I currently have.
Apologies for the long post. I would appreciate any thoughts or suggestions anyway may have.

TCP Connection attempt timeout

$
0
0
On Windows platforms, the default timeout for a remote TCP connection attempt is 20 seconds. In this day and age, for most (if not all) situations, that is excessive. What is a reasonable amount of time to wait for a connection to be established before abandoning the effort?

J.A. Coutts

Exe stop with MSVBVM60.DLL issue

$
0
0
Hi,

I re-compile some old codes to run on Win10, work like a charm. So before you ask for reg dll and ocx, that is not the problem here.

The app can run for hours, start. exit, start, everything is working.

I leave the office at night, leave the EXE open (or sometime after several hours in the day) the app will close when trying to access it.

with this error in theEventViewer, it's in french, but you get the point.

Name:  Annotation 2020-06-15 102135.jpg
Views: 42
Size:  47.7 KB

I don't get why the the path to the file is c:\windows\system32 when in fact it's in SysWow64 ?! and the version that I have on my Win10 is 6.0.98.32. The WinXP that compile that exe was ..98.15

I use RDO connection to a MSSQL DB.

Any idea why ?

Can it be because of a connection close from the DB ? If so, how can I make it open for unlimited of time.

Thanks
Attached Images
 

Program acquires virus online

$
0
0
I've written a program in Visual Basic (5.0) and made an executable (xxx.exe) file of it.
I click on it to run, and it runs on my machine, no problem.
I upload it to my webpage (Weebly).
I download it (by Firefox) to see what the user will experience.
I click to run it and I get messages from Windows Security:
"Active threats have not been remediated and are running on your device."
"Threat detected: Trojan:Win32/Azden.A!cl". Etc.
It's not just a Weebly problem: I've tried it on another server, and I get the same virus messages.
It's not just a Firefox problem: Google Chrome refuses to download it, saying "Virus detected", and
Microsoft Edge downloads it, then detects the virus and deletes it from my Downloads folder.
Any suggestions?

Execute Public Method of a Class using CallWindowProc

$
0
0
Hi dear forum members,

I am carrying out a few experiments in order to learn.

I have this Class with one Public Method and I want to execute this class Method when instantiating the class via a call to the CallWindowProc function.

CallWindowProc expects the address of a function in its first argument so my thinking is to retrieve the Public Method address (Class Vtable + 8 bytes for AddRef and Release) and pass this address to the CallWindowProc API.

Obviously, I must be misunderstanding something fundamental because the code doesn't work. In fact it crashes the entire application.

Can anybody share some light on this ?

Regards.

This is the code I am using (Code inside the Class Module):
Code:

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'Only Public Method
Public Sub ClassMethod()
    MsgBox "First Public Class Method executed."
End Sub



Private Sub Class_Initialize()
    ' Pass the first Public Calss method addr ( VTable addr + 8 bytes) to the CallWindowProc API.
    CallWindowProc ByVal DeRef(ObjPtr(Me)) + 8, 0, 0, 0, 0
End Sub

Private Property Get DeRef(ByVal Address As Long) As Long
    CopyMemory DeRef, ByVal Address, 4
End Property

help about create this theme

$
0
0
hi,i am looking for any sample to can create theme like this.
i can design with activeskin but i want more samle,imprtants to me is material colors and soft radius form corners and objects.



Name:  photo_2020-06-14_19-46-41.jpg
Views: 37
Size:  17.4 KB
Attached Images
 

Visual Basic 6 VB6 help resources: Unable to display help

$
0
0
I have installed Visual Basic 6 on a Windows 10 64-bit system; all works fine except for the help menu where it says "Unable to display help."
Some Italian guy alleged to have developed a tool that can fix that, but it seems like a scam to me as he first asks for a "Donation" in order to download his tool and gives you a broken serial number for which you have to pay 50 Euros to fix it. Does anyone know how to make the VB6 help work?

Visual Basic 6 VB6 help resources: Insert CD2

$
0
0
Name:  Capture.PNG
Views: 24
Size:  4.9 KB

I have a three-CD MSDN Library set for VB6, I could install the first CD, but on %16 progress it said "insert the CD-ROM disk labeled: "MSDN Library - October 2001 CD2."
I tried to mount the ISO file that I have as a virtual CD, but that did not work neither did burning the ISO on a DVD work; it repeats the same message box. Any insight?
Attached Images
 

Migrating from Win xp x32 to Win Server 2012 R2

$
0
0
Hello,
I am attempting to decommission a Win xp x32 system but it runs a exe file from VB 6 that I need to move to a Win Server 2012 R2 system. I have tried to run the exe file but i keep getting the error: The Program cant start because MSVBVM50.DLL is missing from your computer. I do see the file listed in the VB6 folder but I have tried installing the SP that windows offers, and reinstalling the file incase it was corrupted. Does anyone know what this issue could be? I have not been able to find any other leads on issues other than the file missing and needing to be reinstalled.

Rotate Text Using GDI+

$
0
0
Hello,

A while back dilettante and Schmidt helped me with precise positioning of text on a baseline.
http://www.vbforums.com/showthread.p...ing&highlight=

The text is positioned on a marker , and can be left, center, or right aligned.

Now I have a need to rotate this text, and I would like to rotate about a center point ,
and send this point to the DrawTextRotated function.

Any help would be appreciated.

Code:

Option Explicit


Dim gdiplusToken As Long


Private Enum TextJustify
    JustifyCenter
    JustifyLeft
    JustifyRight
End Enum


Dim stat As Long


Private Sub Form_Load()

    Form1.Caption = "GDI+"
    Form1.Width = Screen.TwipsPerPixelX * 600
    Form1.Height = Screen.TwipsPerPixelY * 465
    Form1.BackColor = &H8000000F
    Form1.ScaleMode = vbPixels
   
    Command1.Width = Form1.ScaleWidth
    Command1.Height = 25
    Command1.Left = 0
    Command1.Top = Form1.ScaleHeight - Command1.Height
    Command1.Caption = "execute"
    Command1.ZOrder (0)
   
    Picture1.Appearance = 0
    Picture1.Left = 20
    Picture1.Top = 20
    Picture1.Height = 366
    Picture1.Width = 552
    Picture1.AutoRedraw = True
   
    ' Initialize Windows GDI+
    Dim GdiplusStartupInput As GdiplusStartupInput
    GdiplusStartupInput.GdiplusVersion = 1
    GdiplusStartupInput.DebugEventCallback = 0
    GdiplusStartupInput.SuppressBackgroundThread = False
    GdiplusStartupInput.SuppressExternalCodecs = False
    Dim status As GpStatus
    status = GdiplusStartup(gdiplusToken, GdiplusStartupInput, 0)
    If status <> Ok Then
        MsgBox "Error loading GDI+!", vbCritical
        Call GdiplusShutdown(gdiplusToken)
    End If

End Sub


Private Sub Form_Unload(Cancel As Integer)
   
    ' Clean up resources used by Windows GDI+
    Call GdiplusShutdown(gdiplusToken)
   
End Sub


Private Sub Command1_Click()

    Call GdipSample
   
End Sub


Private Sub GdipSample()

    Picture1.Cls
   
    Dim stat As Long

    ' Create Graphics object
    Dim graphics As Long
    stat = GdipCreateFromHDC(Picture1.hdc, graphics)

    Dim fontFamily As Long
    stat = GdipCreateFontFamilyFromName(StrPtr("Times New Roman"), 0, fontFamily)

   
    stat = GdipSetTextRenderingHint(graphics, TextRenderingHintAntiAlias)
   
   
   
   
    Call DrawTextRotated(graphics, _
                        "Whirligig", _
                        275, 195, _
                        JustifyCenter, _
                        fontFamily, FontStyleRegular, 96, _
                        45)
   
   


    ' Cleanup
    stat = GdipDeleteFontFamily(fontFamily)
    stat = GdipDeleteGraphics(graphics)
   
    Picture1.Refresh
   
End Sub


Private Sub DrawTextRotated(G As Long, _
                            text As String, _
                            x As Single, y As Single, _
                            justify As TextJustify, _
                            fontFamily As Long, FontStyle As FontStyle, fontSize As Single, _
                            rotationAngle As Single)

    '-------------------------------------------------------------------------------------------
    ' Get some font metrics
   
    Dim fontEmSize As Single
    fontEmSize = fontSize

    Dim EmHeight As Integer
    stat = GdipGetEmHeight(fontFamily, FontStyle, EmHeight)

    Dim CellAscent As Integer
    stat = GdipGetCellAscent(fontFamily, FontStyle, CellAscent)

    Dim CellDescent As Integer
    stat = GdipGetCellDescent(fontFamily, FontStyle, CellDescent)

    Dim fontAscentInPixels As Single
    fontAscentInPixels = (fontEmSize * CellAscent / EmHeight)
   
    Dim fontDescentInPixels As Single
    fontDescentInPixels = (fontEmSize * CellDescent / EmHeight)
    '-------------------------------------------------------------------------------------------
   

    '-------------------------------------------------------------------------------------------
    ' Set text baseline

    Dim baselineX As Single
    Dim baselineY As Single
   
    baselineX = x
    baselineY = y
    baselineX = Int(baselineX)
    baselineY = Int(baselineY)
    '-------------------------------------------------------------------------------------------
   
   
    '-------------------------------------------------------------------------------------------
    ' Set the text layout rect

    Dim txtRect As RECTF
    txtRect.Right = 0                                              'width  (0 means no boundary)
    txtRect.Bottom = 0                                            'height (0 means no boundary)
    txtRect.Left = baselineX                                      'x
    txtRect.Top = baselineY - fontAscentInPixels                  'y
    '-------------------------------------------------------------------------------------------

   
    '-------------------------------------------------------------------------------------------
    ' Initialize GDI+ objects
   
    Dim redPen As Long
    stat = GdipCreatePen1(&HFFFF0000, 1, UnitPixel, redPen)

    Dim bluePen As Long
    stat = GdipCreatePen1(&HFF0000FF, 1, UnitPixel, bluePen)
   
    Dim blackBrush As Long
    stat = GdipCreateSolidFill(&HFF000000, blackBrush)
   
    Dim txtFont As Long
    stat = GdipCreateFont(fontFamily, fontEmSize, FontStyle, UnitPixel, txtFont)
   
    Dim txtStringFormat As Long
    stat = GdipStringFormatGetGenericTypographic(txtStringFormat)
    '-------------------------------------------------------------------------------------------
   

    '-------------------------------------------------------------------------------------------
    ' Adjust for Alignment

    Select Case justify
        Case JustifyCenter
            stat = GdipSetStringFormatAlign(txtStringFormat, StringAlignmentCenter)
        Case JustifyLeft
            stat = GdipSetStringFormatAlign(txtStringFormat, StringAlignmentNear)
        Case JustifyRight
            stat = GdipSetStringFormatAlign(txtStringFormat, StringAlignmentFar)
    End Select
    '-------------------------------------------------------------------------------------------
   
   
    '-------------------------------------------------------------------------------------------
    ' Draw Text

    stat = GdipDrawString(G, StrPtr(text), -1, txtFont, txtRect, txtStringFormat, blackBrush)
    '-------------------------------------------------------------------------------------------
   
   
    '-------------------------------------------------------------------------------------------
    ' Draw position marker for the text

    ' horz baseline
    stat = GdipDrawLine(G, redPen, _
                        baselineX - (fontSize / 2), baselineY, _
                        baselineX + (fontSize / 2), baselineY)
   
    ' vert alignment marker
    stat = GdipDrawLine(G, redPen, _
                        baselineX, baselineY, _
                        baselineX, baselineY - fontAscentInPixels + fontDescentInPixels)
    '-------------------------------------------------------------------------------------------

                           
    '-------------------------------------------------------------------------------------------
    ' Draw rotation point
   
    ' horz line
    stat = GdipDrawLine(G, bluePen, _
                        baselineX - 10, _
                        baselineY - ((baselineY - _
                            (baselineY - fontAscentInPixels + fontDescentInPixels)) / 2), _
                        baselineX + 10, _
                        baselineY - ((baselineY - _
                            (baselineY - fontAscentInPixels + fontDescentInPixels)) / 2))
    ' vert line
    stat = GdipDrawLine(G, bluePen, _
                        baselineX, _
                        baselineY - (((baselineY - _
                            (baselineY - fontAscentInPixels + fontDescentInPixels)) / 2) _
                                - 10), _
                        baselineX, _
                        baselineY - (((baselineY - _
                            (baselineY - fontAscentInPixels + fontDescentInPixels)) / 2) _
                                + 10))
    '-------------------------------------------------------------------------------------------
   
   
    '-------------------------------------------------------------------------------------------
    ' Clean-up GDI+ objects

    stat = GdipDeletePen(redPen)
    stat = GdipDeletePen(bluePen)
    stat = GdipDeleteBrush(blackBrush)
    stat = GdipDeleteFont(txtFont)
    stat = GdipDeleteStringFormat(txtStringFormat)
    '-------------------------------------------------------------------------------------------
 
End Sub

[RESOLVED] Center Popup Menu in Screen

$
0
0
When I mouse click on an object a popup menu appears but I want it to show centered in the screen area. I tried the following:

Code:

  '
  '
MenuX = (Screen.Width - 127)
MenuY = (Screen.Height - 101)

PopupMenu mnuOptions, , MenuX, MenuY
  '
  '

127 is width of popup menu in pixels
101 is height of popup menu in pixels

The popup menu always appears in the lower right corner of the screen
Viewing all 21394 articles
Browse latest View live


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