VPF::Как сделать программу фоновой ?

XPurple

Дата 19.5.2006, 07:41 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Написал программу для запуска из командной строки. Интерфейс отсутствует. Но видно, что при запуске программа запускается не в фоновом режиме (форма курсора мышки меняется на песочные часы). Как сделать, чтобы программа запускалась в фоновом режиме ?

--------------------

Кто никогда ни о чем не спрашивает: тот либо знает все, либо не знает ничего. Не помню, кто сказал, может быть, я (с)

boevik

Дата 19.5.2006, 07:46 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35

При создании программы, добавить модуль и убрать форму.
В модуле создать процедуру main, это стартовая тожка программы.
Так же в project properties изменить старт программы с формы на main.

--------------------

Никогда не говори никогда

XPurple

Дата 19.5.2006, 09:47 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Цитата(boevik @ 19.5.2006, 07:46

)

При создании программы, добавить модуль и убрать форму.

Сделал, как вы рекомендоввали, но при загрузке песочные часики остались плюс исчезло свойство иконки (Icon).
Может быть в самой программе как-то можно указать?

Это сообщение отредактировал(а) XPurple - 19.5.2006, 10:02

--------------------

Akina

Дата 19.5.2006, 10:12 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

Цитата(XPurple @ 19.5.2006, 08:41

)

при запуске программа запускается не в фоновом режиме (форма курсора мышки меняется на песочные часы).

Это не программа работает, а ОС ее запускает и ждет возврата управления.

Цитата(XPurple @ 19.5.2006, 10:47

)

исчезло свойство иконки (Icon)

Добавь в ресурсы икону с ID=1.

Цитата(XPurple @ 19.5.2006, 08:41

)

Как сделать, чтобы программа запускалась в фоновом режиме ?

Это тебе не ДОС и не Никсы - тут нет фонового режима, тут ногозадачность вытесняющая, понимаешь. Попробуй в начале программы DoEvents добавить...

--------------------

О(б)суждение моих действий - в соответствующей теме, пожалуйста. Или в РМ. И высшая инстанция - Администрация форума.

~FoX~

Дата 19.5.2006, 10:27 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

SetPriority тебе в руки smile

--------------------

…множественность никогда не следует полагать без необходимости…

XPurple

Дата 19.5.2006, 12:21 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Цитата(~FoX~ @ 19.5.2006, 10:27

)

SetPriority

Пишет, неизвестная функция или процедура.

Это сообщение отредактировал(а) XPurple - 19.5.2006, 13:05

--------------------

boevik

Дата 19.5.2006, 13:19 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1452
Регистрация: 31.5.2004
Где: Израиль

Репутация: 12
Всего: 35

Поосторожнее с приоритетами, а то система может перестать реагировать

--------------------

Никогда не говори никогда

~FoX~

Дата 19.5.2006, 15:21 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

Цитата(XPurple @ 19.5.2006, 13:21

)

Пишет, неизвестная функция или процедура.

Я погорячился, скорее тебе подойдет SetTheardPriority хотя смысл не меняется
Это АПИ функция, ее сначала надо определить:

Код


Public Declare Function SetThreadPriority Lib "Kernel32" _
(ByVal HANDLE As Long, _   ' Хэндл процесса
 ByVal nPriority As Long) _  ' Тип приоритета
As Boolean

Const THREAD_PRIORITY_LOWEST = -2 ' А это то что кладется в nPriority

--------------------

…множественность никогда не следует полагать без необходимости…

XPurple

Дата 19.5.2006, 22:06 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Цитата(~FoX~ @ 19.5.2006, 15:21

)

Public Declare Function SetThreadPriority Lib "Kernel32" _

Несколько раз встречал подобное выражение. Это означает использование функций не из VB ?

--------------------

cardinal

Дата 20.5.2006, 03:14 (ссылка)

(нет голосов)

Загрузка ...

Инженер

Профиль
Группа: Экс. модератор
Сообщений: 6003
Регистрация: 26.3.2002
Где: Германия

Репутация: 19
Всего: 99

Это означает использование библиотеки kernel32.dll, а точнее API функции SetThreadPriority сидящей в этой библиотеке...

--------------------

Немецкая оппозиция потребовала упростить натурализацию иммигрантов
В моем блоге: Разные истории из жизни в Германии

"Познание бесконечности требует бесконечного времени, а потому работай не работай - все едино". А. и Б. Стругацкие

Walera

Дата 22.5.2006, 04:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 17
Регистрация: 4.5.2006

Репутация: нет
Всего: нет

а что должна делать твоя программа в фоновом режиме

XPurple

Дата 22.5.2006, 06:29 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Walera
Она должна считывать список файлов и фольдеров с сохранением в текстовом виде(файле). А почему именно в фоновом режиме -или как меня поправили - с более низким приоритетом (но не в этом суть), то данный процесс может затянуться на достаточно длительный период, хотелось бы обезопасить себя на случай длительного скана, чтобы процесс не тормозил систему.

Добавлено @ 06:37
Вот так сделал пока. Взято из примеров, но почему-то везде в примерах указывают/объявляют SetPriotityClass, а не SetThreadPriority.
Чем эти функции различаются между собой ?

Код


Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As _
Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As _
Long) As Long

Public Enum Priority
   IDLE_PRIORITY_CLASS = &H40
   NORMAL_PRIORITY_CLASS = &H20
   HIGH_PRIORITY_CLASS = &H80
   REALTIME_PRIORITY_CLASS = &H100
End Enum

Public Sub SetPriority(pParam As Priority)
   SetPriorityClass GetCurrentProcess(), pParam
End Sub


Private Sub Form_Load()
SetPriority (IDLE_PRIORITY_CLASS)
'....
End sub

Это сообщение отредактировал(а) XPurple - 22.5.2006, 06:39

--------------------

~FoX~

Дата 22.5.2006, 08:02 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 10
Всего: 68

SetThreadPriority - устанавливает приоретет для потока
SetPriorityClass - устанавливает приоритет для всех потоков процесса

--------------------

…множественность никогда не следует полагать без необходимости…

XPurple

Дата 22.5.2006, 10:13 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Немного в оффтоп:
Как расчитать: какие используются потоки или хотя бы где почерпнуть соответствующую информацию ?

--------------------

Akina

Дата 22.5.2006, 10:18 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

Что-то мне подсказывает, что не в этом дело. Проблема имхо - в неверном написании кода самой программы.

Цитата(XPurple @ 22.5.2006, 07:29

)

Она должна считывать список файлов и фольдеров с сохранением в текстовом виде(файле).

Дай код блока сканирования.

--------------------

XPurple

Дата 22.5.2006, 12:55 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Akina

Код


Public Sub WriteListDir()

If fso.FolderExists(sourceDir) Then
Set fold = fso.GetFolder(sourceDir)
otf2.Write "Файлы в " & sourceDir & vbCrLf
dirListStatus = FileTree(fold)
'otf2.Close

Else
'msg = MsgBox("Папка " & sFile & " не найдена", vbInformation, "Результат")
End If

End Sub

Public Function ListFile(ByRef folder As Object) As String

For Each vfile In folder.Files
otf2.Write Chr(124) + String(6, 151) + Chr(62)
otf2.Write (vfile.Name) & vbCrLf
Next

End Function


Public Function FileTree(ByVal fold1 As folder) As String
'Public Function FileTree(ByVal fold1 As object) As String

For Each vdir In fold1.SubFolders
otf2.Write Chr(124) + String(3, 151) + Chr(62)
otf2.Write UCase(vdir.Name) & vbCrLf
FileTree = FileTree(vdir)
Next

msg = ListFile(fold1)
End Function

Это сообщение отредактировал(а) XPurple - 22.5.2006, 13:02

--------------------

Akina

Дата 22.5.2006, 14:08 (ссылка)

(нет голосов)

Загрузка ...

Советчик

Профиль
Группа: Модератор
Сообщений: 20581
Регистрация: 8.4.2004
Где: Зеленоград

Репутация: 34
Всего: 454

А что есть otf2? файл вывода? как открыт?

Думаю, именно тут источник проблем... попробуй кластеризовать вывод, типа такого:

Код


Const FlushPortion as long = 65536&
buffer = ""
FileHandle = FreeFile
Open FileName$ For Output As #FileHandle
...
buffer = buffer & NextDataToWrite
call FlushBuffer(buffer, FileHandle, False)
...
call FlushBuffer(buffer, FileHandle, True)
Close #FileHandle

...

Sub FlushBuffer(ByVal buffer as string, FileHandle as long, Done as boolean)
if Done then
   write #FileHandle, buffer;
   buffer = ""
ElseIf Len(buffer)>FlushPortion Then
   write #FileHandle, left(buffer, FlushPortion);
   buffer = mid(buffer, FlushPortion+1)
End If
end sub

--------------------

XPurple

Дата 22.5.2006, 14:23 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 140
Регистрация: 4.5.2006
Где: Челябинск

Репутация: 1
Всего: 1

Akina
Вся программа

