Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Alles wieder freigeben um neu zu starten! (https://www.delphipraxis.net/79357-alles-wieder-freigeben-um-neu-zu-starten.html)

R0BIN 20. Okt 2006 20:21


Alles wieder freigeben um neu zu starten!
 
Hi,


ich habe hier folgenden Code

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Bass;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button2: TButton;
    Button3: TButton;
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    cthread: DWORD;
    chan: HSTREAM;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


    FileStream :  TFileStream;
    FileNeme  :  String;     // <= C:\test.mp3



implementation

const
  urls: array[0..9] of String = (
    'http://160.79.128.62:6038','http://205.188.234.129:8024',
    'http://64.236.34.97/stream/1006','http://206.98.167.99:8406',
    'http://160.79.1.141:8000/','http://206.98.167.99:8006',
    'http://205.188.234.4:8016','http://205.188.234.4:8014',
    'http://server2.somafm.com:8000','http://server1.somafm.com:8082'
  );

{$R *.dfm}


function Get_AppPath : string;
begin
 result:= ExtractFilePath( ParamStr( 0 ) );
end;


{ display error messages }
procedure Error(es: String);
begin
  MessageBox(Form1.Handle, PChar(es + #13#10 + '(error code: ' + IntToStr(BASS_ErrorGetCode) + ')'), 'Error', 0);
end;

{ update stream title from metadata }
procedure DoMeta(meta: PChar);
var
  p: Integer;
begin
  if (meta <> nil) then
  begin
    p := Pos('StreamTitle=', meta);
    if (p = 0) then
      Exit;
    p := p + 13;
    Form1.Label3.Caption := Copy(meta, p, Pos(';', meta) - p - 1);
  end;
end;

procedure MetaSync(handle: HSYNC; channel, data, user: DWORD); stdcall;
begin
  DoMeta(PChar(data));
end;



procedure StatusProc(buffer: Pointer; len, user: DWORD); stdcall;
begin
  if (buffer <> nil) and (len = 0) then
    Form1.Label5.Caption := PChar(buffer); // display connection status


  if (FileNeme = '') then
    exit;
  if (FileStream = nil) then
      FileStream:= TFileStream.Create(FileNeme, fmCreate); // create the file
  if (buffer = nil) then
      FileStream.Free // finished downloading
   else
      FileStream.Write(buffer^, len);

end;

function OpenURL(url: PChar): Integer;
var
  icy: PChar;
begin
  FileNeme:= Get_AppPath + 'test.mp3';

  Result := 0;
  BASS_StreamFree(Form1.chan); // close old stream
  Form1.Label4.Caption := 'connecting...';
  Form1.Label3.Caption := '';
  Form1.Label5.Caption := '';
  form1.chan := 0;
//in der nächsten zeile kommt der fehler beim wiederaufbau des threads.
  Form1.chan := BASS_StreamCreateURL(url, 0, BASS_STREAM_META or BASS_STREAM_STATUS, @StatusProc, 0);
  if (Form1.chan = 0) then
  begin
    Form1.Label4.Caption := 'not playing';
    Error('Can''t play the stream');
  end
  else
  begin
    // get the broadcast name and bitrate
    icy := BASS_StreamGetTags(Form1.chan, BASS_TAG_ICY);
    if (icy <> nil) then
      while (icy^ <> #0) do
      begin
        if (Copy(icy, 1, 9) = 'icy-name:') then
          Form1.Label4.Caption := Copy(icy, 10, Length(icy) - 9)
        else
       if (Copy(icy, 1, 7) = 'icy-br:') then
          Form1.Label5.Caption := 'bitrate: ' + Copy(icy, 8, Length(icy) - 7);
        icy := icy + Length(icy) + 1;
      end;
    // get the stream title and set sync for subsequent titles
    DoMeta(BASS_StreamGetTags(Form1.chan,BASS_TAG_META));
    BASS_ChannelSetSync(Form1.chan,BASS_SYNC_META,0,@MetaSync,0);
    // play it!
   
    BASS_ChannelPlay(Form1.chan,FALSE);
  end;
  Form1.cthread := 0;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // check that BASS 2.1 was loaded
  if (BASS_GetVersion <> DWORD(MAKELONG(2,1))) then
  begin
    MessageBox(0,'BASS version 2.1 was not loaded','Incorrect BASS.DLL',0);
    Halt;
  end;
  if (not BASS_Init(1,44100,0,Form1.Handle,NIL)) then
  begin
    Error('Can''t initialize device');
    Halt;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 ThreadId: Cardinal;
begin
  if (cthread <> 0) then
    MessageBeep(0)
  else
    cthread := BeginThread(nil, 0, @OpenURL, PChar(urls[TButton(Sender).Tag]), 0, ThreadId);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

BASS_ChannelStop(form1.chan); //ab hier versuche ich alles freizugeben um den thread neu starten zu können. es kommt auch erst der fehler wenn ich wieder versuche den thread zu starten...dan fliegt er bei obiger zeile form1.chan := BASS_StreamCreate raus!
BASS_StreamFree(form1.chan);
Filestream := nil;



end;

procedure TForm1.Button3Click(Sender: TObject);
begin

end;

end.
unter button2. versuche ich alles freizugeben um den thread neu zu starten, er gibt mir aber error code 5 zugriffsverletzung bei der oben makierten teile, wieso?

R0BIN


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:04 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz