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

VB6 on Windows 10 x64

$
0
0
Hi,

kindly can you help me, I installed vb6 on Windows 10 x64, using the installer present on this site:

http://nuke.vbcorner.net/Articles/VB...S/Default.aspx

all ok until the system update window that gets stuck ... and I have to stop forcing the shutdown.

Consequently when I start vb6 gives me the registration problems of some components (MSCOMCTL.OCX, etc ...)

How can I fix? thank you.

SetWindowPos-Form disappearing

$
0
0
Hello,

i'm using onTop = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, flags) in order to keep forms always on top of the application in the background (Excel in this case)

The problem is that error messages from my exe or Dialogs from Excel are positioned behind the forms and everything is blocked. Without The SetWindowPos command, passing the focus to Excel makes the form disappear (not minimized!).

I suppose that I am doing something wrong. How can the forms be minimized (and available) or making the messages to appear on top of them?

Thanks

get post info from web page

$
0
0
Possible to intercept the string comand send to server when a button is pressed in a web page?
Tks.

i think...

in the web page are many combobox, and i think when the bottun is pressed the post comend get all info from the item of combobox and send it via POST the request to the server, i need thath!

similar:
http:\server1\...\peram of combobox1&param of combobox2...ecc...

How to cretae Setup

$
0
0
Hi

want to create Setup . Setup should be created such that Database file also should be copied and when setup installed Database also should get installed.

Thanks

Virtual Printer??

$
0
0
Maybe a dumb question but is there such a thing as a virtual printer?

I don't have a physical printer but I would like some way to still use the Print button on applications and have the printed results go to an external file instead of a printer so I can later take it to Staples and have them print it out on paper. Any such way to do this?

[RESOLVED] VB6, Oracle, ADO, & Opening a Recordset

$
0
0
Ok, I'm plugging away at getting VB6 hooked up with Oracle, but I keep stumbling. Here's where I am so far, with working code.

Code:

Option Explicit
'
Dim OraConn As ADODB.Connection
Dim OraRecordset As ADODB.Recordset
'

Private Sub Form_Load()
    '
    Const Provider = "OraOLEDB.Oracle"
    Const User = "MalAdmin"
    Const Pass = "pass"
    Const TnsName = "127.0.0.1/XE"
    '
    Set OraConn = New ADODB.Connection
    OraConn.Provider = Provider
    OraConn.Open TnsName, User, Pass
    '
    Set OraRecordset = New ADODB.Recordset
    OraRecordset.Open "ALL_USERS", OraConn, adOpenDynamic, adLockOptimistic, adCmdTable
    'OraRecordset.Open "SELECT * FROM ALL_USERS", OraConn
   
   
   
    If OraRecordset.RecordCount > 0 Then
        OraRecordset.MoveFirst
        Do
            If OraRecordset.EOF Then Exit Do
            Debug.Print OraRecordset![USERNAME]
            OraRecordset.MoveNext
        Loop
    End If
    '
    OraRecordset.Close
    OraConn.Close
   
    Stop
   
End Sub

The above code works using either "open" method (adOpenDynamic with internally generated SQL query), or directly specifying the query.

Now, here's my problem. Here are some screen-shots of my Oracle database via MS-Access through ODBC. Notice the two tables I've created "Patients" and "Encounters". They can be seen in either the PUBLIC_ALL_TABLES table or the PUBLIC_USER_TABLES table:

Name:  Tables1.jpg
Views: 42
Size:  48.3 KB

Name:  Tables2.jpg
Views: 38
Size:  31.6 KB

As can be seen, I've successfully created two tables using MS-Access and the ODBC connection. I just used ODBC passthrough and a SQL query within MS-Access. I can also successfully open these tables from within Access:

Name:  TablePatients.jpg
Views: 39
Size:  26.0 KB

However, when I try and open, say, this "Patients" table from within VB6, it fails:

Name:  Error2.gif
Views: 38
Size:  5.8 KB

Here's the code I'm using:

Name:  Code2.jpg
Views: 40
Size:  41.9 KB

Notice that the table is now named "Patients" rather than "ALL_USERS" in the line of code that's failing. It worked on the "ALL_USERS" table but fails on the "Patients" table that I created. I'm at a loss.

