Открытие формы до завершения Form_Load

[Vasiliy8338]

Добрый день.
Есть два вопроса:
1) Есть программа, которая получает через Command путь к файлу, что-то делает с этим с файлом, показывает результат своей работы в виде сообщения, и после нажатия ОК на месседже закрывается. Пока весь описанный процесс идет, пользователь должен видеть ход выполнения процесса.
Так вот суть проблемы: до окончания функции Form_Load сама форма не отображается... а так как все действия выполняются внутри данной процедуры, то окно формы с ходом выполнения всего процесса не появляется. В конце появляется одинокий месседж и после ОК он закрывается.
Как отобразить форму до того, как процедура Form_Load будет выполнена? Вариант с "создай кнопку, которая будет выполнять действия" не рассматриваются - клиент не хочет нажимать кнопки - все должно быть автоматически.

2) при запуске данной программы из VB или при запуске напрямую код выполняется и программа завершает свой процесс успешно.
Если же ее открывает другой процесс (программа сканирования), который передает в командной строке путь к файлу, то после завершения всех действий процесс висит в задачах. Работа программы завершается командой Unload Me. Пробовал уже ставить в конце процедуры End. Не помогает.
Как побороть эту заразу?

[Viper] :: Vasiliy8338, ты ошибся разделом. На первый раз просто устное предупреждение. Тему переношу. tag_warning

[Viper]

1. Помещать код не в Form_Load, а например в Form_Activate. Другой вариант, вообще не помещать код вычислений в форму, а для отображения хода процесса использовать вызов процедуры экземпляра формы.
2. По твоему описанию вроде бы все верно. Где-то что-то у тебя остается работающее несмотря на Unload Me. Код в студию.

[Demonx]

1) в самом начале form_load() поставь me.show и doevents

[Денис]

1) в самом начале form_load() поставь me.show и doevents

Не соглашусь.
Нужно просто заменить Form_Load процедурой Form_Activate, как уже было сказано.
________________

Но на самом деле, Vasiliy8338, если твоя программа работает с командной строкой, то самым правильным будет писать код в Sub Main() и уже из него подымать инстанс формы (как опять же было предложено)

[Vasiliy8338]

1) в самом начале form_load() поставь me.show и doevents

Это пробовал, не помогает.
Сейчас попробую активацию.

[Viper]

Vasiliy8338, правильные советы не читаем принципиально?

[Vasiliy8338]

Vasiliy8338, правильные советы не читаем принципиально?

Читаем все!
Спасибо, всем, кто посоветовал вставить все в активацию окна - работает на ура!
Сейчас буду искать незавершенные дела, чтобы программа выключалась...

[Viper]

Vasiliy8338, лучше вынеси код в Sub Main, это правильнее.

[Vasiliy8338]

2. По твоему описанию вроде бы все верно. Где-то что-то у тебя остается работающее несмотря на Unload Me. Код в студию.

Public TmpPath As String, CMS$
Dim ScanName As Integer, ScanCoding As Integer, ScanSrvPassive As Integer, ScanSaveLog As Integer, _
ScanMin As Long, ScanSumChk As Integer, ScanSumSet$, ScanURL$, ScanArchive$, ScanLogURL$
Dim ScanFTPLogin$, ScanFTPPass$, ScanFTPSrv$, ScanFTPFolder$
'ÔÓÍÊÖÈÈ ÐÀÁÎÒÛ Ñ FTP-ÑÅÐÂÅÐÎÌ
'óêàçàíèå èíòåðíåò-ïðîòîêîëà
Private Const INTERNET_SERVICE_FTP = 1


'ôóíêöèÿ îòêðûòèÿ èíòåðíåò-ñîåäèíåíèÿ
Private Declare Function InternetOpen _
Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, _
ByVal nAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal nFlags As Long) As Long


