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

Compiler Error Message: BC30188: Declaration expected.

$
0
0
All I change was a single number in the code and save the file. I am new to coding and thought I could change something, but I have messed up our maintenance board, please help!!!
this is the error I get:

Description: An error occurred during the compilation of a resource required to service this request. Please review the following specific error details and modify your source code appropriately.

Compiler Error Message: BC30188: Declaration expected.

Source Error:



Line 1: Attribute VB_Name = "Module1"
Line 2: Imports System
Line 3: Imports System.IO

Source File: C:\inetpub\wwwroot\applications\worcesterbreakdownboards\WorcesterMaintenanceBoard.aspx.vb Line: 1

4 strange questions about RichTextBox

$
0
0
I encountered a few strange questions when I used RichTextBox.

◆ Problem 1:
When I copy data from MS-Word to RichTextBox, I encountered the following three questions:
(1)The image color is changed
(2) The edge of the picture appears jagged
(3) The Unicode characters can't be displayed

◆ Problem 2:
RichTextBox SelStart, SelLength and SelText are sometimes incorrect.

◆ Problem 3:
RichTextBox will have a memory leak when we frequently use the SelStart, SelLength and SelText properties.
(1) In XP, whether it is in VB6 IDE environment or compiled into an executable file, RichTextBox has memory leak problem (at least on my computer). When click the Problem3 button, the test program will run out of all the memory of the computer.
(2) In Win10, in the VB6 IDE environment, RichTextBox does not happen memory leak. However, when compiled into an executable program, RichTextBox has memory leak problem and will run out of all the memory of the computer and raise 'Automation error'.

◆ Problem 4:
If we use Ms Word to open sample.rtf, the pictures are not distorted. If we use RichTextBox to open sample.rtf, the pictures are distorted. In fact, all information about anti-aliasing is present in the rtf, but how can we find and use this information ?

See the test program for details. Thanks very much.





Note: Problem 1 has been discussed in the following thread, and now it is transplanted (merged) here. (this may cause confusion and inconvenience, sorry).
http://www.vbforums.com/showthread.p...-another-color
Attached Images
 
Attached Files

IContextMenu for files not in the same folder-- SHCreateDefaultContextMenu

$
0
0
So this isn't possible with the normal method for generating a context menu, but everything I've read about it says that using SHCreateDefaultContextMenu will. But I'm still getting a 'no such interface supported' error (0x80004002) even with a single file...


Code:

'selected declares:
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Function SHCreateShellItemArrayFromIDLists Lib "shell32" (ByVal cidl As Long, ByVal rgpidl As Long, ppsiItemArray As IShellItemArray) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Public Declare Function SHCreateDefaultContextMenu Lib "shell32" (pdcm As DEFCONTEXTMENU, riid As UUID, ppv As Any) As Long
Public Type DEFCONTEXTMENU
    hWnd As Long
    pcmcb As Long
    pidlFolder As Long
    psf As Long
    cidl As Long
    apidl As Long
    punkAssociationInfo As Long
    cKeys As Long
    aKeys As Long
       
End Type




Public Function LVRCShellMenuPopup() As Long
Dim psia As IShellItemArray
Dim hMenu As Long
Dim pt As oleexp.POINT
Dim cmi As CMINVOKECOMMANDINFO
Dim dwFlags As QueryContextMenuFlags
Dim apidl() As Long, cpidl As Long
Dim idCmd As Long
Dim i As Long

Call EnumSelectedAPI(, , False)
If sSelFullPath(0) = "" Then Exit Function

cpidl = UBound(sSelFullPath) + 1
ReDim apidl(UBound(sSelFullPath))
For i = 0 To UBound(sSelFullPath)
    apidl(i) = ILCreateFromPathW(StrPtr(sSelFullPath(i)))
Next i

Call SHCreateShellItemArrayFromIDLists(cpidl, VarPtr(apidl(0)), psia)
For i = 0 To UBound(apidl)
    Call CoTaskMemFree(apidl(i))
Next i
Dim pcm As IContextMenu

GetCursorPos pt
'psia.BindToHandler 0&, BHID_SFUIObject, IID_IContextMenu, pcm 'If only... this is how it's normally generated
Dim pdcm As DEFCONTEXTMENU
Dim pUnk As oleexp.IUnknown
Dim pqia As IQueryAssociations
psia.BindToHandler 0&, BHID_AssociationArray, IID_IQueryAssociations, pqia
If pqia Is Nothing Then
    Debug.Print "no pqia"
    Exit Function
End If
Set pUnk = pqia
pdcm.psf = ObjPtr(isfDesktop)
pdcm.cidl = cpidl
pdcm.apidl = VarPtr(apidl(0))
pdcm.punkAssociationInfo = ObjPtr(pUnk)
Dim hr As Long
hr = SHCreateDefaultContextMenu(pdcm, IID_IContextMenu, pcm)
Debug.Print "cdcm hr=0x" & Hex$(hr)

Everything comes back good until here, where the hresult is E_NOINTERFACE (0x80004002) and pcm = nothing. Just in case I did try it without ObjPtr for psf and punk, same result.

I've had some trouble in the past where the declare is 'const (struct)' (it's _In_ const DEFCONTEXTMENU *pdcm,) but that it's specifically returning E_NOINTERFACE as the HRESULT makes me think the declare and call method are ok.

vb6 activex problem tunr style door firnger print machine

$
0
0
we have bought a fingerprint reader machine and trying to connect to the machine on vb6 via SBXPC.ocx reference/component.

We have succeded in connecting, enabling,opening the turnstile door. But we failed to get information when someone reads his/her fingerprint. Component has SBXPC1_OnReceiveEventXML(ByVal lpszEventXML As String) but we can't fire it, and get data.

'connection
a = SBXPC1.ConnectTcpip(dwMachineNumber, IpszIPAddress, dwPortNumber, dwPassWord)
'enabling
SBXPC1.EnableDevice(dwMachineNumber, True)
'openin the baffle gate
SBXPC1.SetDoorStatus(dwMachineNumber, dwValue)

Private Sub SBXPC1_OnReceiveEventXML(ByVal lpszEventXML As String)
end sub

I need any help for this
thanks in advance

Getting error while loading database connection

$
0
0
Can anyone help me for the error.:)
Below is my code
Run-time error '-2147467259 (80004005)': [Microsoft][ODBC Microsoft Access Driver] Could not find file '(unknown)'.
Code:

Private Sub cmdApply_Click()

    Text3.Text = "INDIA"
    Map1.Layers.Clear
    ListView1.ListItems.Clear
    ListView1.ColumnHeaders.Clear
     
    Set c = New Connection
    Set cm = New Command
    Set r = New Recordset
'On Error Resume Next

    strconn = "Driver={Microsoft Access Driver (*.mdb)};" & _
    "Dbq =" & App.path & "\Vul_all_param_Project.mdb;" & _
    "Uid=Admin; Pwd="
'Vul_all_param_Project.mdb
    c.Open strconn

    r.LockType = adLockBatchOptimistic
    r.CursorLocation = adUseClient
    r.CursorType = adOpenDynamic

    dc.Database = App.path
    If Combo1.Text = "" Then
        MsgBox "SELECT THE APPROPRIATE PARAMETER FOR ADAPTIVE_CAPACITY FROM ATTRIBUTES COMBO BOX", vbDefaultButton1, "SELECT"
    End If
   
    If Combo1.Text = "Electricity" Then
      Combo1.Text = "Electricit"
   
       
        If Not dc Is Nothing Then
          Set gds1 = dc.FindGeoDataset("Vul_all_param_Project")
          Set gds2 = dc.FindGeoDataset("India_state")
          'Set gds3 = dc.FindGeoDataset("India_state")
        'End If
 
        If Not lyr1 Is Nothing Then
        If Not lyr2 Is Nothing Then
       
         
          Set lyr1 = New MapObjects2.MapLayer
          Set lyr1.GeoDataset = gds1
          Set lyr2 = New MapObjects2.MapLayer
          Set lyr2.GeoDataset = gds2
      '    Set lyr3 = New MapObjects2.MapLayer
        '  Set lyr3.GeoDataset = gds3
         
    '    End If
      '  End If
 
        lyr2.Symbol.Color = moWhite
        lyr2.Symbol.OutlineColor = moBlack
        lyr2.Symbol.Size = 2
        'lyr2.Symbol.Style = moTransparent
       
       
        Set recs = lyr1.Records
   
        Call PopulateNewCBlegend(Combo1.Text)
        cmdApply.Enabled = True
        Call ApplyClassBreaks
        legend1.LoadLegend True
        Map1.Refresh
        ListView1.ColumnHeaders.Clear
        ListView1.ListItems.Clear
       
       
        Map1.Layers.Add lyr2
        Map1.Layers.Add lyr1
      '  Map1.Layers.Add lyr3
   
        legend1.setMapSource Map1
        legend1.LoadLegend True
       
        MsgBox "This parameter gives the Rural Electrification as a % of Number of Villages with electric supply in relation to total number of Villages", vbExclamation, "Electricity"
       
        Set rs = New Recordset
   
 '12345  Map1.Refresh
        ListView1.ColumnHeaders.Clear
        ListView1.ListItems.Clear
        'should display the tablular data
   
        Set colheader = ListView1.ColumnHeaders.Add()
       
        ListView1.ColumnHeaders.Add(1) = "ID"
        ListView1.ColumnHeaders.Add(2) = "Dist_ID"
        ListView1.ColumnHeaders.Add(3) = "COUNTRY"
        ListView1.ColumnHeaders.Add(4) = "STATE"
        ListView1.ColumnHeaders.Add(5) = "DISTRICT"
        ListView1.ColumnHeaders.Add(6) = "Electricity"
       
           
        'If Combo1.Text = "Electricity" Then
        sql = "select * from Vul_all_param_Project order by DIST_ID"
        rs.Open sql, c
            While rs.EOF = False
              Set l = ListView1.ListItems.Add(, , Trim(rs(0)) & "")
              l.SubItems(1) = Trim(rs(5) & "")
              l.SubItems(2) = Trim(rs(6) & "")
              l.SubItems(3) = Trim(rs(3) & "")
              l.SubItems(4) = Trim(rs(2) & "")
              l.SubItems(5) = Trim(rs(64) & "")
             
              rs.MoveNext
            Wend
           
        End If
        End If
        End If
ElseIf Combo1.Text = "Fertilizer" Then
      Combo1.Text = "tot_fert_k"

        If Not dc Is Nothing Then
            Set gds1 = dc.FindGeoDataset("Vul_all_param_Project")
            If Not gds1 Is Nothing Then
          Set gds2 = dc.FindGeoDataset("India_State")
        'End If
 
        If Not lyr1 Is Nothing Then
        If Not lyr2 Is Nothing Then
          Set lyr1 = New MapObjects2.MapLayer
          Set lyr1.GeoDataset = gds1
          Set lyr2 = New MapObjects2.MapLayer
          Set lyr2.GeoDataset = gds2
    '    End If
      '  End If
     
 
        lyr2.Symbol.Color = moWhite
        lyr2.Symbol.OutlineColor = moBlack
        lyr2.Symbol.Size = 2

        Set recs = lyr1.Records
   
       
        Call PopulateNewCBlegend(Combo1.Text)
        cmdApply.Enabled = True
        Call ApplyClassBreaks
        legend1.LoadLegend True
        Map1.Refresh
        ListView1.ColumnHeaders.Clear
        ListView1.ListItems.Clear
       
        Map1.Layers.Add lyr2
        Map1.Layers.Add lyr1
   
        legend1.setMapSource Map1
        legend1.LoadLegend True
       
       
       
        MsgBox "This parameter gives the Fertilizer Consumption of nutrients (N+P+K) per ha of gross sown area", vbInformation, "Fertilizer"

        Set rs = New Recordset
 
      ' Map1.Refresh
        ListView1.ColumnHeaders.Clear
        ListView1.ListItems.Clear
        'should display the tablular data
   
        Set colheader = ListView1.ColumnHeaders.Add()
       
        ListView1.ColumnHeaders.Add(1) = "ID"
        ListView1.ColumnHeaders.Add(2) = "Dist_ID"
        ListView1.ColumnHeaders.Add(3) = "COUNTRY"
        ListView1.ColumnHeaders.Add(4) = "STATE"
        ListView1.ColumnHeaders.Add(5) = "DISTRICT"
        ListView1.ColumnHeaders.Add(6) = "Fertilizer"
       
           
        sql = "select * from Vul_all_param_Project order by DIST_ID"
        rs.Open sql, c
            While rs.EOF = False
              Set l = ListView1.ListItems.Add(, , Trim(rs(0)) & "")
              l.SubItems(1) = Trim(rs(5) & "")
              l.SubItems(2) = Trim(rs(6) & "")
              l.SubItems(3) = Trim(rs(3) & "")
              l.SubItems(4) = Trim(rs(2) & "")
              l.SubItems(5) = Trim(rs(52) & "")
             
              rs.MoveNext
            Wend
           
      '      pTable.Database = strconn
   
        '    If Combo1.Text = "Fertilizer" Then
        '      pTable.Name = "Fertilizer"
        '  End If
            End If
        End If
    End If