Is it something to do with specifying the TableSpace?

Is it something to do with specifying the user who created the table? But that doesn't seem right because I'm logged into Oracle through ADO via the same user (although this won't always be the case.

Any help would be greatly appreciated.

Elroy
Attached Images
     

[RESOLVED] problem with progress bar doesn't reset second time

$
0
0
hey,
i Have a progress bar with a timer that when i hit the button using it for 5 seconds
the thing is if i click on the button again it dosnt do nothing why?
and it also dosnt reach to 0
when it is counting down it shows 5 ,4, 3 ,2 ,1 and thats it.
this is the code i am using
Code:

Private Sub Form_Load()
  PrgBarMsg.Visible = True
  Timer1.Interval = 1000
  Timer1.Enabled = False
End Sub

Code:

Private Sub Command6_Click()
    Timer1.Interval = 1000
    PrgBarMsg.Visible = True
    PrgBarMsg.Max = 50
    Timer1.Enabled = True
    lblTimer.Caption = "5"
End Sub

Code:

    Screen.MousePointer = vbHourglass
    LblProcessing.Visible = Not LblProcessing.Visible
    PrgBarMsg.Value = PrgBarMsg.Value + 10
    lblTimer.Caption = CInt(Val(lblTimer.Caption - 1))
    If PrgBarMsg.Value >= PrgBarMsg.Max Then
        Screen.MousePointer = vbNormal
        lblTimer.Caption = "5"
        PrgBarMsg.Visible = True
        Timer1.Enabled = False
    End If

what i am trying to do is to hit the command button and the progress bar need to show duration for 5 seconds counting down and then if i hit the command button again it will do the same thing.

tnx in advanced
salsa
:)

Change (modify) PDF file

$
0
0
I downloaded several PDF files that contain musical scores and on some of them the notes are incorrect. How can I correct these notes and re-write the corrected PDF file

If llResponse = True

$
0
0
I am somewhat new to VB 6.0.

Is there any reason why the following line should be red?

If llResponse = True

The llResponse is Dim As Boolean.
Attached Images
 

Call Data in text box by loop

$
0
0
Name:  Untitled-1.jpg
Views: 32
Size:  26.3 KB
in this image. when i choose shirts , fabric code data should call for each text box and if choose trousers same too. should i write call code for each text box using this code
Code:

Dim cnview As New ADODB.connection
Dim rsview As New ADODB.Recordset

Call connection(cnview, App.Path & "\Seeyou.mdb", "endromida")
'Call connection(cnview, "\\SEEYOU-PC\shared\Seeyou.mdb", "endromida")

Or is there any way to call once for all
Attached Images
 

Tough question: Form 1, 2, and 3

$
0
0
Doing this one all wrong i think.....

I have 3 forms named Form1, Form2, Form3

Now, If I add a Global Integer, say Global f As Integer, to represent for either number 1, 2, or 3,
and somewhere else I do something like (Form & "f").Label1.Caption = "Hello"

This really does not work, but might there be way??

I installed Visual Basic SP6 and then look what happened

$
0
0
hello I am trying to come to grips as to what had happened to my copy of Visual Basic, when I installed SP6b on my system. I have a legal product of Visual Basic and then installed the SP6b updates to the system. I own a CD stamped version of SP4, which I have installed, not so long ago onto the system. Then when installed the SP onto the system, my license was revoked as like the name, the company and also the serial number were removed off the product. Why did that happen and I guess that I have to reinstall Visual Basic and then get a better product of the SP6b. Or even does Microsoft still support the sale of the SP6b product, in a packaged CD, or not still.

!! Thanks in advance !!

[RESOLVED] VB 6 and windows 10

$
0
0
(I know I'm going to get the vb.net crowd rolling their eyes but..)

I dabble around with VB6 and C++5 - are they compatible for win 10

My BDay is coming up on 7-5 and I could request a new laptop...


Thanks for your input

Jeff

Chrome extension connect with vb6

$
0
0
Hello everyone
I can connect as a Chrome extension with vb6.
and only got in c # but I want it in vb6
Code:

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;

namespace ConsoleApplication1
{
    class Program
    {
        static void Main(string[] args)
        {
            while (OpenStandardStreamIn() != null || OpenStandardStreamIn() != "")
            {
                //Console.WriteLine(OpenStandardStreamIn());
                string a;
                a = OpenStandardStreamIn();
                if (a == "") {
                    System.Environment.Exit(0);
                }
                else
                {
                    System.Windows.Forms.MessageBox.Show(a);
                }
               
            }
        }

        private static string OpenStandardStreamIn()
        {
            //Read first four bytes for length information
            System.IO.Stream stdin = Console.OpenStandardInput();
            int length = 0;
            byte[] bytes = new byte[4];
            stdin.Read(bytes, 0, 4);
            length = System.BitConverter.ToInt32(bytes, 0);

            string input = "";
            for (int i = 0; i < length; i++)
                input += (char)stdin.ReadByte();

            return input;
        }
    }
}

my extension:
manifest.json
Code:

{
    // Extension ID: knldjmfmopnpolahpmmgbagdohdnhkik
    "key":"MIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDcBHwzDvyBQ6bDppkIs9MP4ksKqCMyXQ/A52JivHZKh4YO/9vJsT3oaYhSpDCE9RPocOEQvwsHsFReW2nUEc6OLLyoCFFxIb7KkLGsmfakkut/fFdNJYh0xOTbSN8YvLWcqph09XAY2Y/f0AL7vfO1cuCqtkMt8hFrBGWxDdf9CQIDAQAB",
    "name": "Native Messaging Example",
    "version": "1.0",
    "manifest_version": 2,
    "description": "Send a message to a native application.",
    "browser_action": {
    "default_title": "Test Extension",
    "default_popup": "main.html"
    },
    "icons": {
    "128": "icon-128.png"
    },
    "background": {
    "scripts": ["background.js"],
    "persistent": false
    },
    "permissions": [
    "nativeMessaging"
    ]
}

main.js
Code:

// Copyright 2013 The Chromium Authors. All rights reserved.
// Use of this source code is governed by a BSD-style license that can be
// found in the LICENSE file.

var port = null;

var getKeys = function(obj){
  var keys = [];
  for(var key in obj){
      keys.push(key);
  }
  return keys;
}


function appendMessage(text) {
  document.getElementById('response').innerHTML += "<p>" + text + "</p>";
}

function updateUiState() {
  if (port) {
    document.getElementById('connect-button').style.display = 'none';
    document.getElementById('input-text').style.display = 'block';
    document.getElementById('send-message-button').style.display = 'block';
  } else {
    document.getElementById('connect-button').style.display = 'block';
    document.getElementById('input-text').style.display = 'none';
    document.getElementById('send-message-button').style.display = 'none';
  }
}

function sendNativeMessage() {
  message = {"text": document.getElementById('input-text').value};
  port.postMessage(message);
  appendMessage("Sent message: <b>" + JSON.stringify(message) + "</b>");
}

function onNativeMessage(message) {
  appendMessage("Received message: <b>" + JSON.stringify(message) + "</b>");
}

function onDisconnected() {
  appendMessage("Failed to connect: " + chrome.runtime.lastError.message);
  port = null;
  updateUiState();
}

function connect() {
  var hostName = "com.google.chrome.example.echo";
  appendMessage("Connecting to native messaging host <b>" + hostName + "</b>")
  port = chrome.runtime.connectNative(hostName);

  port.onMessage.addListener(onNativeMessage);
  port.onDisconnect.addListener(onDisconnected);
  updateUiState();
}

document.addEventListener('DOMContentLoaded', function () {
  document.getElementById('connect-button').addEventListener(
      'click', connect);
  document.getElementById('send-message-button').addEventListener(
      'click', sendNativeMessage);
  updateUiState();
});

com.google.chrome.example.echo-win.json
Code:

{
    "name": "com.google.chrome.example.echo",
    "description": "Chrome Native Messaging API Example Host",
    "path": "c.exe",
    "type": "stdio",
    "allowed_origins": [
    "chrome-extension://knldjmfmopnpolahpmmgbagdohdnhkik/"
    ]
}

very important call to the host must be recorded in the register example:
install_host.bat
Code:

REG ADD "HKCU\Software\Google\Chrome\NativeMessagingHosts\com.google.chrome.example.echo" /ve /t REG_SZ /d "%~dp0com.google.chrome.example.echo-win.json" /f
someone can help me I would like RECEIVE data vb6.
sorry for my translation
Thank

trying to run some code but it stucks my program why?

$
0
0
hey,
i placed a timer in my main menu that every 20 seconds it will sync some data to outlook
the problem is that when this code is fires it stucks my whole program why?
what is wrong?
the SyncEventsOutllook is in a module
this is my code
Code:

Public Sub SyncEventsOutllook()

    Dim cAppointmentsToDelete As Collection
    Set cAppointmentsToDelete = New Collection
    Dim oOutlook As New Outlook.Application
    Dim oNameSpace As Namespace
    Dim ObjAppointment As Outlook.AppointmentItem
    Dim OcalItems As Items
    Dim AppointmentDate As Date
    Set oNameSpace = oOutlook.GetNamespace("MAPI")
    Set OcalItems = oNameSpace.GetDefaultFolder(olFolderCalendar).Items
    AppointmentDate = #1/1/2001 10:29:00 AM#
    Set ObjAppointment = OcalItems.GetFirst
   
    Do While Not (ObjAppointment Is Nothing)
        If ObjAppointment.Start > AppointmentDate Then
            cAppointmentsToDelete.Add ObjAppointment
        End If
        Set ObjAppointment = OcalItems.GetNext
    Loop

    Do While cAppointmentsToDelete.Count > 0
      Set ObjAppointment = cAppointmentsToDelete(1)
      ObjAppointment.Delete
      cAppointmentsToDelete.Remove 1
    Loop

   
    Dim Rs As New ADODB.Recordset
    Rs.Open "Select * From Event Where StartDateTime > #" & Format(DateAdd("M", -1, Now), "MM/dd/yyyy") & "#", CN
    Do While Not Rs.EOF
      Dim olAppt As Outlook.AppointmentItem
      Set olAppt = oOutlook.CreateItem(olAppointmentItem)
      With olAppt
          .Start = Rs!StartDateTime
          .End = Rs!EndDateTime
          .Subject = Rs!Subject
          .Location = Rs!Location
          .Body = Rs!Body
          .ReminderSet = False
      End With
      olAppt.Save
    Rs.MoveNext
    Loop
    Rs.Close
   
   
   
    'sync eevents
      Dim olNs As Outlook.Namespace
    Dim ol As Outlook.Application
    Dim SyncObjs As Outlook.SyncObjects
    Dim SyncSinglePbject As Outlook.SyncObject
    Set ol = New Outlook.Application
    Set olNs = ol.GetNamespace("MAPI")
    Set SyncObjs = oNameSpace.SyncObjects
        Sleep (5000)

    Dim i As Integer
    For i = 1 To SyncObjs.Count
        Set SyncSinglePbject = SyncObjs.Item(i)
        SyncSinglePbject.Start
    Next
    oOutlook.Quit
End Sub

Code:

Private Sub TmrSyncEvents_Timer()
    Call SyncEventsOutllook
End Sub

any other method will be just find as long it dosnt get stuck
maybe need a function?
i dont know..

tnx in advanced
salsa :)

