Tp4_lib.pas #1

unit Tp4_lib;

interface

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

type
// *********************************************************************//
// P4Wrapper class
// *********************************************************************//
  Tp4 = class
  private
    p4:           Ip4;
    sl:           TStringList;
    function      GetDefaultInterface: Ip4;
    function      SafeArrayToStringList(psa: PSafeArray): TStringList;
  protected
    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: TStringList;
    function Get_Warnings: TStringList;
    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): TStringList;
    procedure Set_ArrayVar(const varName: WideString; var pVal: TStringList);
    function Get_Os: WideString;
    function Get_ServerVersion: Integer;
  public
    constructor Create;
    destructor  Destroy; override;
    procedure Connect;
    procedure Disconnect;
    function run(const cmd: WideString): TStringList;
    procedure Tagged;
    procedure ParseForms;
    property DefaultInterface: Ip4 read GetDefaultInterface;
    property Errors: TStringList read Get_Errors;
    property Warnings: TStringList 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 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 := p4;
end;

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

destructor Tp4.Destroy;
begin
  inherited Destroy;
  if sl <> nil then
    sl.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);
begin
  DefaultInterface.Charset := pVal;
end;

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

procedure Tp4.Set_Client(const pVal: WideString);
begin
  DefaultInterface.Client := pVal;
end;

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

procedure Tp4.Set_Cwd(const pVal: WideString);
begin
  DefaultInterface.Cwd := pVal;
end;

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

procedure Tp4.Set_Host(const pVal: WideString);
begin
  DefaultInterface.Host := pVal;
end;

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

procedure Tp4.Set_Language(const pVal: WideString);
begin
  DefaultInterface.Language := pVal;
end;

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

procedure Tp4.Set_Password(const pVal: WideString);
begin
  DefaultInterface.Password := pVal;
end;

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

procedure Tp4.Set_Port(const pVal: WideString);
begin
  DefaultInterface.Port := pVal;
end;

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

procedure Tp4.Set_User(const pVal: WideString);
begin
  DefaultInterface.User := pVal;
end;

function Tp4.Get_Errors: TStringList;
var
  psa:  PSafeArray;
begin
  psa := DefaultInterface.Errors;
  Result := SafeArrayToStringList(psa);
end;

function Tp4.Get_Warnings: TStringList;
var
  psa:  PSafeArray;
begin
  psa := DefaultInterface.Warnings;
  Result := SafeArrayToStringList(psa);
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);
begin
  DefaultInterface.Var_[varName] := pVal;
end;

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

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

procedure Tp4.Set_ArrayVar(const varName: WideString; var pVal: TStringList);
begin
{TODO
  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;

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

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

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

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

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

end.