📄 voicemodual.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 + -