⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 voicemodual.pas

📁 Yahoo Messenger for Mobile
💻 PAS
字号:
unit voicemodual;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, YACSCOMLib_TLB, StdCtrls, checklst, Winsock, madCodeHook,
  ScktComp;

type
  Tminivoice = class(TForm)
    YAcs1: TYAcs;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    CheckListBox1: TCheckListBox;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    Memo1: TMemo;
    Label2: TLabel;
    procedure FormShow(Sender: TObject);
    procedure YAcs1onConferenceReady(Sender: TObject);
    procedure YAcs1onRemoteSourceOnAir(Sender: TObject; sourceId: Integer;
      const sourceName: WideString);
    procedure YAcs1onRemoteSourceOffAir(Sender: TObject; sourceId: Integer;
      const sourceName: WideString);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure YAcs1onTransmitReport(Sender: TObject; numReceiving,
      numTotal: Integer);
    procedure YAcs1onLocalOnAir(Sender: TObject);
    procedure YAcs1onSourceMuted(Sender: TObject; numMuting: Integer;
      const sourceName: WideString);
    procedure YAcs1onSourceUnmuted(Sender: TObject; numMuting: Integer;
      const sourceName: WideString);
    procedure Button3Click(Sender: TObject);
    procedure YAcs1onLocalOffAir(Sender: TObject);
    procedure YAcs1onAudioError(Sender: TObject; code: Integer;
      const message: WideString);
    procedure YAcs1onConferenceNotReady(Sender: TObject);
    procedure YAcs1onSourceEntry(Sender: TObject; sourceId: Integer;
      const sourceName: WideString);
    procedure YAcs1onSourceExit(Sender: TObject; sourceId: Integer;
      const sourceName: WideString);
    procedure YAcs1onSystemDisconnect(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    procedure WndProc(var Message: TMessage);override;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  minivoice: Tminivoice;
  WhosPlaying,LoggedInName,RoomName,RoomNum,VoiceAuth: String;
  WhosPlayingID: Integer;
  connectNext: Function(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
  recvfromNext: Function(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
  socketNext: Function(af, Struct, protocol: Integer): TSocket; stdcall;
   recvNext : function( s       : Integer;
               buffer  : PByteArray;
               len     : Integer;
               flags   : Integer ):Integer; stdcall;



Const
 Wm_Speak = Wm_User+1;
 Wm_SpeakRelease = Wm_User+2;
 Wm_Lock = Wm_User+3;
 Wm_LockRelease = Wm_User+4;
 Wm_IgnorePlayer = Wm_User+5;
 Wm_SpeakDown = Wm_User+6;
 Wm_SpeakUp = Wm_User+7;
 Wm_Text = Wm_User+10;


implementation

{$R *.DFM}


function socketCallBack(af, Struct, protocol: Integer): TSocket; stdcall;
Begin
 If Protocol=SOCK_DGRAM	 Then
  Begin
   Protocol:=Sock_Stream;
   MiniVoice.Memo1.Lines.Add('Sock Dgram');
 End;
  Result:=SocketNext(Af,Struct,Protocol);

End;

function recvfromCallBack(s: TSocket; var Buf; len, flags: Integer;
  var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
Begin
 MiniVoice.Memo1.Lines.Add('UDP Diagram');
 Result:=RecvFromNext(S,Buf,Len,Flags,From,FromLen);
End;

function recvCallback( s       : Integer;
          buffer  : PByteArray;
          len     : Integer;
          flags   : Integer ):Integer; stdcall;
var
  cmd, w    :word;
  str, str2 :String;
  GID       :cardinal;
begin
 MiniVoice.Memo1.Lines.Add('Data');
if @buffer = nil then
  begin
    Result := recvNext(s, buffer, len, flags);
    Exit;
  End;
 MiniVoice.Memo1.Lines.Add(String(Pointer(Buffer)));
 Result := recvNext(s, buffer, len, flags);
// Buffer^[0]:=Ord('A');
End;


{function recvCallback( s       : Integer;
          buffer  : PByteArray;
          len     : Integer;
          flags   : Integer ):Integer; stdcall;
var
  cmd, w    :word;
  str, str2 :String;
  GID       :cardinal;
begin
if @buffer = nil then
  begin
    Result := recvNext(s, buffer, len, flags);
    Exit;
  End;
 MiniVoice.Memo1.Lines.Add(String(Pointer(Buffer)));
 Result := recvNext(s, buffer, len, flags);
 //Buffer^[0]:=Ord('A');
End;}



function connectCallback(s: TSocket; var name: TSockAddr;
    namelen: Integer): Integer; stdcall;
Var
 IpAdd: String;
Begin
  { Name.sin_addr.S_un_b.s_b1:=#127;
   Name.sin_addr.S_un_b.s_b2:=#0;
   Name.sin_addr.S_un_b.s_b3:=#0;
   Name.sin_addr.S_un_b.s_b4:=#1;
   Name.sin_port:=htons(8001);}
  // Result:=ConnectNext(s,Name ,0);
   If name.sin_family=SOCK_DGRAM Then
    Begin
//      S.
    //  Name.sin_port:=htons(5001);
   {   Name.sin_addr.S_un_b.s_b1:=#127;
      Name.sin_addr.S_un_b.s_b2:=#0;
      Name.sin_addr.S_un_b.s_b3:=#0;
      Name.sin_addr.S_un_b.s_b4:=#1;}
//      MiniVoice.Memo1.Lines.Add('Diagram');
//     name.sin_family:=SOCK_Stream;
    // Result:=ConnectNext(s,Name ,0);
    // Exit;
    End;
   IpAdd:=IntToStr(Ord(Name.sin_addr.S_un_b.s_b1))+'.'+IntToStr(Ord(Name.sin_addr.S_un_b.s_b2))+'.'+IntToStr(Ord(Name.sin_addr.S_un_b.s_b3))+'.'+IntToStr(Ord(Name.sin_addr.S_un_b.s_b1));
   MiniVoice.Memo1.Lines.Add('Server '+IpAdd);
   Result := ConnectNext(s,Name ,NameLen);
  // Name.sin_addr.S_addr:=Integer(Pchar('127.0.0.1'));
   //Exit;
End;

procedure TMinivoice.WndProc(var Message: TMessage);
Var
 Handled: Boolean;
 Str: String;
 P: Longint;
 Struct: PCOPYDATASTRUCT;
begin
 Handled:=False;
  if Message.Msg = wm_copydata then
   Begin
    Struct:=PCopyDataStruct(Message.LParam);
    Str:=String(Struct^.LpData);
    ShowMessage(Str);
   End;
  if Message.Msg = wm_speakdown then
   Begin
    SendMessage(MiniVoice.Button1.Handle,wm_lbuttondown,0,0);
    Handled:=True;
   End;
  if Message.Msg = wm_speakUp then
   Begin
    SendMessage(MiniVoice.Button1.Handle,wm_lbuttonUp,0,0);
    Handled:=True;
   End;
  if Message.Msg = wm_Lock then
   Begin
    MiniVoice.Button2.Click;
    Handled:=True;
   End;
  if Message.Msg = wm_LockRelease then
   Begin
    MiniVoice.Button2.Click;
    Handled:=True;
   End;
  if Message.Msg = wm_IgnorePlayer then
   Begin
    MiniVoice.Button3.Click;
    Handled:=True;
   End;

 If Handled=False Then
     inherited WndProc(Message);
end;

procedure Tminivoice.FormShow(Sender: TObject);
Var
 Tmp2,Tmp: String;
 N,Params: Integer;
begin
 Tmp:='';
For  N:=1 to ParamCount do
  Tmp:=Tmp+' '+ParamStr(N);
// Tmp:='-+-tobjectpascal-+-Yahoo! Chat Help:1-+-1600326597-+-arAU_AG7ShfYuSH_9e4_.81bWVU2Mzjko--+-';
 Tmp:=Trim(Tmp);
 If Tmp='' Then Exit;
 If copy(Tmp,1,3)='-+-' Then
    Delete(Tmp,1,3);
 LoggedInName:=Copy(Tmp,1,pos('-+-',Tmp)-1);
 Delete(Tmp,1,Length(LoggedInName)+3);
 RoomName:=Copy(Tmp,1,pos('-+-',Tmp)-1);
 Delete(Tmp,1,Length(RoomName)+3);
 RoomNum:=Copy(Tmp,1,pos('-+-',Tmp)-1);
 Delete(Tmp,1,Length(RoomNum)+3);
 voiceauth:=Copy(Tmp,1,pos('-+-',Tmp)-1);
 Delete(Tmp,1,Length(voiceauth)+3);

{  Edit1.Text:=LoggedInName;
  Edit2.Text:=RoomName;
  Edit3.Text:=RoomNum;
  Edit4.Text:=VoiceAuth;}

 Yacs1.userName:=LoggedInName;
 Yacs1.hostName:='vc.yahoo.com';
 Yacs1.confKey:=VoiceAuth;
 Yacs1.appInfo:='ch(381)&l=rqvtsqxst/o&iu=us; T=z=sKVV.AsKVV.Agxoz1rWrWPC&ia=en&lib=yacscom(43)&u'+LoggedInName;
 Yacs1.confName:='ch/'+RoomName+'::'+RoomNum;
// Yacs1.monitorGain:=High(SmallInt);
// Yacs1.outputGain:=High(SmallInt);
// Yacs1.unmuteSource(0,'YacsUI11');
 Yacs1.createAndJoinConference;
end;

procedure Tminivoice.YAcs1onConferenceReady(Sender: TObject);
begin
 Edit1.Text:='Ready!';
end;

procedure Tminivoice.YAcs1onRemoteSourceOnAir(Sender: TObject;
  sourceId: Integer; const sourceName: WideString);
begin
 WhosPlaying:=SourceName;
 WhosPlayingID:=SourceID;
 Edit1.Text:='OnAir '+sourceName;
end;

procedure Tminivoice.YAcs1onRemoteSourceOffAir(Sender: TObject;
  sourceId: Integer; const sourceName: WideString);
begin
Edit1.Text:='OffAir '+sourceName;
end;

procedure Tminivoice.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Yacs1.stopTransmit;
end;

procedure Tminivoice.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 Yacs1.startTransmit;
end;

procedure Tminivoice.Button2Click(Sender: TObject);
begin
If Button2.Caption='Lock' Then
 Begin
   Button2.Caption:='Unlock';
   Yacs1.StartTransmit;
 End
  Else
 Begin
   Button2.Caption:='Lock';
   Yacs1.StopTransmit;
 End;
end;

procedure Tminivoice.YAcs1onTransmitReport(Sender: TObject; numReceiving,
  numTotal: Integer);
begin
 Label1.Caption:=IntToStr(NumTotal)+'/'+IntToStr(numReceiving);
end;

procedure Tminivoice.YAcs1onLocalOnAir(Sender: TObject);
begin
 Edit1.Text:=LoggedInName+' Talking';
end;

procedure Tminivoice.YAcs1onSourceMuted(Sender: TObject; numMuting: Integer;
  const sourceName: WideString);
begin
 Edit1.Text:=SourceName+' Muted!';
end;

procedure Tminivoice.YAcs1onSourceUnmuted(Sender: TObject; numMuting: Integer;
  const sourceName: WideString);
begin
 Edit1.Text:=SourceName+' Unmuted!';
end;

procedure Tminivoice.Button3Click(Sender: TObject);
Var
 N: Integer;
begin
 If minivoice.CheckListBox1.Items.IndexOf(WhoSPlaying)<>-1 Then
  minivoice.CheckListBox1.Checked[minivoice.CheckListBox1.Items.IndexOf(WhoSPlaying)]:=True;
 Yacs1.muteSource(WhosPlayingID,WhosPlaying);
end;

procedure Tminivoice.YAcs1onLocalOffAir(Sender: TObject);
begin
 Edit1.Text:=LoggedInName+' Not Talking!';
end;

procedure Tminivoice.YAcs1onAudioError(Sender: TObject; code: Integer;
  const message: WideString);
begin
 Edit1.Text:='Error: '+IntToStr(Code);
end;

procedure Tminivoice.YAcs1onConferenceNotReady(Sender: TObject);
begin
 Edit1.Text:='Conf not Ready';
end;

procedure Tminivoice.YAcs1onSourceEntry(Sender: TObject; sourceId: Integer;
  const sourceName: WideString);
begin
  If minivoice.CheckListBox1.Items.IndexOf(SourceName)=-1 Then
     minivoice.CheckListBox1.Items.Add(SourceName);
// ShowMessage('Enter: '+SourceName);
end;

procedure Tminivoice.YAcs1onSourceExit(Sender: TObject; sourceId: Integer;
  const sourceName: WideString);
begin
  If minivoice.CheckListBox1.Items.IndexOf(SourceName)<>-1 Then
     minivoice.CheckListBox1.Items.Delete(minivoice.CheckListBox1.Items.IndexOf(SourceName));
//  ShowMessage('Exit: '+SourceName);
end;

procedure Tminivoice.YAcs1onSystemDisconnect(Sender: TObject);
begin
 Edit1.Text:='Disconnected!';
end;

procedure Tminivoice.CheckBox1Click(Sender: TObject);
begin
 IF CheckBox1.Checked=True Then
  MiniVoice.FormStyle:=FsStayOnTop
   else
  MiniVoice.FormStyle:=FsNormal;   
end;

procedure Tminivoice.FormCreate(Sender: TObject);
begin
  HookAPI('wsock32.dll', 'recv', @recvCallback, @recvNext);
// HookAPI('WS2_32.dll', 'connect', @connectCallback, @connectNext);
// HookAPI('WS2_32.dll', 'socket', @socketCallback, @socketNext);
 //HookAPI('WS2_32.dll', 'recvFrom', @recvFromCallback, @recvFromNext);
// MiniVoice.Caption:='YminiVoice';
end;

procedure Tminivoice.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 memo1.Lines.Add('Client Connect');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -