{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Fax service support (VCL)                       }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 20 Apr 2006                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrfax;
interface
uses nrcomm,nrclasses,nrwin32,windows, nrfaxw32,
     classes;

Const
  esFaxNoServer      = 'There are no FAX server';
  esFaxNoDevices     = 'There are no fax devices.';
  esFaxNoDocument    = 'Document for send does not fount.';
  esFaxInitSend      = 'Initialization of Document send failed.';
  esFaxSend          = 'Document send failed.';

Type

  TnrFaxDevice = class(TnrDevice)
  private
    faxPortInf:FAX_PORT_INFO;
    fDeviceName:string;
    fTsid:string;
    fCsid:string;
    hFaxServer:dword;
    function GetProp(const Index: Integer): DWORD;
//    function GetPropS(const Index: Integer): string;
    procedure AssignFaxPortInfo(aPortInf:PFAX_PORT_INFO);
  public
    constructor Create(afsHandle:dword);
    destructor Destroy; override;
    property DeviceId:DWORD     index 0 read GetProp;   // Device ID
    property State:DWORD        index 1 read GetProp;   // State of the device
    property Flags:DWORD        index 2 read GetProp;   // Device specific flags
    property Rings:DWORD        index 3 read GetProp;   // Number of rings before answer
    property Priority:DWORD     index 4 read GetProp;   // Device priority
    property DeviceName:string  read fDeviceName;       // Device name
    property Tsid:string        read fTsid;             // Device Tsid
    property Csid:string        read fCsid;             // Device Csid
  end;

  TnrFax=class(TnrBaseIO)
  private
    fServer: string;
    fDeviceIndex:integer;
    fDocument: string;
    fPortNotify:THandle;
    thrdMon:TThread;
    fEnableMonitor:boolean;
//    procedure ReloadFaxList;
    function GetFaxDevice(Index: integer): TnrFaxDevice;
    function GetDocument: string;
    function GetServer: string;
    procedure SetDocument(const Value: string);
    procedure SetServer(const Value: string);
    procedure MonitorStart;
    procedure MonitorStop;
    procedure DoFaxEvent(aDevice,aJob,aEvent:cardinal);

  protected
    function RequestDeviceHandle:THandle; override;
    procedure Open; override;
    procedure Close; override;
    procedure DeviceListLoad; override;
    function IsFaxServerOpen:boolean;
    procedure Loaded; override;
    procedure SetDeviceIndex(const Value: integer); override;
    function GetDeviceIndex: integer; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;override;
    procedure SendDocument;
    property Device[Index:integer]:TnrFaxDevice read GetFaxDevice;

  published
    property FaxServer:string read GetServer write SetServer;
    property Document:string read GetDocument write SetDocument;
    property DeviceIndex;
    property Log;
    property OnFatalError;
    property Active;
  end;

implementation
uses sysutils;


Type
  TFaxThread = class(TThread)
  private
    fFax:TnrFax;
    fNotifyPort:THandle;
  public
    constructor Create(aFax:TnrFax);
    procedure Execute; override;
    procedure Terminate;
  end;


{ TFaxThread }

constructor TFaxThread.Create(aFax: TnrFax);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  fFax := aFax;
  fNotifyPort := aFax.fPortNotify;
  Resume;
end;

procedure TFaxThread.Execute;
var sz:dword;
    p:THandle;
    pOvl:POverlapped;
    pEvt:PFAX_EVENT;
begin
  OutputDebugString(' Thread Exec ...!');
  if fNotifyPort<>0 then begin
    while not Terminated do begin
      if GetQueuedCompletionStatus(fNotifyPort,sz,p,pOvl,INFINITE) then begin
        pEvt := PFAX_EVENT(pOvl);
        if (pOvl<>nil)and(sz>0) then begin
          if not Terminated
            then fFax.DoFaxEvent(pEvt^.DeviceId,pEvt^.JobId,pEvt^.EventId);
          LocalFree(Cardinal(pOvl));
        end;
      end;
    end;
    CloseHandle(fNotifyPort);
  end;
  OutputDebugString('.. Thread Exit!');
end;

procedure TFaxThread.Terminate;
begin
  inherited Terminate;
  OutputDebugString('Terminate ....');
  PostQueuedCompletionStatus(fNotifyPort,0,0,nil);
end;

{ TnrFax }

constructor TnrFax.Create(AOwner: TComponent);
begin
  inherited;
  sLogPrefix:='nrFax: ';
  fDeviceIndex := -1;
  IsFaxServerOpen;
  sleep(100);
  Close;
  fEnableMonitor:=True;
end;

destructor TnrFax.Destroy;
begin
  if IsHandleValid then Close;
  inherited Destroy;
end;

procedure TnrFax.Open;
begin
  inherited Open;
  Update;
//  ReloadFaxList;
  if IsHandleValid and (not(csDesigning in ComponentState)) and fEnableMonitor
    then MonitorStart;
  OutputDebugString('Open');
end;

procedure TnrFax.Close;
begin
  OutputDebugString('Close');
  if IsHandleValid then begin
    MonitorStop;
    sleep(100);
    FaxClose(Handle);
  end;
  inherited Close;
end;

procedure TnrFax.MonitorStart;
begin
  fPortNotify := CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,0);
  if fPortNotify<>0 then begin
    if not FaxInitializeEventQueue(Handle,fPortNotify,0,0,0) then begin
      CloseHandle(fPortNotify);//
      OutputDebugString(PChar(' ERROR 111!!!! '+ '= '+IntToHex(GetLastError,8)+' '+SysErrorMessage(GetLastError)));
     end else thrdMon:=TFaxThread.Create(Self);
  end;
end;

