unit NetWrite;

interface
uses Windows, wmf9, SysUtils, activex, Classes;

const
  NETWRITE_ASYNC_EVENT	: PCHAR = '{6d12fe9b-d029-4d08-b2eb-92c8cab323c7}';

type

  TWMFNetWrite = class(TObject, IWMReaderCallback, IWMReaderCallbackAdvanced)
  public
    constructor Create;

    destructor  Destroy; override;
    function    Configure(dwPortNum: DWORD; const pwszFile: PWideChar; nMaxClient: cardinal): HRESULT;
    function    WritetoNet: HRESULT;
    function    Init: HRESULT;

    //Methods of IWMReaderCallback

    function OnSample(dwOutputNum: DWORD; cnsSampleTime, cnsSampleDuration: int64;
               dwFlags: DWORD; pSample: INSSBuffer; pvContext: pointer): HRESULT; stdcall;
    function OnStatus(Status: TWMTSTATUS; hr: HRESULT; dwType: TWMTATTRDATATYPE;
               pValue: PBYTE; pvContext: pointer): HRESULT; stdcall;

    //Methhods of IWMReaderCallbackAdvanced

    // Receive a sample directly from the ASF. To get this call, the user
    // must register himself to receive samples for a particular stream.
    function OnStreamSample(wStreamNum: WORD; cnsSampleTime, cnsSampleDuration: int64;
               dwFlags: DWORD; pSample: INSSBuffer; pvContext: pointer): HRESULT; stdcall;

    // In some cases, the user may want to get callbacks telling what the
    // reader thinks the current time is. This is interesting in 2 cases:
    // - If the ASF has gaps in it; say no audio for 10 seconds. This call
    //   will continue to be called, while OnSample won't be called.
    // - If the user is driving the clock, the reader needs to communicate
    //   back to the user its time, to avoid the user overrunning the reader.
    function OnTime(cnsCurrentTime: int64; pvContext: pointer): HRESULT; stdcall;

    // The user can also get callbacks when stream selection occurs.
    function OnStreamSelection(wStreamCount: Word; pStreamNumbers: PWord;
                               pSelections: PWMTSTREAMSELECTION; pvContext: Pointer): HResult; stdcall;
    // Will be called if the user got an async result from their
    // call to SetOutputProps.  The next sample you receive for
    // this output will have these properties.  The contents of the
    // media type after calling SetOutputProps and before receiving
    // an OutputPropsChanged notification are undefined.
    function OnOutputPropsChanged(dwOutputNum: DWORD; pMediaType: PWMMediaType;
               pvContext: pointer): HRESULT; stdcall;


    // If the user has registered to allocate buffers, this is where he must
    // do it.
    function AllocateForStream(wStreamNum: WORD; cbBuffer: DWORD; out ppBuffer: INSSBuffer;
               pvContext: pointer): HRESULT; stdcall;

    function AllocateForOutput(dwOutputNum, cbBuffer: DWORD; out ppBuffer: INSSBuffer;
               pvContext: pointer): HRESULT; stdcall;

    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  private
    function WriteHeader (const pwszName: PWideChar): HRESULT;
    function WriteScript: HRESULT;
  private
    m_hEvent            : THANDLE;
    m_hrAsync           : HRESULT;
    m_qwTime            : Int64;
    m_pWriterAdvanced   : IWMWriterAdvanced;
    m_pReaderAdvanced   : IWMReaderAdvanced;
    m_pReader           : IWMReader;
    m_pWriter           : IWMWriter;
    m_pNetSink          : IWMWriterNetworkSink;
    m_bEOF              : bool;
    m_pReaderHeaderInfo : IWMHeaderInfo;
    m_pWriterHeaderInfo : IWMHeaderInfo;
  public
    function CloseAll: HRESULT;
  end;

