unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, NMUDP, CheckLst,winsock, ElTree,ElHeader,ShellAPI, ExtCtrls,
ComCtrls,MMSystem,Msacm, ElXPThemedControl;
type
TForm1 = class(TForm)
udp_Send: TNMUDP;
Panel1: TPanel;
Panel2: TPanel;
btn_Send: TButton;
Label1: TLabel;
edt_Words: TEdit;
tim_Timer: TTimer;
rih_Words: TRichEdit;
Button1: TButton;
Button2: TButton;
elt_Online: TElTree;
procedure udp_SendDataReceived(Sender: TComponent; NumberBytes: Integer;FromIP: String; Port: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure elt_OnlineHeaderColumnDraw(Sender: TCustomElHeader;Section: TElHeaderSection; R: TRect; Pressed: Boolean);
procedure btn_SendClick(Sender: TObject);
procedure tim_TimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure WndProc(var Msg:TMessage);override;
procedure SendWords(SendMan,ReceiveMan,Word:String;RemoteIP:String);
Function GetHostIP(HostName:String=''):String;
Function ReturnPos(buf:TMemoryStream;Len,StartPos:Integer;Separator:Char):Integer;
procedure DisplayWords(SendMan,ReceiveMan,Word:String);
procedure UserLogin(UserName,IP:String;RemoteIP:String='');
procedure UserLogout(UserName,IP:String);
function AddNextBuffer():Integer;
function InitWaveInHeader():Integer;
function QueueNextBuffer : Integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
type TACMWAVEFORMAT=packed record
case Integer of
0
Format:twaveformatex);
1
Rawdata:array[0..128] of byte);
end;
const
iBufferBlock=2040;
oBufferLen=6;
var
sHostIP,P_UserName,sBroadIP:String;
nTickCount
Word;
NIM_Data:NOTIFYICONDATAA;
bShowIcon,bPlayFlag:Boolean;
iMsgCount,iBufIndex,iInputPoint,iPlayPoint:Integer;
iHdr:Array [0..1] of WAVEHDR;
iBuf:Array [0..1] of pChar;
oBuf:Array [1..oBufferLen] of pChar;
oHdr:Array [1..oBufferLen] of WAVEHDR;
WaveFmt:TACMWAVEFORMAT;
HOut:HWaveOut;
HIn:HWAVEIN;
{$R *.DFM}
{$R msg.res}
procedure TForm1.udp_SendDataReceived(Sender: TComponent;NumberBytes: Integer; FromIP: String; Port: Integer);
var
sUserName,sSendMan,sReceiveMan,sIP,sWord:String;
iMsgType,iPos,i,iTmpPos:Integer;
Node:TEltreeItem;
mBuf:TMemoryStream;
FindHandle, ResHandle: THandle;
ResPtr: Pointer;
begin
if Trim(FromIP)=sHostIP then
Exit;
mBuf := TMemoryStream.Create();
mBuf.SetSize(NumberBytes);
mBuf.Clear;
udp_Send.ReadStream(mBuf);
if (pchar(mBuf.Memory)^=#02) and (pchar(Longint(mBuf.Memory)+1)^=#03) then
iMsgType := ord(pchar(Longint(mBuf.Memory)+2)^)
else
begin
mBuf.Free;
Exit;
end;
sUserName := '';
case iMsgType of
1: //登录
begin
iPos := ReturnPos(mBuf,NumberBytes,4,#$1f);
sUserName := copy(PChar(mBuf.Memory),4,iPos-4);
sIP := copy(PChar(mBuf.Memory),iPos+1,ReturnPos(mBuf,NumberBytes,iPos+1,#$1f)-iPos-1);
for i:=0 to elt_Online.Items.Count-1 do
begin
Node := elt_Online.Items
;
if (strcomp(PChar(sUserName),PChar(Node.Text))=0)
and (strcomp(PChar(sIP),PChar(Node.ColumnText[0]))=0) then
begin
mBuf.Free;
Exit;
end;
end;
Node := elt_Online.Items.Add(nil,sUserName);
Node.ShowCheckBox := True;
Node.ColumnText.Add(sIP);
waveInStop(hIn);
for i:=1 to 3 do
UserLogin(p_UserName,sHostIP,sIP);
waveInStart(hIn);
end;
2: //退出
begin
iPos := ReturnPos(mBuf,NumberBytes,4,#$1f);
sUserName := copy(PChar(mBuf.Memory),4,iPos-4);
sIP := copy(PChar(mBuf.Memory),iPos+1,ReturnPos(mBuf,NumberBytes,iPos+1,#$1f)-iPos-1);
for i:=0 to elt_Online.Items.Count-1 do
begin
Node := elt_Online.Items;
if (strcomp(PChar(sUserName),PChar(Node.Text))=0)
and (strcomp(PChar(sIP),PChar(Node.ColumnText[0]))=0) then
begin
mBuf.Free;
Node.Delete;
Exit;
end;
end;
end;
3: //收到信息
begin
iPos := ReturnPos(mBuf,NumberBytes,4,#$1f);
sSendMan := copy(PChar(mBuf.Memory),4,iPos-4);
iTmpPos := ReturnPos(mBuf,NumberBytes,iPos+1,#$1f);
sReceiveMan := copy(PChar(mBuf.Memory),iPos+1,iTmpPos-iPos-1);
sWord := copy(PChar(mBuf.Memory),iTmpPos+1,ReturnPos(mBuf,NumberBytes,iTmpPos+1,#$1f)-iTmpPos-1);
DisplayWords(sSendMan,sReceiveMan,sWord);
FindHandle:=FindResource(HInstance, 'MSG_WAVE', 'WAVE');
if FindHandle<>0 then
begin
ResHandle:=LoadResource(HInstance, FindHandle);
if ResHandle<>0 then
begin
ResPtr:=LockResource(ResHandle);
if ResPtr<>Nil then
SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
UnlockResource(ResHandle);
end;
FreeResource(FindHandle);
end;
if Not Self.Visible then
begin
tim_Timer.Enabled := True;
end;
end;
4:
begin
if iInputPoint>oBufferLen then
iInputPoint := 1;
CopyMemory(oBuf[iInputPoint],PChar(Longint(mBuf.Memory)+3),iBufferBlock);
iInputPoint := iInputPoint + 1;
if (bPlayFlag = False) and (iInputPoint>oBufferLen/2) then
begin
bPlayFlag := True;
QueueNextBuffer;
QueueNextBuffer;
end;
end;
end;
mBuf.Free;
end;
function TForm1.GetHostIP(HostName: String): String;
var
buf
Char;
iWsaRet:Integer;
Data:WSAData;
hostentHostEnt;
begin
Result := '';
iWsaRet := WSAStartup($101,Data);
if iWsaRet<>0 then
begin
ShowMessage('Socket initialize error!');
Exit;
end;
buf := Allocmem(60);
strcopy(buf,PChar(HostName));
if Trim(buf)='' then
gethostname(buf,60);
hostent := gethostbyname(buf);
Freemem(buf,60);
if hostent=nil then
Exit;
Result := inet_ntoa(pinAddr(hostent^.h_addr^)^);
WSACleanup();
end;
function TForm1.ReturnPos(buf:TMemoryStream;Len,StartPos:Integer;Separator:Char):Integer;
var
i:Integer;
begin
Result := 0;
for i:=StartPos-1 to Len do
if pchar(Longint(buf.Memory)+i)^=#$1f then
begin
Result := i+1;
Break;
end;
end;
procedure TForm1.UserLogin(UserName,IP: String;RemoteIP:String='');
var
mBuf:TMemoryStream;
sData:String;
begin
mBuf := TMemoryStream.Create();
mBuf.Clear;
sData := #$02+#$03+#$01+UserName+#$1f+IP+#$1f+#$03;
mBuf.Write(sData[1],Length(sData));
if Trim(RemoteIP)='' then
udp_Send.RemoteHost := sBroadIP
else
udp_Send.RemoteHost := RemoteIP;
udp_Send.SendStream(mBuf);
mBuf.Free;
end;
procedure TForm1.UserLogout(UserName, IP: String);
var
mBuf:TMemoryStream;
sData:String;
begin
mBuf := TMemoryStream.Create();
mBuf.Clear;
sData := #$02+#$03+#$02+UserName+#$1f+IP+#$1f+#$03;
mBuf.Write(sData[1],Length(sData));
udp_Send.RemoteHost := sBroadIP;
udp_Send.SendStream(mBuf);
mBuf.Free;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i:Integer;
begin
for i:=1 to 3 do
UserLogout(p_UserName,sHostIP);
Shell_NotifyIconA(NIM_DELETE,@NIM_DATA);
end;
procedure TForm1.elt_OnlineHeaderColumnDraw(Sender: TCustomElHeader;Section: TElHeaderSection; R: TRect; Pressed: Boolean);
var
sTmpStr:String;
nRect:TRect;
begin
Sender.Canvas.Font.Size := 10;
sTmpStr := Trim(Section.Text);
nRect := R;
nRect.Top := nRect.Top+1;
DrawText(Sender.Canvas.Handle,PChar(sTmpStr),Length(sTmpStr),nRect,DT_Center);
end;
procedure TForm1.btn_SendClick(Sender: TObject);
var
Node:TEltreeItem;
sUserName,sIP:String;
begin
Node := elt_Online.Selected;
if Node = nil then
begin
Application.MessageBox('对不起，请选择发送对象!','错误',MB_ICONINFORMATION);
Exit;
end;
if Trim(edt_Words.Text)='' then
begin
Application.MessageBox('对不起，你不能发送空信息!','错误',MB_ICONINFORMATION);
edt_Words.SetFocus;
Exit;
end;
if GetTickCount()-nTickCount<250 then
begin
Application.MessageBox('对不起，你的速度太快了!','错误',MB_ICONINFORMATION);
edt_Words.SetFocus;
Exit;
end;
nTickCount := GetTickCount();
sUserName := Trim(Node.Text);
sIP := Trim(Node.ColumnText[0]);
DisplayWords(P_UserName,sUserName,Trim(edt_Words.Text));
SendWords(P_UserName,sUserName,Trim(edt_Words.Text),sIP);
edt_Words.Text := '';
edt_Words.SetFocus;
end;
procedure TForm1.SendWords(SendMan,ReceiveMan,Word:String;RemoteIP:String);
var
mBuf:TMemoryStream;
sData:String;
begin
mBuf := TMemoryStream.Create();
mBuf.Clear;
sData := #$02+#$03+#$03+Trim(SendMan)+#$1f
+ Trim(ReceiveMan)+#$1f+Word+#$1f+#$03;
mBuf.Write(sData[1],Length(sData));
if Trim(RemoteIP)='' then
udp_Send.RemoteHost := sBroadIP
else
udp_Send.RemoteHost := RemoteIP;
udp_Send.SendStream(mBuf);
mBuf.Free;
end;
procedure TForm1.WndProc(var Msg: TMessage);
var
mBuf:TMemoryStream;
begin
if Msg.Msg = MM_WIM_DATA then
begin
mBuf := TMemoryStream.Create();
mBuf.Clear;
mBuf.SetSize(iBufferBlock+3);
mBuf.Write(#$02+#$03+#$04,3);
CopyMemory(Pointer(Longint(mBuf.Memory)+3),iBuf[iBufindex],iBufferBlock);
udp_Send.RemoteHost := sBroadIP;
udp_Send.SendStream(mBuf);
mBuf.Free;
AddNextBuffer;
end;
if Msg.Msg = MM_WOM_DONE then
begin
QueueNextBuffer();
end;
if Msg.Msg=WM_USER+11 then
if Msg.LParam=WM_LBUTTONDBLCLK then
begin
SetForegroundWindow(Self.Handle);
if Self.Visible=False then
begin
Self.Visible := True;
if iMsgCount>1 then
iMsgCount := iMsgCount - 1;
if iMsgCount=0 then
begin
NIM_Data.hIcon := LoadIcon(hInstance,'SHOW_ICON');
Shell_NotifyIconA(NIM_MODIFY,@NIM_DATA);
tim_Timer.Enabled := False;
end;
end;
end;
if Msg.Msg=WM_SYSCOMMAND then
begin
if Msg.WParam=SC_MINIMIZE then
begin
Self.Hide;
Exit;
end;
end;
inherited;
end;
procedure TForm1.tim_TimerTimer(Sender: TObject);
begin
if bShowIcon then
begin
NIM_Data.hIcon := LoadIcon(hInstance,'HIDE_ICON');
Shell_NotifyIconA(NIM_MODIFY,@NIM_DATA);
bShowIcon := False;
end
else
begin
NIM_Data.hIcon := LoadIcon(hInstance,'SHOW_ICON');
Shell_NotifyIconA(NIM_MODIFY,@NIM_DATA);
bShowIcon := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
bufChar;
Node:TEltreeItem;
sTmpStr:String;
FMaxFmtSize,i:Integer;
mRet:MMRESULT;
acmopt : TACMFORMATCHOOSE;
err : MMRESULT;
begin
iBufIndex := 0;
iInputPoint := 1;
iPlayPoint := 1;
buf := Allocmem(60);
Node := elt_Online.Items.Add(nil,'所有人');
Node.ColumnText.Add('');
sHostIP := Trim(GetHostIP());
sBroadIP := '';
sTmpStr := sHostIP;
for i:=1 to 3 do
begin
sBroadIP := sBroadIP + copy(sTmpStr,1,pos('.',sTmpStr));
sTmpStr := copy(sTmpStr,pos('.',sTmpStr)+1,Length(sTmpStr));
end;
sBroadIP := sBroadIP + '255';
gethostname(buf,60);
p_UserName := buf;
FreeMem(buf,60);
GetMem(iBuf[0],iBufferBlock);
if iBuf[0]=nil then
begin
showmessage('error in getmem function');
exit;
end;
GetMem(iBuf[1],iBufferBlock);
if iBuf[1]=nil then
begin
showmessage('error in getmem function');
exit;
end;
for i:=1 to oBufferLen do
begin
GetMem(oBuf,iBufferBlock);
FillChar(oBuf^,iBufferBlock,0);
if oBuf=nil then
begin
showmessage('error in getmem function');
exit;
end;
end;
WaveFmt.Format.wFormatTag := 49;
WaveFmt.Format.nChannels := 1;
WaveFmt.Format.nSamplesPerSec := 22050;
WaveFmt.Format.nAvgBytesPerSec := 4478;
WaveFmt.Format.nBlockAlign := 65;
WaveFmt.Format.wBitsPerSample := 0;
WaveFmt.Format.cbSize := 2;
Wavefmt.Rawdata[18] := 64;
Wavefmt.Rawdata[19] := 1;
{ acmMetrics(nil, ACM_METRIC_MAX_SIZE_FORMAT, FMaxFmtSize);
acmopt.cbStruct := sizeof(acmopt);
acmopt.fdwStyle := ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT;
acmopt.hwndOwner := Handle;
acmopt.pwfx := @WaveFmt;
acmopt.cbwfx := sizeof(wavefmt);
acmopt.pszTitle := 'Select Compression';
acmopt.fdwEnum := ACM_FORMATENUMF_INPUT;
err := acmFormatChoose(acmopt);
for i:=sizeof(wavefmt.format) to 128 do
if wavefmt.rawdata<>0 then
showmessage('offset ' + inttostr(i)+':'+inttostr(wavefmt.rawdata));
showmessage('tag:' + inttostr(WaveFmt.Format.wFormatTag)+#13
+ 'Channels:' + inttostr(WaveFmt.Format.nChannels)+#13
+ 'SamplesPerSec:' + inttostr(WaveFmt.Format.nSamplesPerSec)+#13
+ 'AvgBytesPerSec:' + inttostr(WaveFmt.Format.nAvgBytesPerSec)+#13
+ 'BlockAlign:' + inttostr(WaveFmt.Format.nBlockAlign)+#13
+ 'BitsPerSample:' + inttostr(WaveFmt.Format.wBitsPerSample)+#13
+ 'cbsize:' + inttostr(WaveFmt.Format.cbsize)+#13
+ 'WAVE_FORMAT_PCM:'+ inttostr(WAVE_FORMAT_PCM));
}
mRet := waveInOpen(@HIn,WAVE_MAPPER,@WaveFmt.Format,Self.Handle,0,CALLBACK_WINDOW);
if mRet <> MMSYSERR_NOERROR then
begin
showmessage('Open waveform audio in device error'+inttostr(mRet));
end;
mRet := waveOutOpen(@HOut,WAVE_MAPPER,@WaveFmt,Self.Handle,0,CALLBACK_WINDOW or WAVE_ALLOWSYNC);
if mRet <> MMSYSERR_NOERROR then
begin
showmessage('Open waveform audio out device error'+inttostr(mRet));
end;
for i:=1 to oBufferLen do
begin
oHdr.lpData := oBuf;
oHdr.dwBufferLength := iBufferBlock;
oHdr.reserved := 0;
oHdr.lpNext := nil;
oHdr.dwLoops := 0;
mRet := waveOutPrepareHeader(HOut,@oHdr,sizeof(WAVEHDR));
if mRet <> MMSYSERR_NOERROR then
begin
showmessage(inttostr(mRet));
Exit;
end;
end;
for i:=1 to 3 do
UserLogin(p_UserName,sHostIP);
nTickCount := GetTickCount();
NIM_Data.cbSize := sizeof(NIM_Data);
NIM_Data.Wnd := Self.Handle;
NIM_Data.uID := 100;
NIM_Data.uFlags := NIF_ICON + NIF_MESSAGE + NIF_TIP;
NIM_Data.uCallbackMessage := WM_USER+11;
NIM_Data.szTip := '信息发送工具';
NIM_Data.hIcon := LoadIcon(hInstance,'SHOW_ICON');
Shell_NotifyIconA(NIM_ADD,@NIM_Data);
bShowIcon := True;
iMsgCount := 0;
SetWindowLongA(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;
procedure TForm1.DisplayWords(SendMan, ReceiveMan, Word: String);
begin
with rih_Words do
begin
if Length(Text)<>0 then
Lines.Add('');
Selattributes.Style := SelAttributes.Style + [fsBold] + [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := clBlue;
SelText := SendMan;
Selattributes.Style := SelAttributes.Style - [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := rgb(255,0,128);
SelText := '对';
Selattributes.Style := SelAttributes.Style + [fsBold] + [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := clBlue;
SelText := ReceiveMan;
Selattributes.Style := SelAttributes.Style - [fsItalic];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := rgb(255,0,128);
SelText := '说：';
Selattributes.Style := SelAttributes.Style - [fsItalic]-[fsBold];
SelStart := Length(Text);
SelLength := 0;
SelAttributes.Color := clBlack;
SelText := Word;
SelLength := 0;
SelStart := GetTextLen;
Perform(EM_SCROLLCARET,0,0);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
InitWaveInHeader();
if (waveInPrepareHeader(hIn,@iHdr[0],sizeof(WAVEHDR))<>0) or
(waveInPrepareHeader(hIn,@iHdr[1],sizeof(WAVEHDR))<>0) then
begin
ShowMessage('error in waveinPrepareHeader function');
Exit;
end;
if AddNextBuffer<>0 then
begin
ShowMessage('error in AddNextBuffer function');
Exit;
end;
waveInStart(HIn);
if AddNextBuffer<>0 then
begin
ShowMessage('error in AddNextBuffer function');
Exit;
end;
end;
function TForm1.AddNextBuffer: Integer;
var
mRet:MMRESULT;
begin
mRet := waveInAddBuffer(HIn,@iHdr[iBufIndex],sizeof(WAVEHDR));
if mRet <> 0 then
begin
showmessage('error in waveinAddBuffer function');
Exit;
end;
iBufIndex := 1-iBufIndex;
Result := mRet;
end;
function TForm1.InitWaveInHeader: Integer;
begin
iHdr[0].lpData := iBuf[0];
iHdr[0].dwBufferLength := iBufferBlock;
iHdr[0].reserved := 0;
iHdr[0].lpNext := nil;
iHdr[1].lpData := iBuf[1];
iHdr[1].dwBufferLength := iBufferBlock;
iHdr[1].reserved := 0;
iHdr[1].lpNext := nil;
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
i:Integer;
begin
waveOutClose(hOut);
for i:=1 to oBufferlen do
FreeMem(oBuf,iBufferBlock);
FreeMem(iBuf[0],iBufferBlock);
FreeMem(iBuf[1],iBufferBlock);
end;
function TForm1.QueueNextBuffer : Integer;
begin
oHdr[iPlayPoint].dwFlags := WHDR_PREPARED;
if waveOutWrite(hOut,@oHdr[iPlayPoint],sizeof(WAVEHDR))<>0 then
begin
Result := -1;
Exit;
end;
if iPlayPoint<oBufferLen then
iPlayPoint := iPlayPoint + 1
else
iPlayPoint := 1;
Result := 0;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
dVolWORD;
mRet:MMRESULT;
begin
dVol := 0;
mRet := waveOutGetVolume(hOut,@dVol);
if mRet<>0 then
showmessage('error');
showmessage(inttostr((dvol shr 16) and $0000ffff) + ' ' + inttostr(dvol and $0000ffff));
end;
end.