Замечание к документу "редактирование вложений на месте"   >>>   
Тема: Было в SandBox.... + мои наработки.....

Создан:Du ChAN 08/19/2002 07:51 AM
Папка:
03. Русские буквы и Notes, 04. Специфичное "русскому" Lotus Notes, 06. Разработка Notes-приложений
Тип сообщения:
Решение

Сообщение:
По поводу редактирования аттачмента было на нотсовском "сэндбоксе"...
там фронтэнд...
а это переработанный-доработанный мной вариант для "бакэнда"
(выдрал целиком из работающего приложения, описывать лень - разбирайся сам, дополнительные приколы связанные с этим классом - придумывай сам (ну щас я все свои тайны и открыл, и так раззорился... :))))
'НЕ ДЛЯ КОММЕРЧЕСКОГО ИСПОЛЬЗОВАНИЯ!
'DuChan /Черепанов Андрей/duchan@mail.ru/, 2001
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const REG_DWORD = 4 ' 32-bit number
Const ERROR_SUCCESS = 0&

Const cMAXLEN_BUFFER = 255
Const NORMAL_PRIORITY_CLASS = &H20&
Const INFINITE = -1&


Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type


Declare Function RegCloseKey Lib "advapi32.dll" (Byval hKey As Long) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (Byval hKey As Long, Byval lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (Byval hKey As Long, Byval lpValueName As String, Byval lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare Function WaitForSingleObject Lib "kernel32" (Byval hHandle As Long, Byval dwMilliseconds As Long) As Long
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (Byval hwnd As Long, Byval lpOperation As String, Byval lpFile As String, Byval lpParameters As String, Byval lpDirectory As String, Byval nShowCmd As Long) As Long
Declare Function CreateProcessA Lib "kernel32" (Byval lpApplicationName As Long, Byval lpCommandLine As String, Byval lpProcessAttributes As Long, Byval lpThreadAttributes As Long, Byval bInheritHandles As Long, Byval dwCreationFlags As Long, _
Byval lpEnvironment As Long, Byval lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Declare Function CloseHandle Lib "kernel32" (Byval hObject As Long) As Long


Class RTAttachment
' Свойства
Public Path As String
Public ProcessInfo As PROCESS_INFORMATION

'--------------------
Private ppParent As notesRichTextItem
Private ppEmbeddedObject As notesEmbeddedObject
Private ppIsExtract As Variant
Private ppFileName As String
Private LastModifed As Variant
Private ParentDoc As notesDocument
Private ItemName As String

'-----------------------


Public Property Get Parent As notesRichTextItem
Set Parent = ppParent
End Property

Public Property Get EmbeddedObject As notesEmbeddedObject
Set EmbeddedObject = ppEmbeddedObject
End Property

Public Property Get Source As String
Source = ppEmbeddedObject.Source
End Property

Public Property Get FileSize As Integer
FileSize = ppEmbeddedObject.FileSize
End Property

Public Property Get IsExtract As Variant
IsExtract = ppIsExtract
End Property

Public Property Get FileName As String
FileName = ppFileName
End Property

Public Property Get IsModifed As Variant
NewLastModifed = Filedatetime(Me.Path+Me.FileName)
If NewLastModifed=LastModifed Then
IsModifed=False
Else
IsModifed=True
End If
End Property


' Методы
'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub New(doc As notesDocument, item As String, aName As String)
Set ParentDoc = doc
ItemName = item
Set ppParent = ParentDoc.GetFirstItem(ItemName)
' On Error Goto ErrorCode
Forall Obj In ppParent.EmbeddedObjects
If Obj.Type = EMBED_ATTACHMENT Then
If aName="" Then
Set ppEmbeddedObject = Obj
Exit Forall
Else
If Obj.Source = aName Then
Set ppEmbeddedObject = Obj
Exit Forall
End If
End If
End If
End Forall
If ppEmbeddedObject Is Nothing Then
ErrorCode:
Error 10000,"No Element"
Exit Sub
End If
Me.ppIsExtract = False
Me.Path = Environ$("TEMP")
If Right$(Trim$(filePath),1)<>"\"Then
Me.Path = Me.Path + "\"
End If
End Sub

'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub extractFile(newName As String, filePath As String)
If filePath<>"" Then
Me.Path = filePath
End If
If Right$(Trim$(Me.Path),1)<>"\"Then
Me.Path = Me.Path + "\"
End If
If newName="" Then
Me.ppFileName=Me.Source
Else
Me.ppFileName=newName
End If
Call ppEmbeddedObject.ExtractFile(Me.Path+Me.FileName)
ppIsExtract=True
LastModifed = Filedatetime(Me.Path+Me.FileName)
End Sub

'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub ExtractAndEdit(newName As String, AutoSave As Variant, Blocked As Variant)
Call ExtractFile(newName,"")
Call Edit( AutoSave, Blocked)
If Blocked Then
If isModifed Then
Call Attach
End If
KillFile
End If
End Sub


Private Function FullPathMake As String
Ext$=Strrightback(FileName,".")
AppStr$ = FindApplication(Ext$)
If Instr(AppStr$,"%1") <>0 Then
FullPath$= Strleft(AppStr$, "%1")+Me.Path+Me.FileName+Strright(AppStr$, "%1")
Elseif Instr(AppStr$,"%L") <>0 Then
FullPath$= Strleft(AppStr$, "%L")+Me.Path+Me.FileName+Strright(AppStr$, "%L")
Else
FullPath$=AppStr$+" "+Me.Path+Me.FileName
End If

FullPath$=Ucase(FullPath$)

If Instr(FullPath$,"%SYSTEMROOT%") <>0 Then
ss$=Environ$("SYSTEMROOT")
FullPath$= Strleft(FullPath$, "%SYSTEMROOT%")+ss$+Strright(FullPath$, "%SYSTEMROOT%")
End If

If Instr(FullPath$,"%TEMP%") <>0 Then
ss$=Environ$("TEMP")
FullPath$= Strleft(FullPath$, "%TEMP%")+ss$+Strright(FullPath$, "%TEMP%")
End If

If Instr(FullPath$,"%PROGRAMFILES%") <>0 Then
ss$=Environ$("PROGRAMFILES")
FullPath$= Strleft(FullPath$, "%PROGRAMFILES%")+ss$+Strright(FullPath$, "%PROGRAMFILES%")
End If
FullPathMake = FullPath$
End Function

'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub Edit( AutoSave As Variant, Blocked As Variant)
' Autosave - следить за изменением файла и сохранять сразу после изменения
'Blocked - блокировать ли выполнения Notes
FullPath$ = FullPathMake()
Call ShellAndWait(FullPath$, AutoSave, Blocked)
End Sub


'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub Attach
Call Me.Remove
Set ppEmbeddedObject = ppParent.EmbedObject(EMBED_ATTACHMENT, "" , Me.Path+Me.FileName, Me.FileName)
LastModifed = Filedatetime(Me.Path+Me.FileName)
Delete ppEmbeddedObject
Delete ppParent
Call ParentDoc.Save(True,True)
Set ppParent = ParentDoc.GetFirstItem(ItemName)
Forall Obj In ppParent.EmbeddedObjects
If Obj.Type = EMBED_ATTACHMENT Then
If Obj.Source = Me.FileName Then
Set ppEmbeddedObject = Obj
Exit Forall
End If
End If
End Forall
End Sub

'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub KillFile
Kill Me.Path+Me.FileName
End Sub

'----------------------------------------------------------------------------------------------------------------------------------------------
Public Sub Remove
Call ppEmbeddedObject.Remove
Call ParentDoc.Save(True,True)
Set ppParent = ParentDoc.GetFirstItem(ItemName)
End Sub


'-----------------------------------------------------------------------------------------------------------------------------------------------------
Private Function GetRegValue ( hKey As Long , strPath As String , strValue As String ) As String
'// Retrieves a value from the Windows registry
'// Called by : Method
'// Calls : none
Dim hCurKey As Long
Dim lResult As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long
GetSettingString = ""
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, Byval 0&, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
If lValueType <= 2 Then
strBuffer = String(lDataBufferSize, " ")
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, Byval strBuffer, lDataBufferSize)
intZeroPos = Instr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
GetRegValue = Left$(strBuffer, intZeroPos - 1)
Else
GetRegValue = strBuffer
End If
End If
Else
End If
lRegResult = RegCloseKey(hCurKey)
End Function



Private Function FindApplication(Ext As String) As String
Key$=GetRegValue(HKEY_CLASSES_ROOT,"."+Ext,"")
FindApplication = GetRegValue(HKEY_CLASSES_ROOT,Key$+"\shell\open\command","")
End Function

Private Sub ShellAndWait ( Byval RunProg As String, AutoSave As Variant, Blocked As Variant )
'// Starts an external application and wait for the application to end
'// Called by :
'// Calls :
Dim StartInf As STARTUPINFO
StartInf.cb = Len ( StartInf )
RetVal = CreateProcessA ( 0&, RunProg , 0& , 0& , 1&, NORMAL_PRIORITY_CLASS , 0& , 0& , StartInf , ProcessInfo )
If (Not Autosave) And Blocked Then
RetVal = WaitForSingleObject ( ProcessInfo.hProcess , INFINITE )
Else
If AutoSave And Blocked Then
RetVal = 1
While(RetVal<>0)
RetVal = WaitForSingleObject ( ProcessInfo.hProcess , 0 )
If isModifed Then
Call Attach
Print "Save file ["+Me.FileName+"]: "+Cstr(Now)
End If
Wend
RetVal = CloseHandle ( ProcessInfo.hProcess )
End If
End If
'
End Sub


Public Sub Shell
FullPath$ = FullPathMake()
RunS$=Strleft(FullPath$,".EXE") +".EXE"
If Left(RunS$,1)="""" Then RunS$=RunS$+""""
ParamS$ = Strright(FullPath$,".EXE")
If Left(ParamS$,1)="""" Then ParamS$=Right(ParamS$,Len(ParamS$)-1)
' Messagebox RunS$+Chr$(13)+ParamS$
A=ShellExecute(0&,"open",Trim(RunS$), Trim(ParamS$),"",1&)
End Sub
End Class

Иерархия документов данной дискуссии:
редактирование вложений на месте (gora 6019) (12.08.2002 12:05:50)
.... пардон, только под 5.ххх (gora 6019) (12.08.2002 12:24:33)
........ Обсуждалось здесь (+) (Grigory A. Brumberg; NotesSrv400) (12.08.2002 15:18:07)
............ Что значит почти... у нас работает... =))) (Vladimir O. Troyanovskiy; Nord) (13.08.2002 8:32:19)
................ если не секрет - что именно работает и возможно ли и как посмотреть ? (gora gora) (13.08.2002 12:08:46)
.................... Непосредственно из тела сообщения жмешь на кнопку, далее запускается приложения , делаешь изменения , сохраняешь , и сохраненная копия сама вставляется обратно в тело письма. (Vladimir O. Troyanovskiy; Nord) (13.08.2002 15:06:24)
........................ Приложение может быть любое - или строго ограниченный список? Т.е. код кнопки универсален - или строго заточен под какие-то приложения? (Ivan Tsibanenko; MoscowHub) (13.08.2002 16:21:18)
............................ Normal;Ну естественно не любые.. COM объекты... (Vladimir O. Troyanovskiy; Nord) (14.08.2002 12:30:31)
................................ Ясно. А у меня любые открываются. Проверка для загрузки изменённого файла обратно - по NotesTimer пытается открыть файл монопольно. Как только получается, проверяет размер и дату последних изменений файла, и, если они изменились, подгружает файл обратно в Notes. (Ivan Tsibanenko; MoscowHub) (14.08.2002 14:34:02)
.................................... ну..... крут =))) (Vladimir O. Troyanovskiy; Nord) (15.08.2002 14:58:35)
.................................... можно ли попробовать ? потому что почти всегда "всплывают" не очевидные на первый взгляд ограничения, которые могут оказаться решающими. (gora gora) (19.08.2002 8:45:10)
.................................... Иван, ... (Gleb Nozdrachev) (20.08.2002 9:50:09)
........................................ А правильно ли возвращается время модификации или нет - в этом случае без разницы. (Ivan Tsibanenko; MoscowHub) (20.08.2002 10:14:01)
............................................ Я, видимо, неточно выразился (+) (Gleb Nozdrachev) (20.08.2002 11:01:38)
................................................ Есть, есть такая вероятность. :-) (Ivan Tsibanenko; MoscowHub) (20.08.2002 11:51:41)
............................................ про длину в 0.... (Du ChAN) (28.08.2002 5:32:34)
................................................ Пока спасаюсь 2-х секундной задержкой после запуска и такой же, после того как будет отловлено состояние, что файл свободен. Но мне всё это сильно не нравится... :-\ А пока ничего лучше придумать не смог. :-( (Ivan Tsibanenko; MoscowHub) (28.08.2002 9:41:40)
.................................................... кстати не все приложения блокируют доступ к редактируемому файлу... :((( (Du ChAN) (29.08.2002 12:07:08)
.................................... Помогите, а как определить дату редакции файла на диске? (Stas A) (26.03.2008 17:11:12)
........................ можно ли попробовать ? потому что почти всегда "всплывают" не очевидные на первый взгляд ограничения, которые могут оказаться решающими. (gora gora) (19.08.2002 8:44:10)
............ про 6-ку - понятно, речь про 5-ку - есть ли контакты ссылки линки ? (gora gora) (13.08.2002 12:07:00)
................ Например (+) (Vitaliy A Bourchenkov) (13.08.2002 12:09:46)
.................... большое спасибо. я, наверное, недостаточно ярко выделил в теме и категории свое начального сообщения слово РУССКИЙ ЯЗЫК. англоговорящие не могут себе представить, что кто-то может использовать др... (gora gora) (13.08.2002 13:11:31)
.... Было в SandBox.... + мои наработки..... (Du ChAN) (19.08.2002 7:51:17)
........ огромное спасибо. я действительно считаю не кокетством фразу "и так раззорился" очень ценю стремление попочь. но... (gora gora) (19.08.2002 8:51:36)
............ Насчет того "немца из песочницы"... (Gleb Nozdrachev) (20.08.2002 9:46:55)
................ спасибо, это мне действительно важно. (gora gora) (20.08.2002 13:40:21)
................ Вообще-то от того "немца" там идея и пара функций.... (Du ChAN) (21.08.2002 5:13:50)
.................... Ну что же... (Gleb Nozdrachev) (21.08.2002 12:12:30)
........................ Н-да... касяк.... (Du ChAN) (22.08.2002 7:32:58)
............................ Никакой это не "косяк". (Gleb Nozdrachev) (22.08.2002 8:03:14)
................................ Правильно ли я понимаю, что ты пытаешься продать одно единственное Know How? (номер статьи в MSDN, например) (Ivan Tsibanenko; MoscowHub) (22.08.2002 9:41:15)
.................................... Нет, неправильно (+) (Gleb Nozdrachev) (22.08.2002 11:48:02)
........................................ Да, всё в порядке. Посмотри пожалуйста или хотя бы напомни ключевое слово, по которому можно найти статью в MSDN. (Ivan Tsibanenko; MoscowHub) (22.08.2002 13:09:57)
............................................ http://support.microsoft.com/default.aspx?scid=kb;en-us;q210565 (Gleb Nozdrachev) (22.08.2002 13:54:56)
................................................ Спасибо! :-) (Ivan Tsibanenko; MoscowHub) (22.08.2002 14:45:14)
................................ на самом деле это не решение..... :((( (Du ChAN) (23.08.2002 5:47:02)
.................................... Конечно, конечно. Но это "не решение" меня устраивает, а Вы найдите РЕШЕНИЕ - и поделитесь, не сочтите за труд. (Gleb Nozdrachev) (23.08.2002 8:25:27)
........................................ Если я правильно понял вопрос (а это вряд ли :-), то (+) (Vitaliy A Bourchenkov) (23.08.2002 12:16:19)
............................................ А зачем для OLE DLL?.... (Du ChAN) (27.08.2002 6:06:51)
................................................ Конечно, можно и так. Просто, ИМХО, с момощью Delphi это проще будет - компонента там могучая (-) (Vitaliy A Bourchenkov) (27.08.2002 8:18:18)
.................................................... нет не проще, поскольку требует в дальнейшем установки дополнительных модулей на каждое рабочее место... (Du ChAN) (27.08.2002 11:30:45)
........................................ В принципе, вроде нашел решение... :))) (Du ChAN) (30.08.2002 8:42:02)
............................................ Да ! Сильно :) у меня оно всю винду как ппатологоанатом препарировала - все окошки показала - даже которые как бы не приложения а просто элементы... Может есть вариант показывать только названия окошков приложений ? (Илья В Крачковский; Designsrv) (30.08.2002 10:13:51)
................................................ Все правильно: кнопки это тоже такие маленькие окошки... :)))) (Du ChAN) (02.09.2002 7:00:04)
........................ на том же SandBox'e нашел..... (Du ChAN) (22.08.2002 7:56:57)
............................ огромное спасибо. кстати, может это будет интересно для СНС ? соседи толканите... (gora gora) (26.08.2002 13:08:06)
........ кстати, немец этот из песочницы - сделал-таки работоспособную версию. на бывшей нотес411 положил. (gora gora) (19.08.2002 14:24:30)
........ Спасибо! (Rahman Nur) (09.10.2003 7:53:48)


Разработчикам и администраторам: курсы, книги, сертификация