Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Invoking a perl script
Message
De
14/03/2005 13:35:43
 
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Divers
Thread ID:
00994810
Message ID:
00995609
Vues:
18
Here is an example using createprocess and waiting for the process to end:
(I used activeperl)

It assumes again that the script is in c:\perl\scripts and perl.exe is in c:\perl\bin

vfp program
*Example createprocess and wait for it to end
doapp("c:\perl\bin\perl.exe","c:\perl\scripts\sample.pl")
RETURN

FUNCTION doapp 
LPARAMETERS cApptoRun, cCmdLine

DO DeclareDlls

cProcessInfo = Repli(Chr(0), 16)
cStartupInfo = CHR(68) + REPLICATE(CHR(0),67)
nCreationFlags = 0
cApptoRun = ALLTRIM(cApptorun)
cCmdLine = " " + ALLTRIM(cCmdLine)

nResult = CreateProcess(cApptorun, cCmdLine, 0,0,0,;
		nCreationFlags, 0, "C:\windows", @cStartUpInfo, @cProcessInfo)

?nResult

IF nResult <> 0
	
	lnProcessHandle = buf2dword(SUBSTR(cProcessInfo,1,4))
	lnThreadHandle = buf2dword(SUBSTR(cProcessInfo,5,4))
	
	* wait until the termination of the program
	DOEVENTS

	DO WHILE .T.

      * reset exit code each loop
      STORE 0 TO ExitCode

      * fetch the exit code from the app
      =GetExitCodeProcess(lnProcessHandle,@ExitCode)

      * if exitcode = 259, this means app not busy so exit
      IF exitcode # 259  && not still busy
         EXIT
      ENDIF

      Sleep(100) && wait .1 seconds

	ENDDO

   CloseHandle(lnThreadHandle)
   CloseHandle(lnProcessHandle)
	
ELSE

   STORE GetLastError() TO lnErrorNum
   WAIT WINDOW "Last Error num: " + LTRIM(STR(lnErrorNum))

ENDIF

DO REleaseDLLS
RETURN

*-----------------------------------------------------------
PROCEDURE buf2dword
PARAMETERS tcString
RETURN ASC(SUBSTR(tcString,1,1)) + ;
   ASC(SUBSTR(tcString,2,1)) * 256 + ;
   ASC(SUBSTR(tcString,3,1)) * 65536 + ;
   ASC(SUBSTR(tcString,4,1)) * 16777216 
   TO lnReturn

*-----------------------------------------------------------
PROCEDURE DeclareDLLS
LOCAL dllArray[1], lnNumDLLs

STORE ADLLS(dllarray) TO lnNumDLLs

IF ASCAN(dllarray,'CREATEPROCESS') = 0
	DECLARE INTEGER CreateProcess IN kernel32;
		STRING lpApplicationName, STRING lpCommandLine,;
		INTEGER lpProcessAttributes, INTEGER lpThreadAttributes,;
		INTEGER bInheritHandles, INTEGER dwCreationFlags,;
		INTEGER lpEnvironment, STRING lpCurrentDirectory,;
		STRING @lpStartupInfo, STRING @lpProcessInformation
ENDIF
IF ASCAN(dllarray,'GETLASTERROR') = 0
    DECLARE INTEGER GetLastError IN kernel32
ENDIF
IF ASCAN(dllarray,"CLOSEHANDLE") = 0
    DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
ENDIF
IF ASCAN(dllarray,"GETEXITCODEPROCESS") = 0
    DECLARE INTEGER GetExitCodeProcess IN WIN32API INTEGER hProcess, INTEGER @lpExitCode
ENDIF
IF ASCAN(dllarray,"SLEEP") = 0
    DECLARE Sleep IN kernel32 INTEGER dwMilliseconds
ENDIF

RETURN

*-----------------------------------------------------------
PROCEDURE ReleaseDLLs  && release dlls for exewait function

CLEAR DLLS CreateProcess
CLEAR DLLS GetLastError
CLEAR DLLS CloseHandle
CLEAR DLLS GetExitCodeProcess
CLEAR DLLS Sleep

RETURN
Perl Sample.pl
print "Please type in either heads or tails: ";

#The <STDIN> is the way to read keyboard input
$answer = <STDIN>;
chomp $answer;

while ( $answer ne "heads" and $answer ne "tails" ) {
	print "I asked you to type heads or tails. Please do so: ";
	$answer = <STDIN>;
	chomp $answer;
}

print "Thanks. You chose $answer.\n";
print "Hit enter key to continue: ";

#This line is here to pause the script
#until you hit the carriage return
#but the input is never used for anything.
$_ = <STDIN>;

if ( $answer eq "heads" ) {
	print "HEADS! you WON!\n";
} else {
	print "TAILS?! you lost. Try again!\n";
}
.·*´¨)
.·`TCH
(..·*

010000110101001101101000011000010111001001110000010011110111001001000010011101010111001101110100
"When the debate is lost, slander becomes the tool of the loser." - Socrates
Vita contingit, Vive cum eo. (Life Happens, Live With it.)
"Life is not measured by the number of breaths we take, but by the moments that take our breath away." -- author unknown
"De omnibus dubitandum"
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform