Ls & Winapi

  • Автор темы allex
  • Дата начала
Статус
Закрыто для дальнейших ответов.
A

allex

#1
Код:
RetVal = CreateProcessA ( 0&, RunProg , 0& , 0& , 1&, NORMAL_PRIORITY_CLASS , 0& , 0& , StartInf , proc )
RetVal = WaitForSingleObject ( proc.hProcess , INFINITE )
RetVal = CloseHandle ( proc.hProcess )
Есть проект по созданию нормативных актов, в нем реализован механизм по созданию процесса OpenOffice для открытия шаблона документа с функцией WaitForSingleObject ( proc.hProcess , INFINITE ) , дабы ждать пока пользователь не закончит работу с этим процессом.
Этот блок кода фиг знает с какой закономерностью выкидывает баг, пользователь наколотил текст, закрыл OpenOfficе, сохранил по запросу (или наоборот), файл на диске сохранился с текстом, дальше он выполняет следущие по коду процедуры, НО приатаченный файл пустой шаблон (без текста).

Как бороться с этим змеем ?
 

TIA

:-)
Lotus team
15.05.2009
790
3
#2
Вероятно, при выгрузке процесса, его хэндл закрывается раньше хэндла редактируемого файла.
Попробуй ещё дождаться, пока файл окончательно закроется. Если OpenOffice блокирует редактируемые файлы от записи другими процессами, то проверить, что хэндл файла ещё открыт можно так.

Код:
Public Function IsFileOpen(fileName) As Integer
Dim filenum As Integer

fileNum = Freefile()

On Error 101 Goto errorFileAlreadyOpen

Open fileName For Random Lock Read Write As filenum
Close filenum
IsFileOpen = False
Exit Function

errorFileAlreadyOpen:
IsFileOpen = True
Exit Function
End Function
 

Omh

Lotus team
04.07.2007
2 210
1
#3
TIA
Послухай, а откуда эта процедурка?
Сам писал или нашёл где-то?
------------------
Просто смотрю, у меня очень похожая процедурина есть, а откуда взял не помню.
Ща погуглил, вроде какой-то француз такую в 2005 году выкладывал :)
 

morpheus

скриптописец
07.08.2006
3 915
1
#4
allex

http://codeby.net/forum/threads/19423.html

Запустить программу, дождаться её завершения и только после этого продолжать скрипт
Код:
	Set WShell = CreateObject("WScript.Shell") 
ReturnCode = WShell.Run("%windir%\notepad.exe", 1, True)
Msgbox "123"
 

Omh

Lotus team
04.07.2007
2 210
1
#5
По мне, так тут winapi нафик не нужен.
OpenOffice/MS Office при открытии блочат файл и эта конструкция работает как часы.
 
A

allex

#6
RetVal = WaitForSingleObject ( proc.hProcess , INFINITE )

Именно эта функция ведет себя неадекватно. Причет на отдельных компах она вообще работает на опережение, то есть не возможно прикрепить файл с изменениями, хотя он на диске лежит сохраненный как положено. На других компах раз.. через раз. На моем компе во время разработки и тестирования вообще никогда не проявлялся этот глюк, а вот сейчас и у меня начался. Последнее к тому что засилие разными программами мой комп подвергается чаще и извращеннее чем пользовательские.
 
A

allex

#8
Morpheus

Спасибо за напоминание... совсем вылетело из головы
 
A

allex

#9
Тема оказалась еще актуальна.
Седня пользователь снова взвыл... снова не прикрепляется файл.
Вот пример кода.
У меня подозрение на компьютер пользователя, но в чем может быть причина..непонимаю.
У одного пипла переставлялся комп на чисто, после этого все работало как часы, но юзверь гад чего наставил на свою машину и ошибка вылезла опять.

