si=REPLICATE(CHR(0),68)
si=STUFF(si,1,4,num2dword(68))
* Устанавливаем флаги нового процесса
* STARTF_USESTDHANDLES - Выдать дескрипторы 3 потоков ввод, вывод и ошибки
si=STUFF(si,45,4,num2dword(BITOR(STARTF_USESTDHANDLES,STARTF_USESHOWWINDOW)))
si=STUFF(si,49,2,num2word(SW_SHOW))
si=STUFF(si,57,4,num2dword(m.h_my_input))
si=STUFF(si,61,4,num2dword(m.h_my_output))
pi=REPLICATE(CHR(0),16)
m.r=createprocess(null,pb,null,null,1,CREATE_NEW_CONSOLE,null,db,@si,@pi)
IF m.r=0
? 'CreateProcess failed'
ELSE
m.hproc=dword2num(SUBSTR(pi,1,4))
m.hthread=dword2num(SUBSTR(pi,5,4))
? 'HProcess = ',hproc
? 'HThread = ',hthread
=CloseHandle(m.HThread)
* Действия с процессом
m.str='Привет Всем !!!'+CHR(13)+CHR(10)
m.writtenbytes=0
m.overlapped=REPLICATE(CHR(0),20)
=setlasterror(0)
m.r=writefile(m.w_ph,m.str,LEN(m.str),@writtenbytes,null)
? 'WriteFile = ',m.r#0
? getsystemerror()
? 'ОБМЕН ДАННЫМИ'
m.o_res=dword2num(SUBSTR(m.overlapped,1,4))
IF !EMPTY(o_res)
m.buf=SPACE(100)
? 'Overlapped Internal = ',m.o_res,' - ',getsystemerror(m.o_res)
ENDIF
m.buf=REPLICATE(CHR(0),100)
m.read_bytes=0
? 'ЗАПИСАНО БАЙТ = ',writtenbytes
=setlasterror(0)
DO WHILE WaitForSingleObject(m.hProc, 50) # WAIT_OBJECT_0
DO WHILE (PeekNamedPipe(m.r_ph, null, 0, 0, @read_len, 0)#0 AND (read_len > 0))
IF readfile(m.r_ph,@buf,100,@read_len,null)#0
? getsystemerror()
? SUBSTR(m.buf,1,m.read_len)
? 'ПРОЧИТАНО БАЙТ = ',read_len
ENDIF
ENDDO
ENDDO
* ====================
ENDIF
=CloseHandle(m.hproc)
=CloseHandle(m.h_my_input)
=CloseHandle(m.h_my_output)
=closehandle(m.r_ph)
=closehandle(m.w_ph)
* Функция перевода числа в integer символьного вида - взял из vfp2tray Сергея Титова
FUNCTION num2dword
LPARAMETERS n1
RETURN CHR(BITAND(m.n1, 0xFF)) + ;
CHR(BITRSHIFT(BITAND(m.n1, 0xFF00), 8)) + ;
CHR(BITRSHIFT(BITAND(m.n1, 0xFF0000), 16)) + ;
CHR(BITRSHIFT(BITAND(m.n1, 0xFF000000), 24))
* Перевести строку в 4 байтное число
FUNCTION dword2num
LPARAMETERS str
RETURN
ASC(SUBSTR(m.str,1,1))+ASC(SUBSTR(m.str,2,1))*256+ASC(SUBSTR(m.str,3,1))*256^2+ASC(SUBSTR(m.str,4,1))*256^3
FUNCTION GetPlatform
PRIVATE OSVersionInfo
OSVersionInfo=REPLICATE(CHR(0),148)
OSVersionInfo=STUFF(OSVersionInfo,1,4,num2dword(148))
=getversionex(@OSVersionInfo)
RETURN dword2num(SUBSTR(OSVersionInfo,17,4))
FUNCTION GetSystemError
LPARAMETERS num
IF PARAMETERS()<1
m.num=GetLastError()
ENDIF
#DEFINE MAX_BUF_LEN 100
PRIVATE buf,x
IF m.num=0
RETURN ''
ENDIF
m.buf=SPACE(MAX_BUF_LEN)
=formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,NULL,m.num,0,@buf,MAX_BUF_LEN,NULL)
m.buf=ALLTRIM(m.buf)
IF !EMPTY(m.buf)
m.x=1
DO WHILE m.x<=LEN(m.buf)
IF SUBSTR(m.buf,m.x,1)=CHR(10)
m.buf=STUFF(m.buf,m.x,1,'')
ELSE
m.x=m.x+1
ENDIF
ENDDO
ENDIF
RETURN m.buf
В архиве содержится класс для работы с запущеным процессом. Имеет 3 основных метода :
1) RunEXE
2) WriteStr
3) ReadStr
Свойства имеют возможность перекодировки данных (OEMTOANSI) за счет выставления параметров
методов. Вот пример:
DO charts.prg
SET CLASSLIB TO graphs ADDITIVE
m.a=CREATEOBJECT('my_runner')
WITH a
* Вызов WIN32 приложения
.runexe('cmd /?')
? .readstr(.t.) && Параметр .t. означает перекодировку полученного выражения в ANSI
* При каждом вызове старое приложение теряется (закрывается его Handle и Handle-ы для обмена с
ним) !!!
* Вызов DOS приложения
.runexe('1.exe','',.t.) && Параметр '' - текущий каталог
&& Параметр .t. означает запуск DOS приложения (по умолчанию .f.)
.writestr('Привет всем !!!',.t.) && Параметр .t. что есть перекодировка в OEM (по умолчанию
.f.)
? .readstr(.t.)
ENDWITH
В test_runner.prg кажись не хватает строки
#INCLUDE charts.h
Однако даже с ней у меня не запустилось - видимость объявляемых переменных почему-то только на
test_runner.prg, при запуске в классе пишет, что нету INVALID_HANDLE_VALUE - почему, никак не пойму.
Пирожков Вадим
25.02.04 13:46:47
Хорошая утилита, только я не понял - при выполнении комнады
ping 127.0.0.1 - часть возвращаемого значение теряется (4 пинг и статистика) на команде tracert
www.ru - так же потери. Мне такая штука нужна - но где копать чтобы не терялся хвост - я не пойму.
Ткни носом куда рыть
ответы можно мылом на piva@acmetelecom.ru
Андрей
26.02.04 18:13:41
Да я тестил тоже на Ping-е и там идет потеря данных. Но суть в том что данные если они записаны в
Pipe то они теряться не должны (т.е. должны храниться). Но можно попробовать установить ожидание
процесса побольше т.е. в методе readstr в цикле DO WHILE WaitForSingleObject(m.hProc, 50) #
WAIT_OBJECT_0 вместо 50 поставить 100. Или наоборот поменьше т.е. поиграться с ним...
Пирожков Вадим
28.02.04 07:04:30
Суть - процесс умер, WaitFor уже не работает, а в pipe еще лежат данные Просто их надо забрать
после цикла do while WaitFor ... еще добавил цикл
DO while (PeekNamedPipe(.r_ph, null, 0, 0, @read_len, 0)#0) AND (m.read_len>0)
IF readfile(.r_ph,@buf,MAX_LEN,@read_len,null)#0
IF m.isdos
m.str=m.str+OEMTOANSI(SUBSTR(m.buf,1,m.read_len))
ELSE
m.str=m.str+SUBSTR(m.buf,1,m.read_len)
ENDIF
ENDIF
enddo
и все отлично заработало !
Спасибо за отличную утилиту.
Андрей
03.03.04 12:56:26
Исправлено...
Петров Андрей
28.03.05 12:13:36
Если в коде VCX при CreateProcess заменить константу SW_SHOW
на SW_HIDE то окно DOS может и не появляться...
Метод RunExe
Заменить строку
si=STUFF(si,49,2,.num2word(SW_SHOW))
на
si=STUFF(si,49,2,.num2word(SW_HIDE))
rvc44
11.03.08 10:29:06
А у меня почему-то ничего не пингуется с использованием данной утилиты. По любому адресу интернета
пишет "Превышен интервал ожидания..." Подключение осуществляется по LAN, а далее через модем.
Наверно админы что-то подкрутили и запретили ping, т.к. следующий код отрабатывает отлично и
практически без задержки (см. следующий пост)
rvc44
11.03.08 10:31:58
[code]
* Функция GetIP
LPARAM pHost
LOCAL nStruct, nSize, cBuffer, nAddr, cIP, lcResult
#DEFINE HOSTENT_SIZE 16
DECLARE INTEGER WSAStartup IN ws2_32;
INTEGER wVerRq,;
STRING @ lpWSAData
DECLARE INTEGER gethostbyname IN ws2_32;
STRING hostname
DECLARE RtlMoveMemory IN kernel32 As CopyMemory;
STRING @ Destination,;
INTEGER Source,;
INTEGER nLength
DECLARE STRING inet_ntoa IN ws2_32;
INTEGER in_addr
DECLARE INTEGER WSACleanup IN ws2_32
IF WSAStartup(0x202, Repli(Chr(0),512)) <> 0
=MessageBox("Невозможно инициализировать Winsock на этом компьютере!",48,"Ошибка:")
RETURN .F.
ENDIF
nStruct = gethostbyname(pHost)
IF !Empty(nStruct)
cBuffer = Repli(Chr(0), HOSTENT_SIZE)
cIP = Repli(Chr(0), 4)
= CopyMemory(@cBuffer, nStruct, HOSTENT_SIZE)
= CopyMemory(@cIP, CTOBIN(SubStr(cBuffer,13,4), '4RS'), 4)
= CopyMemory(@cIP, CTOBIN(cIP, '4RS'), 4)
*-- Преобразуем сетевой адрес (Ipv4) в строку стандарта Интернет, разделенную точками
lcResult = inet_ntoa(CTOBIN(cIP, '4RS')) && inet_ntoa(buf2dword(cIP))
ELSE
lcResult = ""
ENDIF
= WSACleanup()
RETURN lcResult
[/code]
rvc44
11.03.08 10:34:25
Правда
[code]
? GetIP("www.yandex.ru")
[/code]
в 2006 году возвращал 213.180.204.11,
а в 2008 году уже возвращает 87.250.251.11
и многие другие сайты также поменяли свои IP-адреса,
хотя некоторые и остались без изменения (пока?),
например, www.altavista.com, www.aport.ru, www.rambler.ru
имеюют соотв. 216.155.200.155, 194.67.1.14, 81.19.70.1
Конференция
