asyncreader.pas

为Delphi2005做了改动 DSPack 2.3.3 (Sep 2004). DSPack is a set of Components and class to write Multimedia

        begin
          Application.Destroy;
          if g_threadedShoutCastStream <> nil then
          begin
            g_threadedShoutCastStream.Destroy;
            g_threadedShoutCastStream := nil;
          end;
          if GFStringQueue <> nil then
          begin
            if assigned(GFFilterCallBack) then
              GFFilterCallBack.AsyncExSockError('Your prebuffer is too small for the pin connection process. Raise the pebuffer!')
            else
              ShowMessage('TAsyncIO.SyncRead: Your prebuffer is too small for the pin connection process. Raise the prebuffer!');
            GFStringQueue.Destroy;
            GFStringQueue := nil;
          end;
          result := E_FAIL;
          exit;
        end;
        Buffer := Buffer + GFStringQueue.getitem(i);
        inc(i);
        if (llPosition + lLength <= Avdata) then
        begin
          StringStream := TStringStream.Create(Buffer);
          StringStream.Position := llPosition;
          Result := StringStream.Read(pBuffer^, lLength);
          freeandnil(StringStream);
          break;
        end
        else
          Avdata := system.length(Buffer);
      end;
    end
    else
    begin
      if assigned(GFFilterCallBack) then
        GFFilterCallBack.AsyncExFilterState(false, false, false, true, 0);
      while not Datawritten do
      begin
        // we need to free some cpu time for other processes -> sleep(1)
        Sleep(1);
        if GFExit then
        begin
          result := E_FAIL;
          Application.destroy;
          if GFStringQueue <> nil then
          begin
            GFStringQueue.Destroy;
            GFStringQueue := nil;
          end;
          exit;
        end;
        while not Buffering do
        begin
          // we need to free some cpu time for other processes -> sleep(1)
          Sleep(1);
          if GFExit then
          begin
            result := E_FAIL;
            Application.destroy;
            if GFStringQueue <> nil then
            begin
              GFStringQueue.Destroy;
              GFStringQueue := nil;
            end;
            exit;
          end;
          Application.ProcessMessages;
          // we needed to process the onsock read events
        // during waiting for the data
          while (llength > Avdata) do
          begin
            // we need to free some cpu time for other processes -> sleep(1)
            Sleep(1);
            if GFExit then
            begin
              result := E_FAIL;
              Application.destroy;
              if GFStringQueue <> nil then
              begin
                GFStringQueue.Destroy;
                GFStringQueue := nil;
              end;
              exit;
            end;
            Application.ProcessMessages;
            // we needed to process the onsock read events
          // during waiting for the data
            if GFStringQueue.getcount > 0 then
            begin
              Buffer := Buffer + GFStringQueue.pop;
              Avdata := system.length(Buffer);
            end
            else
            begin
              Buffering := true;
              if (FTimerPause <> nil) then
                FTimerPause.Enabled := true;
              break;
            end;
          end;
          if (llength <= Avdata) then
          begin
            StringStream := TStringStream.Create(Buffer);
            StringStream.Position := 0;
            Result := StringStream.Read(pBuffer^, llength);
            freeandnil(StringStream);
            if (Avdata - llength > 0) then
            begin
              Tempbuffer := copy(Buffer, llength + 1, system.length(Buffer));
              GFStringQueue.InsertItem(Tempbuffer, 0);
            end;
            Application.Destroy;
            if assigned(GFFilterCallBack) then
              GFFilterCallBack.AsyncExFilterState(false, false, false, true, 0);
            // we can not call Fmediacontrol.play directly at this point,
            // because destroy in uniot Filter won't called if we do,
            // so we call the Fmediacontrol.play via a timer control
            if (FTimerPlay <> nil) then
              FTimerPlay.Enabled := true;
            exit;
          end;
        end;
        if assigned(GFFilterCallBack) then
          GFFilterCallBack.AsyncExFilterState(true, false, false, false,
            trunc((Avdata * 100) / (GFBufferSize)));
        if GFStringQueue.getcount > 0 then
          Buffer := Buffer + GFStringQueue.pop;
        Avdata := system.length(Buffer);
        if ((GFBufferSize) <= Avdata) then
        begin
          if assigned(GFFilterCallBack) then
            GFFilterCallBack.AsyncExFilterState(true, false, false, false, 100);
          StringStream := TStringStream.Create(Buffer);
          StringStream.Position := 0;
          Result := StringStream.Read(pBuffer^, llength);
          freeandnil(StringStream);
          if (Avdata - llength > 0) then
          begin
            Tempbuffer := copy(Buffer, llength + 1, system.length(Buffer));
            GFStringQueue.InsertItem(Tempbuffer, 0);
          end;
          if assigned(GFFilterCallBack) then
            GFFilterCallBack.AsyncExFilterState(false, false, false, true, 0);
          if (FTimerPlay <> nil) then
            FTimerPlay.Enabled := true;
          break;
        end;
      end;
    end;
    Application.Destroy;
  end
  else
  begin
    FListsLock.Lock;
    try
      if FFlushing then
        Result := VFW_E_WRONG_STATE
      else
      begin
        Req := CreateRequest(llPosition, lLength, false, pBuffer, nil, 0);
        CompleteRequest(Req);
        Result := Req.Fhr;
        Dispose(Req);
      end;
    finally
      FListsLock.UnLock;
    end;
  end;
end;

function TAsyncIO.PutWorkItem(AItem: PAsyncRequest): HRESULT;
begin
  FListsLock.Lock;
  try
    if FFlushing then
      Result := VFW_E_WRONG_STATE
    else
    begin
      FWorkList.Push(AItem);
      FWorkEvent.SetEv;
      Result := S_OK;
    end;
  finally
    FListsLock.UnLock;
  end;
end;

function TAsyncIO.GetWorkItem: PAsyncRequest;
begin
  FListsLock.Lock;
  Result := FWorkList.Pop;
  if FWorkList.Count = 0 then
    FWorkEvent.Reset;
  FListsLock.UnLock;
end;

function TAsyncIO.GetDoneItem: PAsyncRequest;
begin
  FListsLock.Lock;
  Result := FDoneList.Pop;
  if (FDoneList.Count = 0) and (not FFlushing or FWaiting) then
    FDoneEvent.Reset;
  FListsLock.UnLock;
end;

procedure TAsyncIO.PutDoneItem(AItem: PAsyncRequest);
begin
  Assert(FListsLock.CritCheckIn);
  FDoneList.Push(AItem);
  FDoneEvent.SetEv;
end;

function TAsyncIO.Length(out pTotal, pAvailable: int64): HResult;
begin
  FReaderLock.Lock;
  try
    if FURLMode then
    begin
      // we return the max int64 value
      pTotal := GCFInt64max;
      GFStreamLength := pTotal;
      FStrmSize := pTotal;
      Result := S_OK; //VFW_S_ESTIMATED;
    end
    else
    begin
      if FStrmSize = 0 then
        InitStreamLen;
      pTotal := FStrmSize;
      GFStreamLength := FStrmSize;
      pAvailable := pTotal;
      Result := S_OK;
      exit;
    end;
  finally
    FReaderLock.UnLock;
  end;
end;

function TAsyncIO.SetPosition(const APos: Int64): HResult;
var
  CPos: Int64;
begin
  FReaderLock.Lock;
  Result := S_OK;
  try
    if FStrmSize = 0 then
      InitStreamLen;
    CPos := GetStreamPos;
    if not FFwdStream then
    try
      if CPos <> APos then
        Result := SetStreamPos(APos);
    except
      //sometimes it's not working
      //try from the begining
      Result := S_FALSE;
    end
    else
    begin
      try
        if Apos <> CPos then
        begin
          if APos < CPos then
            SetStreamPos(0);
          Result := SetStreamPos(APos);
        end;
      except
        Result := S_FALSE;
      end;
    end;
  finally
    FReaderLock.UnLock;
  end;
end;

procedure TAsyncIO.InitStreamLen;
begin
  if not FFwdStream then
  try
    FFwdStream := FStream.Seek(0, STREAM_SEEK_END, FStrmSize) <> S_OK;
  except
    FStrmSize := 0;
    FFwdStream := true;
  end;
  if FFwdStream then
  try
    SetStreamPos(0);
    FStrmSize := 32768;
    try
      while SetStreamPos(FStrmSize) = S_OK do
        FStrmSize := 2 * FStrmSize;
    except
    end;
    FStrmSize := GetStreamPos;
    SetStreamPos(0);
  except
    FStrmSize := 10000; //fake
  end;
end;

function TAsyncIO.GetStreamPos: Int64;
begin
  FStream.Seek(0, STREAM_SEEK_CUR, Result);
  GFStreamPos := Result;
