Tp4.pas #1

unit Tp4_Lib;

interface

uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;

type
// *********************************************************************//
// P4Wrapper class
// *********************************************************************//
  Tp4 = class
  private
    p4:           Ip4;
    sl:           TStringList;
    function      GetDefaultInterface: Ip4;
    function      SafeArrayToStringList(psa: PSafeArray): TStringList;
  protected
    procedure InitServerData; override;
    function Get_Charset: WideString;
    procedure Set_Charset(const pVal: WideString);
    function Get_Client: WideString;
    procedure Set_Client(const pVal: WideString);
    function Get_Cwd: WideString;
    procedure Set_Cwd(const pVal: WideString);
    function Get_Host: WideString;
    procedure Set_Host(const pVal: WideString);
    function Get_Language: WideString;
    procedure Set_Language(const pVal: WideString);
    function Get_Password: WideString;
    procedure Set_Password(const pVal: WideString);
    function Get_Port: WideString;
    procedure Set_Port(const pVal: WideString);
    function Get_User: WideString;
    procedure Set_User(const pVal: WideString);
    function Get_Errors: PSafeArray;
    function Get_Warnings: PSafeArray;
    function Get_ExceptionLevel: Integer;
    procedure Set_ExceptionLevel(pVal: Integer);
    function Get_TempFilename: WideString;
    function Get_Var_(const varName: WideString): WideString;
    procedure Set_Var_(const varName: WideString; const pVal: WideString);
    function Get_VarExists(const varName: WideString): Integer;
    function Get_ArrayVar(const varName: WideString): PSafeArray;
    procedure Set_ArrayVar(const varName: WideString; var pVal: PSafeArray);
    function Get_Os: WideString;
    function Get_ServerVersion: Integer;
    procedure Set_ArrayVar_variant(const varName: WideString; Param2: PPSafeArray2);
    function Get_Errors_variant: OleVariant;
    function Get_Warnings_variant: OleVariant;
  public
    constructor Create;
    destructor  Destroy;
    procedure Connect;
    procedure Disconnect; override;
    function run(const cmd: WideString): TStringList;
    procedure Tagged;
    procedure ParseForms;
    function run_variant(const cmd: WideString): OleVariant;
    property DefaultInterface: Ip4 read GetDefaultInterface;
    property Errors: PSafeArray read Get_Errors;
    property Warnings: PSafeArray read Get_Warnings;
    property TempFilename: WideString read Get_TempFilename;
    property Var_[const varName: WideString]: WideString read Get_Var_ write Set_Var_;
    property VarExists[const varName: WideString]: Integer read Get_VarExists;
    property Os: WideString read Get_Os;
    property ServerVersion: Integer read Get_ServerVersion;
    property ArrayVar_variant[const varName: WideString]: PPSafeArray2 write Set_ArrayVar_variant;
    property Errors_variant: OleVariant read Get_Errors_variant;
    property Warnings_variant: OleVariant read Get_Warnings_variant;
    property Charset: WideString read Get_Charset write Set_Charset;
    property Client: WideString read Get_Client write Set_Client;
    property Cwd: WideString read Get_Cwd write Set_Cwd;
    property Host: WideString read Get_Host write Set_Host;
    property Language: WideString read Get_Language write Set_Language;
    property Password: WideString read Get_Password write Set_Password;
    property Port: WideString read Get_Port write Set_Port;
    property User: WideString read Get_User write Set_User;
    property ExceptionLevel: Integer read Get_ExceptionLevel write Set_ExceptionLevel;
  published
  end;

implementation

uses ComObj;

function Tp4.GetDefaultInterface: Ip4;
begin
  Result := FIntf;
end;

constructor Tp4.Create;
begin
  FIntf := Cop4.Create;
end;

destructor Tp4.Destroy;
begin
  inherited Destroy;
  Fintf.Destroy;
end;

function Tp4.SafeArrayToStringList(psa: PSafeArray): TStringList;
var
  ArrayData: pointer;
  bOK: boolean;
  LBound, UBound: integer;
  i: integer;
  s: widestring;
type TStringArray = array of WideString;
begin
  bOK := (psa <> NIL);
  ArrayData := nil;
  if bOK then
    bOK := (SafeArrayGetDim(psa) = 1); // Must be 1 dimensional
  if bOK then
    bOK := Succeeded(SafeArrayGetLBound(psa, 1, LBound));
  if bOK then
    bOK := Succeeded(SafeArrayGetUBound(psa, 1, UBound));
  if bOK then
    bOK := Succeeded(SafeArrayAccessData(psa, ArrayData));
  try
    sl := TStringList.Create;
    if bOK then
    begin
      for i := 0 to (UBound - LBound - 1) do
      begin
        s := TStringArray(ArrayData)[i];
        sl.Add(s);
      end;
    end;
  finally
    if ArrayData <> NIL then
      SafeArrayUnaccessData(psa);
  end;
  Result := sl;