[RESOLVED] file saved by mshflexgrid

$
0
0
I have a saved MsHflexgrid that looks like below
the 8 stands is for rows
the 12 is columns
what does the 5 stand for Y
8,12,5
"","Entry Date","Reminder Description","Date/Time","Reminder Type","Next Reminder","Open","Delete","Sort","Notifications","Sound","Due Shown"
"Yr20160222150333.rtf","02-22-2016","Melissas Birthday remind 8 days","07-04-2016","Yearly","37 Days","View","X","53280","8:0|:-1|:-1","",""
"Yr20160122064953.rtf","01-22-2016","Sarahs Birthday remind 8 days","07-26-2016","Yearly","59 Days","View","X","84960","8:0|:-1|:-1","",""
"Yr20160122065129.rtf","01-22-2016","jessica died aug 3 1990 remind 2 days","08-03-2016","Yearly","67 Days","View","X","96480","2:0|:-1|:-1","",""
"1d20160122065542.rtf","01-22-2016","renew system mechanic notify 4 days","10-25-2016","No Repeat","150 Days","View","X","216000","4:0|:-1|:-1","",""
"1d20160122065724.rtf","01-22-2016","renew tracphone minutes remind 5 days","12-23-2016","No Repeat","209 Days","View","X","300960","5:0|:-1|:-1","",""
"Yr20160222150152.rtf","02-22-2016","Nicky Birthday remind 8 days","03-01-2017","Yearly","277 Days","View","X","398880","8:0|:-1|:-1","",""
"Yr20160408090546.rtf","04-08-2016","Kristys Birthday 8 days","04-29-2017","Yearly","336 Days","View","X","483840","8:0|:-1|:-1","Yodal|Yes",""

