shoutcaststream.pas

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

unit ShoutCastStream;

   (*********************************************************************
    * The contents of this file are used with permission, subject to    *
    * the Mozilla Public License Version 1.1 (the "License"); you may   *
    * not use this file except in compliance with the License. You may  *
    * obtain a copy of the License at                                   *
    * http://www.mozilla.org/MPL/MPL-1.1.html                           *
    *                                                                   *
    * Software distributed under the License is distributed on an       *
    * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or    *
    * implied. See the License for the specific language governing      *
    * rights and limitations under the License.                         *
    *                                                                   *
    * (C) 2004 Martin Offenwanger: [e-mail]                    *
    *********************************************************************)
{
@author(Martin Offenwanger: [e-mail])
@created(Apr 22, 2004)
@lastmod(Sep 09, 2004)
}

interface

uses
  Windows, Controls, Sock, Forms, SysUtils, BaseClass, Dialogs,
  WinSock, ICYParser;

{ how to use tip:
  we are running a async. winsock
  The Winsock sends its event handling trough the Windows Message Queue
  You should create this class in a Thread and/or use
  TApplication.processmessages in external buffering loops }

type
  TShoutcastStream = class
  public
    FApplication: TApplication;
    constructor Create;
    destructor Destroy; override;
    procedure SetConnectToIp(Adress: string; Port: string;
      Location: string; Meta: boolean);
    function SetRipStream(RipStream: boolean; Path: string;
      FileO: string): HRESULT;
    function GetRipStream(out RipStream: boolean; out Path: string): HRESULT;
  private
    FLock: TBCCritSec;
    FSock: TSock; // Winsock class
    { sock message receiver
      ( we are running a async winsock.
      " requires a TForm listener "  ) }
    FReceiveForm: TForm;
    FLocation: string; // host Location (Path only)
    FHeaderFound: boolean; // header flag
    FICYHeader: string; // the header itself
    // ripper feature Objects
    FPath: string; // used filePath
    FFile: string; // Location and filename
    FFileNoMetaData: string; // file to record in NoMetaData Mode
    FFileObject: TextFile; // FileObject
    FRipStream: boolean; // ripper state flag
    FFileCreated: boolean; // file state flag
    // Metadata count
    FMetaInterval: integer;
    FMetaCount: integer;
    FMetaStartFound: boolean;
    FTempSave: string;
    FOutOfSync: boolean;
    FMetadataEnabled: boolean;
    // connect message receiver
    procedure OnSockConnect(Sender: TObject);
    // read message receiver
    procedure OnSockRead(Sender: TObject; Count: Integer);
    procedure OnSockInfo(Sender: TObject; SocketInfo: TSocketInfo; Msg: string);
    // metadata format: "StreamTitle='content;StreamURL='content';"
    function getStreamTitle(Metadata: string): string;
    function getStreamURl(Metadata: string): string;
    // ripper
    procedure createNewFileIfNeeded(Metadata: string);
    procedure createFileNoMeataInt(FileO: string);
  protected
  end;

implementation

uses config;

function TShoutcastStream.GetRipStream(out RipStream: boolean;
  out Path: string): HRESULT;
begin
  FLock.Lock;
  RipStream := FRipStream;
  Path := copy(FPath, 1, length(FPath));
  RESULT := S_OK;
  FLock.UnLock;
end;

function TShoutcastStream.SetRipStream(RipStream: boolean; Path: string;
  FileO: string): HRESULT;
begin
  FLock.Lock;
  FRipStream := RipStream;
  FPath := copy(Path, 1, length(Path));
  FFileNoMetaData := copy(FileO, 1, length(FileO));
  RESULT := S_OK;
  FLock.UnLock;
end;

function TShoutcastStream.GetStreamTitle(Metadata: string): string;
var
  Pos1: integer;
  Temp: string;
begin
  Pos1 := Pos('''', Metadata);
  Temp := copy(Metadata, Pos1 + 1, length(Metadata) - Pos1 - 1);
  Pos1 := Pos('''', Temp);
  Result := copy(Temp, 1, Pos1 - 1);
end;

function TShoutcastStream.GetStreamURl(Metadata: string): string;
var
  Pos1: integer;
  Temp: string;
begin
  // search for the first offset
  Pos1 := Pos(';', Metadata);
  Temp := copy(Metadata, Pos1 + 1, length(Metadata) - Pos1 - 1);
  Result := getStreamTitle(Temp);
end;

procedure TShoutcastStream.createNewFileIfNeeded(metadata: string);
var
  Title: string;
  Pos1: integer;
begin
  Title := getStreamTitle(Metadata);
  Title := Title;
  if (Title <> FFile) then
    GFFileName := Title + '.mp3';
  if FRipStream then
  begin
    if (Title <> FFile) then
    begin
      FFile := Title;
      if FPath <> '' then
        SetCurrentDir(FPath);
      if FFileCreated then
        CloseFile(FFileObject);
      // check if the file name is supported ( \/:*?"<>| )
      Pos1 := Pos('\', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('/', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos(':', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('*', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('?', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('"', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('<', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('>', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      Pos1 := Pos('|', Title);
      if Pos1 <> 0 then
        Title := copy(Title, 1, Pos1 - 1);
      // rewrite existing files to reduce overhead :/
      if FileExists(Title + '.mp3') then
        DeleteFile(Title + '.mp3');
      try
        AssignFile(FFileObject, Title + '.mp3');
        ReWrite(FFileObject);
        FFileCreated := true;
      except
        ShowMessage('A bug has been found in ASyncEx Filter' +
          'please post the folowing line to: [e-mail]  : ' +
          Title + '.mp3');
      end;
    end;
  end
  else
  begin
    if FFileCreated then
      CloseFile(FFileObject);
    FFileCreated := false;
  end;
end;

procedure TShoutcastStream.createFileNoMeataInt(FileO: string);
begin
  if FRipStream then
  begin
    if not FFileCreated then
    begin
      if FileExists(FileO) then
        // we rewrite existing files to reduce overhead :/
        DeleteFile(FileO);
      try
        if FPath <> '' then
          SetCurrentDir(FPath);
        if FFileCreated then
          CloseFile(FFileObject);
        AssignFile(FFileObject, FileO);
        ReWrite(FFileObject);
        FFileCreated := true;
      except
        ShowMessage('A bug has been found in DSPlayer ASync.Source' +
          'please post the folowing line to: [e-mail]  : ' +
          FileO);
      end;
    end;
  end
  else
  begin
    if FFileCreated then
      CloseFile(FFileObject);
    FFileCreated := false;
  end;
end;

procedure TShoutcastStream.OnSockRead(Sender: TObject; Count: Integer);
var
  Temp: string;
  Temp2: string;
  MyPos: integer;
  Subi: integer;
  Pos1, Pos2: integer;
  MetaString: string;
  LengthO: byte;
  CharO: char;
  TempSave: string;
  MetaTitle: string;
  MetaUrl: string;
  ErrMsg: string;
begin
  { -> This section includes the streamparser,fileripper and buffer abilties <-
               todo: - code cleaning
                     - better helper functions or helper classes
  }
  try
    FLock.Lock;
    Temp := FSock.Receive; // get the received data from winsock buffer
    // get the end of url header count
    MyPos := 0;
    if not FHeaderFound then
    begin
      FTempSave := FTempSave + Temp;
      Temp := FTempSave;
      MyPos := Pos(#13#10#13#10, Temp);
    end;
    if MyPos <> 0 then
    begin
      // cut the header and save it into FICYHeader
      Temp2 := Temp;
      Temp := Copy(Temp, MyPos + 4, StrLen(@MyPos) - 4); // get mp3 data
      Temp2 := Copy(Temp2, 0, MyPos + 2); // get the URL header
      FICYHeader := Temp2; // save the URL header
      // get the Metadata count:
      FMetaInterval := GetServerICYInt(Temp2);
      // header callback
      if GFFilterCallBack <> nil then