|
Quote: the 'language' i use is based on lisp
Unfortunately, I'm not familiar with LISP programming.
Quote: the problem whit basic is that the
operant is not on the same place every time
parsing is a lot easyer that way
Quote:
do you have use for the liberty/just code
than we wil have translated it earlyer ?
And yes, parsing is much easier in this particular case. Since that, just change the algorithm.
Anyway, what you've implemented is *NOT* a genetic algorithm in whatever language you have used.
Quote: do you have use for the liberty/just code
than we wil have translated it earlyer ?
To parse math expressions I would recommend that reverse 'polish notation' algorithm is a good one.
Just give a try to implement it by using LISP, or Liberty BASIC, or VB.NET 2017, or whatsoever. 
Also, I would recommend you to start the development using VB.NET 2017 right from the very beginning, so that there will be no need to rework the code from other languages such LISP or Liberty BASIC.
|
|
|
|
|
Probably, this is a correct solution. Just check it:
Module Module1
Function Compute(expr As String)
Dim Result As Int32 = 0
Dim val As String = ""
Dim op() As String = {"+", "-", "*", "/"}
Dim strings As List(Of String) = New List(Of String)
For index = 0 To expr.Length() - 1 Step 1
If IsNumeric(expr(index)) Then
val = Nothing
Dim done As Boolean = False
While index < expr.Length() And done = False
If IsNumeric(expr(index)) Then
val += expr(index)
index = index + 1
Else done = True
End If
End While
strings.Add(val)
ElseIf expr(index) = op(0) Then
strings.Add(op(0))
ElseIf expr(index) = op(1) Then
strings.Add(op(1))
ElseIf expr(index) = op(2) Then
strings.Add(op(2))
ElseIf expr(index) = op(3) Then
strings.Add(op(3))
End If
Next
Dim n As Int32 = 0
While strings.Contains("*") Or strings.Contains("/")
Dim found As Boolean = False
While n < strings.Count() And found = False
If strings(n) = op(2) Then
Dim op1 As Int32 = Integer.Parse(strings(n - 1))
Dim op2 As Int32 = Integer.Parse(strings(n + 1))
Dim Res = op1 * op2
strings.RemoveAt(n - 1)
strings(n - 1) = Res
strings.RemoveAt(n)
Result = Res
found = True
n = 0
End If
If strings(n) = op(3) Then
Dim op1 As Int32 = Integer.Parse(strings(n - 1))
Dim op2 As Int32 = Integer.Parse(strings(n + 1))
Dim Res = CInt(op1 / op2)
strings.RemoveAt(n - 1)
strings(n - 1) = Res
strings.RemoveAt(n)
Result = Res
found = True
n = 0
End If
n = n + 1
End While
End While
n = 0
While strings.Contains("+") Or strings.Contains("-")
Dim found As Boolean = False
While n < strings.Count() And found = False
If strings(n) = op(0) Then
Dim op1 As Int32 = Integer.Parse(strings(n - 1))
Dim op2 As Int32 = Integer.Parse(strings(n + 1))
Dim Res = op1 + op2
strings.RemoveAt(n - 1)
strings(n - 1) = Res
strings.RemoveAt(n)
Result = Res
found = True
n = 0
End If
If strings(n) = op(1) Then
Dim op1 As Int32 = Integer.Parse(strings(n - 1))
Dim op2 As Int32 = Integer.Parse(strings(n + 1))
Dim Res = op1 - op2
strings.RemoveAt(n - 1)
strings(n - 1) = Res
strings.RemoveAt(n)
Result = Res
found = True
n = 0
End If
n = n + 1
End While
End While
Return Result
End Function
Function Parse(input As String)
Dim t As Int32 = 0
Dim oe(0) As Int32
Dim strings As List(Of String) = New List(Of String)
For index = input.Length() - 1 To 0 Step -1
If input(index) = "(" Or index = 0 Then
Dim sb As String = ""
Dim n As Int32 = 0
If index = 0 Then
n = index
Else n = index + 1
End If
Dim exists As Boolean = False
Do
exists = False
Dim bracket As Boolean = False
While n < input.Length() And bracket = False
If input(n) <> ")" Then
sb += input(n)
Else bracket = True
End If
n = n + 1
End While
If exists <> True Then
Dim r As Int32 = 0
While r < oe.Count() And exists = False
If oe(r) = n Then
exists = True
sb += ") "
n = n + 1
End If
r = r + 1
End While
End If
Loop While exists = True
If exists = False Then
Array.Resize(oe, oe.Length + 1)
oe(t) = n
t = t + 1
End If
strings.Add(sb)
End If
Next
For index = 0 To strings.Count() - 1 Step 1
Dim Result As String = Compute(strings.Item(index)).ToString()
For n = index To strings.Count() - 1 Step 1
strings(n) = strings.ElementAt(n).Replace("(" + strings.Item(index) + ")", Result)
Next
Next
Return Compute(strings.Item(strings.Count() - 1))
End Function
Sub Main()
Dim input As String = "1769 - (40 + 80 / (60 - 1 * 20) + 6) / 15 + 1"
Console.WriteLine(input)
Console.WriteLine("Result = {0}", Parse(input))
Console.ReadKey()
End Sub
End Module
Looking forward to your feedback.
|
|
|
|
|
@ arthur v raz :
nice try
how does parse report a iligal calulation ?
|
|
|
|
|
okey, I'll give a try it later on.
|
|
|
|
|
<pre>Hi,
I am pretty new to VBscripts. I am trying to use a VBscript to copy calendar entries from an excel spreadsheet into an Outlook Calendar. I have found on forums this script below:
Dim objExcel, objWorkbook
Dim objOutlook, objNameSpace, objFolder, foundItems, objAppt
Dim i, j, strFilter
Const olFolderCalendar = 9
Set objExcel = CreateObject("Excel.Application")
objExcel.Application.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open("C:\VBATest\Dates.xlsx")
objExcel.Application.Visible = False
'objExcel.ActiveWorkbook.Save'
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderCalendar)
For i = 1 To 3
j = 1
While j > 0
strFilter = "[Start] >= 'objWorkbook.Worksheets(i).Cells(4,2)' AND [Start] <= 'objWorkbook.Worksheets(i).Cells(4,3)' AND [Subject = 'objWorkbook.Worksheets(i).Cells(6,j)'"
Set foundItems = objFolder.Items.Restrict(strFilter)
Set foundItems = objFolder.Items.Restrict(strFilter)
If foundItems.Count = 1 Then foundItems.Item.Delete
Set objAppt = objFolder.Items.Add
With objAppt
.Subject = "objWorkbook.Worsheets(i).Cells(6,j)"
.Body = "objWorkbook.Worsheets(i).Cells(6,j)"
.Start = "objWorkbook.Worsheets(i).Cells(7,j)"
.AllDayEvent = True
.ReminderMinutesBeforeStart = 1440
.Save
End With
Set j = j + 1
If objWorkbook.Worksheets(i).Cells(6, j) = "stop" Then Set j = 0
If objWorkbook.Worksheets(i).Cells(6, j) = "stop" Then j = 0
Wend
Next
objWorkbook.Close False
Set objExcel = Nothing
Set objWorkbook = Nothing
Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objFolder = Nothing
Set objAppt = Nothing
but I get the below error:
Error on line 20: Cannot parse condition. Error at "[Subject = 'objWorkbook.Worksheets(i).Ce...".
Code 80020009.
Any ideas how I can resolve this?</pre>
|
|
|
|
|
Have you took a look at/with the debugger to see what is (perhaps) missing ?
From where have you got this code-line :
strFilter = "[Start] >= 'objWorkbook.Worksheets(i).Cells(4,2)' AND [Start] <= 'objWorkbook.Worksheets(i).Cells(4,3)' AND [Subject = 'objWorkbook.Worksheets(i).Cells(6,j)'"
|
|
|
|
|
You dont need the quotes in these lines and you have misspelled Worksheets as Worsheets
.subject = "objWorkbook.Worsheets(i).Cells(6,j)"
.Body = "objWorkbook.Worsheets(i).Cells(6,j)"
.Start = "objWorkbook.Worsheets(i).Cells(7,j)"
Change them to:
.Subject = objWorkbook.Worksheets(i).Cells(6,j)
.Body = objWorkbook.Worksheets(i).Cells(6,j)
.Start = objWorkbook.Worksheets(i).Cells(7,j)
=========================================================
I'm an optoholic - my glass is always half full of vodka.
=========================================================
|
|
|
|
|
... and Start and Subject are used before they are assigned ...
|
|
|
|
|
In addition to the answer above, your filter is wrong. You're missing the closing ] around Subject, and you're searching for the literal string objWorkbook.Worksheets(i).Cells(6,j) rather than the value of that cell.
strFilter = "[Start] >= '" & objWorkbook.Worksheets(i).Cells(4,2) & "' AND [Start] <= '" & objWorkbook.Worksheets(i).Cells(4,3) & "' AND [Subject] = '" & objWorkbook.Worksheets(i).Cells(6,j) & "'"
"These people looked deep within my soul and assigned me a number based on the order in which I joined."
- Homer
|
|
|
|
|
Dim objExcel, objWorkbook
Dim objOutlook, objNameSpace, objFolder, foundItems, objAppt
Dim i, j, strFilter
Const olFolderCalendar = 9
Set objExcel = CreateObject("Excel.Application")
objExcel.Application.DisplayAlerts = False
Set objWorkbook = objExcel.Workbooks.Open("C:\VBATest\Dates.xlsx")
objExcel.Application.Visible = False
'objExcel.ActiveWorkbook.Save'
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderCalendar)
For i = 1 To 3
j = 1
While j > 0
strFilter = "[Start] >= '" & objWorkbook.Worksheets(i).Cells(4,2) & "' AND [Start] <= '" & objWorkbook.Worksheets(i).Cells(4,3) & "' AND [Subject] = '" & objWorkbook.Worksheets(i).Cells(6,j) & "'"
Set foundItems = objFolder.Items.Restrict(strFilter)
Set foundItems = objFolder.Items.Restrict(strFilter)
If foundItems.Count = 1 Then foundItems.Item.Delete
Set objAppt = objFolder.Items.Add
With objAppt
.Subject = objWorkbook.Worksheets(i).Cells(6,j)
.Body = objWorkbook.Worksheets(i).Cells(6,j)
.Start = objWorkbook.Worksheets(i).Cells(7,j)
.AllDayEvent = True
.ReminderMinutesBeforeStart = 1440
.Save
End With
Set j = j + 1
If objWorkbook.Worksheets(i).Cells(6, j) = "stop" Then Set j = 0
If objWorkbook.Worksheets(i).Cells(6, j) = "stop" Then j = 0
Wend
Next
objWorkbook.Close False
Set objExcel = Nothing
Set objWorkbook = Nothing
Set objOutlook = Nothing
Set objNameSpace = Nothing
Set objFolder = Nothing
Set objAppt = Nothing
I now get the error Line 20 Error: Condition is not valid.
Any ideas?
|
|
|
|
|
Probably a problem with your date formats:
Filtering Items Using a Date-time Comparison[^]
NB: That uses VBA's Format function, which isn't availble in VBScript. You'll need to use FormatDateTime[^] instead:
Dim minDate, maxDate
minDate = FormatDateTime(objWorkbook.Worksheets(i).Cells(4,2), 0)
maxDate = FormatDateTime(objWorkbook.Worksheets(i).Cells(4,3), 0)
For i = 1 To 3
j = 1
While j > 0
strFilter = "[Start] >= '" & minDate & "' AND [Start] <= '" & maxDate & "' AND [Subject] = '" & objWorkbook.Worksheets(i).Cells(6,j) & "'"
...
"These people looked deep within my soul and assigned me a number based on the order in which I joined."
- Homer
|
|
|
|
|
I need to load some icons in jp2 format into an ImageList.
I searched online for a solution, but everything I've found is out of date (I'm using Visual Studio VB 2017.)
There's a free DLL called "FreeImage" for reading & converting image formats, but all VB/.Net code is out of date and the documentation sux rocks. (Images as loaded as "Long" values???)
I've resorted to a simple CLI utility called "ImageMagick" that can I can call from VB to convert jp2's to png's that I can then load normally. This works, but is much too slow if you have a lot of files.
I don't need to manipulate the images in any way, and don't need to save them. I only need to be able to load them.
TIA
|
|
|
|
|
Message Removed
modified 6-Mar-18 16:02pm.
|
|
|
|
|
When i click browse button instead of opening document folder, It should open as per configured path.
Can some one please help me.
|
|
|
|
|
|
<pre lang="text">I am using WebClient.UploadFile to upload local files to a Hostmonster web server. I have code that downloads files from my website correctly but I am new to uploading. If doesn't seem very difficult but I just can't get it to work. I have basically copied the vb.net code from https://msdn.microsoft.com/en-us/library/36s52zhs(v=vs.110).aspx. I am using server side code located in the same folder that the file is being transferred to, referred to as Upload.net and listed below.
<%@ Import Namespace="System"%>
<%@ Import Namespace="System.IO"%>
<%@ Import Namespace="System.Net"%>
<%@ Import NameSpace="System.Web"%>
<Script language="VB" runat=server>
Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs)
Dim f As String
Dim file
For Each f In Request.Files.AllKeys
file = Request.Files(f)
file.SaveAs(Server.MapPath("~/data/" & file.FileName)
Next f
End Sub
</Script>
<html>
<body>
<p> Upload complete. </p>
</body>
</html>
Function TestWcWrite()
Dim LoginUser As String = "testuser"
Dim UserPassword As String = "testpass"
Dim UrlLicensePath As String = "http://www.xxx.com/data/"
Using wc As New System.Net.WebClient()
ServicePointManager.ServerCertificateValidationCallback =
New System.Net.Security.RemoteCertificateValidationCallback(AddressOf CertificateValidation)
wc.Credentials = New System.Net.NetworkCredential(LoginUser, UserPassword)
Dim responseArray As Byte() = wc.UploadFile(UrlLicensePath & "upload.net", "POST", "C:\temp\test.txt")
Console.WriteLine(ControlChars.Cr & "Response Received.The contents of the file uploaded are: " &
ControlChars.Cr & "{0}", System.Text.Encoding.ASCII.GetString(responseArray))
wc.Dispose()
End Using
End Function
The folder I am loading to is password protected and the permissions are set to 777 at this point. I was using Https originally so that is why the RemoteCertificateValidationCallback is in the code. Anyway when I execute the code, the file isn't copied and the response returned is the contents of upload.net file. What am I missing here? Obviously it is something minor.
Thanks for your help,
Bob
|
|
|
|
|
In an existing vb.net 2010 desktop application, I have users that would like all the screens to be larger since some of them say the cannot see the screens.
Thus is there something like a 'zoom' enlarge feature that can be added to the application without having to enlarge all the screens in the application? If so, can you tell me how to accomplish this goal?
If not, would you tell me that also?
|
|
|
|
|
Even better; Windows has some tools built-in to help people with visual limitations, including a magnifier[^]. If that doesn't help them enough, you could change the DPI-setting and/or change the color-scheme to a high-contrast version.
Bastard Programmer from Hell 
If you can't read my code, try converting it here[^]
|
|
|
|
|
The problem is the user has no problems with the other applications. They only want application size to be increased.
|
|
|
|
|
This is usually not a problem that a user has "per application"; sorry, but can't help there.
Bastard Programmer from Hell
If you can't read my code, try converting it here[^]
|
|
|
|
|
The first thing you need to do is to look at your GUI design to see why the "screens" (not sure what you mean by that) are so small that users cannot see them.
|
|
|
|
|
Hi All.
I Want to use VBA code to get data from Oracle DB The code is here but I fail
Const IPServer = "123.168.YY.XXX" ' Server hosting the Oracle db
Const DBNAME = "NMS" '"DatabaseName"
Const ORACLE_USER_NAME$ = "user"
Const ORACLE_PASSWORD$ = "pass"
Const port = "1521"
Sub ConnectTOOracle()
Dim oRs As ADODB.Recordset
Dim oCon As ADODB.Connection
Set oCon = New ADODB.Connection
Dim mtxData As Variant
Dim strConOracle As String
strConOracle = "Driver={Microsoft ODBC for Oracle}; CONNECTSTRING=(DESCRIPTION=(ADDRESS=(PROTOCOL=TCP) "
strConOracle = strConOracle & "(HOST=" & IPServer & ")(PORT=port))(CONNECT_DATA=(SERVICE_NAME=" & DBNAME
strConOracle = strConOracle & "))); uid=" & ORACLE_USER_NAME & " ;pwd=" & ORACLE_PASSWORD & ";"
oCon.Open strConOracle
'Cleanup in the end
Set oRs = Nothing
Set oConOracle = Nothing
End Sub
Please help.
|
|
|
|
|
hmanhha wrote: but I fail
Yes, you fail to tell us what the problem is. However, looking at your code I get the feeling that
")(PORT=port))(CONNECT_DATA=(SERVICE_NAME="
is not correct. Probably should be:
")(PORT=" & port & "))(CONNECT_DATA=(SERVICE_NAME="
|
|
|
|
|
Thanks.
I have modify it.
But the problem the same.
Run-Time error '-2147467259 (80004005':
[Microsoft][ODBC Driver manager] Driver's SQLAllocHandle on SQL_HANDLE_ENV failed.
And warning
Microsoft ODBC for Oracle.
The Oracle (tm) client and networking componets were not found.
These components are supplied by Oracle......
|
|
|
|
|
Plug the warning into google and you will find there are some components you need to source from oracle, just like the warning says.
Never underestimate the power of human stupidity
RAH
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