Код


Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Const IDLE_PRIORITY_CLASS = &H40
Dim fso, otf, gf, otf2 As Object
Dim fso1 As New FileSystemObject
Dim sourceDir, FileTreeFileName As String
Dim msg
Dim ConfFile, ResultFile, ResultDir As String
Dim confFileExist As Boolean
Dim fold As Object
Dim vfile As Object
Dim vdir As Object
Dim dirListStatus As String
Dim permissionFile As Boolean
Dim retval As Integer


Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As _
Long, ByVal dwPriorityClass As Long) As Long
Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As _
Long) As Long

Public Enum Priority
   IDLE_PRIORITY_CLASS = &H40
   NORMAL_PRIORITY_CLASS = &H20
   HIGH_PRIORITY_CLASS = &H80
   REALTIME_PRIORITY_CLASS = &H100
End Enum

Public Sub SetPriority(pParam As Priority)
   SetPriorityClass GetCurrentProcess(), pParam
End Sub




Private Sub Form_Load()
SetPriority (IDLE_PRIORITY_CLASS)

ConfFile = "filetree.ini"
confFileExist = ReadConfFile()
'ResultFile = ResultDir & "\" & FileTreeFileName
ResultFile = ResultDir & FileTreeFileName

On Error GoTo CheckError ' Turn on error handling.
    If confFileExist And fso.FolderExists(ResultDir) Then
    Set otf2 = fso.OpenTextFile(ResultFile, ForWriting, True)
    WriteListDir
    
    
    otf2.Close
    Else
    'msg = MsgBox("Файл resultDir" & fso.FolderExists(ResultDir) & " существует", vbInformation, "Результат")
    End If
 
CheckError:
permissionFile = PermissionAccess()

  End
End Sub

Public Function ReadConfFile() As Boolean

   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FileExists(ConfFile)) Then
        Set otf = fso.OpenTextFile(ConfFile, ForReading, True)
      Set gf = fso.GetFile(ConfFile)
             If gf.Size > 0 Then
           
             sourceDir = SelectString(otf, True)
             ResultDir = SelectString(otf, True)
             FileTreeFileName = SelectString(otf, False)
             'FileTreeFileName = SelectString(9)
             'otf.Skip (12)
             'ResultDir = otf.ReadLine()
             'otf.Skip (9)
             'FileTreeFileName = otf.ReadLine()
             
             'msg = MsgBox("Файл sFile" & ConfFile & " существует", vbInformation, "Результат")
             ReadConfFile = True
             'msg = MsgBox("Файл " & ConfFile & " нормальный", vbInformation, "Результат")
              Else
            'msg = MsgBox("Файл " & ConfFile & " пустой", vbInformation, "Результат")
            ReadConfFile = False
            
            End If
          otf.Close
    Else
      'msg = MsgBox("Файл " & ConfFile & " не найден", vbInformation, "Результат")
   End If
End Function

Public Sub WriteListDir()

If fso.FolderExists(sourceDir) Then
Set fold = fso.GetFolder(sourceDir)
otf2.Write "Файлы в " & sourceDir & vbCrLf
dirListStatus = FileTree(fold)
'otf2.Close
Else
'msg = MsgBox("Папка " & sFile & " не найдена", vbInformation, "Результат")
End If
End Sub

Public Function PermissionAccess() As Boolean
Const conErrPermissionDenied = 70
    If (Err.Number = conErrPermissionDenied) Then
    PermissionAccess = False
    'msg = MsgBox("Файл " & ResultFile & " не доступен", vbInformation, "Результат")
    Else
    'msg = MsgBox("Файл " & ResultFile & " доступен", vbInformation, "Результат")
    
    PermissionAccess = True
      End If
End Function

Public Function ListFile(ByRef folder As Object) As String

For Each vfile In folder.Files
otf2.Write Chr(124) + String(6, 151) + Chr(62)
otf2.Write (vfile.Name) & vbCrLf
Next

End Function


Public Function FileTree(ByVal fold1 As folder) As String
'Public Function FileTree(ByVal fold1 As object) As String
For Each vdir In fold1.SubFolders
otf2.Write Chr(124) + String(3, 151) + Chr(62)
otf2.Write UCase(vdir.Name) & vbCrLf
FileTree = FileTree(vdir)
Next
msg = ListFile(fold1)
End Function



Public Function SelectString(ByVal openReadConf As Object, ByVal CheckSlash As Boolean) _
As String
Dim valTemp As String
Dim position As Integer

valTemp = openReadConf.ReadLine()
position = InStr(1, valTemp, "=", vbTextCompare)
valTemp = Right(valTemp, Len(valTemp) - position)
'MsgBox valTemp

If Right(valTemp, 1) <> "\" And CheckSlash Then
SelectString = valTemp + "\"
Else
SelectString = valTemp
End If
End Function

Это сообщение отредактировал(а) XPurple - 22.5.2006, 14:24

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »