我需要使用 lotusscript 从网页中读取字段值。本质上,我打算编写一个代理来访问特定的 URL,从页面中获取一个值,然后将该值用于它发送给用户的 url。
谁能给我指点?
一个
我需要使用 lotusscript 从网页中读取字段值。本质上,我打算编写一个代理来访问特定的 URL,从页面中获取一个值,然后将该值用于它发送给用户的 url。
谁能给我指点?
一个
2019 年 12 月更新:从 Notes 10(2018 年发布)开始,有一个 NotesHTTPRequest 类与我的代码完全相同。
我一直这样做,一点也不难(在 Windows 上)。我创建了一个类来做到这一点,所以它很容易实现。
这是你如何称呼它的:
Dim internet As New RemoteHTML()
Dim html As String
html = internet.GetHTTP("http://www.texasswede.com/mypage.html")
就是这样,现在您只需从 html 字符串中提取您想要的任何信息。
这是课程:
Option Public
Option Declare
Class RemoteHTML
Private httpObject As Variant
Public httpStatus As Integer
Public Sub New()
Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
End Sub
Public Function GetHTTP(httpURL As String) As String
Dim retries As Integer
retries = 0
Do
If retries>1 Then
Sleep 1 ' After the two first calls, introduce a 1 second delay betwen each additional call
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
httpStatus = httpObject.Status
If retries >= 10 Then
httpStatus = 0 ' Timeout
End If
Loop Until httpStatus = 200 Or httpStatus > 500 Or httpStatus = 404 Or httpStatus = 0
If httpStatus = 200 Then
GetHTTP = Left$(httpObject.responseText,16000)
Else
GetHTTP = ""
End If
End Function
Public Function GetFile(httpURL As String, filename As String) As Boolean
Dim session As New NotesSession
Dim retries As Integer
Dim stream As NotesStream
Dim flag As Boolean
Dim responsebody As variant
Dim cnt As Long
Dim buffer As String
Dim tmp As Byte
Set stream = session.CreateStream
retries = 0
Do
If retries>1 Then
Sleep 1 ' After the two first calls, introduce a 1 second delay betwen each additional call
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
httpStatus = httpObject.Status
If retries >= 10 Then
httpStatus = 0 ' Timeout
End If
Loop Until httpStatus = 200 Or httpStatus > 500 Or httpStatus = 404 Or httpStatus = 0
If httpStatus = 200 Then
flag = stream.Open(filename, "binary")
If flag = False Then
MsgBox "Failed to create " & filename & "..."
GetFile = False
Exit function
End If
responsebody = httpObject.ResponseBody
ForAll r in responsebody
tmp = r
Call Stream.Write(Chr$(CInt(tmp)))
cnt = cnt + 1
End ForAll
MsgBox cnt
GetFile = True
Else
GetFile = False
End If
End Function
Private Function getString(ByVal StringBin As string)
Dim intCount As Long
getString =""
For intCount = 1 To LenB(StringBin)
getString = getString & Chr( Asc(MidB(StringBin, intCount, 1)) )
Next
End Function
End Class
如果您的代码将在 Windows 上运行,您可以使用 WinHTTP 或 XMLHTTP COM 类来读取网页。如果代码将在任何其他平台上运行,则最好使用 Java 而不是 LotusScript。
如果您尝试从 NotesField 中读取,则可以采用以下方法。创建 Tha 类是为了专门处理将 RichText 项导出到 html 字符串中,以便找到可能存在于 NotesRichText 项中的其他隐藏的嵌入图像(粘贴的图形)。函数 ExportDoc() 将 html 响应文本复制到手头文档的用户定义字段中:
Public Class RTExporter
session As NotesSession
db As NotesDatabase
doc As NotesDocument
obj As Variant
url As String
Public Sub New()
Set Me.session = New NotesSession()
Set db = session.CurrentDatabase
Set obj = CreateObject("Microsoft.XMLHTTP")
End Sub
' Handles export from eventual NotesRichTextitems in the form of HTml
Public Function ExportDoc(hostUrl As String, doc As NotesDocument, rtFieldName As String, htmlFieldName As String)
Dim htmlString As String
url = hostUrl & Me.db.FilePath & "/0/" & doc.Universalid & "/" & rtFieldname & "?openfield&charset=utf-8
Set Me.doc = doc
htmlString = GetHtmlFromField(htmlFieldName)
Call doc.ReplaceItemValue(htmlFieldName, htmlString)
Call doc.Save(True, False)
End Function
' Get http response text and store it in <fieldname>
Private Function GetHtmlFromField(rtFieldName As String) As String
Dim html As String
On Error Goto ERH
obj.open "GET", Me.url, False, "", ""
obj.send("")
GetHtmlFromField = Trim$(obj.responseText)
Exit Function
ERH:
GetHtmlFromField = "Error " & Err & ": " & Error & " occured on line: " & Erl
End Function
End Class