Ls & Winapi

Тема в разделе "Lotus - Программирование", создана пользователем allex, 10 июл 2009.

Статус темы:
Закрыта.
  1. allex

    allex Гость

    Код (Text):
    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е, сохранил по запросу (или наоборот), файл на диске сохранился с текстом, дальше он выполняет следущие по коду процедуры, НО приатаченный файл пустой шаблон (без текста).

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

    TIA :-)
    Lotus team

    Регистрация:
    15 май 2009
    Сообщения:
    790
    Симпатии:
    0
    Вероятно, при выгрузке процесса, его хэндл закрывается раньше хэндла редактируемого файла.
    Попробуй ещё дождаться, пока файл окончательно закроется. Если OpenOffice блокирует редактируемые файлы от записи другими процессами, то проверить, что хэндл файла ещё открыт можно так.

    Код (Text):
    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
     
  3. Omh

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    TIA
    Послухай, а откуда эта процедурка?
    Сам писал или нашёл где-то?
    ------------------
    Просто смотрю, у меня очень похожая процедурина есть, а откуда взял не помню.
    Ща погуглил, вроде какой-то француз такую в 2005 году выкладывал :)
     
  4. morpheus

    morpheus скриптописец

    Регистрация:
    7 авг 2006
    Сообщения:
    3.927
    Симпатии:
    0
    allex

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

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

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    По мне, так тут winapi нафик не нужен.
    OpenOffice/MS Office при открытии блочат файл и эта конструкция работает как часы.
     
  6. allex

    allex Гость

    RetVal = WaitForSingleObject ( proc.hProcess , INFINITE )

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

    TIA :-)
    Lotus team

    Регистрация:
    15 май 2009
    Сообщения:
    790
    Симпатии:
    0
    Кажется, из песочницы, в составе какой-нибудь LS-Lib
     
  8. allex

    allex Гость

    Morpheus

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

    allex Гость

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

    Код (Text):
    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 )
    Пример покажи, как сделать чтоб после сохранения файла в OpenOffice он приаттачился .. ну и потом по ходу скрипта выполнялись следующие за этим действием процедуры
     
  10. Omh

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    TempFolder - папка, куда екстрактнули файл.
    AttachmentName - собственно, сам файл.
    IsFileOpen приводили чуть раньше.

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

    Код (Text):
    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
     
  11. allex

    allex Гость

    покурим..ка...
     
  12. Omh

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    Тока кажись с OpenOffice надо немного изменить вот эту строку
    Код (Text):
    Open fileName For Random Lock Read Write As filenum
    Попытаться открыть в другом режиме.
    Я когда-то пробовал и у меня с OO работало, только не помню, что точно менял.
     
  13. lmike

    lmike нет, пердело совершенство
    Команда форума Lotus team

    Регистрация:
    27 авг 2008
    Сообщения:
    6.073
    Симпатии:
    299
    опенофисовые доки - это архив, на форуме есть код по работе с ним (джава)
    может пробовать разархивировать или просто получить список в архиве
     
  14. allex

    allex Гость

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

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

    Код (Text):
    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
    Сделал в конечном итоге попростому.
    ИТОГ

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

    Код (Text):
        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 )
     
  15. Kee_Keekkenen

    Kee_Keekkenen Well-Known Member

    Регистрация:
    5 сен 2006
    Сообщения:
    616
    Симпатии:
    4
    не пробовал вызывать аналогичных приложений, т.е. в которых пользователь что-то делает..
    а так архиватор запустить и т.п. использую аналогичную функцию
    Код (Text):
    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
     
  16. allex

    allex Гость

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

    allex Гость

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

    Код (Text):
    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)
    Ни как не понимаю что и почему так влияет на нормальную работу скрипта
     
  18. Omh

    Omh Lotus team
    Lotus team

    Регистрация:
    4 июл 2007
    Сообщения:
    2.210
    Симпатии:
    0
    allex
    Я с OO делал так:
    Код (Text):
    Result = Shell(<OO Path> <EDIT_FILE_PATH>, 1)
    Sleep(2) 'надо дать время OO запуститься и залочить файл
    Проверка на открытотсть файла и т.д.
     
  19. allex

    allex Гость

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


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

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

    Do While OriginalFileDateTime = Filedatetime(ShortFileName$)
    Print "Файл находится в процессе редактирования..."
    Loop
    Print "Идет сохранение файла и прикрепление к карточке..."
    Sleep 3
    ' ******а дальше ******* приатачивание файла *************
    Только sleep задал на сохранение файла
     
Загрузка...
Похожие Темы - Winapi
  1. bestguru
    Ответов:
    0
    Просмотров:
    913
  2. DreamForse
    Ответов:
    0
    Просмотров:
    2.214
  3. Vadik(R)
    Ответов:
    1
    Просмотров:
    1.438
  4. Vadik(R)
    Ответов:
    1
    Просмотров:
    1.404
  5. alekssgor
    Ответов:
    0
    Просмотров:
    1.914
Статус темы:
Закрыта.

Поделиться этой страницей