Sub Click(Source As Button)
Dim uiDoc As NotesUIDocument
Dim Conn 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
Dim strSQL As String, FileName As String
Dim ndSQLProfile As NotesDocument
Dim SQLUserID As String, SQLUserPass As String
Dim SQLSource As String, SQLDatebase As String
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Const Blocksize = 4096
Set wks =New NotesUIWorkspace
Set Sess =New NotesSession
Set ndSQLProfile =sess.Currentdatabase.getProfileDocument("pf.Access.SQL")
SQLSource =ndSQLProfile.SourceName(0)
SQLUserID =ndSQLProfile.SQLLogin(0)
SQLUserPass =ndSQLProfile.SQLPassword(0)
Set uiDoc =wks.CurrentDocument
Set CurDoc =uiDoc.Document
' Call CurDoc.Save( False, False)
Set Conn = CreateObject( "ADODB.Connection" )
Conn.Provider = "SQLOLEDB"
' Conn.Open "Provider=SQLOLEDB; Integrated Security=SSPI; Persist Security Info=False; Initial Catalog=Images; Data Source=DARUMA\SQLEXPRESS;User ID=sa;Password=sa;"
Conn.Open "User ID=" + SQLUserID + "; Password=" + SQLUserPass +";Initial Catalog=Images; Data Source=" + SQLSource +";Persist Security Info=true;"
If Conn.State = 0 Then
Messagebox "Невозможно подключиться к серверу " & SQLSource & "!"
Exit Sub
End If
Set RecordSet = CreateObject( "ADODB.Recordset" )
strSQL = "SELECT format, Image, Date FROM Images.dbo.Images WHERE type=4 and adrno=" & CurDoc.UnitCode(0)
RecordSet.Open strSQL, Conn
If RecordSet.State = 0 Then
Print "RecordSet.State = 0"
Goto l_finish
End If
If Not( ( RecordSet.BOF <> True ) Or ( RecordSet.EOF <> True ) ) Then
Goto l_finish
End If
' RecordSet.Close
' strSQL = "SELECT Image FROM Images.dbo.Images WHERE AdrNo=" & CurDoc.UnitCode(0)
' RecordSet.Open strSQL, Conn
Set ADOStream = CreateObject( "ADODB.Stream" )
ADOStream.Type = adTypeBinary
RecordSet.MoveFirst
Do
RecordsCnt = RecordsCnt + 1
Call ADOStream.Open
Set ADOField = RecordSet.Fields( "Image" )
FileLength = ADOField.ActualSize
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
If LeftOver <> 0 Then
ADOStream.Write ADOField.getchunk( LeftOver )
End If
For intLoop = 1 To NumBlocks
ADOStream.Write ADOField.getchunk( BlockSize )
Next
' Call ADOStream.SaveToFile( "C:\Work\AU" + Cstr( RecordSet( "AdrNo" ).value ) + ".jpg", adSaveCreateOverWrite )
FileName = "C:\Work\РК" & CurDoc.UnitCode(0) & ".jpg"
Call ADOStream.SaveToFile( FileName, adSaveCreateOverWrite )
Call ADOStream.Close
RecordSet.MoveNext
Loop While RecordSet.EOF = False
l_finish:
RecordSet.Close
Conn.Close
CurDoc.FileName =FileName
Call uiDoc.RefreshHideFormulas
' Call AttachFile( "AUPhoto", FileName)
' Dim r As Variant
' r = Shell (FileName,1)
Exit Sub
onerr:
' Call LogErrorEx( Cstr( Getthreadinfo(1) ), 1, Nothing )
Resume rez
rez:
End Sub
