VB6 Error :Object variable or with block variable not set - vb6

I get this
"Object variable or with block variable not set" inside 'dblog' sub function
in this line , I guess its with 'm_Session'
If iType >= Int(m_Session("_SysParam_LogLevel")) Then
My Code
Private m_Session As ASPTypeLibrary.Session
Public Function InitializeSite(Optional intCheckMode As Integer = 0) As Boolean
InitializeSite = False
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
DBLog "Initializing started - "
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = DBConnection
end with
end function
Public Sub DBLog(ByVal sTxt As String, Optional ByVal iType As Integer = 0, Optional ByVal sCategory As String = "DEBUG")
'On Error Resume Next
Dim cmd As ADODB.Command
If iType >= Int(m_Session("_SysParam_LogLevel")) Then
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = DBConnection
End With
End If
Set cmd = Nothing
On Error GoTo 0
End Sub
Property Get DBConnection() As String
DBConnection = IIf(Not IsNull(m_Session("_SysParam_DBConnection")), m_Session("_SysParam_DBConnection"), "")
End Property
Please help me moving forward.

Function InitializeSite should also initialize variable m_Session before calling DBLog sub, or you could modify code in DBLog sub adding
If m_Session Is Nothing Then Exit Sub
at the beginning.
Or you could initialize variable m_Session adding this sub to your class
Public Sub OnStartPage(SC As ASPTypeLibrary.ScriptingContext)
Set m_Session = SC.Session
End Sub
Take a look at How to share ASP classic session variable from ASP to VB6?

Try to replace your first line of code with:
Private m_Session As new ASPTypeLibrary.Session

Related

BC42104 error code how can I fix this error?

Warning BC42104: Variable 'pass' is used before it has been assigned a value. A null reference exception could result at runtime.
This is my code:
Private Sub btnLogin_Click(sender As Object, e As EventArgs) Handles btnLogin.Click
Dim uname As String = ""
Dim pword As String
Dim username As String = ""
Dim pass As String
If TextBox1.Text = "" Or TextBox2.Text = "" Then
MsgBox("Please fill the info")
Else
uname = TextBox1.Text
pword = TextBox2.Text
Dim query As String = "Select Password From Register where Username= '" & uname & "';"
Dim dbsource As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Gui\Documents\Database4.accdb"
Dim conn = New OleDbConnection(dbsource)
Dim cmd As New OleDbCommand(query, conn)
conn.Open()
Try
pass = cmd.ExecuteScalar().ToString
Catch ex As Exception
MsgBox("Username does not exit")
End Try
If (pword = pass) Then
MsgBox("Login success")
Reg.Show()
If Reg.Visible Then
Me.Hide()
End If
Else
MsgBox("login Failed")
TextBox1.Clear()
TextBox2.Clear()
End If
End If
End Sub
As the error is saying, you are not initializing the variable pass and under some condition, you may end up with using it.
To be exact, if the control lands in the 'catch' block, the variable 'pass' will not have any values, which means it is possible that If (pword = pass) statement is reached without this variable having any values.
To fix the error, just assign a null value or empty string to the variable at the point of initialization. For example use this statement:
Dim pass As String = "";

Sub or Function is not defined vb6

Why am I getting an error "Sub or Function is not defined"...Here is my code
FORM2
Option Explicit
Public Report As New CrystalReport1
Public mvCn As New ADODB.Connection
Public Function printReport()
Dim strConnectionString As String
Dim rs As ADODB.Recordset
Dim strScript As String
strConnectionString = "Provider=SQLOLEDB............"
mvCn.ConnectionString = strConnectionString
mvCn.CommandTimeout = 0
mvCn.CursorLocation = adUseClient
mvCn.Open
strScript = strScript & "SELECT * FROM employee" & vbCrLf
Set rs = mvCn.Execute(strScript)
Report.Database.SetDataSource rs
Report.AutoSetUnboundFieldSource crBMTNameAndValue
CRViewer1.ReportSource = Report
CRViewer1.ViewReport
Set Report = Nothing
End Function
Form 1.....Call my function "printReport" here
Option Explicit
Private Sub Command1_Click()
printReport
End Sub
The error message goes here "Private Sub Command1_Click()"
Where is your printReport function defined? If it's in a class module, then you need to instantiate an instance of the class then call printReport as a method of that class. For instance:
Private Sub Command1_Click()
Dim oClass As New Class1
oClass.printReport
End Sub
Or you can place your printReport function in a module, then you don't instantiate it or call it as a method - you would instead call it as you have in your click event.
A procedure can be called in such a simple way.[As you have called is correct]
Eg.
Private Sub Form_Load()
Test1
End Sub
Sub Test1()
MsgBox "Test1"
End Sub

