Exécution de scripts VBS

resultat% = dll_call1("ExecuteVBS",hnd%)

Essai("Bonjour")
Essai(17)

sub Essai(par)
msgbox "Sous-programme Essai" & vbcrlf & "Le paramètre est " & par
end sub

library wscript;


uses
  Windows,
  Sysutils,
  Math,
  Messages,
  Classes;

var
{ Déclarations publiques }
  sNewFileName: string;

{ définir un type de Pointeur sur Integer pour déclaration de procédure }
type
  PInteger = ^Integer;
  PString = ^String;

{ Function GetOtherWindowMemoText(const sCaption : String) : WideString;
var
        hWindow : THandle;
        hChild  : THandle;

        aTemp      : array[0..5000] of Char;
        sClassName : String;
begin
        Result := '';

        hWindow := FindWindow(Nil,PChar(sCaption));

        if hWindow = 0 then begin
            ShowMessage('Could NOT find the other program');
            exit;
        end;

        hChild := GetWindow(hWindow, GW_CHILD);
        while hChild <> 0 do Begin
              if GetClassName(hChild, aTemp, SizeOf(aTemp)) > 0 then begin
                  sClassName := StrPAS(aTemp);

                  if sClassName = 'Edit' then begin
                    SendMessage(hChild,WM_GETTEXT,SizeOf(aTemp),Integer(@aTemp));

                    Result := StrPAS(aTemp);
                  end;
              end;
              hChild := GetWindow(hChild, GW_HWNDNEXT);
        end;
end;            }

// créer un nom de fichier unique pour le fichier temporaire
function CreateNewFileName(BaseFileName: String; Ext: String;
  AlwaysUseNumber: Boolean = True): String;
var
  DocIndex: Integer;
  FileName: String;
  FileNameFound: Boolean;
begin
  DocIndex := 1;
  Filenamefound := False;
  {if number not required and basefilename doesn't exist, use that.}
  if not(AlwaysUseNumber) and (not(fileexists(BaseFilename + ext))) then
  begin
    Filename := BaseFilename + ext;
    FilenameFound := true;
  end;
  while not (FileNameFound) do
  begin
    filename := BaseFilename + inttostr(DocIndex) + Ext;
    if fileexists(filename) then
      inc(DocIndex)
    else
      FileNameFound := true;
  end;
  Result := filename;
end;

// exécuter le contenu d'un memo Panoramic en tant que script VBS
function ExecuteVBS(const hnd: integer): integer; stdcall; export;
var
  aTemp: array[0..5000] of Char;
  str, temp: string;
  StartInfo : TStartupInfo;
  ProcInfo : TProcessInformation;
  CreateOK : Boolean;
  F: TextFile;
begin

  SendMessage(hnd,WM_GETTEXT,SizeOf(aTemp),Integer(@aTemp));
  str := StrPAS(aTemp);
{ fill with known state}
  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  temp := GetEnvironmentVariable('TEMP');
  sNewFileName := CreateNewFileName(temp + '\script_temporaire','.vbs');
  AssignFile(F, sNewFileName);
  Rewrite(F);
  WriteLn(F, str);
  CloseFile(F);
  CreateOK := CreateProcess(nil, PChar('wscript '+sNewFileName), nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
              nil, nil, StartInfo, ProcInfo);
{ check to see if successful}
  if CreateOK then
    begin
        WaitForSingleObject(ProcInfo.hProcess, INFINITE);
        result := length(str);
    end
  else
    begin
      result := -1;
    end;
  DeleteFile(sNewFileName);
  CloseHandle(ProcInfo.hProcess);
  CloseHandle(ProcInfo.hThread);
end;

exports
        ExecuteVBS
;


begin
end.