I've been trying to figure out how to get the current url to be used by the webbrowser in the following code:
Dim t As String = client.DownloadString("browserurl")
Here is my code so far:
Dim client As New WebClient
Dim t As String = client.DownloadString("browserurl")
Dim p As String = ""
Dim r As New System.Text.RegularExpressions.Regex(p)
Dim v As String = reg.Match(t).Value
I'm trying to parse data from the websites which the webbrowser is visiting.
Related
I have to integrate with a third-party webservice, they send us an example in VB.NET. I have no idea how could I do the same in Delphi. I have the values of "URL_WS", "CERTIFICADO_WS" and "CONFIG_STRING"
VB.NET exemple:
Dim ServiceEndpoint = New EndpointAddress(New Uri(URL_WS),
EndpointIdentity.CreateDnsIdentity(CERTIFICADO_WS)
Dim Binding = New WSHttpBinding()
Binding.Security.Mode = SecurityMode.Message
Binding.Security.Message.ClientCredentialType = MessageCredentialType.UserName
Dim result = New Integracao.IintegracaoClient(Binding, ServiceEndpoint)
result.ClientCredentials.ServiceCertificate.Authentication.CertificateValidationMode =
Security.X509CertificateValidationMode.None
result.ClientCredentials.UserName.UserName = CONFIG_STRING
result.ClientCredentials.UserName.Password = ""
I found this code for find and replace everywhere with VB6 in Word files, however it is early bound.
However I need it for late bound, since my EXE will be used on different systems, thus I can't use the Reference to Word Library.
What my code needs to do is:
Find Red text in all Word files and replace it with hidden font.
I had it working for the main text, but the header also contains red text and also needs to be hidden.
Here is my current code, which does not replace anything anymore.
Private Sub PREP_Click()
Const wdColorRed = 255
Dim oWordApp As Object
On Error Resume Next
Dim fs As Object
Dim rngStory As Object
Dim lngJunk As Long
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim strPathName As String
Dim locFolder As String
locFolder = InputBox("Enter the folder path to the file(s) your want to prepare.", "File Preparation", "Type your path here... Make sure it end with a back slash, e.g. C:\myfiles\")
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "PREP")
Set tFolder = fs.GetFolder(locFolder & "PREP")
Set oWordApp = CreateObject("Word.Application")
Set rngStory = CreateObject("Word.Range")
For Each oFile In oFolder.Files
oWordApp.Visible = False
oWordApp.Documents.Open (oFile.Path)
lngJunk = oWordApp.ActiveDocument.Sections(1).Headers(1).range.StoryType
'Iterate through all story types in the current document
For Each rngStory In oWordApp.ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
With oWordApp.rngStory.Find
oWordApp.rngStory.WholeStory
oWordApp.rngStory.Find.Font.Hidden = True
oWordApp.rngStory.Find.Replacement.Font.Hidden = False
oWordApp.rngStory.Find.Execute Replace:=2
End With
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
strDocName = oWordApp.ActiveDocument.Name
oWordApp.ChangeFileOpenDirectory (tFolder)
oWordApp.ActiveDocument.SaveAs FileName:=strDocName
oWordApp.ChangeFileOpenDirectory (oFolder)
Next oFile
oWordApp.Quit
Set rngStory = Nothing
Set oWordApp = Nothing
End Sub
I think the problem is the rngStory part. Please help!
That code is not early bound Ben. It's late bound.
Dim oWordApp As Object
Set oWordApp = CreateObject("Word.Application")
Is late bound, every where your dealing with Object your dealing with a late binding.
I used Selection instead of Range and it is working now:
Private Sub PREP_Click()
Const wdColorRed = 255
Dim oWordApp As Object
On Error Resume Next
Dim fs As Object
Dim rngStory As Object
Dim myDoc As Object
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim strPathName As String
Dim locFolder As String
locFolder = InputBox("Enter the folder path to the file(s) your want to prepare.", "File Preparation", "Type your path here... Make sure it end with a back slash, e.g. C:\myfiles\")
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "PREP")
Set tFolder = fs.GetFolder(locFolder & "PREP")
Set oWordApp = CreateObject("Word.Application")
For Each oFile In oFolder.Files
oWordApp.Visible = False
oWordApp.Documents.Open (oFile.Path)
oWordApp.ActiveDocument.Sections(1).Headers(1).Range.Select
oWordApp.Selection.WholeStory
oWordApp.Selection.Find.Font.Color = wdColorRed
oWordApp.Selection.Find.Replacement.Font.Hidden = True
oWordApp.Selection.Find.Execute Replace:=2
oWordApp.ActiveDocument.Select
oWordApp.Selection.WholeStory
oWordApp.Selection.Find.Font.Color = wdColorRed
oWordApp.Selection.Find.Replacement.Font.Hidden = True
oWordApp.Selection.Find.Execute Replace:=2
strDocName = oWordApp.ActiveDocument.Name
oWordApp.ChangeFileOpenDirectory (tFolder)
oWordApp.ActiveDocument.SaveAs FileName:=strDocName
oWordApp.ChangeFileOpenDirectory (oFolder)
Next oFile
oWordApp.Quit
Set oWordApp = Nothing
End Sub
i try to extract video ID from youtube using Regex.Match, for example I have www.youtube.com/watch?v=3lqexxxCoDo and i want to extract only 3lqexxxCoDo.
Dim link_vids As Match = Regex.Match(url_comments.Text, "https://www.youtube.com/watch?v=(.*?)$")
url_v = link_vids.Value.ToString
MessageBox.Show(url_v)
how i can extract video id ?, thanks !
Finally got the solution
Dim Str() As String
Str = url_comments.Text.Split("=")
url_v = Str(1)
Private Function getID(url as String) as String
Try
Dim myMatches As System.Text.RegularExpressions.Match 'Varible to hold the match
Dim MyRegEx As New System.Text.RegularExpressions.Regex("youtu(?:\.be|be\.com)/(?:.*v(?:/|=)|(?:.*/)?)([a-zA-Z0-9-_]+)", RegexOptions.IgnoreCase) 'This is where the magic happens/SHOULD work on all normal youtube links including youtu.be
myMatches = MyRegEx.Match(url)
If myMatches.Success = true then
Return myMatches.Groups(1).Value
Else
Return "" 'Didn't match something went wrong
End If
Catch ex As Exception
Return ex.ToString
End Try
End Function
This function will return just the video ID.
you can basically replace "www.youtube.com/watch?v=" with "" using "String.Replace"
MSDN String.Replace
url.Replace("www.youtube.com/watch?v=","")
You can use this expression, in PHP I am using this.
function parseYtId($vid)
{
if (preg_match('%(?:youtube(?:-nocookie)?\.com/(?:[^/]+/.+/|(?:v|e(?:mbed)?)/|.*[?&]v=)|youtu\.be/)([^"&?/ ]{11})%i', $vid, $match)) {
$vid = $match[1];
}
return $vid;
}
I am attempting to bind to a web service at run time and call a simple method to get this code working, and get the above error message when I try to get the reply from the web service. Below is the following code, first how I'm invoking the service:
Public Sub BeginInvoke(invokeCompleted As AsyncCallback)
Dim invoke As New DelegateInvokeService(AddressOf Me.InvokeWebService)
Dim result As IAsyncResult = invoke.BeginInvoke(invokeCompleted, Nothing)
End Sub
Public Function EndInvoke(result As IAsyncResult) As String
Dim asyncResult = DirectCast(result, AsyncResult)
Dim message As ReturnMessage = DirectCast(asyncResult.GetReplyMessage(), ReturnMessage)
Return message.ReturnValue.ToString()
End Function
Public Function InvokeWebService() As String
Try
'Create the request
Dim request As HttpWebRequest = CreateWebRequest()
'write the soap envelope to request stream
Using s As Stream = request.GetRequestStream()
Using writer As New StreamWriter(s)
writer.Write(CreateSoapEnvelope())
End Using
End Using
'get the response from the web service
Dim response As WebResponse = request.GetResponse()
Dim stream As Stream = response.GetResponseStream()
Dim reader As New StreamReader(stream)
Dim str = reader.ReadToEnd()
Return StripResponse(HttpUtility.HtmlDecode(str))
Catch ex As Exception
Return ex.Message
End Try
End Function
Now for building the soap package and web request:
Private Function CreateSoapEnvelope() As String
Dim method As String = "<" & WebMethod & " xmlns=""http://tempuri.org/"">"
Dim params As String = Parameters.Aggregate(String.Empty, Function(current, param) current & "<" & param.Name & ">" & param.Value & "</" & param.Name & ">")
method &= params & "</" & WebMethod & ">"
Dim sb As New StringBuilder(SoapEnvelope)
sb.Insert(sb.ToString().IndexOf("</soap:Body>"), method)
Return sb.ToString()
End Function
Private Function CreateWebRequest() As HttpWebRequest
Dim request As HttpWebRequest = DirectCast(WebRequest.Create(Url), HttpWebRequest)
If WSServiceType = ServiceType.WCF Then
request.Headers.Add("SOAPAction", """http://tempuri.org/" & WCFContractName & "/" & WebMethod & """")
Else
request.Headers.Add("SOAPAction", """http://tempuri.org/" & WebMethod & """")
End If
request.Headers.Add("To", Url)
request.ContentType = "text/xml;charset=""utf-8"""
request.Accept = "text/xml"
request.Method = "POST"
Return request
End Function
The SoapEnvelope variable looks like so:
Private Const SoapEnvelope As String = "<soap:Envelope " & _
"xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " & _
"xmlns:xsd='http://www.w3.org/2001/XMLSchema' " & _
"xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'>" & _
"<soap:Body></soap:Body></soap:Envelope>"
And this is how I'm calling the above invoking:
Protected Sub GoButtonClick(sender As Object, e As EventArgs) Handles GoButton.Click
_oClient = New SoapClient()
Dim params As New List(Of SoapClient.Parameter)
params.Add(New SoapClient.Parameter() With {.Name = "str", .Value = "Richard"})
With _oClient
.Url = "http://localhost:7659/WebServices/SampleService.asmx"
.WebMethod = "HelloWorld"
.WSServiceType = SoapClient.ServiceType.Traditional
.Parameters = params
End With
_oClient.BeginInvoke(AddressOf InvokeCompleted)
End Sub
Public Sub InvokeCompleted(result As IAsyncResult)
ErrorMessage.Text = _oClient.EndInvoke(result)
End Sub
The error is generated on this line in InvokeWebService
'get the response from the web service
Dim response As WebResponse = request.GetResponse()
Anyone know where I'm going wrong here?
It turned out to be a problem with my sample web service I was testing with, once I fixed that error the above code works beautifully.
I m getting a null reference exception in the line webrequest.create(v_strURL)
Dim objHttpWebRequest As HttpWebRequest
Dim objHttpWebResponse As HttpWebResponse
Dim objRequestStream As Stream = Nothing
Dim objResponseStream As Stream = Nothing
Dim objXMLReader As XmlTextReader
objHttpWebRequest = CType((WebRequest.Create(v_strURL)), HttpWebRequest) ''This line throws exception.
The Url is correct and does give a proper response .