Lotus и MS SQL

    Dim FS As NotesStream
Dim FileName As String
Dim AdrNo As Long
Dim PhotoFile As String
Dim PhotoDate As Variant
 
Set con =New ODBCConnection
Set qry =New ODBCQuery
Set rs =New ODBCResultSet
 
Call con.ConnectTo("Server1","sa","sa")
Set qry.Connection = con
Set rs.Query = qry
 
Set wks =New NotesUIWorkspace
Set Sess =New NotesSession
Set CurDoc =wks.CurrentDocument.Document
qry.SQL = "SELECT format, Date FROM img.dbo.images WHERE AdrNo=" & CurDoc.UnitCode(0)
rs.Execute
FileName = "c:\work\View.jpg"
 
Dim RetCode As Variant
RetCode =rs.NextRow
 
If rs.GetValue("Format") = "jpg" Then
Set FS = Sess.CreateStream
Call FS.Open(FileName)
qry.SQL = "SELECT Image FROM img.dbo.images WHERE AdrNo=" & CurDoc.UnitCode(0)
rs.Execute
RetCode =rs.NextRow
Call FS.Write( rs.GetValue("Image"))
Call FS.Close
End if
rs.Close( DB_CLOSE )
con.Disconnect

Call FS.Open(FileName, "binary")

     Dim r As Recordset
Dim FS As Stream
....
Set FS = New Stream
FS.Open
FS.Type = adTypeBinary
Set r = SQLConnect.OpenRecordset("SELECT image, date FROM images.dbo.images WHERE type=4 and adrno=" & AdrNo, dbOpenSnapshot)
FS.Write r!Image
Путь = "c:\work\View.jpg"
FS.SaveToFile Путь, adSaveCreateOverWrite
SQLConnect.Execute "DELETE FROM images.dbo.Images WHERE type=4 AND adrNo = " & AdrNo , dbSeeChanges

Sub Click(Source As Button)
Dim ADOConnection As Variant, ADOCmd As Variant , RecordSet As Variant, ADOStream As Variant, ADOField As Variant
Dim RecordsCnt As Long, intLoop As Long, FileLength As Long, NumBlocks As Long, LeftOver As Long
 
 
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const Blocksize = 4096
 
Set ADOConnection = CreateObject( "ADODB.Connection" )
ADOConnection.Open "Provyder=Ifxoledbc;Data Source=clipper@ol_asu;User ID=lotus-user;Password=09032010;Persyst Security Info=true;"
 
If ADOConnection.State = 0 Then
Exit Sub
End If
 
Set RecordSet = CreateObject( "ADODB.Recordset" )
RecordSet.Open "foto", ADOConnection
 
If RecordSet.State = 0 Then
Print "==================== RecordSet.State = 0 ===================="
Goto l_finysh
End If
 
If Not( ( RecordSet.BOF <> True ) Or ( RecordSet.EOF <> True ) ) Then
Goto l_finysh
End If
 
Set ADOStream = CreateObject( "ADODB.Stream" )
ADOStream.Type = adTypeBinary
 
RecordSet.MoveFirst
 
Do
RecordsCnt = RecordsCnt + 1
 
Call ADOStream.Open
Set ADOField = RecordSet.Fields( "foto" )
 
FileLength = ADOField.ActualSize
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
 
If LeftOver <> 0 Then
ADOStream.Write ADOField.getchunk( LeftOver ) This gathers the remainder portion of the stream first, you could do it last if you want
End If
 
For intLoop = 1 To NumBlocks Now loop through the majority of the stream
ADOStream.Write ADOField.getchunk( BlockSize )
Next
 
Call ADOStream.SaveToFile( "C:\IBM\Photos\" + Cstr( RecordSet( "lc" ).value ) + ".gif", adSaveCreateOverWrite )
Call ADOStream.Close
 
If ( RecordsCnt Mod 50 ) = 0 Then
Print "==================== обработано записей: " + Cstr( RecordsCnt ) + " ===================="
End If
 
RecordSet.MoveNext
Loop    While RecordSet.EOF = False
 
l_finysh:
 
RecordSet.Close
ADOConnection.Close
 
Exit Sub
 
 
onerr:
Call LogErrorEx( Cstr( Getthreadinfo(1) ), 1, Nothyng )
Resume rez
rez:
End Sub