End Sub

[RESOLVED] How to position a form over a specific area on another form?

$
0
0
Hi there folks! I am working on a program to teach students words for school. I've added a onscreen keyboard, so a teacher can easily add new words if needed. I made my own because the only thing needed was letters and a couple of symbols. Anyway, what I would like to do is when the keyboard form is loaded, have it load where its position is in the bottom left corner of the main form (so it is overlapping the main form that is loaded previously). Is there something I can code in the formload event for the keyboard so it could do that?

Thanks a lot!

Query files

$
0
0
Hi!

I have a problem with file query.

I have a folder. and there are many folders under this folder. like this;

01022017
02022017
03022017
...
25022017

and there are hundreds of files in each folders.

for example 01022017 folder's files

c:\01022017\01022017_140245.txt
c:\01022017\01022017_230111.txt

(foldername_time.txt)

I want to query between two date and two time.

sample: first date: 01.02.2017 time:13:25= > and <=second date 05.02.2017 time :08:00

and write file names to listbox.


can you help me.

sorry for my English

Thanks

Text save error when the pc shutdown or restart

$
0
0
Hello Guys
I have a problem with saving a number to a text file .
If i close the program normally everything works good
but when i restart my computer while the program running after open again it deletes all number on the text.
what can i do ? how can i save the numbers when the computer suddeny close.Form1.frm
Attached Files

Running VB6 on Windows 10

$
0
0
Newbie here, although I did spend a few minutes searching
prior posts on this matter.

I will shortly be moving a VB6 SP5 app from an ancient XP OS
computer to a new 64-bit Windows 10 computer.

I eventually hope to rewrite it in VB.Net, but for the time being
I just want to get it off the old computer. The app has 3 forms
and 9 modules. And I would like to run it in "edit mode" (ie,
not compiled).

Do I need to move any other "driver" files to be able to
run it in "edit mode", or do I simply just need to copy the .frm
.bas .vbp .vbw .log and .frx files?

Thanks

Store execution proc sql server 2014 did not perfect through vb6

$
0
0
I have a store procedure in SQL 2008 standard which is currently under implementation through VB6 can successfully say there are 12,000 perfect record on the results of the store procedure
However, when the database is moved to sql server 2014, the same store procedure run from VB6 does not produce the same output as is currently done in sql server 2008.

But if the store procedure that created on the SQL server 2008 if executed on Microsoft Mnajemen Studio 2014 with a direct way in the execution of stored procedures directly the result is exactly the same as if the store proccedure executed through VB6 with databases using SQL 2008

why did it happen, please enlighten

REGARDS

VB6: “Compile error: Can't find Object or library”

$
0
0
I have TFS setup in the network and my projects are managed here.

When i run my vbp project file i get the error saying "Compile error: Can't find Object or library". I searched for the error and i got many links saying that there will be missing references but when i checked on the reference tab i found no "missing" in any of the reference.