'ôóíêöèÿ ñîåäèíåíèÿ ñ èíòåðíåòîì
Private Declare Function InternetConnect _
Lib "wininet.dll" Alias "InternetConnectA" ( _
ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUserName As String, _
ByVal sPassword As String, _
ByVal nService As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long

'âûãðóçêà íà FTP
Private Declare Function FtpPutFile _
Lib "wininet.dll" Alias "FtpPutFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean

'çàêðûòèå ñîåäèíåíèÿ ñ FTP
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" (ByVal hInet As Long) As Integer


'ÔÓÍÊÖÈÈ ÄËß ÐÀÁÎÒÛ Ñ ÐÅÅÑÒÐÎÌ
Private Const REG_SZ = 1

Public Enum HKEY_CONSTANTS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum

'×òåíèå çíà÷åíèÿ èç ðååñòðà
Private Declare Function RegQueryValueExS Lib "advapi32.dll" _
Alias "RegQueryValueExA" ( _
ByVal hkey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As String, _
lpcbData As Long) As Long

'Çàïèñü çíà÷åíèÿ â ðååñòð
Private Declare Function RegSetValueExS Lib "advapi32.dll" _
Alias "RegSetValueExA" ( _
ByVal hkey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByVal lpData As String, _
ByVal cbData As Long) As Long

'îòêðûòèå ðååñòðà äëÿ ÷òåíèÿ/çàïèñè
Private Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" ( _
ByVal hkey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

'çàêðûòèå ðååñòðà ïîñëå ÷òåíèÿ/çàïèñè
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hkey As Long) As Long

'ñîçäàíèå êëþ÷à â ðååñòðå
Private Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" ( _
ByVal hkey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

'ÔÓÍÊÖÈß ÏÎËÓ×ÅÍÈß ÇÍÀ×ÅÍÈß ÈÇ ÐÅÅÑÒÐÀ
Private Function GetString( _
ByVal HomeKey As HKEY_CONSTANTS, _
ByVal KeyName As String, _
ByVal ValueName As String) As String

'Handle ðàçäåëà ðååñòðà
Dim hkey As Long
'ïåðåìåííàÿ äëÿ õðàíåíèÿ çíà÷åíèÿ
Dim sData As String
'Ðåçóëüòàò ðàáîòû API ôóíêöèé
Dim lres As Long
'Òèï âîçâðàùàåìîãî çíà÷åíèÿ
Dim lDataType As Long
'ïåðåìåííàÿ äëÿ õðàíåíèÿ äëèíû ñòðîêè
Dim lDlen As Long

'Îòêðûâàåì Ðàçäåë
lres = RegOpenKey(HomeKey, KeyName, hkey)

'Åñëè âåðíóëñÿ íå íîëü - îøèáêà, âûõîäèì
If lres <> 0 Then
lres = RegCloseKey(hkey)
GetString = vbNullString: Exit Function
End If

'Ïðîäîëæàåì, çàïîëíÿåì ñòðîêó ïðîáåëàìè.
sData = String$(64, 32) & Chr$(0)
lDlen = Len(sData)
'×èòàåì çíà÷åíèå
lres = RegQueryValueExS(hkey, ValueName, 0, lDataType, sData, lDlen)

'îïÿòü ïðîâåðêà íà îøèáêó
If lres <> 0 Then
GetString = vbNullString: Exit Function
End If

'ïðîâåðÿåì òèï ïîëó÷åííûõ äàííûõ
If lDataType = REG_SZ Then
GetString = Left$(sData, lDlen - 1)
Else:
GetString = vbNullString
End If

'è çàêðûâàåì ðàçäåë
lres = RegCloseKey(hkey)

End Function

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'ÔÓÍÊÖÈß ÈÇÌÅÍÅÍÈß ÊÎÄÈÐÎÂÊÈ
Private Function StringConvert(ByVal strSrc As String, ByVal nFromCP As Long, ByVal nToCP As Long) As String
Dim nLen As Long
Dim strDst As String
Dim strRet As String
Dim nRet As Long

nLen = Len(strSrc)
strDst = String(nLen * 2, Chr(0))
strRet = String(nLen * 2, Chr(0))
nRet = MultiByteToWideChar(nFromCP, MB_PRECOMPOSED, strSrc, nLen, strDst, nLen)
nRet = WideCharToMultiByte(nToCP, 0, strDst, nRet, strRet, nLen * 2, ByVal 0, 0)
StringConvert = Left(strRet, nRet)
'Çíà÷åíèÿ äëÿ êîäèðîâîê:
'0) Win-1251 - 1251
'1) KOI8-R - 20866
'2) KOI8-U - 21866
'3) Unicode UTF-7 - 65000
'4) Unicode UTF-8 - 65001
'5) ISO-8859-5 - 28595
'6) DOS Cyr - 866
'7) MAC Cyr 2000 - 10007

