tnscript.pas

BaiduMp3 search baidu mp3

        NewEvent^.Search  := UpperCase(Search)
    else
        NewEvent^.Search  := Search;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Remove an event from the list, given his ID                               }
procedure TTnScript.RemoveEvent(ID : Integer);
var
    Item   : Integer;
    PEvent : PEventDescriptor;
begin
    if not Assigned(FEventList) then
        raise TnScriptException.Create('AddEvent: No Event List');

    Item := SearchEvent(ID);
    if Item < 0 then
        raise TnScriptException.Create('RemoveEvent: ID ' + IntToStr(ID) +
                                       ' does''nt exist');
    PEvent := FEventList.Items[Item];

    { Replace the ID to check later that we do not reuse the freed event }
    PEvent^.ID := -1;

    { Free the memory and remove the pointer from list }
    Dispose(PEvent);
    FEventList.Delete(Item);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnScript.RemoveAllEvents;
var
    PEvent : PEventDescriptor;
begin
    if not Assigned(FEventList) then
        raise TnScriptException.Create('AddEvent: No Event List');

    while FEventList.Count > 0 do begin
        PEvent := FEventList.Items[0];
        PEvent^.ID := -1;
        Dispose(PEvent);
        FEventList.Delete(0);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF DUMP}
procedure WriteCh(Ch : Char);
begin
    if ord(Ch) < 32 then
        write('<', CtrlCode[Ord(Ch)], '>')
    else
        write(Ch);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure WriteBuf(Buffer : PChar; Len : Integer);
var
    I : Integer;
begin
    for I := 0 to Len - 1 do
        WriteCh(Buffer[I]);
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Advance char index in the circular buffer                                 }
procedure TTnScript.NextOne(var N : Integer);
begin
    Inc(N);
    if N >= FInputBufferSize then
        N := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Search for a string in the circular buffer.                               }
{ Returns the number of chars between the buffer start and the end of the   }
{ event found, or -1 if not found.                                          }
function TTnScript.FindEventString(S : String; Flags : TEventFlags) : Integer;
var
    N, M, I, J, K : Integer;
    Ch            : Char;
begin
    Result := -1;
    I      := FInputBufferStart;
    N      := 0;
    while N < FInputBufferCount do begin
        if efIgnoreCase in Flags then
            Ch := UpperCase(FInputBuffer[I])[1]
        else
            Ch := FInputBuffer[I];

        if Ch = S[1] then begin
            { Same first letter, check up to end of S }
            J := I;
            K := 2;
            M := N;
            while TRUE do begin
                if K > Length(S) then begin {FP 30/07/2004 moved here }
                    { Found ! }             {FP 30/07/2004            }
                    Result := M + 1;        {FP 30/07/2004            }
                    Exit;                   {FP 30/07/2004            }
                end;                        {FP 30/07/2004            }

                NextOne(J);

                Inc(M);
                if M >= FInputBufferCount then
                    break;

                if efIgnoreCase in Flags then
                    Ch := UpperCase(FInputBuffer[J])[1]
                else
                    Ch := FInputBuffer[J];
                if Ch <> S[K] then
                    break;     { Compare failed }
                Inc(K);
            end;
        end;

        NextOne(I);
        Inc(N);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF OLD_FindEventString}
function TTnScript.FindEventString(S : String; Flags : TEventFlags) : Integer;
var
    N, M, I, J, K : Integer;
    Ch            : Char;
begin
    Result := -1;
    I      := FInputBufferStart;
    N      := 0;
    while N < FInputBufferCount do begin
        if efIgnoreCase in Flags then
            Ch := UpperCase(FInputBuffer[I])[1]
        else
            Ch := FInputBuffer[I];

        if Ch = S[1] then begin
            { Same first letter, check up to end of S }
            J := I;
            K := 2;
            M := N;
            while TRUE do begin
                NextOne(J);

                Inc(M);
                if M >= FInputBufferCount then
                    break;

                if K > Length(S) then begin
                    { Found ! }
                    Result := M + 1;
                    Exit;
                end;
                if efIgnoreCase in Flags then
                    Ch := UpperCase(FInputBuffer[J])[1]
                else
                    Ch := FInputBuffer[J];
                if Ch <> S[K] then
                    break;     { Compare failed }
                Inc(K);
            end;
        end;

        NextOne(I);
        Inc(N);
    end;
