bonjour à tous,
me revoilou avec un autre pb sur mon projet qui dure, qui dure...
j'ai une appli GUI avec un bouton qui lance une appli console... le pb est que je voudrais la fermer proprement aussi depuis mon appli GUI avec un autre bouton mais je ne sais pas comment faire!
voici le code de l'appli GUI:
procedure TfrmMeasureConsoleTest.btOnClick(Sender: TObject);
begin
// Lancement des mesures
Finish := False;
// Blabla de config...
CmdLine := PChar(IntToStr(SmallInt(ConverterAccuracy))
+ ' ' + IntToStr(SmallInt(PresentModulesCount))
+ ' ' + IntToStr(SmallInt(MovingWay))
+ ' ' + BoolToStr(LogicalInputs));
sStorePath := GetEnvironmentVariable('BDSPROJECTSDIR');
pstupinfomes.cb := SizeOf(pstupinfomes);
pstupinfomes.lpTitle := PAnsiChar('Console de mesure');
pstupinfomes.dwFlags := STARTF_USESHOWWINDOW;
pstupinfomes.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
pstupinfomes.wShowWindow := SW_SHOWMINIMIZED; // SW_SHOWMINIMIZED
// ou SW_SHOWNORMAL
// ou SW_HIDE
// pstupinfomes.hStdInput := ;
// pstupinfomes.hStdOutput := ;
// pstupinfomes.hStdError := ;
if not CreateProcess( PChar(sStorePath+'\Bpl\En test\MesConsole.exe'),
PChar(CmdLine),
nil,
nil,
TRUE,
CREATE_NEW_CONSOLE, // 0 ou CREATE_NEW_CONSOLE
nil,
PChar(sStorePath+'\Bpl\En test'),
pstupinfomes,
pprocinfomes)
then Exception.Create('Erreur à la création de la console de mesure');
end;
procedure TfrmMeasureConsoleTest.btOffClick(Sender: TObject);
begin
// Arrêt des mesures là je sais que je suis complètement ds les choux
Finish := True;
end;
voici le code de l'appli console:
program MesConsole;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
Dialogs,
uParalPortR in '..\MesSources\uParalPortR.pas',
uCommonTypesandValues in '..\MesSources\uCommonTypesandValues.pas';
const BUFSIZE = 4096;
kernel32 = 'kernel32.dll';
shell32 = 'shell32.dll';
function GetCommandLineW(): PWideChar; stdcall; external kernel32;
function CommandLineToArgvW(lpCmdLine: PWideChar; pNumArgs: PInteger): PPWideChar; stdcall; external shell32;
var
// hChildStdInRd, hChildStdInWr, hChildStdInWrDup,
// hChildStdOutRd, hChildStdOutWr, hChildStdOutRdDup,
// hInputFile, hSaveStdIn, hSaveStdOut : THandle;
WalkMeasureAcquirer : TMeasureAcquirer;
OneCompleteMeasure : TCompleteMeasure;
dwRead, dwWritten : DWORD;
sRead, sWrite : String;
i,n : Integer;
p : Array[0..3] of String;
sz : SmallInt;
// len : Integer;
// wbn : Cardinal;
// pOvLap : POverlapped;
// saEventSecAttr : PSecurityAttributes;
RTLCriticSection : TRTLCriticalSection;
cmdln : PChar;
convacc : SmallInt = -1;
convrng : SmallInt = -1;
prsmodcnt : SmallInt = -1;
walkway : SmallInt = -1;
alarms : Boolean;
//var
MeasureTime : TLargeInteger;
hs : SmallInt;
chId : SmallInt;
//procedure ErrorExit(const ErrStr : PAnsiChar);
//var
// hStdErr : THandle;
//begin
// hStdErr := GetStdHandle(STD_ERROR_HANDLE);
// WriteLn(hStdErr, ErrStr);
// ExitProcess(0);
//end;
//function CreateChildProcess : Boolean;
//var piProcInfo : _PROCESS_INFORMATION;
// siStartInfo : _STARTUPINFOA;
// bFuncRetn : Boolean;
//begin
// bFuncRetn := FALSE;
//
//// Set up members of the PROCESS_INFORMATION structure.
// ZeroMemory( @piProcInfo, SizeOf(_PROCESS_INFORMATION) );
//
//// Set up members of the STARTUPINFO structure.
// ZeroMemory( @siStartInfo, SizeOf(_STARTUPINFOA) );
// siStartInfo.cb := SizeOf(_STARTUPINFOA);
//
//// Create the child process.
// bFuncRetn := CreateProcess( nil,
// 'child', // command line
// nil, // process security attributes
// nil, // primary thread security attributes
// TRUE, // handles are inherited
// 0, // creation flags
// nil, // use parent's environment
// nil, // use parent's current directory
// siStartInfo, // STARTUPINFO pointer
// piProcInfo); // receives PROCESS_INFORMATION
//
// if (not bFuncRetn)
// then ErrorExit('CreateProcess failed')
// else begin
// CloseHandle(piProcInfo.hProcess);
// CloseHandle(piProcInfo.hThread);
// end;
// Result := bFuncRetn;
//end;
//procedure WriteToPipe;
//var dwRead, dwWritten : DWORD;
// chBuf : PAnsiChar;
// i : Integer;
//begin
//
// // Read from a file and write its contents to a pipe.
// for i:=0 to BUFSIZE do
// begin
// if (not ReadFile(hInputFile, chBuf, BUFSIZE, dwRead, nil) or (dwRead=0))
// then Break;
// if not WriteFile(hChildStdInWrDup, chBuf, dwRead, dwWritten, nil)
// then Break;
// end;
//
// // Close the pipe handle so the child process stops reading.
// if not CloseHandle(hChildStdInWrDup)
// then ErrorExit('Close pipe failed');
//end;
//procedure ReadFromPipe;
//var dwRead, dwWritten : DWORD;
// chBuf : PAnsiChar;
// hStdout : Integer;
// i : Integer;
//begin
// hStdOut := GetStdHandle(STD_OUTPUT_HANDLE);
//
// // Close the write end of the pipe before reading from the
// // read end of the pipe.
// if not CloseHandle(hChildStdOutWr)
// then ErrorExit('Closing handle failed');
//
// // Read output from the child process, and write to parent's STDOUT.
// for i:=0 to BUFSIZE do
// begin
// if ((not ReadFile( hChildStdOutRdDup, chBuf, BUFSIZE, dwRead, nil)) or (dwRead=0))
// then Break;
// if (not WriteFile(hSaveStdOut, chBuf, dwRead, dwWritten, nil))
// then Break;
// end;
//end;
procedure ExecProg;
var mescnt : Integer;
begin
try
mescnt := WalkMeasureAcquirer.GetEntireMeasure;
if mescnt=0
then begin
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := GetLastError;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue ' + IntToStr(ExitCode)
+ ' dans la procédure de mesure. Mesure n° '
+ IntToStr(OneCompleteMeasure.elMeasureCount)
+ ' à ' + DateTimeToStr(Now);
raise Exception.Create(sWrite);
Exit;
end
else begin
try
Inc(OneCompleteMeasure.elMeasureCount);
// OneCompleteMeasure.elMeasureCount := WalkMeasureAcquirer.GetMeasureCount;
OneCompleteMeasure.elDeviceClockCount := WalkMeasureAcquirer.GetDeviceClockCount;
OneCompleteMeasure.elSystemClockCount := WalkMeasureAcquirer.GetSystemClockCount;
OneCompleteMeasure.elTOR := WalkMeasureAcquirer.GetTORStatus;
OneCompleteMeasure.elDeviceValues := WalkMeasureAcquirer.EntireMeasure;
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_STORING_ERROR;
//Gérer la condition d'erreur
Dec(OneCompleteMeasure.elMeasureCount);
sWrite := 'Exception imprévue ' + IntToStr(GetLastError)
+ ' dans la procédure de mesure '
+ ' (' + IntToStr(ExitCode) + '). Mesure n° '
+ IntToStr(OneCompleteMeasure.elMeasureCount)
+ ' à ' + DateTimeToStr(Now);
raise Exception.Create(sWrite);
Exit;
end;
end;
// Traitement des alarmes
// A PERSONNALISER................................
case OneCompleteMeasure.elTOR of
// 0 : begin
0..15 : begin
// Stockage dans un fichier texte pour affichage temporaire
sWrite := 'Mesure n° '
+ IntToStr(OneCompleteMeasure.elMeasureCount)
+ ' effectuée à ' + IntToStr(OneCompleteMeasure.elSystemClockCount)
+ ' : ';
for hs:=SmallInt(hsLeft) to SmallInt(hsRight)
do for chId:=SmallInt(chHWCntTOR) to SmallInt(chC)
do if (hs=SmallInt(hsLeft)) and (chId=SmallInt(chHWCntTOR))
then sWrite := sWrite + IntToStr(OneCompleteMeasure.elDeviceValues[THandSide(hs),TChannelIndex(chId)])
else sWrite := sWrite + ' / '
+ IntToStr(OneCompleteMeasure.elDeviceValues[THandSide(hs),TChannelIndex(chId)]);
sWrite := sWrite + ' ( alarmes TOR : ' + IntToStr(OneCompleteMeasure.elTOR) + ' ) ';
// Stockage dans un fichier de données
sz := SizeOf(OneCompleteMeasure);
WriteFile( hDataFileHandle,
OneCompleteMeasure,
sz,
dwWritten,
nil);
end;
// 1..15 : begin
// //Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
// ExitCode := EXTERNAL_EVENT_ERROR;
// //Gérer la condition d'erreur
// sWrite := 'Exception imprévue ' + IntToStr(GetLastError)
// + ' dans la procédure de mesure '
// + ' (' + IntToStr(ExitCode) + '). Mesure n° '
// + IntToStr(OneCompleteMeasure.elMeasureCount)
// + ' à ' + DateTimeToStr(Now);
// raise Exception.Create(sWrite);
// end;
else begin
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := EXTERNAL_EVENT_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue ' + IntToStr(GetLastError)
+ ' dans la procédure de mesure '
+ ' (' + IntToStr(ExitCode) + '). Mesure n° '
+ IntToStr(OneCompleteMeasure.elMeasureCount)
+ ' à ' + DateTimeToStr(Now);
raise Exception.Create(sWrite);
end;
end;
finally
WriteLn(fTxtFile, sWrite );
end;
end;
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
///////////////////////////// PROGRAMME PRINCIPAL /////////////////////////////
///////////////////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////////////////
begin
{ TODO -oUser -cConsole Main : placez le code ici }
// PARAMETRES A ENVOYER LORS DE L'EXECUTION //
// PAR LIGNE DE COMMANDE OU //
// EN TANT QUE SERVICE //
// cmdln := PChar( IntToStr(SmallInt(caLow))
// + ' ' + IntToStr(SmallInt(mcMax))
// + ' ' + IntToStr(SmallInt(mwAway))
// + ' ' + BoolToStr(False, True));
// cmdln := PChar( IntToStr(SmallInt(caHigh))
// + ' ' + IntToStr(SmallInt(mcMin))
// + ' ' + IntToStr(SmallInt(mwBack))
// + ' ' + BoolToStr(True, True));
cmdln := GetCommandLine;
//////////////////////////////////////////////
ExitCode := MEASURE_NO_ERROR;
Finish := False;
try
// Text File Creation
try
AssignFile(fTxtFile,sTxtFileName);
Rewrite(fTxtFile);
sWrite := DateTimeToStr(Now);
WriteLn(fTxtFile,sWrite);
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_FILE_CREATION_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue dans la création du fichier texte '
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
raise Exception.Create(sWrite);
CloseFile(fTxtFile);
ExitProcess(ExitCode);
end;
// Data File Creation
try
hDataFileHandle := CreateFile( PChar(sDataFileName),
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
saDataFileSecAttr,
CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL,
0);
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_FILE_CREATION_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue dans la création du fichier texte '
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
raise Exception.Create(sWrite);
ExitProcess(ExitCode);
end;
// Interprétation de la ligne de commande
try
sWrite := '';
n := 0;
for i:=0 to Length(cmdln)
do begin
if ((cmdln[i] <>' ') and (cmdln[i] <>#0))
then sWrite := sWrite + cmdln[i]
else begin
p[n] := sWrite;
Inc(n);
sWrite := '';
end;
end;
convacc := StrToInt(p[0]);
prsmodcnt := StrToInt(p[1]);
walkway := StrToInt(p[2]);
alarms := StrToBool(p[3]);
// sWrite := IntToStr(convacc)
// + ' ' + IntToStr(prsmodcnt)
// + ' ' + IntToStr(walkway)
// + ' ' + BoolToStr(alarms,True);
// WriteLn(fTxtFile, sWrite );
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_COMMMANDLINE_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue dans la configuration du système '
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
WriteLn(fTxtFile, sWrite );
raise Exception.Create(sWrite);
ExitProcess(ExitCode);
end;
// Création de l'objet carte d'acquisition
try
WalkMeasureAcquirer := TMeasureAcquirer.CreateSelf( TModulesCount(prsmodcnt),
TConverterAccuracy(convacc),
TMovingWay(walkway),
alarms);
sWrite := IntToStr(SmallInt(WalkMeasureAcquirer.GetSensorsAccuracy))
+ ' ' + IntToStr(SmallInt(WalkMeasureAcquirer.GetModulesCount))
+ ' ' + IntToStr(SmallInt(WalkMeasureAcquirer.GetMovingWay))
+ ' ' + IntToStr(WalkMeasureAcquirer.GetSystemClockFreq)
+ ' ' + BoolToStr(WalkMeasureAcquirer.GetTORActivation,True);
WriteLn(fTxtFile, sWrite );
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_SYSTEM_CONFIG_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue dans la définition du système '
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
WriteLn(fTxtFile, sWrite );
raise Exception.Create(sWrite);
ExitProcess(ExitCode);
end;
// Création de la variable de mesure
try
OneCompleteMeasure.elMeasureCount := 0;
OneCompleteMeasure.elTOR := 0;
sWrite := IntToStr(Integer(OneCompleteMeasure.elMeasureCount))
+ ' ' + IntToStr(OneCompleteMeasure.elSystemClockCount)
+ ' ' + IntToStr(SizeOf(OneCompleteMeasure.elDeviceValues))
+ ' ' + IntToStr(OneCompleteMeasure.elTOR)
+ ' ' + IntToStr(SizeOf(OneCompleteMeasure));
WriteLn(fTxtFile, sWrite );
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_OBJECT_CREATION_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue dans la création de la variable de données '
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
WriteLn(fTxtFile, sWrite );
raise Exception.Create(sWrite);
ExitProcess(ExitCode);
end;
// Initialize the critical section one time only.
try
InitializeCriticalSection(RTLCriticSection);
except
//Définit ExitCode <> MEASURE_NO_ERROR pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_CRITICAL_SECTION_CREATION_ERROR;
//Gérer la condition d'erreur
sWrite := 'Exception imprévue dans la création de la variable de données '
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
WriteLn(fTxtFile, sWrite );
raise Exception.Create(sWrite);
ExitProcess(ExitCode);
end;
// Création du processus enfant
// try
// CreateChildProcess;
// except
// ExitProcess(ExitCode);
// end;
// Boucle de programme
while not Finish do
begin
try
// Prise de mesure
EnterCriticalSection(RTLCriticSection);
ExecProg;
LeaveCriticalSection(RTLCriticSection);
// Temporisation
Sleep(1);
except
//Définit ExitCode <> 0 pour indiquer la condition d'erreur (par convention)
ExitCode := MEASURE_MAINLOOP_ERROR;
////// SetLastError
//Gérer la condition d'erreur
sWrite := 'Fin de programme dûe à une exception dans la boucle principale'
+ IntToStr(GetLastError) + ' (' + IntToStr(ExitCode) + ')';
WriteLn(fTxtFile, sWrite );
raise Exception.Create('Exception imprévue dans la boucle principale');
ExitProcess(ExitCode);
end;
end;
finally
DeleteCriticalSection(RTLCriticSection);
if ExitCode=MEASURE_NO_ERROR
then sWrite := 'Application réussie'
else sWrite := 'Application avortée';
WriteLn(fTxtFile, sWrite);
sWrite := DateTimeToStr(Now);
WriteLn(fTxtFile, sWrite );
CloseFile(fTxtFile);
WalkMeasureAcquirer.Free;
CloseFile(fTxtFile);
CloseHandle(hDataFileHandle);
ExitProcess(ExitCode);
end;
end.
je sais que je suis nul et je ne demande qu'à m'améliorer! par pitié aidez-moi!
et pardonnez mon post trop long!
bonne journée à vous et à très vite j'espère
si Delphi m'était conté...