End Function
Private Function nasDirExists(strPathName As String) As Boolean
On Error Resume Next
Dim strDir As String

strDir = Dir(strPathName, vbDirectory)
If (Len(strDir) = 0 Or Err = 76) Then
nasDirExists = False
Else:
nasDirExists = True
End If
End Function
Private Function ReadURL(ByVal URL4Read As String)
Dim i%, URLLen%, CurURL$
URLLen = Len(URL4Read)
CurURL = URL4Read
For i = 1 To URLLen
If Right(Left(CurURL, i), 1) = ":" Then
ScanFTPLogin = Left(CurURL, i - 1)
CurURL = Right(CurURL, URLLen - i)
i = URLLen
End If
Next i
URLLen = Len(CurURL)
For i = 1 To URLLen
If Right(Left(CurURL, i), 1) = "@" Then
ScanFTPPass = Left(CurURL, i - 1)
CurURL = Right(CurURL, URLLen - i)
i = URLLen
End If
Next i
URLLen = Len(CurURL)
For i = 1 To URLLen
If Right(Left(CurURL, i), 1) = "/" Then
ScanFTPSrv = Left(CurURL, i - 1)
ScanFTPFolder = Right(CurURL, URLLen - i)
i = URLLen
End If
Next i
End Function

Private Sub Form_Activate()
DoEvents


Dim FileNum As Integer 'çàäàåì ïåðåìåííóþ (Íîìåð ôàéëà äëÿ ââîäà-âûâîäà)


lblAppName.Caption = "Scan2FTP v" & App.Major & "." & App.Minor 'óñòàíàâëèâàåì çàãîëîâîê îêíà
frFTP.Visible = False 'äåëàåì ôðåéì ïî-óìîë÷àíèþ íåâèäèìûì

Dim CmdPath$, TodayTime$, YYYY$, MM$, DD$, HH$, MI$, SS$ 'îáúÿâëåíèå ïåðåìåííûõ
TodayTime = Now 'îïðåäåëåíèå ïåðåìåííîé (òåêóùàÿ äàòà)
YYYY = Year(TodayTime) 'îïðåäåëåíèå ïåðåìåííîé (òåêóùèé ãîä)
MM = Month(TodayTime) 'îïðåäåëåíèå ïåðåìåííîé (òåêóùèé ìåñÿö)
DD = Day(TodayTime) 'îïðåäåëåíèå ïåðåìåííîé (òåêóùèé äåíü)
HH = Hour(TodayTime) 'îïðåäåëåíèå ïåðåìåííîé (òåêóùèé ÷àñ)
MI = Minute(TodayTime) 'îïðåäåëåíèå ïåðåìåííîé (òåêóùàÿ ìèíóòà)
SS = Second(TodayTime) 'îïðåäåëåíèå ïåðåìåííîé (òåêóùàÿ ñåêóíäà)
If Len(MM) < 2 Then 'åñëè ìåñÿö ìåíüøå 10, òî äîáàâëÿåì â íà÷àëå "0"
MM = "0" & MM
End If
If Len(DD) < 2 Then 'åñëè äåíü ìåíüøå 10, òî äîáàâëÿåì â íà÷àëå "0"
DD = "0" & DD
End If
If Len(HH) < 2 Then 'åñëè ÷àñ ìåíüøå 10, òî äîáàâëÿåì â íà÷àëå "0"
HH = "0" & HH
End If
If Len(MI) < 2 Then 'åñëè ìèíóòà ìåíüøå 10, òî äîáàâëÿåì â íà÷àëå "0"
MI = "0" & MI
End If
If Len(SS) < 2 Then 'åñëè ñåêóíäà ìåíüøå 10, òî äîáàâëÿåì â íà÷àëå "0"
SS = "0" & SS
End If

If Dir(App.Path & "\s2f.dat") <> "s2f.dat" Then 'åñëè íå íàéäåí ôàéë ñ íàñòðîêàìè, òî çàêðûâàåì ïðîãðàììó ñ ñîîáùåíèåì îá îøèáêå
MsgBox "Íå íàéäåí ôàéë íàñòðîåê." & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If

CMS = GetString(HKEY_LOCAL_MACHINE, "Software\2FTP", "CMS")


FileNum = FreeFile 'îáúÿâëÿåì ïåðåìåííóþ (Íîìåð ôàéëà äëÿ ââîäà-âûâîäà)
Open App.Path & "\s2f.dat" For Input As #FileNum

Line Input #FileNum, ScanSumSet
ScanSumSet = modCryptText.UnCryptText(ScanSumSet)
If ScanSumSet = "UNCRYPTERROR" Then
Close FileNum
MsgBox "Êðèòè÷åñêàÿ îøèáêà (321)!" & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If
Line Input #FileNum, ScanPass
ScanPass = modCryptText.UnCryptText(ScanPass)
If ScanPass = "UNCRYPTERROR" Then
Close FileNum
MsgBox "Êðèòè÷åñêàÿ îøèáêà (321)!" & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If
ScanName = Left(ScanSumSet, 1)
ScanCoding = Right(Left(ScanSumSet, 2), 1)
ScanSrvPassive = Right(Left(ScanSumSet, 3), 1)
ScanSaveLog = Right(Left(ScanSumSet, 4), 1)
ScanMin = Right(Left(ScanSumSet, 7), 3)
ScanSumChk = Right(Left(ScanSumSet, 10), 3)
If ScanSumChk <> ScanName + ScanCoding + ScanSrvPassive + ScanSaveLog + ScanMin Then
Close FileNum
MsgBox "Êðèòè÷åñêàÿ îøèáêà (321)!" & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If

Line Input #FileNum, ScanURL
ScanURL = modCryptText.UnCryptText(ScanURL)
If ScanURL = "UNCRYPTERROR" Then
Close FileNum
MsgBox "Êðèòè÷åñêàÿ îøèáêà (321)!" & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If
Line Input #FileNum, ScanArchive
ScanArchive = modCryptText.UnCryptText(ScanArchive)
If ScanArchive = "UNCRYPTERROR" Then
Close FileNum
MsgBox "Êðèòè÷åñêàÿ îøèáêà (321)!" & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If

If ScanSaveLog = 1 Then
Line Input #FileNum, ScanLogURL
ScanLogURL = modCryptText.UnCryptText(ScanLogURL)
If ScanLogURL = "UNCRYPTERROR" Then
Close FileNum
MsgBox "Êðèòè÷åñêàÿ îøèáêà (321)!" & Chr(10) & "Äàëüíåéøàÿ ðàáîòà íåâîçìîæíà." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà"
End
End If
End If

Close FileNum

CmdPath = Command

'îïðåäåëåíèå ïåðåìåííûõ (ïóòü ê ñêàíèðîâàííîìó ôàéëó)
If ScanName = 1 Then
addData.Show 1
TmpPath = App.Path & "\tmp\tmp_" & TmpPath
Else:
TmpPath = App.Path & "\tmp\tmp_" & CMS & "_" & YYYY & MM & DD & "_" & HH & MI & SS & _
".jpg" 'îïðåäåëåíèå ïåðåìåííûõ (ïóòü ê âðåìåííîìó ôàéëó)
End If


If nasDirExists(App.Path & "\tmp\") = False Then 'åñëè íåò ïàïêè âðåìåííûõ ôàéëîâ, òî ñîçäàåì åå
MkDir (App.Path & "\tmp\")
End If



If CmdPath = vbNullString Then 'åñëè êîìàíäíàÿ ñòðîêà ïóñòàÿ, òî ïðîâåðÿåì íåîòïðàâëåííûå ôàéëû
If Dir(App.Path & "\tmp\tmp_*.jpg") <> "" Then 'åñëè åñòü íåîòïðàâëåííûå ôàéëû, òî ïûòàåìñÿ èõ îòïðàâèòü áåç âîïðîñîâ
lblStatus.Caption = "Íàéäåíû íåîòïðàâëåííûå ôàéëû."
While Dir(App.Path & "\tmp\tmp_*.jpg") <> ""
lblFTP.Caption = "Îòïðàâëÿåòñÿ ôàéë " & Dir(App.Path & "\tmp\tmp_*.jpg") & "..."
Call SendScan(App.Path & "\tmp\" & Dir(App.Path & "\tmp\tmp_*.jpg"))
Wend
Else: 'èíà÷å çàêðûâàåì ïðîãðàììó ñ ñîîáùåíèåì îá îòñóòñòâèè ñêàíà è íåîòïðàâëåííûõ ôàéëîâ
MsgBox "Ñêàíèðîâàíèå íå ïðîèçâîäèëîñü." & Chr(10) & "Íåîòïðàâëåííûõ ôàéëîâ íå íàéäåíî." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbInformation, "Scan2FTP v" & App.Major & "." & App.Minor
End
End If
Else:
CmdPath = Left(CmdPath, Len(CmdPath) - 1)
CmdPath = Right(CmdPath, Len(CmdPath) - 1)
If Right(Dir(CmdPath), 4) <> ".jpg" Then 'åñëè íå íàéäåí ôàéë ñêàíà, òî çàêðûâàåì ïðîãðàììó ñ ñîîáùåíèåì îá îøèáêå
MsgBox "Ñêàíåð ïåðåäàë íåâåðíûé ïóòü," & Chr(10) & "èëè ôàéë èìååò íåâåðíûé ôîðìàò." _
& Chr(10) & "Ïðèëîæåíèå áóäåò çàêðûòî.", vbCritical, "Îøèáêà ïîëó÷åíèÿ ôàéëà"
End
End If
Dim Chislo As Long
Chislo = 1024 * ScanMin
If FileLen(CmdPath) < Chislo Then
MsgBox "Ìèíèìàëüíûé äîïóñòèìûé ðàçìåð ôàéëà: " & ScanMin & " ÊÁ." & Chr(10) & _
"Óâåëè÷üòå ðàçðåøåíèå è ïîâòîðèòå ïîïûòêó.", vbCritical, "Îøèáêà ðàçìåðà ôàéëà"
Kill CmdPath
End
End If
If FileLen(CmdPath) > 307200 Then
Kill CmdPath
MsgBox "Ìàêñèìàëüíûé äîïóñòèìûé ðàçìåð ôàéëà: 300 ÊÁ." & Chr(10) & _
"Óìåíüøèòå ðàçðåøåíèå è ïîâòîðèòå ïîïûòêó.", vbCritical, "Îøèáêà ðàçìåðà ôàéëà"
End
End If
FileCopy CmdPath, TmpPath
Kill CmdPath
lblStatus.Caption = "Ôàéë îò ñêàíåðà ïîëó÷åí. Èäåò îòïðàâêà..."
Call SendScan(TmpPath)
If Dir(App.Path & "\tmp\tmp_*.jpg") <> "" Then 'åñëè åñòü íåîòïðàâëåííûå ôàéëû, òî ïûòàåìñÿ èõ îòïðàâèòü áåç âîïðîñîâ
lblStatus.Caption = "Íàéäåíû íåîòïðàâëåííûå ôàéëû."
While Dir(App.Path & "\tmp\tmp_*.jpg") <> ""
lblFTP.Caption = "Îòïðàâëÿåòñÿ ôàéë " & Dir(App.Path & "\tmp\tmp_*.jpg") & "..."
Call SendScan(App.Path & "\tmp\" & Dir(App.Path & "\tmp\tmp_*.jpg"))
Wend
End If
End If
MsgBox "Îòïðàâêà çàâåðøåíà.", vbInformation, "Ñîîáùåíèå"
End
End Sub

Private Sub cmdFTP_Click()
End
End Sub
'ôóíêöèÿ îòïðàâêè ñêàíà
Private Function SendScan(ByVal FileFrom As String)
DoEvents

'ïåðåìåííûå ðàáîòû ñ ÔÒÏ-ñåðâåðîì
Dim hInetSession As Variant, hSession As Variant
Dim FTPPath$, FTPMode$


frFTP.Visible = True
lblFTP.Caption = "Óñòàíîâêà ñâÿçè ñ ñåðâåðîì..."
progFTP.Value = 10
'ðàçáèðàåì ññûëêó äëÿ ñêàíîâ íà ëîãèí, ïàðîëü, ñåðâåð, ïàïêó
Call ReadURL(ScanURL)
'çàäàåì ïóòü ê ôàéëó ñêàíà íà ÔÒÏ
FTPPath = ScanFTPFolder & Right(Dir(FileFrom), Len(Dir(FileFrom)) - 4)
progFTP.Value = 20
'ìåíÿåì êîäèðîâêó ïóòåé â ñîîòâåòñòâèè ñ íàñòðîéêàìè
If ScanCoding = 1 Then
FTPPath = StringConvert(FileFrom, 1251, 20866)
End If
If ScanCoding = 2 Then
FTPPath = StringConvert(FileFrom, 1251, 21866)
End If
If ScanCoding = 3 Then
FTPPath = StringConvert(FileFrom, 1251, 65000)
End If
If ScanCoding = 4 Then
FTPPath = StringConvert(FileFrom, 1251, 65001)
End If
If ScanCoding = 5 Then
FTPPath = StringConvert(FileFrom, 1251, 28595)
End If
If ScanCoding = 6 Then
FTPPath = StringConvert(FileFrom, 1251, 866)
End If
If ScanCoding = 7 Then
FTPPath = StringConvert(FileFrom, 1251, 10007)
End If
lblFTP.Caption = "Îòêðûâàåì ñîåäèíåíèå ñ Èíòåðíåòîì..."
progFTP.Value = 30

hInetSession = InternetOpen("MyFTPClient", 0, vbNullString, vbNullString, 0)
If ScanSrvPassive = 1 Then
FTPMode = "&H8000000"
Else:
FTPMode = "0"
End If
lblFTP.Caption = "Ñîåäèíåíèå ñ Èíòåðíåòîì îòêðûòî."
progFTP.Value = 40
lblFTP.Caption = "Óñòàíàâëèâàåì ñîåäèíåíèå ñ FTP-ñåðâåðîì..."

hSession = InternetConnect(hInetSession, ScanFTPSrv, "21", ScanFTPLogin, ScanFTPPass, 1, FTPMode, 1)
If hSession = 0 Then
progFTP.Value = 0
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hInetSession)
MsgBox "Íå óäàëîñü óñòàíîâèòü ñîåäèíåíèå ñ FTP-ñåðâåðîì." _
& Chr(10) & "Ïîïðîáóéòå ïîâòîðèòü ïîçäíåå èëè îáðàòèòåñü â òåõïîääåðæêó.", vbCritical, "Îøèáêà ñâÿçè": End
End If
progFTP.Value = 50
lblFTP.Caption = "Ñîåäèíåíèå ñ ñåðâåðîì óñòàíîâëåíî."
Dim SendFile As Boolean
SendFile = FtpPutFile(hSession, FileFrom, FTPPath, 2, 1)
If SendFile = False Then
progFTP.Value = 0
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hInetSession)
MsgBox "Ñîåäèíåíèå ñ ñåðâåðîì áûëî óñòàíîâëåíî," & Chr(10) & _
"íî ôàéë ñêîïèðîâàòü íå óäàëîñü." & Chr(10) & _
"Îáðàòèòåñü çà ïîìîùüþ â òåõïîääåðæêó.", vbCritical, "Îøèáêà êîïèðîâàíèÿ": End
End If
Call InternetCloseHandle(SendFile)
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hInetSession)
'åñëè ñòîèò îïöèÿ ñîõðàíåíèÿ ëîãîâ, òî ïðîäåëûâàåì îïÿòü âñå äëÿ ëîã-ôàéëà
If ScanSaveLog = 1 Then
progFTP.Value = 60
Dim ScanLogName$, LogFileNum As Integer
LogFileNum = FreeFile
ScanLogName = Left(Right(Dir(FileFrom), Len(Dir(FileFrom)) - 4), Len(Right(Dir(FileFrom), Len(Dir(FileFrom)) - 4)) - 4)
Open App.Path & "\tmp\" & ScanLogName For Output As #LogFileNum
Close #LogFileNum
Open App.Path & "\tmp\" & ScanLogName For Output As #LogFileNum
Close #LogFileNum
Call ReadURL(ScanLogURL)
FTPPath = ScanFTPFolder & ScanLogName
progFTP.Value = 70
'ìåíÿåì êîäèðîâêó ïóòåé â ñîîòâåòñòâèè ñ íàñòðîéêàìè
If ScanCoding = 1 Then
FTPPath = StringConvert(FileFrom, 1251, 20866)
End If
If ScanCoding = 2 Then
FTPPath = StringConvert(FileFrom, 1251, 21866)
End If
If ScanCoding = 3 Then
FTPPath = StringConvert(FileFrom, 1251, 65000)
End If
If ScanCoding = 4 Then
FTPPath = StringConvert(FileFrom, 1251, 65001)
End If
If ScanCoding = 5 Then
FTPPath = StringConvert(FileFrom, 1251, 28595)
End If
If ScanCoding = 6 Then
FTPPath = StringConvert(FileFrom, 1251, 866)
End If
If ScanCoding = 7 Then
FTPPath = StringConvert(FileFrom, 1251, 10007)
End If
lblFTP.Caption = "Îòêðûâàåì ñîåäèíåíèå ñ Èíòåðíåòîì..."
progFTP.Value = 80

hInetSession = InternetOpen("MyFTPClient", 0, vbNullString, vbNullString, 0)
If ScanSrvPassive = 1 Then
FTPMode = "&H8000000"
Else:
FTPMode = "0"
End If
progFTP.Value = 90

hSession = InternetConnect(hInetSession, ScanFTPSrv, "21", ScanFTPLogin, ScanFTPPass, 1, FTPMode, 1)
If hSession = 0 Then
progFTP.Value = 100
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hInetSession)
MsgBox "Ñêàíèðîâàííàÿ êîïèÿ áûëà óñïåøíî îòïðàâëåíà." _
& Chr(10) & "Ëîã-ôàéë îòïðàâèòü íå óäàëîñü.", vbExclamation, "Îøèáêà ñâÿçè": End
End If
progFTP.Value = 90
lblFTP.Caption = "Ñîåäèíåíèå ñ ñåðâåðîì óñòàíîâëåíî."
Dim SendLogFile As Boolean
SendLogFile = FtpPutFile(hSession, FileFrom, FTPPath, 2, 1)
If SendFile = False Then
progFTP.Value = 100
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hInetSession)
MsgBox "Ñêàíèðîâàííàÿ êîïèÿ áûëà óñïåøíî îòïðàâëåíà." & Chr(10) & _
"Ëîã-ôàéë îòïðàâèòü íå óäàëîñü.", vbExclamation, "Îøèáêà êîïèðîâàíèÿ": End
End If
Call InternetCloseHandle(hSession)
Call InternetCloseHandle(hInetSession)
Kill App.Path & "\tmp\" & ScanLogName
End If
If nasDirExists(ScanArchive) = False Then 'åñëè íåò ïàïêè âðåìåííûõ ôàéëîâ, òî ñîçäàåì åå
MkDir (ScanArchive)
End If
ScanArchive = ScanArchive & Right(Dir(FileFrom), Len(Dir(FileFrom)) - 4)
FileCopy FileFrom, ScanArchive
Kill FileFrom
lblFTP.Caption = "Îòïðàâêà çàâåðøåíà."
lblStatus.Caption = "Ôàéë " & Dir(Right(TmpPath, Len(TmpPath) - 4)) & " óñïåøíî îòïðàâëåí."
progFTP.Value = 100
End Function

Вот так вот вышло. При обработке кода из VB все ок. Если создать файл, то не выгружается... Точнее первый запуск проходит успешно, а вот во второй раз не выгружается. Если подождать минут 10, то опять же все выгружается ровно один раз.

[Хакер]

Размешение до сумашествия длинного сообщения с неоформленным кодом было последней каплей.

В качестве наказания тема закрывается.