Check a recordset for an empty field

I'm trying to pre-view if a field of the recordset is empty/null or not.
If IsNull(rs.Fields("fieldname")) = True Then ...
If IsNull(rs.Fields("fieldname")).Value = True Then ...
if IsNull(rs.Fields("fieldName").Value) Then...
All of these methods fires up an error... Why? How may I check if the recordset is null before I assign it's value to a variable.
If I understand correctly, you want to ensure that a field exists in the recordset. If that is correct, you need to either iterate the fields looking for the field you are searching for, or try to directly access the field and trap any errors. Here is a method that iterates the field collection and returns True if the field exists.
Public Function FieldExists(ByVal rsRecSet As ADODB.Recordset, ByVal FieldName As String) As Boolean
Dim fld As ADODB.Field
Dim Rtn As Boolean
If Not rsRecSet Is Nothing Then
For Each fld In rsRecSet.Fields
If StrComp(fld.Name, FieldName, vbTextCompare) = 0 Then
Rtn = True
Exit For
End If
Next fld
End If
FieldExists = Rtn
End Function
Here is a way to print out the columns of a table.
Dim cat
Set cat = CreateObject("ADOX.Catalog")
Set cat.ActiveConnection = db 'db is the adodb.connection object
Dim tbl
Dim clm
For Each tbl In cat.Tables
For Each clm In tbl.Columns
Debug.Print (clm) ' Prints the column name from the table
Next
Next
Try using IsDbNull() instead. DbNull is different than Null.
Edit, just loop through the field names and have a boolean if it found it, otherwise use a try catch structure.
For Each field in rs.Fields
if field.Name = "someFieldName" then
foundField = true
exit for
else
foundField = false
end if
next
I'm using AtValue and AtField helpers like this
Option Explicit
Private Sub Form_Load()
Dim rs As Recordset
If IsEmpty(AtValue(rs, "Test")) Then
Debug.Print "Field is Empty or non-existant"
End If
If LenB(C2Str(AtValue(rs, "Test"))) = 0 Then
Debug.Print "Field is Null, Empty, empty string or non-existant"
End If
'-- this will never fail, even if field does not exist
AtField(rs, "Test").Value = 42
End Sub
Public Function AtValue(rs As Recordset, Field As String) As Variant
On Error GoTo QH
AtValue = rs.Fields(Field).Value
Exit Function
QH:
' Debug.Print "Field not found: " & Field
End Function
Public Function AtField(rs As Recordset, Field As String) As ADODB.Field
Static rsDummy As Recordset
On Error GoTo QH
Set AtField = rs.Fields(Field)
Exit Function
QH:
' Debug.Print "Field not found: " & Field
Set rsDummy = New Recordset
rsDummy.Fields.Append Field, adVariant
rsDummy.Open
rsDummy.AddNew
Set AtField = rsDummy.Fields(Field)
End Function
Public Function C2Str(Value As Variant) As String
On Error GoTo QH
C2Str = CStr(Value)
QH:
End Function
My type-casting helpers are actually using VariatChangeType API (so to work with Break on all errors setting) like this
Public Function C_Str(Value As Variant) As String
Dim vDest As Variant
If VarType(Value) = vbString Then
C_Str = Value
ElseIf VariantChangeType(vDest, Value, VARIANT_ALPHABOOL, VT_BSTR) = 0 Then
C_Str = vDest
End If
End Function
rs.EOF flag will tell whether RecordSet is Empty or not
If Not rs.EOF Then
..Your desired logic..
End If