The result is False. Now whhat to do make it a positive True, but then not to display

$
0
0
Hello I am working on a IDE much like Visual Basic is, like now or was before .NET came along. Then the error when you try to input a string value, such as <CLS> or even <CancelError>, then the result is False, inside the RicbTextBox, instead of the input string, of such things even like anything else rather than False. What do I do to make it clear and simple to be the text entry on the line that I wish to write it on. Here is the specific source code as below stating the problem...
Code:

Private Sub rtbCode_Change(Index As Integer)
On Error Resume Next

With UserControl.rtbCode(0)
    .SelStart = 0
    .SelLength = Len(.Text)
    .SelColor = vbRed
End With

For lngPosition = 1 To Len(UserControl.rtbCode(0).Text) + 1
    With UserControl.rtbCode(0)
        .SelStart = lngPosition - 1
        .SelColor = vbBlack
    End With
   
    If lngPosition = Len(UserControl.rtbCode(0).Text) + 1 Then
        strCurrentChar = " "
    Else
        strCurrentChar = Mid(UserControl.rtbCode(0).Text, lngPosition, 1)
    End If
   
    Select Case strCurrentChar
    Case " ", ".", "(", ")", ",", "{", "}", "[", "]", vbCr, vbLf
        If Not strBuffer = "" Then
            If Not blnInsideQuotations Then
                If blnIsComment Then
                    With UserControl.rtbCode(0)
                        .SelStart = lngPosition - (Len(strBuffer) + 2)
                        .SelLength = Len(strBuffer) + 1
                        .SelColor = &H8000&
                    End With
                Else
                    blnWordFound = False
                    For lngKeyWord = 0 To UserControl.lstKeywords.ListCount - 1
                        strKeyWord = UserControl.lstKeywords.List(lngKeyWord)
                        If LCase(strKeyWord) = LCase(strBuffer) Then
                            With UserControl.rtbCode(0)
                                .SelStart = lngPosition - (Len(strBuffer) + 1)
                                .SelLength = Len(strBuffer)
                                .SelColor = vbBlue
                                .SelText = strKeyWord
                            End With
                           
                            blnWordFound = True
                            Exit For
                        End If
                    Next lngKeyWord
                    If Not blnWordFound Then
                    End If
                End If
            End If
        End If
        If strCurrentChar = vbCr Or strCurrentChar = vbLf Then
            blnInsideQuotations = False
            blnIsComment = False
        End If
        strBuffer = ""
    Case "'"
        If Not blnInsideQuotations Then blnIsComment = True
    Case """"
        If Not blnIsComment Then
            blnInsideQuotations = Not blnInsideQuotations
            strBuffer = ""
        End If
    Case Else
        strBuffer = strBuffer + strCurrentChar
    End Select
    DoEvents
Next lngPosition
End Sub

PLEASE HELP, ERROR 3021. Empty recordset

$
0
0
so im trying to open a recordset and put one of the fileds content to the textbox called "tnama"
here is the code:

Code:

Private Sub cnip_click()
Call koneksi
rskaryawan.Open "Select * from karyawan where NIP ='" & cnip & "'", KON

tnama.Text = rskaryawan!namapegawai

"cnip" here is a combobox containing the primary key for a table in mysql called "karyawan". NIP here is the primary key itself. Whenever i run the code, it gives me error 3021. Either bof and eof are true, or the record has been deleted.
the error is on the last line where i attempt to put namapegawai's content into tnama textbox. i already check and compared the fields name in my mysql and in my form, they all match. my deadline is tommorow (monday), please help. Thanks before

Flexgrid: A long word is not wrapping in MSFlexgrid

$
0
0
Hello, unfortunately the MSFlexgrid control doesn't wrap long words, as the following
code sample shows.
Code:

Code sample :

Name:  cropped2.jpg
Views: 18
Size:  4.2 KB
Private Sub Form_Activate()
    DoEvents
    MSFlexGrid1.Height = 1600
    MSFlexGrid1.RowHeight(1) = 800
    MSFlexGrid1.WordWrap = True
    MSFlexGrid1.TextMatrix(1, 1) = "XaaaaaaaaaaaaaaaaaY"
End Sub

So I coded my own wordwrapper function. It needs a TextBox with the "multiline" property
set to "True" and it is using "SendMessage". The wordwrapper is working fine :
Code:

Function wordwrapper(s As String) As String
  Const EM_GETLINECOUNT = &HBA
  Const EM_LINEINDEX = &HBB
  Dim NumOfLines As Long, y As Long, firstCharInThisLine As Long
  Dim firstCharInThisLineOld As Long
    Text1.Text = s
    'getting the number of lines in Text1 :
    NumOfLines = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&)
    For y = 1 To NumOfLines - 1
        firstCharInThisLine = SendMessage(Text1.hwnd, EM_LINEINDEX, y, ByVal 0&)
        wordwrapper = wordwrapper & Mid(Text1, firstCharInThisLineOld _
        + 1, firstCharInThisLine - firstCharInThisLineOld) & vbCrLf
        firstCharInThisLineOld = firstCharInThisLine
    Next
    wordwrapper = wordwrapper & Mid(Text1, firstCharInThisLineOld + 1)
End Function


My problem:
In the thread http://www.vbforums.com/showthread.p...le-long-words) I used the "DrawText"
API to break a single long word like "XaaaaaaaaaaaaaaaaaY" (successfully!).
-My question: How can I write the "DrawText" output to the Flexgrid Cell(1,1) ?
-I want to do this with an API, and I don't want to use MSFlexGrid1.TextMatrix(1, 1) = "XaaaaaaaaaaaaaaaaaY".

The API Viewer is showing eleven different "TextOut" functions.
Name:  cropapiviewer.jpg
Views: 31
Size:  14.2 KB
Attached Images
  

[RESOLVED] ODBC SQLite in VBA not updating through the recordset object.

$
0
0
As described in the title. SQLite in VBA not updating through the ODBC recordset object.

It fails in the cmdAlters Event below.
With the error:

' Query based update failed because the row to update could not be found. '
Code:

Option Explicit
 
' *** Testing in VB6 ***
 
  Dim oConn As ADODB.Connection
  Dim oRec As ADODB.Recordset

Private Sub cmdAlter_Click()
  'oConn.Execute ("UPDATE animals SET NAME = 'Angel Fish' WHERE NAME = 'bob'")
  'oConn.Execute ("INSERT INTO animals (NAME, SIZE, WEIGHT, AREA) VALUES('Zebras',42,64,'Manzanita')")

  oRec.MoveFirst
  oRec!Name = "WOO HOO"
  Call MsgBox(oRec!Name)  ' <== Verified record changed here
 
  oRec.Update  '    <=== Fails here

End Sub

Private Sub cmdOpen_Click()
  Dim sConn As String
 
  sConn = "Driver=SQLite3 ODBC Driver; Database=c:\dbdemos.db3"
 
  Set oConn = New ADODB.Connection
  Set oRec = New ADODB.Recordset
 
  oConn.ConnectionString = sConn
  oConn.Open
 
  Call oRec.Open("SELECT * FROM Animals", oConn, adOpenDynamic, adLockOptimistic)
 
  Set Grid.DataSource = oRec
End Sub

Private Sub cmdClose_Click()
  oRec.Close
  oConn.Close
  Set oRec = Nothing
  Set oConn = Nothing
End Sub

This code works in an Access database why not here?
Viewing all 21856 articles
Browse latest View live


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