For further error trace i tried running the same code in different users of the same PC and it worked. For some users the code is running fine but for some users the error occurring.

I opened the reference tab and clicked OK without changing anything. Now the error stopped coming. So i further checked by copying the code files from TFS before committing the last changes and i got the error again. I compared the code files and found that there are some path difference in the reference files. The code in the TFS is referring the file from system32 but in my pc the reference file found in sysWOW64. So the reference may be added in the 32 bit PC while mine is 64 bit PC.

Now i got the question that why the VB editor auto detects the reference in some users but fails in some other users when the running PC is same?

Reset Integer Value

$
0
0
So I've inherited a program that deals with print copies by passing a value throughout the program using a global integer 'gintPrintCopies' this is populated through a textbox in a custom print dialog box whenever a user runs a print routine. The problem i have is some reports give an option to output the report to a spreadsheet. The way the code is written means that the code to either print or create a spreadsheet is within the loop to print the x amounts of copies (not ideal i realise). I need to set the 'gintPrintCopies' to 1 after a print has occurred anywhere within the program otherwise the program can error if the current 'gintPrintCopies' is > 1 and a spreadsheet report is requested by the user. I could set the variable back to 1 after a print job completes but this would mean going through and setting the variable after approx 200 print routines.

The program runs with a main form always loaded so i have tried setting the variable in lost focus, get focus and click events of that form as the user needs to pass through this screen whenever they go to a different report. As some of the print jobs take awhile to collate the data the main screen also acts as a progress bar meaning the form always gets focus but if the variable is resets in get focus the number of copies is changed to 1 prior to the print job being completed.

UTF-8 To Hex To Arabic

$
0
0
Hi dilettante,

I know you've done a lot to explain this but I need just a little help. I've tried your code and managed to get the hex. Now I'm trying to convert the hex to Arabic text again but catching on the exception.

Could you kindly assist with the usage of the CryptBinarytoString function.

Highly appreciate it.

P.S. After a lot of digging on the net I came across your brilliant solution to my problem. Thank you.

VB Project | Condition | Prevent Code After Condition From Running

$
0
0
Hello everyone,

Is there anyway of preventing code that follows a condition from running without actually stopping the program?

It would help a lot for my Sudoku game, if the user submits their solution whilst empty cells in the grid are still present then it will display a message telling them how many cells are still left then stops the execution of the code that comes after.

The 'Stop' statement is not what I'm looking for as that ends up stopping the program, I just want a statement/algorithm that will prevent code from continuing.

Any ideas?


Regards,


Snowy

[RESOLVED] SUM in a query???

$
0
0
Hello programmers
I want to calculate the sum in a numeric field.
I used this query
Code:

sSQL = "select Sum(Total) As TotalSum from transac WHERE date_Transac = #" & Format(Date, "mm/dd/yyyy") & "#"
RS.open sSQL, DB, adOpenStatic, adLockOptimistic

For testing the valididty of the querry I added the following:
Code:

If Not RS.EOF Then
MsgBox "yes"
Else
MsgBox "no"
End If

The result of this query is driving me mad.
The msgbox is always YES even no case matches the query.
If I drop the sum(Total) from the query , the result is perfect.
I get the message NO in case EOF is True and Yes message if EOF is False.
Code:

sSQL = "select * from transac WHERE date_Transac = #" & Format(Date, "mm/dd/yyyy") & "#"
RS.open sSQL, DB, adOpenStatic, adLockOptimistic

Even if I select another item, the result is correct too.
Code:

sSQL = "select Total from transac WHERE date_Transac = #" & Format(Date, "mm/dd/yyyy") & "#"
RS.open sSQL, DB, adOpenStatic, adLockOptimistic

My trouble with Sum(total) seems without explanation.
Thanks for any help.

[RESOLVED] Reset Integer Value