end;

function TAsyncIO.SetStreamPos(const APos: Int64): HResult;
var
  NewPos: Int64;
begin
  Result := FStream.Seek(APos, STREAM_SEEK_SET, NewPos);
end;

procedure TAsyncIO.CompleteRequest(Req: PAsyncRequest);
var
  R: integer;
begin
  FReaderLock.Lock;
  with Req^ do
  try
    Fhr := SetPosition(FPos);
    R := 0;
    if Fhr = S_OK then
    begin
      Fhr := FStream.Read(FBuffer, FLength, @R);
      if FLength <> R then
      begin
        Fhr := S_FALSE;
        FLength := R;
      end;
    end;
  finally
    FReaderLock.UnLock;
  end;
end;

function TAsyncIO.CreateRequest(
  llPos: LONGLONG; lLength: Integer; bAligned: BOOL; pBuffer,
  pContext: Pointer; dwUser: DWORD): PAsyncRequest;
begin
  New(Result);
  with Result^ do
  begin
    FPos := llPos;
    FAligned := bAligned;
    FLength := lLength;
    FBuffer := pBuffer;
    FContext := pContext;
    FUser := dwUser;
    Fhr := VFW_E_TIMEOUT;
  end;
end;

function TAsyncIO.InitAllocator(out Alloc: IMemAllocator): HRESULT;
begin
  Result := CoCreateInstance(CLSID_MemoryAllocator, nil, CLSCTX_INPROC_SERVER,
    IID_IMemAllocator, Alloc);
end;

function TAsyncIO.WaitForNext(dwTimeout: DWORD; out ppSample: IMediaSample;
  out pdwUser: DWORD): HResult;
var
  cbActual: Longint;
begin
  result := DoWaitForNext(dwTimeout, Pointer(ppSample), pdwUser, cbActual);
end;

function TAsyncIO.RequestAllocator(pPreferred: IMemAllocator;
  pProps: PAllocatorProperties; out ppActual: IMemAllocator): HResult; stdcall;
var
  P, PA: TAllocatorProperties;
begin
  P := pProps^;
  P.cbAlign := 1;
  if pPreferred <> nil then
  begin
    Result := pPreferred.SetProperties(P, PA);
    if Succeeded(Result) and (P.cbAlign = PA.cbAlign) then
    begin
      ppActual := pPreferred;
      exit;
    end;
  end;
  InitAllocator(ppActual);
  Result := ppActual.SetProperties(P, PA);
  if Succeeded(Result) and (P.cbAlign = PA.cbAlign) then
  begin
    Result := S_OK;
    exit;
  end;
  if Succeeded(Result) then
    Result := VFW_E_BADALIGN;

  ppActual := nil;
end;

function TAsyncIO.SyncReadAligned(pSample: IMediaSample): HResult;
var
  T1, T2: TReferenceTime;
  Start, Total: LONGLONG;
  Length: Longint;
  Buffer: PByte;
begin
  pSample.GetTime(T1, T2);
  if not FURLMode then
    Self.Length(Total, Start)
  else
    Buffer := nil;
  Start := T1 div NANOSECONDS;
  Length := (T2 - T1) div NANOSECONDS;

  if not FURLMode then
    if Start + Length > Total then
    begin
      Length := Total - Start;
      T2 := Total * NANOSECONDS;
      pSample.SetTime(@T1, @T2);
    end;

  Result := pSample.GetPointer(Buffer);
  if (FAILED(Result)) then
    exit;

  Result := SyncRead(Start, Length, Buffer);
end;

function TAsyncIO.Request(pSample: IMediaSample; dwUser: DWORD): HResult;
var
  T1, T2: TReferenceTime;
  Start, Total: LONGLONG;
  Length: Longint;
  Buffer: PByte;
begin
  pSample.GetTime(T1, T2);
  self.Length(Total, Start);
  Start := T1 div NANOSECONDS;
  Length := (T2 - T1) div NANOSECONDS;

  if Start + Length > Total then
  begin
    Length := Total - Start;
    T2 := Total * NANOSECONDS;
    pSample.SetTime(@T1, @T2);
  end;

  Result := pSample.GetPointer(Buffer);
  if (FAILED(Result)) then
    exit;

  Result := DoRequest(Start, Length,
    false, Buffer, Pointer(pSample), dwUser);
end;

end.