تشغيل المايك بدون مكون

[M_Mori2010]

السلام عليكم ورحمة الله وبركاته
بحثت على مكون مايكروفون وجدت هذه الطريقة لتشغيل المايك بدون مكون
كيف تعديل الطريقة:

PHP كود :

unit Unit1;

interface

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

const
     {The larger the size of the block the fewer blocks recorded}
     {per second and therefore the longer the delay between}
     {recording and playback}
  memBlockLength = 1000;
     {500 bytes at 11k/sec = delay of 500/11000 of a second}
     {roughly a 20th}

type
  Tmemblock = array[0..memblocklength] of byte;
  PmemBlock = ^TmemBlock;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
             { Private declarations }
    HwaveIn: PHWaveIn;

    HWaveOut: PHWaveOut;
    close_invoked, close_complete: boolean;
    in_count, out_count: integer;
    procedure MMOutDone(var msg: Tmessage); message MM_WOM_DONE;
    procedure MMInDone(var msg: Tmessage); message MM_WIM_DATA;
  public
             { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  WaveFormat: PPCMWaveFormat;
  Header: PWaveHdr;
  memBlock: PmemBlock;
  i, j: integer;
begin
  WaveFormat := new(PPCMwaveFormat);
  with WaveFormat^.wf do
  begin
    WFormatTag := WAVE_FORMAT_PCM; {PCM format - the only option!}
    NChannels := 1; {mono}
    NSamplesPerSec := 11000; {11kHz sampling}
    NAvgBytesPerSec := 11000; {we aim to use 8 bit sound so only 11k per second}
    NBlockAlign := 1; {only one byte in each sample}
    waveformat^.wBitsPerSample := 8; {8 bits in each sample}
  end;
  i := waveOutOpen(nil, 0, PWaveFormatex(WaveFormat), 0, 0, WAVE_FORMAT_QUERY);
  if i <> 0 then application.messagebox('Error', 'Play format not supported', mb_OK);

  i := waveInOpen(nil, 0, PWaveFormatex(WaveFormat), 0, 0, WAVE_FORMAT_QUERY);
  if i <> 0 then application.messagebox('Error', 'Record format not supported', mb_OK);

  HwaveOut := new(PHwaveOut);
  i := waveOutOpen(HWaveOut, 0, Pwaveformatex(WaveFormat), form1.handle, 0, CALLBACK_WINDOW);
  if i <> 0 then application.messagebox('Error', 'Problem creating play handle', mb_OK);

  HwaveIn := new(PHwaveIn);
  i := waveInOpen(HWaveIn, 0, Pwaveformatex(WaveFormat), form1.handle, 0, CALLBACK_WINDOW);
  if i <> 0 then application.messagebox('Error', 'Problem creating record handle', mb_OK);


     {these are the count of the number of blocks sent to}
     {the audio device}
  in_count := 0;
  out_count := 0;

     {need to add some buffers to the recording queue}
     {in case the messages that blocks have been recorded}
     {are delayed}
  for j := 1 to 3 do
  begin
          {make a new block}
    Header := new(PWaveHdr);
    memBlock := new(PmemBlock);



    Header := new(PwaveHdr);
    with header^ do
    begin
      lpdata := pointer(memBlock);  ;
      dwbufferlength := memblocklength;
      dwbytesrecorded := 0;
      dwUser := 0;
      dwflags := 0;
      dwloops := 0;
    end;


          {prepare the new block}
    i := waveInPrepareHeader(HWaveIn^, Header, sizeof(TWavehdr));
    if i <> 0 then application.messagebox('In Prepare error', 'error', mb_ok);




          {add it to the buffer}
    i := waveInAddBuffer(HWaveIn^, Header, sizeof(TWaveHdr));
    if i <> 0 then application.messagebox('Add buffer error', 'error', mb_ok);

    inc(in_count);

  end; {of loop}

     {finally start recording}
  i := waveInStart(HwaveIn^);
  if i <> 0 then application.messagebox('Start error', 'error', mb_ok);

  close_invoked := false;
  close_complete := false;
end;

procedure TForm1.MMOutDone(var msg: Tmessage);
var
  Header: PWaveHdr;
  i: integer;
begin
  dec(out_count);



     {get the returned header}
  Header := PWaveHdr(msg.lparam);

   

  i := waveOutUnPrepareHeader(HWaveOut^, Header, sizeof(TWavehdr));
  if i <> 0 then application.messagebox('Out Un Prepare error', 'error', mb_ok);


     {free the memory}
  dispose(Header^.lpdata);
  dispose(Header);

     {if there's no more blocks being recorded}
  if (out_count = 0) then
  begin
    WaveOutClose(HWaveOut^);
    HwaveOut := nil;
  end;

     {if there's nothing more to do then close}
  if (in_count = 0) and (out_count = 0) then
  begin
    close_complete := true;
    close;
  end;

end;

procedure TForm1.MMInDone(var msg: Tmessage);
var
  Header: PWaveHdr;
  memBlock: PmemBlock;
  i: integer;
begin
  dec(in_count);
     {block has been recorded}
  Header := PWaveHdr(msg.lparam);




  i := waveInUnPrepareHeader(HWaveIn^, Header, sizeof(TWavehdr));
  if i <> 0 then application.messagebox('In Un Prepare error', 'error', mb_ok);

  if not (close_invoked) then
  begin
          {prepare it for play back}
    i := waveOutPrepareHeader(HWaveOut^, Header, sizeof(TWavehdr));
    if i <> 0 then application.messagebox('Out Prepare error', 'error', mb_ok);

          {add it to the playback queue}
    i := waveOutWrite(HWaveOut^, Header, sizeof(TWaveHdr));
    if i <> 0 then application.messagebox('Wave out error', 'error', mb_ok);

    inc(out_count);

          {make a new block}
    Header := new(PWaveHdr);
    memBlock := new(PmemBlock);



    Header := new(PwaveHdr);
    with header^ do
    begin
      lpdata := pointer(memBlock);
      dwbufferlength := memblocklength;
      dwbytesrecorded := 0;
      dwUser := 0;
      dwflags := 0;
      dwloops := 0;
    end;



          {prepare the new block}
    i := waveInPrepareHeader(HWaveIn^, Header, sizeof(TWavehdr));
    if i <> 0 then application.messagebox('In Prepare error', 'error', mb_ok);













    //    Header^.dwBytesRecorded:=Header^.dwBytesRecorded +5000;



          {add it to the buffer}
    i := waveInAddBuffer(HWaveIn^, Header, sizeof(TWaveHdr));
    if i <> 0 then application.messagebox('Add buffer error', 'error', mb_ok);





    inc(in_count);
  end;

     {if there's no more blocks being recorded}
  if (in_count = 0) then
  begin
    WaveInClose(HWaveIn^);
    HwaveIn := nil;
  end;

     {if there's nothing more to do then close}
  if (in_count = 0) and (out_count = 0) then
  begin
    close_complete := true;
    close;
  end;
end;



procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
     {reset the output channel}
  if HWaveOut <> nil then WaveOutReset(HWaveOut^);

     {reset the input channel}
  if HwaveIn <> nil then WaveInReset(HWaveIn^);
  close_invoked := true;
  canclose := close_complete;
end;

end. 


التعديل الى :
في حال الضغط على زر بوتون 1 يقوم بالتشغيل وفي حال الضغط على زر بوتون 2 بقوم بأيقاف تشغيل
وفي حال الضغط على بوتون 3 يقوم بكتم الصوت فقط و ليس ايقاف التشغيل
وماهي طريقة المشاركة بين الخادم والعميل من نوع سوكيت ؟
جزاكم الله كل خير

[sa7er100]

انت تقوم بعمل برنامج شبيه ببرنامج لايت سي صح ؟؟

استخدم اداة wavelive تفي بالغرض

[onexite]

برنامج شبيه ببرنامج لايت سي صح ؟؟

هل هو برنامج مفتوح المصدر ؟
لان وجدت ان احد مبرمجيه لغمه :p
الكل يسعى الى ان يصنع برنامج اختـراق
لن تجدوا يد العوــن هنا لاسباب صحية
كان يوجد موقع ابن س ك لاكن للاسف الان مغلق

[sa7er100]

لا ليس برنامج اختراق بل هو برنامج غرف محادثة

[onexite]

لا ليس برنامج اختراق بل هو برنامج غرف محادثة

اعلم انه برنامج محادثة
ولاكني وجدت احد المبرمجين العرب غير على الشكل ولغم السورس برابط ftp
لذلك سؤالي كان هل البرنامج مفتوح المصدر ؟

[محمد عبد العزيز]

السلام عليكم ورحمة الله

وجدت هذه الطريقة لتشغيل المايك بدون مكون

ان لم تكن متمكن من دلفي + النظام وكيف يعمل من الاسهل/الاحسن لك استخدام مكونات جاهزة

كان هل البرنامج مفتوح المصدر ؟

لا، ليس مفتوح المصدر

[M_Mori2010]

شكراً لكم وجزاكم الله كل خير وتم الموضوع بنجاح وجدت مكونات مجانية وبميزات بالفعل رائعة سوف اقوم بتنزيل المكونات في قسم المكونات المجانية وجزاكم الله كل خير