end;
{$ENDIF}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnScript.ScanEvents;
var
    Item    : Integer;
    PEvent  : PEventDescriptor;
    I       : Integer;
{$IFDEF DUMP}
    J       : Integer;
{$ENDIF}
    ID      : Integer;
    Handler : TEventHandler;
begin
{$IFDEF DUMP}
    Write('ScanEvents Start=', FInputBufferStart,
                    ' Count=', FInputBufferCount,
                     ' ''');
    I := FInputBufferStart;
    for J := 1 to FInputBufferCount do begin
        WriteCh(FInputBuffer[I]);
        NextOne(I);
    end;
    WriteLn('''');
{$ENDIF}

    Item := 0;                             {FP 30/07/2004 }
    while Item < FEventList.Count do begin {FP 30/07/2004 }
        PEvent := PEventDescriptor(FEventList.Items[Item]);
{$IFDEF DUMP}
WriteLn('Searhing ''', PEvent^.Search, '''');
{$ENDIF}
        I := FindEventString(PEvent^.Search, PEvent^.Flags);
        if I <> -1 then begin
{$IFDEF DUMP}
            WriteLn('Found event ''', PEvent^.Search, '''');
{$ENDIF}
            TriggerDisplay('Event ''' + PEvent^.Search + '''');
            { Here we delete the character up to the string we just found }
            { This means that we could not see other strings defined in   }
            { events after the one we just found.                         }
            FInputBufferCount := FInputBufferCount - I;
            FInputBufferStart := FInputBufferStart + I;
            if FInputBufferStart >= FInputBufferSize then
                FInputBufferStart := FInputBufferStart - FInputBufferSize;
            ID      := PEvent^.ID;
            Handler := PEvent^.Handler;
            if Length(PEvent^.ToSend) > 0 then
                SendStr(PEvent^.ToSend);
            { Call the global event handler OnStringMatch }
            TriggerStringMatch(ID);
            { Call the specific event handler }
            if Assigned(Handler) then
                Handler(Self, ID);
            { It's possible that the event has been removed !  }
            { Make sure it is always there before using it     }
            try
                if PEvent^.ID = ID then begin
                    if not (efPersistent in PEvent^.FLags) then begin
                        RemoveEvent(ID);
                        Dec(Item);  {FP 30/07/2004 }
                    end;
                end;
            except
                { Ignore any exception }
            end;
{FP  30/07/2004           Exit;                                       }
{ Exit here would suppress search for more events in the same packet. }
{ They would be searched only in when the next packet comes in,       }
{ if it ever comes in...                                              }
        end;
        Inc(Item);   {FP 30/07/2004                                   }
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnScript.ProcessInputData(Buffer: PChar; Len: Integer);
const
    Recurse : Integer = 0;
var
    I, J : Integer;
begin
    if not Assigned(FInputBuffer) then
        Exit;

    Inc(Recurse); { For debugging purpose }

    if Len > (FInputBufferSize div 2) then begin
        { Input buffer too small, process recursively two halfs }
        ProcessInputData(Buffer, Len div 2);
        ProcessInputData(Buffer + (Len div 2), Len - (Len div 2));
        Dec(Recurse);
        Exit;
    end;

{$IFDEF DUMP}
    WriteLn;
    Write({Calls, ' ',} Recurse, ' ', FInputBufferStart, ' ',
          FInputBufferCount, ') Len=', Len, ' Buffer=''');
    WriteBuf(Buffer, Len);
    WriteLn('''');
{$ENDIF}

    { Where is the end of the circular buffer, that's the question ! }
    I := FInputBufferStart + FInputBufferCount;
    if I >= FInputBufferSize then
         I := I - FInputBufferSize;

    { Add data to the end of the circular buffer, overwriting any previously }
    { stored data (remember, we don't ever receive more than 1/2 buffer size }
    J := 0;
    while J < Len do begin
        FInputBuffer[I] := Buffer[J];
        Inc(J);
        NextOne(I);
        if FInputBufferCount = FInputBufferSize then
            NextOne(FInputBufferStart)
        else
            Inc(FInputBufferCount);
    end;
    { Scan for events }
    ScanEvents;

    Dec(Recurse); { For debugging purpose }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnScript.TriggerDataAvailable(Buffer : Pointer; Len: Integer);
begin
    if FEventList.Count > 0 then
        ProcessInputData(PChar(Buffer), Len);

    inherited TriggerDataAvailable(Buffer, Len);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

end.