implementation

  constructor TWMFNetWrite.Create;
  begin
    m_pReaderHeaderInfo := nil;
    m_pWriterHeaderInfo := nil;
    m_pWriterAdvanced   := nil;
    m_pReaderAdvanced   := nil;
    m_pReader           := nil;
    m_pWriter           := nil;
    m_pNetSink          := nil;
    m_hEvent            := 0;
    m_bEOF              := false;
    m_qwTime            := 0;
    m_hrAsync           := S_OK;
  end;

  destructor TWMFNetWrite.Destroy;
  begin
    CloseAll;
    CloseHandle(m_hEvent);
    m_pWriterAdvanced := nil;
    m_pWriter := nil;
    m_pNetSink := nil;
    m_pReaderAdvanced := nil;
    m_pReader := nil;
    inherited destroy;
  end;

  function TWMFNetWrite.Configure(dwPortNum: DWORD; const pwszFile: PWideChar; nMaxClient: cardinal): HRESULT;
  var
    pProfile : IWMProfile;
    pStream  : IWMStreamConfig;
    err, cchURL, dwStreams, i, cInputs : DWORD;
    pwszURL : PWideChar;
    wStreamNumber: WORD;
  begin
    if((dwPortNum = 0) or (pwszFile = nil)) then
    begin
      result := E_INVALIDARG;
      exit;
    end;

    if ((m_pWriterAdvanced = nil) or (m_pReaderAdvanced = nil) or (m_pNetSink = nil)) then
    begin
      result := E_UNEXPECTED;
      exit;
    end;

    // Create event for handling asynchronous calls
    result   := S_OK;
    pProfile := nil;
    pStream  := nil;

    m_hrAsync := S_OK;

    m_hEvent := CreateEvent(nil, FALSE, FALSE, NETWRITE_ASYNC_EVENT);
    if (m_hEvent = 0) then
    begin
      err := GetLastError;
      writeln(format('Could not Create Event: (hr=$%x)',[err]));
      result := err;
      exit;
    end;

    // Configure the Net Sink
    result := m_pNetSink.SetNetworkProtocol(WMT_PROTOCOL_HTTP);
    if (FAILED(result)) then
    begin
      writeln('Could not Set Network protocol');
      exit;
    end;

    result := m_pNetSink.Open(dwPortNum);
    if (FAILED(result)) then
    begin
      writeln(format('Network sink failed to open port no %d',[dwPortNum]));
      exit;
    end; 

    cchURL := 0;

    result := m_pNetSink.GetHostURL(nil, cchURL);
    if(FAILED(result)) then
    begin
      writeln('Could not get the host URL from IWMWriterNEtworkSink');
      exit;
    end;
     

    getmem(pwszURL, cchURL * sizeof(WCHAR));
    if (pwszURL = nil) then
    begin
      result := E_OUTOFMEMORY; // Insufficient Memory
      exit;
    end;

    result := m_pNetSink.GetHostURL(pwszURL, cchURL);
    if (FAILED(result)) then
    begin
      writeln('Could not get the host URL from IWMWriterNEtworkSink');
      FreeMem(pwszURL);
      exit;
    end;

    writeln('Connect to '+pwszURL);
 //   Sleep(1000);

    FreeMem(pwszURL);

    // Set the max no of clients that can connect to the port
    result := m_pNetSink.SetMaximumClients(nMaxClient);
    if (FAILED(result)) then
    begin
      writeln('Could not Set maximum clients');
      exit;
    end;

    // Add the network sink to the Writer Advanced
    result := m_pWriterAdvanced.AddSink(m_pNetSink);
    if (FAILED(result)) then
    begin
      writeln('Could not Add Sink');
      exit;
    end;   

    // Open the requested file
    result := m_pReader.Open(pwszFile, self, nil);
    if (FAILED(result)) then
    begin
      writeln('Could not open file');
      exit;
    end;

    // Wait for the open to finish
    WaitForSingleObject(m_hEvent, INFINITE);
    if (FAILED(m_hrAsync)) then
    begin
      writeln(format('Open failed (hr=$%x)',[m_hrAsync]));
      result := m_hrAsync;
      exit;
    end;

    // Turn on manual stream selection, so we get all streams.
    result := m_pReaderAdvanced.SetManualStreamSelection(TRUE);
    if (FAILED(result)) then
    begin
      writeln('Failed to set manual stream selection');
      exit;
    end; // 

    // Get the profile interface, loop thru all the
    // streams and request the reader to deliver compressed samples
    result := m_pReader.QueryInterface(IID_IWMProfile, pProfile);
    if (FAILED(result)) then
    begin
      writeln('Could not Query for IWMProfile');
      exit;
    end;   


    dwStreams := 0;
    result := pProfile.GetStreamCount(dwStreams);
    if (FAILED(result)) then
    begin
      writeln(format('GetStreamCount on IWMProfile failed (hr=$%x)', [result]));
      exit;
    end; 

    for i := 0 to dwStreams - 1 do
    begin
      result := pProfile.GetStream(i, pStream);
      if (FAILED(result)) then
      begin
        writeln(format('Could not get Stream %d of %d from IWMProfile (hr=0x%08x)',[i,dwStreams,result]));
        break;
      end;
      wStreamNumber := 0;
      //Get the stream number of the current stream
      result := pStream.GetStreamNumber(wStreamNumber);
      if (FAILED(result)) then
      begin
        writeln(format('Could not get stream number from IWMStreamConfig %d of %d (hr=$%x)',
			[i, dwStreams, result]));
        break;
      end;

      pStream := nil;

      //Set the stream to be recieved in compressed mode
      result := m_pReaderAdvanced.SetReceiveStreamSamples(wStreamNumber, TRUE);
      if (FAILED(result)) then
      begin
        writeln(format('Could not SetReceivedStreamSamples for stream number %d (hr=$%x)',
                       [wStreamNumber, result]));
        break;
      end;
    end;
    pStream := nil;
    if (FAILED(result)) then exit;

    // Turn on the user clock
    result := m_pReaderAdvanced.SetUserProvidedClock(TRUE);
    if (FAILED(result)) then
    begin
      writeln(format('SetUserProvidedClock failed (hr=$%x)', [result]));
      exit;
    end; 

    // Now set the writers properties
    result := m_pWriter.SetProfile(pProfile);
    if(FAILED(result)) then
    begin
      writeln(format('Could not set profile on IWMWriter (hr=$%x)',[result]));
      exit;
    end;

    pProfile := nil;

    cInputs := 0;

    result := m_pWriter.GetInputCount(cInputs);
    if(FAILED(result)) then
    begin
      writeln(format('Could not get input count from IWMWriter (hr=$%x)',[result]));
      exit;
    end;

    for i := 0 to cInputs -1 do
      // Set the input props to NULL to indicate that we don't need a codec
      // because we are writing compressed samples to the port
       m_pWriter.SetInputProps(i, nil);

    // Write all the header attributes, which can be set, from the
    // input file to the output port.
    result := WriteHeader(g_wszWMTitle);
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMAuthor) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMDescription) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMRating) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMCopyright) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMAlbumTitle) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMTrack) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMPromotionURL) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMAlbumCoverURL) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMGenre) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMYear) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMGenreID) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMMCDI) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMBannerImageType ) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMBannerImageData ) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMBannerImageURL ) ;
    if(FAILED(result)) then exit;

    result := WriteHeader( g_wszWMCopyrightURL ) ;
    if(FAILED(result)) then exit;

    //Header has been written. Lets write the script
    result := WriteScript;
  end;

  function TWMFNetWrite.WritetoNet: HRESULT;
  begin
    if ((m_hEvent          = 0)   or
        (m_pWriterAdvanced = nil) or
        (m_pReaderAdvanced = nil) or
        (m_pNetSink        = nil)) then
    begin
      result := E_UNEXPECTED;
      exit;
    end;
    // Start Writing
    result := m_pWriter.BeginWriting;
    if (FAILED(result)) then
    begin
      writeln(format('BeginWriting on IWMWriter failed (hr=$%x)',[result]));