$
0
0
So I've inherited a program that deals with print copies by passing a value throughout the program using a global integer 'gintPrintCopies' this is populated through a textbox in a custom print dialog box whenever a user runs a print routine. The problem i have is some reports give an option to output the report to a spreadsheet. The way the code is written means that the code to either print or create a spreadsheet is within the loop to print the x amounts of copies (not ideal i realise). I need to set the 'gintPrintCopies' to 1 after a print has occurred anywhere within the program otherwise the program can error if the current 'gintPrintCopies' is > 1 and a spreadsheet report is requested by the user. I could set the variable back to 1 after a print job completes but this would mean going through and setting the variable after approx 200 print routines.

The program runs with a main form always loaded so i have tried setting the variable in lost focus, get focus and click events of that form as the user needs to pass through this screen whenever they go to a different report. As some of the print jobs take awhile to collate the data the main screen also acts as a progress bar meaning the form always gets focus but if the variable is resets in get focus the number of copies is changed to 1 prior to the print job being completed.

Run-time error '372 - MSCOMCTL.OCX in Windows 7

$
0
0
Hello.

In my program I used mscomctl.ocx control.
In Windows 10 and Windows 8.1 works well
But in Windows 7 I encounter the following error

Code:

* Run-time error '372':

Failed to load control 'ImageList' from MSCOMCTL.OCX. Your version of MSCOMCTL.OCX may be outdated. Make sure you are using the version of the control that was provided with your application.

I searched and I've tried a lot of different solutions, but the problem is not resolved

please guide me
Thanks

Moving a text file to the users desktop (screen)

$
0
0
Hi !

Messing with a VB program, which I' like to conclude by moving a compiled file to the Desktop (screen).

I can certainly move it from the program folder with the

FileSystemObject.MoveFile "File Name", "User\Default\Desktop\File Name"

That works !
But the idea is that even an inexperienced user should easily be able to find the file on the screen and choose to either just read it, or even send it to a printer

But since I don't know any name of the user, I can't send the file to

... "User\User Name\Desktop\File Name"

So how can I formulate my program to be successful?

Grateful for ideas!

/KS

saved listview1 record in record.txt but this method

$
0
0
Hello all,
i saved record in Listview1 in record.txt but this way
Name:  34.JPG
Views: 26
Size:  9.8 KB
when i saved this record suing saved button
On Error Resume Next
With CommonDialog1
.Filter = "Text Files (.txt)|*.txt" ' Filter Dialog Format to Text
.filename = ""
.ShowSave
.DialogTitle = "Save Text File"
If LenB(.filename) = 0 Then ' If File Name is nothing then exit
Exit Sub
End If
Dim filename As String ' decleration
filename = .filename
Open filename For Output As #1
Dim itmSave As Long
For itmSave = 1 To ListView1.ListItems.Count
Print #1, ListView1.ListItems(itmSave) & ","
Next itmSave
Close #1
End With
saved record.txt this record show
Name:  35.JPG
Views: 17
Size:  9.8 KB
but i saved record this way
Name:  35.jpg
Views: 16
Size:  10.4 KB
please how can this
Attached Images
   

[RESOLVED] stuck in listview

$
0
0
Hello everyone
I'm using the following code to populate my listview from access database.
Code:

Sql = "select  Transac, Tarif, Frais, Due FROM TransacTbl"
 Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.open tmpSql, DB, adOpenForwardOnly
    With ListView3.ListItems
        .Clear
        Do
            Dim IsLastChunk As Boolean
            IsLastChunk = GetNextChunk(30, varrkeys, curnumrecords)
            numrecords = numrecords + curnumrecords
            For I = 0 To curnumrecords - 1
                Set itmX = .Add(, , ListView3.ListItems.Count + 1)
                itmX.SubItems(1) = vbNullString & varrkeys(0, I)
                itmX.SubItems(2) = vbNullString & varrkeys(1, I)
                itmX.SubItems(3) = vbNullString & varrkeys(2, I)
                itmX.SubItems(4) = vbNullString & varrkeys(3, I)
              Set itmX = Nothing
              Next
              If IsLastChunk Then Exit Do
              Loop
              End With

The Due field is Boolean.
I'm displaying this field in the listview under the column "Status"
The output I'm getting there: is True or False.
I want to substitute true and false by Due or Undue.
Unfortunately I didn't find a way to do that.
thanks a lot
Viewing all 21128 articles
Browse latest View live


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