Connection String in Textbox

I'am new in programming and my problem is. i have put my ado db connection string into a text box how can i call that text box? i'm creating my program in vb 6 and here's my code.
Private Sub lvButtons_H2_Click()
On Error GoTo errtrap
If Label47.Caption = "True" Then
MsgBox "INITIAL SETTING FOR SHIP ACCOUNT IS BEING PERFORMED", vbOKOnly, "ABORT"
Exit Sub
End If
Dim conas As New ADODB.Connection, rs01 As New ADODB.Recordset, rsx1 As New ADODB.Recordset, RS9 As New ADODB.Recordset
conas.Connectio`enter code here`nString = Text1155.Text
conas.Open
Set RS9 = New ADODB.Recordset
RS9.ActiveConnection = conas
RS9.CursorType = 3
RS9.LockType = 3
RS9.Open ("SELECT * FROM [SHIPACCOUNT].[dbo].[SPARE PART LIST BOND 29 MONTHLY] WHERE NAMECODE = " & Text2.Text & "")
Set DataReport2.DataSource = RS9
DataReport2.Sections("Section2").Controls.item("LABEL12").Caption = Text1.Text
DataReport2.Sections("Section2").Controls.item("LABEL11").Caption = Text3.Text
DataReport2.Sections("Section1").Controls.item("TEXT1").DataField = RS9![PARTSNAME].Name
DataReport2.Sections("Section1").Controls.item("TEXT2").DataField = RS9![Price].Name
DataReport2.Sections("Section1").Controls.item("TEXT3").DataField = RS9![unit].Name
DataReport2.Sections("Section1").Controls.item("TEXT4").DataField = RS9![QTYAPPLY].Name
DataReport2.Sections("Section1").Controls.item("TEXT5").DataField = RS9!QTYAPPROVE.Name
DataReport2.Sections("Section1").Controls.item("TEXT6").DataField = RS9![AMOUNTAPPROVE].Name
DataReport2.Sections("Section1").Controls.item("TEXT7").DataField = RS9![Date].Name
DataReport2.Show 1
Exit Sub
errtrap:
MsgBox Err.Description, vbCritical, "The system encountered an error"
End Sub
You can pass the connection string as parameter to the Connection.Open method
Such as (assuming the name of the textbox is Text1155):
Dim conas As New ADODB.Connection
conas.Open Text1155.Text
(You don't need parenthesis for calling a Sub in vb6)
Your code looks right otherwize...

problem with .net windows service

have written a windows service. while the code worked for a simple form app, its not working in a windows service. here;s the code
Imports System.Text.RegularExpressions
Imports System.Net.Sockets
Imports System.Net
Imports System.IO
Public Class Service1
Public Shared Function CheckProxy(ByVal Proxy As String) As Boolean
Dim myWebRequest As HttpWebRequest = CType(WebRequest.Create("http://google.com"), HttpWebRequest)
myWebRequest.Proxy = New WebProxy(Proxy, False)
myWebRequest.Timeout = 10000
Try
Dim myWebResponse As HttpWebResponse = CType(myWebRequest.GetResponse(), HttpWebResponse)
Dim loResponseStream As StreamReader = New StreamReader(myWebResponse.GetResponseStream())
Return True
Catch ex As WebException
If (ex.Status = WebExceptionStatus.ConnectFailure) Then
End If
Return False
End Try
End Function
Protected Overrides Sub OnStart(ByVal args() As String)
System.IO.File.AppendAllText("C:\AuthorLog.txt",
"AuthorLogService has been started at " & Now.ToString())
MsgBox("1")
Timer1.Enabled = True
End Sub
Protected Overrides Sub OnStop()
' Add code here to perform any tear-down necessary to stop your service.
Timer1.Enabled = False
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
MsgBox("2")
' Check if the the Event Log Exists
If Not Diagnostics.EventLog.SourceExists("Evoain Proxy Bot") Then
Diagnostics.EventLog.CreateEventSource("MyService", "Myservice Log") ' Create Log
End If
' Write to the Log
Diagnostics.EventLog.WriteEntry("MyService Log", "This is log on " & _
CStr(TimeOfDay), EventLogEntryType.Information)
Dim ProxyURLList As New Chilkat.CkString
Dim ProxyListPath As New Chilkat.CkString
Dim WorkingProxiesFileData As New Chilkat.CkString
Dim ProxyArray(10000000) As String
Dim event1 As New Chilkat.CkString
event1.setString("started")
event1.saveToFile("B:\serv.txt", "utf-8")
Dim ns As Integer = 0
'Read Configuration File
Dim sFileName As String
Dim srFileReader As System.IO.StreamReader
Dim sInputLine As String
sFileName = "config.ini"
srFileReader = System.IO.File.OpenText(sFileName)
sInputLine = srFileReader.ReadLine()
Dim temp As New Chilkat.CkString
Do Until sInputLine Is Nothing
temp.setString(sInputLine)
If temp.containsSubstring("proxyurllist=") = True Then
'Read Proxy-URL-List
ProxyURLList.setString(sInputLine)
If ProxyURLList.containsSubstring("proxyurllist=") = True Then
ProxyURLList.replaceFirstOccurance("proxyurllist=", "")
End If
ElseIf temp.containsSubstring("finalproxylistpath=") = True Then
'Read Proxy-List-Path
ProxyListPath.setString(sInputLine)
If ProxyListPath.containsSubstring("finalproxylistpath=") = True Then
ProxyListPath.replaceFirstOccurance("finalproxylistpath=", "")
End If
End If
sInputLine = srFileReader.ReadLine()
Loop
'*********Scrape URLs From Proxy-URL-List*********************
Dim ProxyURLFileData As New Chilkat.CkString
ProxyURLFileData.loadFile(ProxyURLList.getString, "utf-8")
Dim MultiLineString As String = ProxyURLFileData.getString
Dim ProxyURLArray() As String = MultiLineString.Split(Environment.NewLine.ToCharArray, System.StringSplitOptions.RemoveEmptyEntries)
Dim i As Integer
For i = 0 To ProxyURLArray.Count - 1
'********Scrape Proxies From Proxy URLs***********************
Dim http As New Chilkat.Http()
Dim success As Boolean
' Any string unlocks the component for the 1st 30-days.
success = http.UnlockComponent("Anything for 30-day trial")
If (success <> True) Then
Exit Sub
End If
' Send the HTTP GET and return the content in a string.
Dim html As String
html = http.QuickGetStr(ProxyURLArray(i))
Dim links As MatchCollection
links = Regex.Matches(html, "[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}:[0-9]{1,5}")
For Each match As Match In links
Dim matchUrl As String = match.Groups(0).Value
ProxyArray(ns) = matchUrl
ns = ns + 1
Next
Next
'*************CHECK URLs*****************
Dim cnt As Integer = 0
For cnt = 0 To 1
Dim ProxyStatus As Boolean = CheckProxy("http://" + ProxyArray(cnt) + "/")
If ProxyStatus = True Then
WorkingProxiesFileData.append(Environment.NewLine)
WorkingProxiesFileData.append(ProxyArray(cnt))
End If
Next
WorkingProxiesFileData.saveToFile(ProxyListPath.getString, "utf-8")
End Sub
End Class
what are the basic thing i cannot do in a windows service? oh, and i am using the chilkat library too..
why can't i use all of my code in OnStart? i did so and the services stops just as it starts.
can i use something else except a timer and put an endless loop?
Running as a windows service typically won't let you see any popup boxes, etc since there's no UI (Unless you check the box to allow interaction with the desktop).
Try adding a Timer1.Start in your OnStart method. Then in your Timer1_Tick method, first thing stop the timer, then at the end start it back up, this way your Tick method won't fire while you're already doing work.
I realize I'm (very) late to this party, but what kind of timer are you using? A System.Windows.Forms.Timer is designed for use in a single threaded Windows Form and will not work in a Windows Service app. Try a System.Timers.Timer instead.

Resources