end;

function Tp4.Get_Charset: WideString;
begin
    Result := DefaultInterface.Charset;
end;

procedure Tp4.Set_Charset(const pVal: WideString);
  { Warning: The property Charset has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Charset := pVal;
end;

function Tp4.Get_Client: WideString;
begin
    Result := DefaultInterface.Client;
end;

procedure Tp4.Set_Client(const pVal: WideString);
  { Warning: The property Client has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Client := pVal;
end;

function Tp4.Get_Cwd: WideString;
begin
    Result := DefaultInterface.Cwd;
end;

procedure Tp4.Set_Cwd(const pVal: WideString);
  { Warning: The property Cwd has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Cwd := pVal;
end;

function Tp4.Get_Host: WideString;
begin
    Result := DefaultInterface.Host;
end;

procedure Tp4.Set_Host(const pVal: WideString);
  { Warning: The property Host has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Host := pVal;
end;

function Tp4.Get_Language: WideString;
begin
    Result := DefaultInterface.Language;
end;

procedure Tp4.Set_Language(const pVal: WideString);
  { Warning: The property Language has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Language := pVal;
end;

function Tp4.Get_Password: WideString;
begin
    Result := DefaultInterface.Password;
end;

procedure Tp4.Set_Password(const pVal: WideString);
  { Warning: The property Password has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Password := pVal;
end;

function Tp4.Get_Port: WideString;
begin
    Result := DefaultInterface.Port;
end;

procedure Tp4.Set_Port(const pVal: WideString);
  { Warning: The property Port has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Port := pVal;
end;

function Tp4.Get_User: WideString;
begin
    Result := DefaultInterface.User;
end;

procedure Tp4.Set_User(const pVal: WideString);
  { Warning: The property User has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.User := pVal;
end;

function Tp4.Get_Errors: PSafeArray;
begin
    Result := DefaultInterface.Errors;
end;

function Tp4.Get_Warnings: PSafeArray;
begin
    Result := DefaultInterface.Warnings;
end;

function Tp4.Get_ExceptionLevel: Integer;
begin
    Result := DefaultInterface.ExceptionLevel;
end;

procedure Tp4.Set_ExceptionLevel(pVal: Integer);
begin
  DefaultInterface.Set_ExceptionLevel(pVal);
end;

function Tp4.Get_TempFilename: WideString;
begin
    Result := DefaultInterface.TempFilename;
end;

function Tp4.Get_Var_(const varName: WideString): WideString;
begin
    Result := DefaultInterface.Var_[varName];
end;

procedure Tp4.Set_Var_(const varName: WideString; const pVal: WideString);
  { Warning: The property Var_ has a setter and a getter whose
    types do not match. Delphi was unable to generate a property of
    this sort and so is using a Variant as a passthrough. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Var_ := pVal;
end;

function Tp4.Get_VarExists(const varName: WideString): Integer;
begin
    Result := DefaultInterface.VarExists[varName];
end;

function Tp4.Get_ArrayVar(const varName: WideString): PSafeArray;
begin
  Result := DefaultInterface.Get_ArrayVar(varName);
end;

procedure Tp4.Set_ArrayVar(const varName: WideString; var pVal: PSafeArray);
begin
  DefaultInterface.Set_ArrayVar(varName, pVal);
end;

function Tp4.Get_Os: WideString;
begin
    Result := DefaultInterface.Os;
end;

function Tp4.Get_ServerVersion: Integer;
begin
    Result := DefaultInterface.ServerVersion;
end;

procedure Tp4.Set_ArrayVar_variant(const varName: WideString; Param2: PPSafeArray2);
begin
  DefaultInterface.ArrayVar_variant[varName] := Param2;
end;

function Tp4.Get_Errors_variant: OleVariant;
var
  InterfaceVariant : OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  Result := InterfaceVariant.Errors_variant;
end;

function Tp4.Get_Warnings_variant: OleVariant;
var
  InterfaceVariant : OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  Result := InterfaceVariant.Warnings_variant;
end;

function Tp4.run(const cmd: WideString): TStringList;
var
  psa:  PSafeArray;
begin
  psa := FIntf.run(cmd);
  Result := SafeArrayToStringList(psa);
end;

procedure Tp4.Connect1;
begin
  DefaultInterface.Connect;
end;

procedure Tp4.Disconnect1;
begin
  DefaultInterface.Disconnect;
end;

procedure Tp4.Tagged;
begin
  DefaultInterface.Tagged;
end;

procedure Tp4.ParseForms;
begin
  DefaultInterface.ParseForms;
end;

function Tp4.run_variant(const cmd: WideString): OleVariant;
begin
  Result := DefaultInterface.run_variant(cmd);
end;

end.