unit UMainSCU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, DicomObjects8_TLB,
  Vcl.Buttons, DOWrappers, Vcl.OleServer, ipwcore, ipwipport;

type
  TfrmSCU = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    btnSendSyncIStream: TButton;
    memLog: TMemo;
    sbFileName: TSpeedButton;
    edtFilename: TEdit;
    btnSendAsyncIStream: TButton;
    DcmServer: TDicomServer;
    Label4: TLabel;
    edtIP: TEdit;
    btnOpenAssociation: TButton;
    Label7: TLabel;
    edtPort: TEdit;
    procedure btnSendSyncIStreamClick(Sender: TObject);
    procedure sbFileNameClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnSendAsyncIStreamClick(Sender: TObject);
    procedure DcmServerActionComplete(ASender: TObject;
      const Connection: IDicomConnection; const Action: WideString;
      Tag: OleVariant; Success: WordBool; const ErrorMessage: WideString);
    procedure DcmServerInfoMessage(ASender: TObject; InfoType: SmallInt;
      const Text: WideString);
    procedure btnOpenAssociationClick(Sender: TObject);
  private
    { Private declarations }
    //FAsyncConnectionWrapper: TDicomConnectionWrapper;
    FDcmServerWrapper: TDicomServerWrapper;
    procedure LogEvent(const msg: string);
    procedure LogError(const msg: string);
  public
    { Public declarations }
  end;

var
  frmSCU: TfrmSCU;

implementation


{$R *.dfm}

procedure TfrmSCU.btnOpenAssociationClick(Sender: TObject);
var
  AsyncConnectionWrapper: TDicomConnectionWrapper;
begin
  AsyncConnectionWrapper := TDicomConnectionWrapper.Create(DcmServer);
  try
    AsyncConnectionWrapper.SetDestination(edtIP.Text, StrToIntDef(edtPort.Text, 104), 'SCU', 'SCP');
    LogEvent(Format('Opened async association #%d with IStream on local IP %s just to echo', [AsyncConnectionWrapper.Association, AsyncConnectionWrapper.LocalIP]));
    AsyncConnectionWrapper.Tag := 'ECHO';
  finally
    AsyncConnectionWrapper.ReleaseRef;
  end;
end;

procedure TfrmSCU.btnSendAsyncIStreamClick(Sender: TObject);
var
  AsyncConnectionWrapper: TDicomConnectionWrapper;
begin
  AsyncConnectionWrapper := TDicomConnectionWrapper.Create(DcmServer);
  try
    AsyncConnectionWrapper.SetDestination(edtIP.Text, StrToIntDef(edtPort.Text, 104), 'SCU', 'SCP');
    LogEvent(Format('Opened async association #%d with IStream on local IP %s', [AsyncConnectionWrapper.Association, AsyncConnectionWrapper.LocalIP]));
  finally
    AsyncConnectionWrapper.ReleaseRef;
  end;
end;

procedure TfrmSCU.btnSendSyncIStreamClick(Sender: TObject);
var
  DcmConnection: TDicomConnectionWrapper;
  MyImages: DicomImages;
begin
  // doesn't work, freezes at SetDestinationIStream
  DcmConnection := TDicomConnectionWrapper.Create();
  MyImages := CoDicomImages.Create;
  try
    try
      MyImages.ReadFile(edtFilename.Text);
      LogEvent(Format('Opened file for assoc #%d', [DcmConnection.Association]));
      DcmConnection.SetDestination(edtIP.Text, StrToIntDef(edtPort.Text, 104), 'SCU', 'SCP');
      LogEvent(Format('Opened sync association #%d with IStream on local IP %s', [DcmConnection.Association, DcmConnection.LocalIP]));
      DcmConnection.SendImages(MyImages);
      LogEvent(Format('Sent image for assoc #%d', [DcmConnection.Association]));
      DcmConnection.Close;
      LogEvent(Format('Closed association #%d', [DcmConnection.Association]));
    except
      on E: Exception do
      begin
        LogError(Format('Could not send on assoc #%d: %s', [DcmConnection.Association, E.Message]));
      end;
    end;
  finally
    MyImages.Clear;
    MyImages := nil;
    DcmConnection.ReleaseRef;
  end;
end;

procedure TfrmSCU.DcmServerActionComplete(ASender: TObject;
  const Connection: IDicomConnection; const Action: WideString; Tag: OleVariant;
  Success: WordBool; const ErrorMessage: WideString);
var
  MyImages: DicomImages;
  AsyncConnectionWrapper: TDicomConnectionWrapper;
begin
  AsyncConnectionWrapper := LookupWrapper(Connection);
  if (Action = 'SetDestination') and Success then
  begin
    if AsyncConnectionWrapper.Tag = 'ECHO' then
      AsyncConnectionWrapper.SendVerify
    else
    begin
      LogEvent(Format('Finished opening association #%d', [AsyncConnectionWrapper.Association]));
      MyImages := CoDicomImages.Create;
      try
        MyImages.ReadFile(edtFilename.Text);
        LogEvent(Format('Opened file for assoc #%d', [AsyncConnectionWrapper.Association]));
        AsyncConnectionWrapper.Tag := 1;
        AsyncConnectionWrapper.SendImages(MyImages);
        LogEvent(Format('Sent image for assoc #%d', [AsyncConnectionWrapper.Association]));
      finally
        MyImages := nil;
      end;
    end;
  end
  else if (Action = 'SendImages') then
  begin
    if Success then
    begin
      LogEvent(Format('Finished sending images for assoc #%d', [AsyncConnectionWrapper.Association]));
      AsyncConnectionWrapper.Close;
      LogEvent(Format('Closed association #%d', [AsyncConnectionWrapper.Association]));
    end
    else
    begin
      LogEvent(Format('SendImages failed for assoc #%d: %s', [AsyncConnectionWrapper.Association, ErrorMessage]));
      AsyncConnectionWrapper.Close;
      LogEvent(Format('Closed association #%d', [AsyncConnectionWrapper.Association]));
    end;
  end
  else if (Action = 'Sendverify') then
  begin
    if Success then
      LogEvent(Format('Successful ECHO on #%d', [AsyncConnectionWrapper.Association]))
    else
      LogEvent(Format('Failed ECHO on #%d', [AsyncConnectionWrapper.Association]));
    AsyncConnectionWrapper.Close;
  end
  else if Success then
    LogEvent(Format('Success on #%d: %s', [AsyncConnectionWrapper.Association, Action]))
  else
    LogEvent(Format('Failure on #%d: %s', [AsyncConnectionWrapper.Association, Action]));
end;

procedure TfrmSCU.DcmServerInfoMessage(ASender: TObject; InfoType: SmallInt;
  const Text: WideString);
begin
  if InfoType <= 3 then
    LogEvent(Text);
end;

procedure TfrmSCU.FormCreate(Sender: TObject);
begin
  FDcmServerWrapper := TDicomServerWrapper.Create(DcmServer);
end;

procedure TfrmSCU.FormDestroy(Sender: TObject);
begin
  FDcmServerWrapper.Free;
end;

procedure TfrmSCU.LogError(const msg: string);
begin
  memLog.Lines.Add(FormatDateTime('hh:nn:ss: ERROR: ', Now) + msg);
end;

procedure TfrmSCU.LogEvent(const msg: string);
begin
  memLog.Lines.Add(FormatDateTime('hh:nn:ss:', Now) + msg);
end;

procedure TfrmSCU.sbFileNameClick(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    if Execute then
      edtFilename.Text := FileName;
  end;
end;

end.
