Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)
-   -   Ejecutar scripts .vbs (https://www.clubdelphi.com/foros/showthread.php?t=62740)

Charly911 12-01-2009 02:43:46
Ejecutar scripts .vbs -> Solucionado
 
Hola gente del foro, primero que nada me quiero presentar.
Soy Cristian, 19 años, Argentino, primer post :D
De programacion se poco, y lo que se lo aprendi por mi cuenta leyendo, copiando, probando....

Estoy haciendo un pequeño programa que ejecuta scripts de visual basic para instalar programas. Es una lista con CheckBox que revisa una por una y ejecuta un script a la vez, y espera a que termine el instalador para ejecutar el siguiente. El programa esta casi listo, ya que lo probe con ejecutables y funciono a la perfeccion. Pero luego lo probe con los scripts y no anda :(
Para la ejecucion use la funcion CreateProcess, ya que con esta puedo verificar si el proceso esta o no en ejecucion.

Codigo:

Código Delphi [-]
unit PostSateging;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls, SHELLAPI;

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    Button1: TButton;
    CheckBox12: TCheckBox;
    procedure Button1Click(Sender: TObject);
          private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Form2: TForm2;

implementation

{$R *.dfm}


 function WinExecAndWait32(FileName:String; Visibility:integer):integer; //Esta funcion la copie de la web...
 var
   zAppName:array[0..512] of char;
   zCurDir:array[0..255] of char;
   WorkDir:String;
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
   Resultado,exitCode: DWord;
 begin
   StrPCopy(zAppName,FileName);
   GetDir(0,WorkDir);
   StrPCopy(zCurDir,WorkDir);
   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
   StartupInfo.cb := Sizeof(StartupInfo);

   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartupInfo.wShowWindow := Visibility;
   CreateProcess(nil,
     zAppName,                      { pointer to command line string }
     nil,                           { pointer to process security attributes}
     nil,                           { pointer to thread security attributes}
     false,                         { handle inheritance flag }
     CREATE_NEW_CONSOLE or          { creation flags }
     NORMAL_PRIORITY_CLASS,
     nil,                           { pointer to new environment block }
     nil,                           { pointer to current directory name }
     StartupInfo,                   { pointer to STARTUPINFO }
     ProcessInfo);

   {Espera a que termine la ejecucion}
   {Wait until execution finish}
   Repeat
     exitCode := WaitForSingleObject( ProcessInfo.hProcess,1000);
     Application.ProcessMessages;
   Until (exitCode <> WAIT_TIMEOUT);
   GetExitCodeProcess(ProcessInfo.hProcess,Resultado);
   MessageBeep(0);
   CloseHandle(ProcessInfo.hProcess );
   Result:=Resultado;
 end;


procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckBox1.Checked then WinExecAndWait32('C:\Documents and Settings\Charly\Escritorio\hola.vbs'{C:\Packages\ACCSS002003ENGC1\ACCSS002003ENGC1-JM.vbs'},1);
if CheckBox2.Checked then WinExecAndWait32('C:\Packages\OLPCA601312ENGC1\OLPCA601312ENGC1.vbs',1);
if CheckBox3.Checked then WinExecAndWait32('C:\Packages\Citrix 10.1\ica32pkg.vbs',1);
if CheckBox4.Checked then WinExecAndWait32('C:\Packages\install_flash_player\install_flash_player.vbs',1);
if CheckBox5.Checked then WinExecAndWait32('C:\Packages\ORACL000817ENGC1\ORACL000817ENGC1_VE_dep.vbs',1);
if CheckBox6.Checked then WinExecAndWait32('C:\Packages\DVLPR000045ENGC2\DVLPR000045ENGC2_VE_dep.vbs',1);
if CheckBox7.Checked then WinExecAndWait32('C:\Packages\PDFCT000093ENGC1\PDFCT000093ENGC1_deploy.vbs',1);
if CheckBox8.Checked then WinExecAndWait32('C:\Packages\PRJCT002003ENGC1P1\PRJCT002003ENGC1P1_deploy.vbs',1);
if CheckBox9.Checked then WinExecAndWait32('C:\Packages\SAPGU000640ENGC3\SAPGU00064ENGC3_VE_dep.vbs',1);
if CheckBox10.Checked then WinExecAndWait32('C:\Packages\SISLG000010SPAC1\SISLG000010SPAC1_deploy.vbs',1);
if CheckBox11.Checked then WinExecAndWait32('C:\Packages\Scripts\CONF_LOC.vbs',1);
if CheckBox12.Checked then WinExecAndWait32('C:\Packages\Scripts\RestartSystem.vbs',1);
end;

end.
Les agradeceria que me indiquen si es posible ejecutar este tipo de archivos con esta funcion, o si hay otra que me sirva.

Cristian.

-----------------------------------

Edit ->

Como la funcion CreateProcess solo puede ejecutar archivos .exe lo que hay que hacer para ejecutar cualquier archivo, en este caso un .vbs, se debe ejecutar el programa que lo abre diciendole que abra el archivo.
El codigo quedaria asi:

Código Delphi [-]
unit PostSateging;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls, SHELLAPI;

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    Button1: TButton;
    CheckBox12: TCheckBox;
    procedure Button1Click(Sender: TObject);
          private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Form2: TForm2;

implementation

{$R *.dfm}


 function WinExecAndWait32(FileName:String; Visibility:integer):integer;
 var
   zAppName:array[0..512] of char;
   zCurDir:array[0..255] of char;
   WorkDir:String;
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
   Resultado,exitCode: DWord;
 begin
   StrPCopy(zAppName,FileName);
   GetDir(0,WorkDir);
   StrPCopy(zCurDir,WorkDir);
   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
   StartupInfo.cb := Sizeof(StartupInfo);

   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartupInfo.wShowWindow := Visibility;
   CreateProcess(nil,
     zAppName,                      { pointer to command line string }
     nil,                           { pointer to process security attributes}
     nil,                           { pointer to thread security attributes}
     false,                         { handle inheritance flag }
     CREATE_NEW_CONSOLE or          { creation flags }
     NORMAL_PRIORITY_CLASS,
     nil,                           { pointer to new environment block }
     nil,                           { pointer to current directory name }
     StartupInfo,                   { pointer to STARTUPINFO }
     ProcessInfo);

   {Espera a que termine la ejecucion}
   {Wait until execution finish}
   Repeat
     exitCode := WaitForSingleObject( ProcessInfo.hProcess,1000);
     Application.ProcessMessages;
   Until (exitCode <> WAIT_TIMEOUT);
   GetExitCodeProcess(ProcessInfo.hProcess,Resultado);
   MessageBeep(0);
   CloseHandle(ProcessInfo.hProcess );
   Result:=Resultado;
 end;


procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckBox1.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\ACCSS002003ENGC1\ACCSS002003ENGC1-JM.vbs',1);
if CheckBox2.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\OLPCA601312ENGC1\OLPCA601312ENGC1.vbs',1);
if CheckBox3.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\Citrix 10.1\ica32pkg.vbs',1);
if CheckBox4.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\install_flash_player\install_flash_player.vbs',1);
if CheckBox5.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\ORACL000817ENGC1\ORACL000817ENGC1_VE_dep.vbs',1);
if CheckBox6.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\DVLPR000045ENGC2\DVLPR000045ENGC2_VE_dep.vbs',1);
if CheckBox7.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\PDFCT000093ENGC1\PDFCT000093ENGC1_deploy.vbs',1);
if CheckBox8.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\PRJCT002003ENGC1P1\PRJCT002003ENGC1P1_deploy.vbs',1);
if CheckBox9.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\SAPGU000640ENGC3\SAPGU00064ENGC3_VE_dep.vbs',1);
if CheckBox10.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\SISLG000010SPAC1\SISLG000010SPAC1_deploy.vbs',1);
if CheckBox11.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\Scripts\CONF_LOC.vbs',1);
if CheckBox12.Checked then WinExecAndWait32('C:\WINDOWS\system32\wscript.exe C:\Packages\Scripts\RestartSystem.vbs',1);
end;

end.

Cristian.

duilioisola 12-01-2009 13:14:14
No se que quieres decir con "no anda".
- Significa que da error: ¿Qué error?
- Significa que se queda colgado: ¿Responde a algo?, ¿ejecuta alguno de los scrips?
- Alguna otra cosa?

Por lo que veo, solo debería ejecutarte el primero, porque en el bucle repeat...until solo sales si el código de salida es WAIT_TIMEOUT.
Supongo que la condición debería ser until (exitcode<>"Está Procesando") o until (exitcode<>0) o until (exitcode<>-1) algo así.

Código Delphi [-]
{Wait until execution finish}
   Repeat
     exitCode := WaitForSingleObject( ProcessInfo.hProcess,1000);
     Application.ProcessMessages;
   Until (exitCode <> WAIT_TIMEOUT);

Charly911 12-01-2009 13:17:51
Justo posteaste cuando estaba editando la solucion :P
El bucle anda bien, ya lo probe.
Fijate lo que edite, ahi estan los cambios... :D:D

Cristian.

duilioisola 12-01-2009 13:21:39
Del help de Delphi 6:
Cita:
The WaitForSingleObject function returns when one of the following occurs:

· The specified object is in the signaled state.
· The time-out interval elapses.


DWORD WaitForSingleObject(

HANDLE hHandle, // handle of object to wait for
DWORD dwMilliseconds // time-out interval in milliseconds
);


Parameters

hHandle

Identifies the object. For a list of the object types whose handles can be specified, see the following Remarks section.
Windows NT: The handle must have SYNCHRONIZE access. For more information, see Access Masks and Access Rights.

dwMilliseconds

Specifies the time-out interval, in milliseconds. The function returns if the interval elapses, even if the object's state is nonsignaled. If dwMilliseconds is zero, the function tests the object's state and returns immediately. If dwMilliseconds is INFINITE, the function's time-out interval never elapses.



Return Values

If the function succeeds, the return value indicates the event that caused the function to return.
If the function fails, the return value is WAIT_FAILED. To get extended error information, call GetLastError.
The return value on success is one of the following values:

Value Meaning
WAIT_ABANDONED The specified object is a mutex object that was not released by the thread that owned the mutex object before the owning thread terminated. Ownership of the mutex object is granted to the calling thread, and the mutex is set to nonsignaled.
WAIT_OBJECT_0 The state of the specified object is signaled.
WAIT_TIMEOUT The time-out interval elapsed, and the object's state is nonsignaled.


Remarks

The WaitForSingleObject function checks the current state of the specified object. If the object's state is nonsignaled, the calling thread enters an efficient wait state. The thread consumes very little processor time while waiting for the object state to become signaled or the time-out interval to elapse.
Before returning, a wait function modifies the state of some types of synchronization objects. Modification occurs only for the object or objects whose signaled state caused the function to return. For example, the count of a semaphore object is decreased by one.

Charly911 14-01-2009 18:37:36
duilioisola:

Te agradezco por tu ayuda, pero como comente en el primer post, se muy poco de programacion y no comprendo muy bien que es lo que hace la funcion...
Igualmente ya la probe en repetidas ocaciones y funciona a la perfeccion :D:D

Un saludo Cristian.


La franja horaria es GMT +2. Ahora son las 15:00:22.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi