FoxPro Club Главная

Конференция Решения Фотоальбом Сайт М.Дроздова Статьи Файловый архив Книга Visual FoxPro 9.0 Русский Help для Visual FoxPro
Пользователей: 9233
Вход
Запуск консольной (включая DOS) программы с перехватом потоков ввода/вывода (без < > !)

Теперь можно запускать прогу из под VFP и читать из нее данные как из файла (аналогично запись...) Использую функцию CreateProcess.


 
Прислал: Петров Андрей   Категория: Система


Запуск DOS программы с перехватом потоков ввода/вывода (без < > !)

Вот код программы - вместо 1.exe напишите то что нуджно вызвать...

#INCLUDE charts.h
DO charts.prg
CLEAR

PRIVATE pb,db,si,pi,hproc,hthread,h_my_input,h_my_output,secattr,r_ph,w_ph
pb='1.exe'
db=SYS(5)+SYS(2003)

IF GetPlatform() # VER_PLATFORM_WIN32_NT
pb='COMMAND.COM /c '+pb
ELSE
pb='cmd /c '+pb
ENDIF

* Создаем дескрипторы потоков ввода/вывода
m.secattr=REPLICATE(CHR(0),12)
m.secattr=STUFF(m.secattr,1,4,num2dword(12))
m.secattr=STUFF(m.secattr,9,4,num2dword(1))

m.r_ph=0
m.w_ph=0
m.read_len=0
STORE INVALID_HANDLE_VALUE TO h_my_output, h_my_input

*=createpipe(@h_my_input, @h_my_output, secattr, 0)
=createpipe(@r_ph, @h_my_output, secattr, 0)
IF h_my_output = INVALID_HANDLE_VALUE
? 'error creating output pipe'
RETURN .t.
ELSE
? 'h_my_output = ',h_my_output
ENDIF

=createpipe(@h_my_input, @w_ph, secattr, 0)
IF h_my_input = INVALID_HANDLE_VALUE
? 'error creating input pipe'
RETURN .t.
ELSE
? 'h_my_input = ',h_my_input
ENDIF

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))

FUNCTION num2word
LPARAMETERS n1
RETURN CHR(BITAND(m.n1, 0xFF)) + ;
CHR(BITRSHIFT(BITAND(m.n1, 0xFF00), 8))

* Перевести строку в 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

 
Сделайте оценку этого решения Плохо Удовлетворительно Так себе Хорошо Отлично Текущая оценка: (4.778) Вложение [11.55]kb
Дополнения пользователей
Запуск консольной (включая DOS) программы с перехватом потоков ввода/вывода (без < > !)
[+][?]
Т. Аскольд
28.04.04 13:12:02

В 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

[Дополнить]



© 2000-2017 Fox Club 
При размещении любых материалов с сайта на других ресурсах- прямая ссылка на www.foxclub.ru обязательна
Яндекс.Метрика