Лазарев Евгений
Зарегистрирован: 12.06.2008 Сообщения: 48 Откуда: УралГеоИнформ
|
Добавлено: Пт 11 Июл 2008 11:37 Заголовок сообщения: |
|
|
ага!!! я все таки нашел как это делается!!!
в мета данные необходимо добавить еще один класс:
Код: |
<class name="System/OutputDocument" caption="Выходной документ" list-caption="Выходные документы" data-table="SysOutDoc" is-root="true" order-by="CreationDate">
<property name="id" caption="Идентификатор" data-field="OID" data-type="char" data-length="12" data-nullable="false" purpose="id" searchable="false" editable="false"/>
<property name="ClassName" caption="Класс" data-field="ClassName" data-type="string" data-length="64" data-nullable="false"/>
<property name="ObjectID" caption="Идентификатор объекта" data-field="ObjectID" data-type="char" data-length="12" data-nullable="false" searchable="false" purpose="association" ref-select-case="ClassName">
<case value="Monument" ref-class="Monument" ref-property="id" is-built-in=""/>
<case value="MonumentArcheolog" ref-class="MonumentArcheolog" ref-property="id" is-built-in=""/>
<case value="ProtectionData" ref-class="ProtectionData" ref-property="id" is-built-in=""/>
</property>
<property name="CreationDate" caption="Дата формирования" data-field="CreationDate" data-type="datetime" data-nullable="false"/>
<property name="DocCaption" caption="Заголовок документа" data-field="DocCaption" data-type="string" data-length="100" data-nullable="false"/>
<property name="UserAccount" caption="Учетная запись пользователя" data-field="UserAccount" data-type="string" data-length="64" data-nullable="false"/>
<property name="FileName" caption="Имя файла" data-field="FileName" data-type="string" data-length="64" data-nullable="false" searchable="false"/>
<object-view name="default" is-internal="false">
<![CDATA[<%=CreationDateProperty%>:
<%=DocCaptionProperty%>:
<%=UserAccountProperty%> к ч<%=ClassNameProperty%> <%=Object_Property%>]]>
<virtual-property name="Object_" association="ObjectID"/>
</object-view>
<object-view name="table" is-internal="false" purpose="table">
<![CDATA[<td><%=CreationDateProperty%></td>
<td>
<a href="object_data_form.asp?class=<%=ClassNameProperty%>&id=<%=ObjectIDProperty%>">
<%=Object_Property%>
</a>
</td>
<td><%=DocCaptionProperty%></td>
<td><%=UserAccountProperty%></td>]]>
<header column-count="4">
<![CDATA[<th>Дата</th>
<th>Объект</th>
<th>Заголовок</th>
<th>Пользователь</th>]]>
</header>
<virtual-property name="Object_" association="ObjectID"/>
</object-view>
<sql-select-template name="Main">
<![CDATA[<%
dim WhereSection
WhereSection = ""
sub AddParamCondition(ByVal aParam, ByVal aFieldName, ByVal aDataType, ByVal anOp)
dim aFieldCondition, aSysUtils
if (aParam = "") or IsEmpty(aParam) or IsNull(aParam) then exit sub
if IsEmpty(anOp) then
anOp = "like"
set aSysUtils = CreateObject("InMetaUtils.InMetaSysUtils")
aParam = "%" & aSysUtils.DBXEncodeLikePattern(aParam) & "%"
end if
aFieldCondition = "(" & aFieldName & " " & anOp & " ?" & ")"
Content.AppendParam aParam, aDataType
if WhereSection = "" then
WhereSection = " where " & aFieldCondition
else
WhereSection = WhereSection & " and " & aFieldCondition
end if
end sub
AddParamCondition ClassName, "ClassName", "string", Empty
AddParamCondition DocCaption, "DocCaption", "string", Empty
AddParamCondition UserAccount, "UserAccount", "string", Empty
AddParamCondition DateFrom, "CreationDate", "datetime", ">="
AddParamCondition DateTo, "CreationDate", "datetime", "<="
%>
select distinct OID as id from SysOutDoc <%=WhereSection%>]]>
<param name="ClassName" data-type="string"/>
<param name="DateFrom" data-type="datetime"/>
<param name="DateTo" data-type="datetime"/>
<param name="DocCaption" data-type="string"/>
<param name="UserAccount" data-type="string"/>
</sql-select-template>
<search-form-template name="Main" caption="По реквизитам" sql-select-template="Main" default-search-form="true" object-view="table">
<![CDATA[<style>
Input {
border: 1 solid steelblue;
font-family: verdana,arial;
font-size: 8pt;
}
</style>
<table border="0">
<tr>
<td>
Имя класса:<br>
<input type="text" inmeta-param="ClassName">
</td>
</tr>
<tr>
<td>
Дата от:<br>
<div style="behavior:url(#inmeta#inputdate)" inmeta-param="DateFrom"
inmeta-data-type="datetime" elem-attr="curvalue"></div>
</td>
</tr>
<tr>
<td>
Дата по:<br>
<div style="behavior:url(#inmeta#inputdate)" inmeta-param="DateTo"
inmeta-data-type="datetime" elem-attr="curvalue"></div>
</td>
</tr>
<tr>
<td>
Заголовок документа:<br>
<input type="text" inmeta-param="DocCaption">
</td>
</tr>
<tr>
<td>
Учетная запись:<br>
<input type="text" inmeta-param="UserAccount">
</td>
</tr>
</table>]]>
</search-form-template>
<method name="PrintOut" caption="Распечатать помеченные" run-at="client">
<![CDATA[option explicit
dim Session, XmlUtils, errAttachmentNotFound
errAttachmentNotFound = vbObjectError + 1
set Session = CreateObject("InMetaCR.InMetaDataServiceClient")
Session.ServerUrl = InMeta.AppBaseUrl
set XmlUtils = CreateObject("InMetaUtils.InMetaXmlUtils")
'Процедуры работы с аттачментами
function QueryAttachment(byval anAction, byval aClassName, byval anObjectID, _
byval aFileName, byval aPos, byval aSize)
Dim aDoc, aNode
Set aDoc = XmlUtils.CreateDoc(anAction)
Set aNode = aDoc.documentElement
XmlUtils.SetAttr aNode, "class", aClassName
XmlUtils.SetAttr aNode, "id", anObjectID
XmlUtils.SetAttr aNode, "file", aFileName
if aPos <> -1 then
XmlUtils.SetAttr aNode, "pos", aPos
end if
if aSize <> -1 then
XmlUtils.SetAttr aNode, "size", aSize
end if
set QueryAttachment = XmlUtils.LoadHttp( _
Session.ServerURL & "/inmeta/attachments_data.asp", aDoc)
end function
function AttachmentExists(byval aClassName, byval anObjectID, byval aFileName)
dim aListDoc
set aListDoc = QueryAttachment("list", aClassName, anObjectID, "", -1, -1)
AttachmentExists = not aListDoc.documentElement.selectSingleNode( _
"attachment[@file='" & aFileName & "']") is Nothing
end function
sub GetAttachment(byval aClassName, byval anObjectID, byval aFileName, byval aLocalFileName)
const SliceSize = 100000
dim aSliceDoc, aSlicePos, aSliceSize, Utils
set Utils = CreateObject("InMetaCR.InMetaScriptingUtils")
aSlicePos = 0
do
set aSliceDoc = QueryAttachment("get", aClassName, anObjectID, aFileName, aSlicePos, SliceSize)
aSliceSize = CLng(aSliceDoc.DocumentElement.getAttribute("size"))
if aSliceSize > 0 then
Utils.SaveBinaryFileSlice aLocalFileName, aSlicePos, aSliceDoc.DocumentElement.NodeTypedValue
end if
aSlicePos = aSlicePos + aSliceSize
loop while aSliceSize = SliceSize
end sub
'------------------------------------------------------------------------------
function PrintWordDocument(ByVal aFileName)
dim aWord
PrintWordDocument = false
on error resume next
set aWord = CreateObject("Word.Application")
aWord.Documents.Open(aFileName).PrintOut False
aWord.Quit 0
if Err = 0 then PrintWordDocument = true
on error goto 0
end function
sub PrintAttachment(ByVal aClassName, ByVal anObjectID, ByVal aFileName)
dim aFSO, aLocalFileName
if not AttachmentExists(aClassName, anObjectID, aFileName) then
Err.Raise errAttachmentNotFound, "PrintAttachment", _
"У объекта '" & aClassName & "[" & anObjectID & "]'" & _
" не найден приложенный файл '" & aFileName & "'"
end if
Set aFSO = CreateObject("Scripting.FileSystemObject")
aLocalFileName = aFSO.GetSpecialFolder(2) & "\" & aFileName
GetAttachment aClassName, anObjectID, aFileName, aLocalFileName
if not PrintWordDocument(aLocalFileName) then
Err.Raise vbObjectError, "PrintAttachment", "Не удалось распечатать документ."
end if
on error resume next
aFSO.DeleteFile aLocalFileName
on error goto 0
end sub
sub log(ByVal anIndicator, ByVal aMsg)
anIndicator.SetText aMsg
end sub
sub PrintOut
dim anIndicator, anErrIndicator, aNotFoundIndicator
dim anObjectList, anObject, anObjectIDs
dim anObjectCount, anErrorCount, aPrintedCount, aNotFoundCount, aCurrent
if LBound(Form.SelectedObjectIDs) > UBound(Form.SelectedObjectIDs) then
MsgBox "Необходимо пометить объекты для печати."
exit sub
end if
set anIndicator = CreateObject("InMetaCR2.ProgressIndicator")
anIndicator.Init True, 0
set anErrIndicator = anIndicator.NewIndicator
set aNotFoundIndicator = anErrIndicator.NewIndicator
anObjectIDs = Array()
anObjectList = Session.GetObjectInfoArray(Form.ClassName, Form.SelectedObjectIDs, _
"ClassName,ObjectID,FileName", "{{null}}")
anObjectCount = UBound(anObjectList) + 1
anErrorCount = 0
aPrintedCount = 0
aNotFoundCount = 0
aCurrent = 0
for each anObject in anObjectList
if anIndicator.Terminate then exit for
aCurrent = aCurrent + 1
log anIndicator, "Печать " & aCurrent & "-го документа из " & anObjectCount & "."
on error resume next
PrintAttachment anObject.PropertyValue("ClassName"), _
anObject.PropertyValue("ObjectID"), anObject.PropertyValue("FileName")
if Err = 0 then
aPrintedCount = aPrintedCount + 1
ReDim preserve anObjectIDs(UBound(anObjectIDs) + 1)
anObjectIDs(UBound(anObjectIDs)) = anObject.id
elseif Err = errAttachmentNotFound then
aNotFoundCount = aNotFoundCount + 1
else
anErrorCount = anErrorCount + 1
end if
on error goto 0
if anErrorCount > 0 then
log anErrIndicator, "Не удалось распечатать: " & anErrorCount & "."
end if
if aNotFoundCount > 0 then
log aNotFoundIndicator, "Не найдено файлов для печати: " & aNotFoundCount & "."
end if
next
if anObjectCount > 0 then
Form.RemoveFromSelectedObjects anObjectIDs
log anIndicator, "Распечатано документов: " & aPrintedCount & " из " & anObjectCount & "."
MsgBox "Печать документов завершена.", vbSystemModal
anIndicator.Done
end if
end sub]]>
<appearance form="object_list_form_actions"/>
</method>
</class>
|
и выделенные объекты можно получить в коде метода путем перебора массива Form.SelectedObjectIDs
Код: |
for count=lbound(Form.SelectedObjectIDs) to ubound(Form.SelectedObjectIDs)
msgbox Form.SelectedObjectIDs(count)
next |
|
|