Einzelnen Beitrag anzeigen

itsme

Registriert seit: 3. Aug 2006
32 Beiträge
 
Delphi XE Architect
 
#16

AW: Wie TLS Callback in Delphi

  Alt 27. Okt 2010, 10:09
Zunächst vielen Dank für alle guten Ratschläge, welche mir die richtige Richtung gezeigt haben.
Und nein, es gab hier weder falsche, noch sinnlose posts.
Der Miniplayer von omata war schon in etwa, was ich gesucht hatte, allerdings habe ich ihn leider zu spät gelesen, aber fürs Feintuning war er noch allemal nützlich.
Nachfolgend der Code, den ich nun nach meinen Vorstellungen entwickelt hatte, wobei ich auf jegliches Error-Handling verzichtet habe, um ihn für mein post möglichst kurz zu halten...
Ich denke die Profis hier werden den Code in der Luft zerreißen, aber damit muss ein Hobby-Täter wie ich, wohl oder übel leben.

Code:
begin
  Application.Initialize;

  GetTempPath(Length(aTempPath), aTempPath);
  fName := aTempPath;
  StrCat(fName, 'Bass.dll');

  if not FileExists(fName) then
  begin
    nHandle := FindResource(hInstance, 'Bass', RT_RCDATA);
    nPointer := LockResource(LoadResource(hInstance, nHandle));
    nSize := SizeOfResource(hInstance, nHandle);

    hFile := CreateFile(fName, GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
             CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, FILE_FLAG_DELETE_ON_CLOSE);
    WriteFile(hFile, nPointer^, nSize, nCount, nil);
    CloseHandle(hFile);
  end;

type
  QWORD = Int64;
  HSAMPLE = DWORD;
  HCHANNEL = DWORD;
  myFree = function(): bool; stdcall;
  myGetChannel = function(handle: HSAMPLE; onlynew: BOOL): HCHANNEL; stdcall;
  myChannelPlay = function(handle: DWORD; restart: BOOL): BOOL; stdcall;
  myInit = function(dev: LongInt; freq, flags: DWORD; win: HWND; clsid: PGUID): BOOL; stdcall;
  mySampleLoad = function(mem: BOOL; f: Pointer; offset: QWORD; length, max, flags: DWORD): HSAMPLE; stdcall;

var
  Form1: TForm1;
  aTempPath: array[0..255] of char;
  BASS_Free: myFree;
  BASS_Init: myInit;
  BASS_SampleLoad: mySampleLoad;
  BASS_SampleGetChannel: myGetChannel;
  BASS_ChannelPlay: myChannelPlay;
  hLib: THandle;
  hFile: THandle;
  hChan: HCHANNEL;
  hSamp: HSAMPLE;
  fName: PChar;
  nHandle: cardinal;
  nPointer: Pointer;
  nSize: cardinal;
  nCount: cardinal;
  const BASS_UNICODE = $80000000;
  const BASS_SAMPLE_LOOP = 4;

procedure TForm1.OnActivate(Sender: TObject);
begin
  GetTempPath(Length(aTempPath), aTempPath);
  fName := aTempPath;
  StrCat(fName, 'Bass.dll');
  nHandle := FindResource(hInstance, 'Intro', RT_RCDATA);
  nPointer := LockResource(LoadResource(hInstance, nHandle));
  nSize := SizeOfResource(hInstance, nHandle);
  hLib := LoadLibrary(aTempPath);
  @BASS_Free := GetProcAddress(hLib, 'BASS_Free');
  @BASS_Init := GetProcAddress(hLib, 'BASS_Init');
  @BASS_SampleLoad := GetProcAddress(hLib, 'BASS_SampleLoad');
  @BASS_SampleGetChannel := GetProcAddress(hLib, 'BASS_SampleGetChannel');
  @BASS_ChannelPlay := GetProcAddress(hLib, 'BASS_ChannelPlay');
  BASS_Init(-1, 44100, 0, Handle, nil);
  hSamp := BASS_SampleLoad(True, nPointer, 0, nSize, 10,
           BASS_SAMPLE_LOOP {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});
  hChan := BASS_SampleGetChannel(hSamp, True);
  BASS_ChannelPlay(hChan, True);
end;

procedure TForm1.OnClose(Sender: TObject; var Action: TCloseAction);
begin
  BASS_Free();
  FreeLibrary(hLib);
  if FileExists(fName) then
    DeleteFile(fName);
  Application.Terminate;
end;
LG itsme
  Mit Zitat antworten Zitat