Winsock downloading files - vb6 - vb6

I'm trying to use Winsock to download some files and save them.
In my case, I have a MSHFlexGrid with 2 columns: one with URL and the other with the "path+filename" (where the file is going to be saved).
I'm iterating through all rows calling the next function:
Public Function DownloadSock(ArqURL As String, ArqDestino As String) As Boolean
'ArqURL is the file URL
'ArqDestino is where the downloaded file is going to be stored, in my hard disc
Dim arquivo() As Byte
Dim ficheiroID As Integer
ficheiroID = FreeFile
On Error GoTo Trata_erro
Open ArqDestino For Binary Access Write As #ficheiroID
Me.Winsock1.Connect ArqURL, 80
Me.Winsock1.GetData arquivo()
Put #ficheiroID, , arquivo()
Close #ficheiroID
DownloadSock = True
Exit Function
Trata_erro:
MDIForm1.Text1 = MDIForm1.Text1 & "Error! " & Err.Number & Err.Description & " - " & Err.Source & " - URL: " & ArqURL & " - Destino: " & ArqDestino & vbNewLine
DownloadSock = False
End Function
I'm getting this error
40006: Wrong protocol or connection
state for the requested transaction or
request
What am I doing wrong?

Have you checked out this Microsoft Support page? It indicates there's a bug in the Winsock control and the hotfix may be helpful.
Another thing to try is to make sure your winsock connection is open before trying to read/send data, and if it is closed, reopen a new connection:
if winsock.state=9 ' error state
winsock.close
while winsock.state<>0 ' closed state
doEvents
wend ' you need a while loop, because it doesn't close "immediately".
end if
' now you reopen it, or do whatever else you need
You might also consider changing your connection code to something like:
With Winsock1
If .State <> sckClosed Then .Close
.RemoteHost = ArqURL
.RemotePort = 80
.Connect
End With
One last thing. Check out this post on using the Winsock control.

I think you have overestimated the power of the Winsock control. You can't just use the Winsock's GetData method to reach out and grab a file. There has to be an active connection between your client application and some other application on the server side. After a connection is established, this server application will feed data to your application, the Winsock's DataArrival event will fire, and then you can use the GetData method to retrieve it. Your code should look more like this:
Public Sub DownloadSock(ArqURL As String)
Dim arquivo() As Byte
Dim ficheiroID As Integer
ficheiroID = FreeFile
Me.Winsock1.Connect ArqURL, 80
End Function
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim ArqDestino As String
Dim arquivo() As Byte
Dim ficheiroID As Integer
ficheiroID = FreeFile
Open ArqDestino For Binary Access Write As #ficheiroID
Me.Winsock1.GetData arquivo()
Put #ficheiroID, , arquivo()
Close #ficheiroID
End Sub
This is far from complete however (nor is it guaranteed to be syntactically correct, consider it pseudo code). After making the connection, you then have to implement some mechanism to tell the server to begin sending the file. If the file is large enough it will take many DataArrival events to get it all, so it will have to be held in an accumulator while the data comes across. There's more to this than you think.
I would take a look at some tutorials and/or sample code (look for a VB6 project that uses the Winsock control on CodeProject, like this one).

Related

Winsock Error 429: activeX component can't create object