Код:
Dim db As NotesDatabase,ws As New notesuiworkspace,s As New NotesSession,itm As NotesRichTextItem
Set db = s.currentdatabase
Set uidoc = ws.CurrentDocument
Call uidoc.save
Set doc = uidoc.Document
Call doc.replaceitemvalue("tema","Постановление")
Call doc.Save( True , False )
Set itm = doc.GetFirstItem("Body")	
Set WShell = CreateObject("WScript.Shell") 
Set view = db.GetView ( "($TEMPLATES)" )
Set TemplateDoc = view.GetDocumentByKey ( "Постановление" )		
Set TemplateField = TemplateDoc.GetFirstItem ( "Body" )
If ( TemplateField.Type = RICHTEXT ) Then
Forall o In TemplateField.EmbeddedObjects 
Call o.ExtractFile ( "c:\lotustemp\" & o.Name )
TName = o.Name
End Forall 
End If
file = "c:\lotustemp\" & TName
ReturnCode = WShell.Run("swriter.exe " + file,1, True)
Print "Файл " + TName + " сохранен как " + file

Call itm.embedObject(EMBED_ATTACHMENT,"", file)
Call doc.Save( True , False )
doc.SaveOptions = "0"
Call uidoc.close
Call ws.EditDocument( True , doc )
По мне, так тут winapi нафик не нужен.
OpenOffice/MS Office при открытии блочат файл и эта конструкция работает как часы.
Пример покажи, как сделать чтоб после сохранения файла в OpenOffice он приаттачился .. ну и потом по ходу скрипта выполнялись следующие за этим действием процедуры
 

Omh

Lotus team
04.07.2007
2 210
1
#10
TempFolder - папка, куда екстрактнули файл.
AttachmentName - собственно, сам файл.
IsFileOpen приводили чуть раньше.

Мы значит экстрактнули, запустили OpenOffice с этим файлом и делаем следующее:

Код:
Dim OriginalFileDateTime As Variant
OriginalFileDateTime = Filedatetime(TempFolder + AttachmentName)

Dim Flag As Boolean
Flag = True

While Flag
Sleep(0.5)
Flag = IsFileOpen(TempFolder + AttachmentName)
'ждём пока OpenOffice не освободит файл
Wend

'о! освободил

If Filedatetime(TempFolder + AttachmentName) <> OriginalFileDateTime Then
'Файл сохранили и закрыли - процесь
End If
 

Omh

Lotus team
04.07.2007
2 210
1
#12
Тока кажись с OpenOffice надо немного изменить вот эту строку
Код:
Open fileName For Random Lock Read Write As filenum
Попытаться открыть в другом режиме.
Я когда-то пробовал и у меня с OO работало, только не помню, что точно менял.
 

lmike

нет, пердело совершенство
Lotus team
27.08.2008
6 601
277
#13
опенофисовые доки - это архив, на форуме есть код по работе с ним (джава)
может пробовать разархивировать или просто получить список в архиве
 
A

allex

#14
Файл открывается ника иначе как только на Чтение, не ЧигО не понимаю

Я уж грешным делом думаю а не контролировать ли наличие .~lock файла

Код:
Dim db As NotesDatabase,ws As New notesuiworkspace,s As New NotesSession,itm As NotesRichTextItem
Set db = s.currentdatabase
Set uidoc = ws.CurrentDocument
Call uidoc.save
Set doc = uidoc.Document
Call doc.replaceitemvalue("tema","Постановление")
Call doc.Save( True , False )
Set itm = doc.GetFirstItem("Body")	
'	Set WShell = CreateObject("WScript.Shell") 
Set view = db.GetView ( "($TEMPLATES)" )
Set TemplateDoc = view.GetDocumentByKey ( "Постановление" )		
Set TemplateField = TemplateDoc.GetFirstItem ( "Body" )
If ( TemplateField.Type = RICHTEXT ) Then
Forall o In TemplateField.EmbeddedObjects 
Call o.ExtractFile ( "c:\lotustemp\" & o.Name )
TName = o.Name
End Forall 
End If
file = "c:\lotustemp\" & TName
'ReturnCode = WShell.Run("swriter.exe " + file,1)
Dim mass() 
Dim xlWbk As Variant 		
Set xlglob = CreateObject ( "com.sun.star.ServiceManager" ) 
Set Desktop = xlglob.createInstance("com.sun.star.frame.Desktop") 
Set document= Desktop.loadComponentFromURL("file:///"+file, "_blank", 0, mass)
'	Print "Файл " + TName + " сохранен как " + file

'*********************** проверка на использование файла его редактируемой программой
Dim OriginalFileDateTime As Variant
OriginalFileDateTime = Filedatetime(file)
Print "дата исходного файла " + Cstr(Filedatetime(file))
Dim Flag As Boolean
Flag = True
While Flag
Sleep(0.5)
Flag = IsFileOpen(file)
'ждём пока OpenOffice не освободит файл
Wend

'о! освободил
Print "дата сохраненного файла " + Cstr(Filedatetime(file))
If Filedatetime(file) <> OriginalFileDateTime Then
'Файл сохранили и закрыли - процесь
Call itm.embedObject(EMBED_ATTACHMENT,"", file)
End If

Function IsFileOpen(fileName) As Integer
Dim filenum As Integer
fileNum = Freefile()
On Error 101 Goto errorFileAlreadyOpen
Open fileName For Input Access Read Write As filenum ' менял эту строчку по всякому, открывает вайл только на чтение и все
Close filenum
IsFileOpen = False
Exit Function
errorFileAlreadyOpen:
IsFileOpen = True
Exit Function
End Function
Сделал в конечном итоге попростому.
ИТОГ

На моем компе все замечательно работает, а вот на тех глюкавых, вирусам погрызанных, но вылеченных НЕ РАБОТАЕТ, хоть лоб расшиби.

Код:
	ReturnCode = WShell.Run("swriter.exe " + file,1)

Dim OriginalFileDateTime As Variant
OriginalFileDateTime = Filedatetime(file)
Print "дата исходного файла " + Cstr(Filedatetime(file))
Sleep(2.5)
While OriginalFileDateTime <> Filedatetime(file)
'ждём пока OpenOffice не освободит файл
Wend
Stop
'о! освободил
Print "дата сохраненного файла " + Cstr(Filedatetime(file))
'If Filedatetime(file) <> OriginalFileDateTime Then
'Файл сохранили и закрыли - процесь
Call itm.embedObject(EMBED_ATTACHMENT,"", file)
Call doc.Save( True , False )
doc.SaveOptions = "0"
Call uidoc.close
Call ws.EditDocument( True , doc )
 

Kee_Keekkenen

Well-known member
05.09.2006
639
4
#15
Код:
RetVal = CreateProcessA ( 0&, RunProg , 0& , 0& , 1&, NORMAL_PRIORITY_CLASS , 0& , 0& , StartInf , proc )
RetVal = WaitForSingleObject ( proc.hProcess , INFINITE )
RetVal = CloseHandle ( proc.hProcess )
Этот блок кода фиг знает с какой закономерностью выкидывает баг, пользователь наколотил текст, закрыл OpenOfficе, сохранил по запросу (или наоборот), файл на диске сохранился с текстом, дальше он выполняет следущие по коду процедуры, НО приатаченный файл пустой шаблон (без текста).
не пробовал вызывать аналогичных приложений, т.е. в которых пользователь что-то делает..
а так архиватор запустить и т.п. использую аналогичную функцию
Код:
Function runShellAndWait(Byval programPath As String) As Boolean
Dim retVal As Long
Dim procInfo As ProcessInfoTYPE
Dim strtInfo As StartupInfoTYPE	
try:
On Error Goto catch	
strtInfo.cb = Len(strtInfo)	
' получение аргументов
retVal = W32CreateProcessA( 0, programPath, 0, 0, 0, NORMAL_PRIORITY_CLASS, 0, 0, strtInfo, procInfo) 		
' приостановка текущего приложения до выполнения shell'a
retVal = W32WaitForSingleObject(procInfo.hProcess, INFINITE)		
' закрытие процесса
retVal = W32CloseHandle(procInfo.hProcess) 
If retVal = 0 Then 
'Call logs.taskAdd("'Ошибка при закрытии процесса " & Getthreadinfo(1))
End If	
' удаление хендла
retVal = W32CloseHandle(procInfo.hThread) 
If retVal = 0 Then 
'Call logs.taskAdd("Ошибка при закрытии хендла " & Getthreadinfo(1))
End If	
runShellAndWait = True
Exit Function
catch:	
'errorType = 3
'Call logs.taskAdd("Во время выполнения агента произошла критическая ошибка:" 	&  _
'Cstr(Err) & ": " & Error & ", в строке " & Cstr( Erl) & " в модуле " & Getthreadinfo(1))
Exit Function
End Function
 
A

allex

#16
Смысл тотже... так у меня пользователь и так делает в запускаемом процессе свои дела, потом сохраняет свои изваяния и продолжает согластно диалогу скрипта
 
A

allex

#17
Щас пробовал выполнить код на другой машинке, которую ни вирусы не грызли и пользоатель не глумится над нею.
Так все тоже самое,

Код:
Dim db As NotesDatabase,ws As New notesuiworkspace,s As New NotesSession,itm As NotesRichTextItem
Set db = s.currentdatabase
Set uidoc = ws.CurrentDocument
Call uidoc.save
Set doc = uidoc.Document
Call doc.replaceitemvalue("tema","Постановление")
Call doc.Save( True , False )
Set itm = doc.GetFirstItem("Body")	
Set WShell = CreateObject("WScript.Shell") 
Set view = db.GetView ( "($TEMPLATES)" )
Set TemplateDoc = view.GetDocumentByKey ( "Постановление" )		
Set TemplateField = TemplateDoc.GetFirstItem ( "Body" )
If ( TemplateField.Type = RICHTEXT ) Then
Forall o In TemplateField.EmbeddedObjects 
Call o.ExtractFile ( "c:\lotustemp\" & o.Name )
TName = o.Name
End Forall 
End If
file = "c:\lotustemp\" & TName
ReturnCode = WShell.Run("swriter.exe " + file,1, True)
....................../
ВОТ НА ЭТОЙ / СТРОЧКЕ СОЗДАЕТСЯ ОБЪЕКТ но True не отрабатывает а идет дальше по коду и выполняется приатачивание файла
Print "Файл " + TName + " сохранен как " + file
Call itm.embedObject(EMBED_ATTACHMENT,"", file)
Ни как не понимаю что и почему так влияет на нормальную работу скрипта
 

Omh

Lotus team
04.07.2007
2 210
1
#18
allex
Я с OO делал так:
Код:
Result = Shell(<OO Path> <EDIT_FILE_PATH>, 1)
Sleep(2) 'надо дать время OO запуститься и залочить файл
Проверка на открытотсть файла и т.д.
 
A

allex

#19
Вопрос решен зацикливанием с проверкой на дату файла

allex
Я с OO делал так:
Код:
Result = Shell(<OO Path> <EDIT_FILE_PATH>, 1)
Sleep(2) 'надо дать время OO запуститься и залочить файл
Проверка на открытотсть файла и т.д.

Вот я так же и сделал.

Код:
OriginalFileDateTime = Filedatetime(ShortFileName$)
zz = Shell(ExeFile & " " & ShortFileName$, 1)

Do While OriginalFileDateTime = Filedatetime(ShortFileName$)
Print "Файл находится в процессе редактирования..."
Loop
Print "Идет сохранение файла и прикрепление к карточке..."
Sleep 3
' ******а дальше ******* приатачивание файла *************
Только sleep задал на сохранение файла
 
Статус
Закрыто для дальнейших ответов.