mixster

library ExecProg;



uses

  FastShareMem,

  SysUtils,

  Classes,

  Windows,

  Graphics,

  ShellAPI;



{$R *.res}



type

  TSCARPlugFunc = record

    Name: string;

    Ptr: Pointer;

  end;



var

  curRun: Boolean;

  ProcessInfo: TProcessInformation;

  ReadPipe,WritePipe : THandle;

  Buffer : Pchar;



function InitProgram(DosApp: string): Boolean; stdcall;

const

  ReadBuffer = 2400;

var

  Security : TSecurityAttributes;

  Start : TStartUpInfo;

begin

  Result := False;

  if(curRun) then

    exit;



  with Security do begin

    nlength := SizeOf(TSecurityAttributes);

    binherithandle := true;

    lpsecuritydescriptor := nil;

  end;

  if Createpipe (ReadPipe, WritePipe, @Security, 0) then

  begin

    Buffer := AllocMem(ReadBuffer + 1);

    FillChar(Start,Sizeof(Start), #0);

    start.cb := SizeOf(start);

    start.hStdOutput := WritePipe;

    start.hStdInput := ReadPipe;

    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;

    start.wShowWindow := SW_HIDE;



    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true, NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then

    begin

      Result := True;

      curRun := True;

      exit;

    end;

  end;

end;



function CheckProgram: Boolean; stdcall;

begin

  Result := (curRun) and (WaitForSingleObject(ProcessInfo.hProcess,100) <> WAIT_TIMEOUT);

end;



function FreeProgram: string; stdcall;

const

  ReadBuffer = 2400;

var

  BytesRead : DWord;

  RetVal: string;

begin

  if ((not curRun) or (not CheckProgram)) then

  begin

    Result := StrAlloc(1);

    if (curRun) then

      Result := '1'

    else

      Result := '0';

    exit;

  end;



  repeat

    BytesRead := 0;

    ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead,nil);

    Buffer[BytesRead]:= #0;

    OemToAnsi(Buffer, Buffer);

    RetVal := RetVal + String(Buffer);

  until (BytesRead < ReadBuffer);



  FreeMem(Buffer);

  CloseHandle(ProcessInfo.hProcess);

  CloseHandle(ProcessInfo.hThread);

  CloseHandle(ReadPipe);

  CloseHandle(WritePipe);

  curRun := False;

  Result := StrAlloc(Length(RetVal));

  Result := RetVal;

end;



function ExecProgram(DosApp: string): string; stdcall;

const

  ReadBuffer = 2400;

var

  Security : TSecurityAttributes;

  ReadPipe,WritePipe : THandle;

  Start : TStartUpInfo;

  ProcessInfo : TProcessInformation;

  Buffer : Pchar;

  BytesRead : DWord;

  Apprunning : DWord;

  RetVal: string;

begin

  With Security do begin

    nlength := SizeOf(TSecurityAttributes);

    binherithandle := true;

    lpsecuritydescriptor := nil;

  end;

  if Createpipe (ReadPipe, WritePipe, @Security, 0) then

  begin

    Buffer := AllocMem(ReadBuffer + 1);

    FillChar(Start,Sizeof(Start), #0);

    start.cb := SizeOf(start);

    start.hStdOutput := WritePipe;

    start.hStdInput := ReadPipe;

    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;

    start.wShowWindow := SW_HIDE;



    if CreateProcess(nil, PChar(DosApp), @Security, @Security, true, NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo) then

    begin

      repeat

        Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);

      until (Apprunning <> WAIT_TIMEOUT);

      repeat

        BytesRead := 0;

        ReadFile(ReadPipe,Buffer[0], ReadBuffer,BytesRead,nil);

        Buffer[BytesRead]:= #0;

        OemToAnsi(Buffer,Buffer);

        RetVal := RetVal + String(Buffer);

      until (BytesRead < ReadBuffer);

    end;

    FreeMem(Buffer);

    CloseHandle(ProcessInfo.hProcess);

    CloseHandle(ProcessInfo.hThread);

    CloseHandle(ReadPipe);

    CloseHandle(WritePipe);

    Result := StrAlloc(Length(RetVal));

    Result := RetVal;

  end;

end;



function GetFunctionCount(): Integer; stdcall; export;

begin

  Result := 4;

end;



function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;

begin

  case x of

    0:

      begin

        ProcAddr := @ExecProgram;

        StrPCopy(ProcDef, 'function ExecProgram(DosApp: string): string;');

      end;

    1:

      begin

        ProcAddr := @InitProgram;

        StrPCopy(ProcDef, 'function InitProgram(DosApp: string): Boolean;');

      end;

    2:

      begin

        ProcAddr := @CheckProgram;

        StrPCopy(ProcDef, 'function CheckProgram(): Boolean;');

      end;

    3:

      begin

        ProcAddr := @FreeProgram;

        StrPCopy(ProcDef, 'function FreeProgram(): string;');

      end;

  else

    x := -1;

  end;

  Result := x;

end;



exports GetFunctionCount;

exports GetFunctionInfo;

end.