procedure TnrFax.MonitorStop;
begin
  if thrdMon<>nil then begin
    TFaxThread(thrdMon).Terminate;
    thrdMon := nil;
    fPortNotify := 0;
  end;
end;


function TnrFax.IsFaxServerOpen: boolean;
begin
  if not IsHandleValid then Open;
  Result := Active;
end;

{procedure TnrFax.ReloadFaxList;
var fd:TnrFaxDevice;
    pFdl,P:PFAX_PORT_INFO;
    i,cnt:integer;
begin
  ClearDeviceList;
  if not IsHandleValid then exit;
  if FaxEnumPorts(Handle,pFdl,cnt) and (cnt >0) then begin
    for i:=0 to cnt-1 do begin
      P := Pointer(Cardinal(pFdl)+Cardinal(i*SizeOf(FAX_PORT_INFO)));
      fd := TnrFaxDevice.Create(Handle);
      fd.AssignFaxPortInfo(P);
      //Devices.AddObject(fd.DeviceName,fd);
      AddDevice(fd);
    end;
    FaxFreeBuffer(pFdl);
  end;
end;}

function TnrFax.RequestDeviceHandle: THandle;
var pcSrv:PChar;
begin
  if fServer = ''
    then pcSrv := nil
    else pcSrv := @fServer[1];
  if not FaxConnectFaxServer(pcSrv, Result)
    then Result := INVALID_HANDLE_VALUE;
end;

function TnrFax.GetFaxDevice(Index: integer): TnrFaxDevice;
begin
//  Result := nil;
//  if (Index<0)or(Index>=Devices.Count) then exit;
  Result := TnrFaxDevice(inherited Device[Index]);
end;

procedure TnrFax.SendDocument;
var pfJob : PFAX_JOB_PARAM;
    pfCover : PFAX_COVERPAGE_INFO;
//    fSave : boolean;
    idJob:dword;
begin

//  fSave := Active;
  if not IsFaxServerOpen then begin
    DoFatalErrors(ECC_FAX,1,esFaxNoServer,False);
    exit;
  end;

  if DeviceCount<=0 then begin
    DoFatalErrors(ECC_FAX,2,esFaxNoDevices,False);
    exit;
  end;

  if (fDocument = '' )or(not FileExists(fDocument)) then begin
    DoFatalErrors(ECC_FAX,3,esFaxNoDocument,False);
    exit;
  end;

  if not FaxCompleteJobParams(pfJob,pfCover) then begin
    DoFatalErrors(ECC_FAX,4,esFaxInitSend,False);
    exit;
  end;

  if not FaxSendDocument(Handle,PChar(fDocument),pfJob^,pfCover^,idJob) then begin
    DoFatalErrors(ECC_FAX,5,esFaxSend,False);
    exit;
  end;

  FaxFreeBuffer(pfJob);
  FaxFreeBuffer(pfCover);

end;

function TnrFax.GetDocument: string;
begin
  Result := fDocument;
end;

function TnrFax.GetServer: string;
begin
  Result := fServer;
end;

procedure TnrFax.SetDocument(const Value: string);
begin
  fDocument := Trim(Value);
end;

procedure TnrFax.SetServer(const Value: string);
begin
  fServer := Trim(Value);
end;

procedure TnrFax.DoFaxEvent(aDevice, aJob, aEvent: cardinal);
begin
  LoggingFmt(dlDetail,'fax notify: %Xh/%Xh/%Xh',[aDevice, aJob, aEvent]);
end;

procedure TnrFax.Loaded;
begin
  inherited Loaded;
  SetActive(fActive);
end;

procedure TnrFax.DeviceListLoad;
var fd:TnrFaxDevice;
    pFdl,P:PFAX_PORT_INFO;
    i,cnt:integer;
begin
  DeviceListClear;
  if not IsHandleValid then exit;
  if FaxEnumPorts(Handle,pFdl,cnt) and (cnt >0) then begin
    for i:=0 to cnt-1 do begin
      P := Pointer(Cardinal(pFdl)+Cardinal(i*SizeOf(FAX_PORT_INFO)));
      fd := TnrFaxDevice.Create(Handle);
      fd.AssignFaxPortInfo(P);
      //Devices.AddObject(fd.DeviceName,fd);
      AddDevice(fd);
    end;
    FaxFreeBuffer(pFdl);
  end;
end;

function TnrFax.GetDeviceIndex: integer;
begin
  Result := fDeviceIndex;
end;

procedure TnrFax.SetDeviceIndex(const Value: integer);
begin
  fDeviceIndex := Value;
  inherited;
end;

{ TnrFaxDevice }

procedure TnrFaxDevice.AssignFaxPortInfo(aPortInf: PFAX_PORT_INFO);
begin
  if aPortInf<>nil then begin
    CopyMemory(@faxPortInf,aPortInf,SizeOf(FAX_PORT_INFO));
    fDeviceName := String(aPortInf^.DeviceName);
    NameFriendly := fDeviceName;
    fTsid := String(aPortInf^.Tsid);
    fCsid := String(aPortInf^.Csid);
    faxPortInf.DeviceName := @fDeviceName;
    faxPortInf.Tsid := @fTsid;
    faxPortInf.Csid := @fCsid;
  end;
end;

constructor TnrFaxDevice.Create(afsHandle:dword);
begin
  inherited Create;
  hFaxServer := afsHandle;
end;

destructor TnrFaxDevice.Destroy;
begin
  inherited Destroy;
end;

function TnrFaxDevice.GetProp(const Index: Integer): DWORD;
var pInf:PDWORD;
begin
  pInf :=Pointer(Cardinal(@faxPortInf)+Cardinal((Index+1)*4));
  Result := pInf^;
end;

end.