So I know that my code below works. The purpose is to create a tcp Ethernet connection between a scale and computer, so that when a weight is read on the scale, the value is displayed on the computer at the push of a button. I copied this code to a new lab machine that was just imaged for me. As for the winsock, I dynamically created it at run-time by adding it to the references. I understand that this is not what I am supposed to do (see: https://support.microsoft.com/en-us/kb/313984).
With a breakpoint at the CFixPicture_Initialize function, the code hits "set tcpC = new Winsock" line and breaks with error 429: avtiveX componenet can't create object. Does anybody have any ideas as to how I can get this license/get this Winsock control to work? Thanks!
Option Explicit
Private WithEvents tcpC As Winsock
Private Sub CFixPicture_Close()
Set tcpC = Nothing
End Sub
Private Sub CFixPicture_Initialize()
Set tcpC = New Winsock
tcpC.LocalPort = 0
tcpC.Connect "192.168.0.1", 8000
End Sub
Private Sub CommandButton1_click()
On Error GoTo errHandler
tcpC.SendData "S" & vbCrLf
Exit Sub
errHandler:
MsgBox "error:" & Err.Description
End Sub
Private Sub tcpC_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Dim strDataString As String
tcpC.GetData strData
strDataTrim = Mid(strData, 11)
Text1.Caption = "Weight: " & vbCrLf
The control is not present or is present but not registered on the new machine.
Copy over mswinsck.ocx from your *system directory to the new machines *system directory
Open a console as admnistrator and run regsvr32.exe c:\whatever\mswinsck.ocx
*\System32 or \SysWoW64 on 64 bit Windows.
As there was no license for the Winsock, I found a license online. I simply ran this program and voila! The Winsock worked. Thanks!
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4860&lngWId=1

Not receiving reply from syringe pump via rs232 using MSComm1.Input

I am trying to communicate with the syringe pump from PC through rs232.
I want to send a string "02DC;50803" to the pump for establishing the communication and pump should reply "C".
I am using MSComm1.Output="02DC;50803" to send the command and Text1.Text=Text1.Text+MSComm1.Input for receiving. When MSComm1.Output executes I am able to see a LED blinking on the end device but there is no reply using MSComm1.input.
Please help me out with this problem and if I put these instruction under MSComm() control, it seems to be dead.
There could be a number of problems here.
For example:
your cable could be broken
your serial port may not be functioning - I see that a lot
Your command is malformed
the pump simply doesn't expect to reply to the command you are sending
Those last 2 might be unlikely, the pump will probably reply to everything you fire at it - all the ones I have here sure answer back.
Really need a lot more information to help you.
What make/model pump?
Manual for the pump so that your commands can be checked.
Have you connected to the pump with an existing software package? - if there is one.
P.S. My software won't support your pump; I don't recognize those commands.
To continue the list from timb:
Are you using the correct baudrate?
What are the settings of .RThreshold and .SThreshold?
Are the other comport settings correct (usually N,8,1 but there are exceptions)?
Did you try the command using hyperterminal and get the expected reply?
Where in your code do you read MSComm1.Input? in Which event?
Does the device have a led as well which blinks it is when sending data? does it blink?
Does the command need an end-char like vbCrLf or vbCr of anything else?
Please post the complete code of the function/sub where you send the command, and please post the complete code of the function/sub where you read MSCOmm1.Input
Have a look at the following testproject in which I send the "AT" command to my modem which is connected to commport 1 and with which I communicate at baudrate 9600:
'1 form with:
' 1 textbox control : name=Text1
' 1 command button : name=Command1
' 1 MSComm control : name=MSComm1
Option Explicit
Private Sub Command1_Click()
MSComm1.Output = "at" & vbCrLf
End Sub
Private Sub Form_Load()
With MSComm1
If .PortOpen Then .PortOpen = False
.Settings = "9600,n,8,1"
.CommPort = 1
.RThreshold = 1 'read data per char
.SThreshold = 0 'send all data at once
.PortOpen = True
End With 'MSComm1
End Sub
Private Sub Form_Resize()
Dim sngWidth As Single
Dim sngCmdHeight As Single
Dim sngTxtHeight As Single
sngWidth = ScaleWidth
sngCmdHeight = 315
sngTxtHeight = ScaleHeight - sngCmdHeight
Text1.Move 0, 0, sngWidth, sngTxtHeight
Command1.Move 0, sngTxtHeight, sngWidth, sngCmdHeight
End Sub
Private Sub MSComm1_OnComm()
Dim strData As String
With MSComm1
Select Case .CommEvent
Case comEvReceive
strData = .Input
ShowData strData
End Select
End With 'MSComm1
End Sub
Private Sub ShowData(strData As String)
With Text1
.SelStart = Len(.Text)
.SelText = strData
End With 'Text1
End Sub
When I click on Command1 it will send "AT" & vbCrLf and the modem replies with "OK" which is shown in Text1.

VB.net Service Programming and using TCP Sockets

I am having a problem and I was curious if anyone could help me solve it. I took a tutorial for client-server socket programming for VB.NET. I then tried to implement it using a service rather than a program. I understand how it works as a program, but when I try to port it over to a service it doesn't work. When I run the service it starts and stops instantly. It never makes a connection. Unfortunately, I am not that great of VB.net programmer but so far I am liking it a lot for rapid development of programs.
The idea of this service is to:
run when the computer starts
grab the name of the PC
Send the name of the PC to the server
a. the server then takes the name and looks it up in a database
b. returns the time that the client machine is suppose to back up
The client machine then does the math for the current time and the time it’s suppose to backup & put everything in ms.
Then the machine backs up at that specified time by running a dos command to launch the program.
Now to answer a question that I have found common in the forums. Why don't I use task scheduler. Well I did use task schedule and had the server control times to machines that way. However, some computers will go into a dormant state, I would say this dormant state affects 20% of the machines. No this dormant state is not sleep mode and not hibernation. The computers are on and they are react very quickly to mouse movement. I created a service that writes the time to a file on the C:\ and this has always worked. So now I have decided to have a service on the client machine and have it communicate with the server.
I have collected very little information about creating service and network socket programming. Unfortunately, I haven’t found anything that ties the 2 together. I found a vb.net client-server program that does what I want, but I want it as a service not a program. I found a temporary solution with creating files using PSEXEC from the server, but this process is just so umm unsophisticated.
I did the next best thing and I went and reviewed the Microsoft library for sockets and tried to build my own service based on what makes sense. Still nothing works. If you know of any books, resources, have any advice, etc. any help you can give me will be greatly appreciated. Thank you for your assistance.
Below you will find my code. At this point all I care about doing is making the connections between clients and the server. I can go back to figuring out the rest and tweek the code from there.
Mike
Here is the server code I have been playing with:
Imports System.Net.Sockets
Imports System.Net
Imports System.Text
Public Class BackupService
Private Mythread As Threading.Thread
Private clientThread As Threading.Thread
Private listener As New TcpListener(IPAddress.Parse("#.#.#.252"), 8888)
Protected Overrides Sub OnStart(ByVal args() As String)
' Add code here to start your service. This method should set things
' in motion so your service can do its work.
listener.Start() 'Listener for clients
System.IO.File.WriteAllText("C:\test\listener.txt", My.Computer.Clock.LocalTime)
Mythread = New Threading.Thread(AddressOf listenerLoop)
Mythread.Start()
End Sub
Protected Overrides Sub OnStop()
' Add code here to perform any tear-down necessary to stop your service.
Mythread.Abort()
End Sub
Protected Sub listenerLoop()
Dim client As TcpClient = listener.AcceptTcpClient()
Dim networkStream As NetworkStream = client.GetStream
Dim bytes(client.ReceiveBufferSize) As Byte
Dim dataReceived As String
While True
networkStream.Read(bytes, 0, CInt(client.ReceiveBufferSize)) 'Receives data from client and stores it into bytes
dataReceived = Encoding.ASCII.GetString(bytes) 'Encodes the data to ASCII standard
System.IO.File.AppendAllText("C:\test\listener.txt", dataReceived) 'Copies information to text file
Threading.Thread.Sleep(1000)
End While
'Listening for incoming connections
'While True
' If (listener.Pending = False) Then
' System.IO.File.AppendAllText("C:\test\listener.txt", "Sorry, no connection requests have arrived")
' Else
' 'Finds Incoming message and creates a thread for the client-server to pass information'
' clientThread = New Threading.Thread(AddressOf clientConnection)
' clientThread.Start()
' End If
' Threading.Thread.Sleep(1000) 'Let loop/thread sleep for 1 second to allow other processing and waits for clients
'End While
End Sub
'Protected Sub clientConnection()
' Dim client As TcpClient = listener.AcceptTcpClient()
' Dim networkStream As NetworkStream = client.GetStream
' Dim bytes(client.ReceiveBufferSize) As Byte
' Dim dataReceived As String
' Dim datasent As Boolean = False
' While datasent = False 'Continuously loops looking for sent data
' If (networkStream.CanRead = True) Then
' networkStream.Read(bytes, 0, CInt(client.ReceiveBufferSize)) 'Receives data from client and stores it into bytes
' dataReceived = Encoding.ASCII.GetString(bytes) 'Encodes the data to ASCII standard
' System.IO.File.AppendAllText("C:\test\listener.txt", dataReceived) 'Copies information to text file
' datasent = True
' End If
' Threading.Thread.Sleep(1000)
' End While
' networkStream.Close() 'Closes the network stream
' client.Close() 'Closes the client
' clientThread.Abort() 'Kills the the current thread
'End Sub
End Class
Client Code (service):
Imports System.Net.Sockets
Imports System.Net
Imports System.Text
Public Class TestWindowsService
Dim Mythread As Threading.Thread
Protected Overrides Sub OnStart(ByVal args() As String)
' Add code here to start your service. This method should set things
' in motion so your service can do its work.
'clientCommunication()
Mythread = New Threading.Thread(AddressOf KeepCounting)
Mythread.Start()
End Sub
Protected Overrides Sub OnStop()
' Add code here to perform any tear-down necessary to stop your service.
Mythread.Abort()
End Sub
'Protected Sub KeepCounting()
' Dim wait As Integer = 0
' Dim hour As Integer = 0
' Dim min As Integer = 0
' System.IO.File.WriteAllText("C:\test\StartTime.txt", "Start Time: " & My.Computer.Clock.LocalTime)
' Do While True
' hour = My.Computer.Clock.LocalTime.Hour
' If (hour = 1) Then
' min = (My.Computer.Clock.LocalTime.Minute * 60) + 60000
' Threading.Thread.Sleep(min) 'Sleeps for the number of minutes till 2am
' file.FileTime()
' Else
' Threading.Thread.Sleep(3600000) 'Sleeps for 1 hour
' System.IO.File.WriteAllText("C:\test\hourCheck\ThreadTime.txt", "Time: " & My.Computer.Clock.LocalTime)
' End If
' Loop
'End Sub
Protected Sub KeepCounting()
Dim tcpClient As New System.Net.Sockets.TcpClient()
tcpClient.Connect(IPAddress.Parse("#.#.#.11"), 8000)
Dim networkStream As NetworkStream = tcpClient.GetStream()
If networkStream.CanWrite And networkStream.CanRead Then
' Do a simple write.
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes("Is anybody there")
networkStream.Write(sendBytes, 0, sendBytes.Length)
' Read the NetworkStream into a byte buffer.
Dim bytes(tcpClient.ReceiveBufferSize) As Byte
networkStream.Read(bytes, 0, CInt(tcpClient.ReceiveBufferSize))
' Output the data received from the host to the console.
Dim returndata As String = Encoding.ASCII.GetString(bytes)
Console.WriteLine(("Host returned: " + returndata))
Else
If Not networkStream.CanRead Then
Console.WriteLine("cannot not write data to this stream")
tcpClient.Close()
Else
If Not networkStream.CanWrite Then
Console.WriteLine("cannot read data from this stream")
tcpClient.Close()
End If
End If
End If
' pause so user can view the console output
Console.ReadLine()
End Sub
End Class
Client Code (extended Module)
Imports System.Net.Sockets
Imports System.Net
Imports System.Text
Module Client_TCP_Communication
Public Sub clientCommunication()
Dim tcpClient As New System.Net.Sockets.TcpClient()
tcpClient.Connect("127.0.0.1", 8000)
Dim networkStream As NetworkStream = tcpClient.GetStream()
If networkStream.CanWrite And networkStream.CanRead Then
' Do a simple write.
Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes("Is anybody there")
networkStream.Write(sendBytes, 0, sendBytes.Length)
' Read the NetworkStream into a byte buffer.
Dim bytes(tcpClient.ReceiveBufferSize) As Byte
networkStream.Read(bytes, 0, CInt(tcpClient.ReceiveBufferSize))
' Output the data received from the host to the console.
Dim returndata As String = Encoding.ASCII.GetString(bytes)
Console.WriteLine(("Host returned: " + returndata))
Else
If Not networkStream.CanRead Then
Console.WriteLine("cannot not write data to this stream")
tcpClient.Close()
Else
If Not networkStream.CanWrite Then
Console.WriteLine("cannot read data from this stream")
tcpClient.Close()
End If
End If
End If
' pause so user can view the console output
Console.ReadLine()
'Dim clientSocket As New System.Net.Sockets.TcpClient()
'Dim serverStream As NetworkStream
'While True
' serverStream = clientSocket.GetStream()
' Dim outStream As Byte() = System.Text.Encoding.ASCII.GetBytes("Message from client$")
' Dim inStream(1024) As Byte
' Dim returnData As String
' System.IO.File.WriteAllText("C:\test\client\ClientStarted.txt", "Time: " & My.Computer.Clock.LocalTime)
' clientSocket.Connect(IPAddress.Parse("#.#.#.11"), 8999)
' System.IO.File.WriteAllText("C:\test\client\ClientConnected.txt", "Time: " & My.Computer.Clock.LocalTime)
' serverStream.Write(outStream, 0, outStream.Length)
' serverStream.Flush()
' serverStream.Read(inStream, 0, CInt(clientSocket.ReceiveBufferSize))
' returnData = System.Text.Encoding.ASCII.GetString(inStream)
' System.IO.File.WriteAllText("C:\test\client\returnData.txt", "Time: " & returnData)
'End While
End Sub
End Module
To find out why it's starting and then stopping, you might try looking in the Application event log after trying to start the service. Could be running into an error on (or just after) startup that is causing the service to stop.
I ran into that problem when trying to write a similar service--in my case I was trying to auto-detect the IP address to use, and it turns out it was inadvertently selecting my IPv6 loopback address and failing to bind. An error in the event log hinted at this for me.

Example VB6 code for Siemens OPC Client?

I am trying to update an ancient VB6 project to enable communication with a remote OPC Server. I have installed the Siemens toolkit but I am unable to find any useful documentation on how to use it with VB6. (Works with C#)
The application is very simple. I just need to connect to the remote server and write/read single addresses.
I found the DatCon OCX control which I assume handles the communication but all the ServerName values I tried to enter by hand did not work.
Can anyone help?
Add a reference to the DLL or OCX (the seimens toolkit) to your VB6 project and then use the object browser to browse around the exposed objects. You can often times figure out what you need just be doing that.
The C# docs should also provide a wealth of info. If the library is a COM library, you'll use it essentially the same way from VB6.
Since posting, I did make some progress. The following example helped me to get going.
http://support.automation.siemens.com/WW/llisapi.dll?func=cslib.csinfo&objId=25229521&load=treecontent&lang=en&siteid=cseus&aktprim=0&objaction=csview&extranet=standard&viewreg=WW
Here is my current code. It's not much - just makes contact with the server and tries to write a value. I didn't get any further. I started getting COM errors and assumed the installation was bad (I had had problems installing) so I decided to reinstall. It didn't work. Installation was impossible. Waiting for an upgrade from Siemens.
'
' OPC Communication
'
' Paul Ramsden 24.11.2011
'
'
Option Explicit
Option Base 1
Public MyOpcServer As OPCServer
Public ServerHandle As Variant
Private ServerName As String
Private ServerNode As String
Private TestGroup As OPCGroup
Private MyOpcItem As OPCItem
Private IsInitialised As Boolean
Public Sub InitialiseOPC()
On Error GoTo ProcError
IsInitialised = False
Set MyOpcServer = New OPCServer
ServerNode = "xyz.abc.10.101"
ServerName = "OPC.SimaticNET.1"
Dim LocalServers
LocalServers = MyOpcServer.GetOPCServers(ServerNode)
Dim tmp
ServerHandle = ""
For Each tmp In LocalServers
If CStr(tmp) = ServerName Then
Call MyOpcServer.Connect(tmp)
MsgBox MyOpcServer.ServerNode & vbCr & MyOpcServer.ServerName & vbCr & MyOpcServer.ServerState
ServerHandle = tmp
Set TestGroup = MyOpcServer.OPCGroups.Add("TestGroup")
Exit For
End If
Next
If ServerHandle = "" Then
MsgBox "Could not find server " & ServerName & " on " & ServerNode
Else
IsInitialised = True
End If
ProcExit:
Exit Sub
ProcError:
MsgBox Err.Description
Resume ProcExit
End Sub
Private Sub ClearGroup()
Dim handles() As Long
Dim errors() As Long
Call TestGroup.OPCItems.Remove(TestGroup.OPCItems.Count, handles, errors)
End Sub
Public Sub WriteOPC(address As String, value As String)
On Error GoTo ProcError
Call ClearGroup
Set MyOpcItem = TestGroup.OPCItems.AddItem(address, 2011)
MyOpcItem.Write (value)
Exit Sub
ProcError:
MsgBox "Write error! " & Err.Description
End Sub
Public Function ReadOPC(address As String) As String
On Error GoTo ProcError
Call ClearGroup
Set MyOpcItem = TestGroup.OPCItems.AddItem(address, 2011)
Dim value As String
ReadOPC = MyOpcItem.Read
ProcError:
MsgBox "Read error! " & Err.Description
End Function
Public Sub TestOPC()
InitialiseOPC
WriteOPC "SIMATIC 300(1).CPU 315-2 DP.Q0_0TestAusgang1", "1"
End Sub

How to access the database from the other system or server?

Using VB 6
How to access the database from the other system or server?
Code
Cn.ConnectionString = "Provider=Microsoft.jet.oledb.4.0; Data Source=" & _
App.Path & "\DC-CS.MDB"
Cn.Open
I don’t want to give the connection directly in my code, I want to select a connection and *.mdb file from the other system or same system or server.
What type of control I have to use in VB for connection testing and mdb file selection from the other system or server?
First thing I want to select a connection, if connection tested, then I want to select a *.mdb file from other system or server. How can I select a connection and *.mdb file in VB 6.
Please need VB 6 Code Help
You can use the Data Link Properties dialog to define an OLE DB connection string. You can start out by predefining the Provider and other attributes, and then let the user browse for an MDB file and choose it if you have predefined Jet 4.0 as the Provider.
Once this selection has been made you can persist the connection as a .UDL (Universal Data Link) file. UDLs were what replaced DSNs a long, long time ago. I'm amazed they get so little use.
Here is some sample code that lets your program specify a UDL and a default path for the user to browse for an MDB file. If the UDL does not exist, it opens the Data Link Properties dialog so the user can choose an MDB, and lets them Test Connection from that dialog before Oking or Canceling their settings. Once it has the connection fully defined it persists it as a .UDL file and opens the Connection object.
If the UDL file exists it opens the Connection using the specs in the UDL.
The key here is the DbOpenPromptSave() function.
'Requries references to:
' Microsoft ActiveX Data Objects x Library (x >= 2.5)
' Microsoft OLE DB Service Component 1.0 Type Library
Private Function DbOpenPromptSave( _
ByVal Conn As ADODB.Connection, _
ByVal UDLPath As String, _
Optional ByVal MDBSearchStartPath As String = "") As Boolean
'Returns True if user cancels the dialog.
On Error Resume Next
GetAttr UDLPath
If Err.Number Then
'No UDL, we need to prompt the user then create one.
On Error GoTo 0
Dim dlkUDL As MSDASC.DataLinks
Set dlkUDL = New MSDASC.DataLinks
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Persist Security Info=False;" _
& "Jet OLEDB:Engine Type=5;" _
& "Data Source=" & MDBSearchStartPath & "\;" _
& "Window Handle=" & CStr(Me.hWnd)
If Not dlkUDL.PromptEdit(Conn) Then
DbOpenPromptSave = True
Exit Function
End If
'Use a Stream as Unicode writer. Using a relative path to save
'respects the Current Directory of the process.
Dim stmUDL As ADODB.Stream
Set stmUDL = New ADODB.Stream
With stmUDL
.Open
.Type = adTypeText
.Charset = "unicode"
.WriteText "[oledb]", adWriteLine
.WriteText "; Everything after this line is an OLE DB initstring", _
adWriteLine
.WriteText Conn.ConnectionString
.SaveToFile UDLPath, adSaveCreateOverWrite
.Close
End With
Conn.Open
Else
Conn.Open "File Name=" & UDLPath
End If
End Function
Private Function DbActions() As Boolean
'Returns True on cancel.
Dim connDB As ADODB.Connection
Set connDB = New ADODB.Connection
If DbOpenPromptSave(connDB, "sample.udl", App.Path) Then
MsgBox "User canceled!"
DbActions = True
Exit Function
End If
DoDbOperations connDB 'Whatever you need to do until closing.
connDB.Close
End Function
The DbActions() function is simply an example of calling DbOpenPromptSave() to open the database. This function opens the database, calls DoDbOperations() (not shown) to actually work with the open database, and then closes the database Connection.
This example uses a relative path (current directory, usually the same as App.Path) for sample.udl and sets the MDBSearchStartPath (where the Select Access database dialog opens) to App.Path (because this dialog defaults to where the last CommonDialog had been opened).
So in other words...
It looks for/saves the UDL sample.udl in CD (usually App.Path), and the MDB selection dialog opens in App.Path. Whew.
I suppose just passing CurDir$() might have been clearer in this case.
I hope this comes close to what you were requesting, it was a little vague.
The MDB selection subdialog the user opens is pretty much a standard CommonDialog.ShowOpen dialog. The user should be able to browse for the MDB file on any drive including file shares on remote systems.
RBarry is referring to the fact that you can "share" a particular folder on one computer, so that it is accessible to another computer.
If two computers are named computer1 and computer2, then computer2 can share a folder on it's C: drive giving it some name like "sharedfolder". Then computer1 can access that folder using the path "\\computer2\sharedfolder".
If an application on computer1 can't use that path, then you can "map" a drive letter (like F:) to the path "\\computer2\sharedfolder". Then it just looks like the F: drive on computer1.
Share your App.Path to the domain. Then on the other system, point it's App.Path to your share.
If you want to dynamically select your path and/or file, then use the FileOpen dialog/control.
As for code examples, I haven't used real VB6 in almost 5 years, so I do not have any true examples or anyway to make one. The closest I can come is Excel VBA 6.5. Here is an example of a VBA function that I use in Excel to browse for and open an Access database:
Public Function OpenDB() As Boolean
'Open the Database and indicate if successful'
If IsOpen Then
OpenDB = True 'we are already open'
Exit Function
End If
If sFile = "" Then sFile = GetSetting("YourAppName", "History", "DBName")
With Application.FileDialog(msoFileDialogFilePicker)
'specify the file open dialog'
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Access Workbooks", "*.mdb"
.Filters.Add "All Files", "*.*"
.InitialFileName = sFile
.Title = "Open TIP Database"
.Show
If .SelectedItems.Count > 0 Then
sFile = .SelectedItems(1)
Else 'user canceled ...'
OpenDB = False
Exit Function
End If
End With
DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFile
On Error Resume Next
DB.Open
If Err.Number <> 0 Then
MsgBox "Error(" & Err.Number & "): " & Err.Description, vbOKOnly + vbCritical, "Error in OpenDB"
OpenDB = False
Exit Function
End If
'Opened ok, so finsh-up and exit'
OpenDB = True
SaveSetting "YourAppName", "History", "DBName", sFile
End Function
You will have to replace the "Application.FileDialog" with a reference to a VB Forms FileDialog control/component, which you should drop onto your VB from from the toolbox (its actually a component-control, so it's not really visible).
You should expect that it will have some differences because these are GUI features and the VB Forms GUI is radically different from the Excel GUI. So the properties & settings might be different and you'll have to play around with them or look them up in VB Help.
Note: the GetSetting and SaveSetting stuff is just saving the last file name and path used in the registry, so that it can use it as the default location for the next time.

Resources