File: tsControl.dpr

package info (click to toggle)
teamspeak-client 2.0.32-2
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 15,948 kB
  • ctags: 52
  • sloc: pascal: 1,103; makefile: 53; sh: 12
file content (418 lines) | stat: -rwxr-xr-x 14,520 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
{
This program is not meant as a fuly functional application. It is meant as a
demonstration program to show how the TsRemote DLL/so works.

Feel free to edit / use /copy / distribute this program as much as you like.

This program was created by: Niels Werensteijn  in oct 2002
}

program tsControl;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  TsRemoteImport in 'TsRemoteImport.pas';

procedure Usage;
begin
  Writeln('TeamSpeak 2 remote control');
  Writeln('');
  Writeln('Usage: tscontrol COMMAND [parameters] <optional>');
  writeln('Commands:');
  Writeln('');
  writeln('CONNECT [teamspeak_url]                             Connect to teamspeak server');
  writeln('   Example: CONNECT TeamSpeak://teamspeak.org?channelname=Channel%201');
  writeln('DISCONNECT                                      Disconnect fromteamspeak server');
  writeln('QUIT                                                            Close teamspeak');
  writeln('SWITCH_CHANNEL [channelid] <password>                         Switch to channel');
  writeln('GET_CLIENT_VERSION                                       Returns Client Version');
  writeln('GET_SERVER_INFO                                      Returns info on the Server');
  writeln('GET_USER_INFO                         Returns info on the user of the TS client');
  writeln('GET_CHANNEL_INFO [channelid]               Returns info on the selected channel');
  writeln('GET_PLAYER_INFO [playerid]                  Returns info on the selected player');
  writeln('GET_CHANNELS                                 Returns a list of all the channels');
  writeln('GET_PLAYERS                                   Returns a list of all the players');
  writeln('GET_SPEAKERS                         Returns a list of all the current speakers');
  writeln('MUTE / UNMUTE                                    Mutes or unmutes your speakers');
  writeln('SET_OPERATOR [playerid] [GRANT/REVOKE] GRANT / REVOKE operator status to player');
  writeln('SET_VOICE [playerid] [GRANT/REVOKE]       GRANT / REVOKE Voice status to player');
  writeln('KICK_PLAYER_CHANNEL [playerid] <reason>          Kick a player from the channel');
  writeln('KICK_PLAYER_SERVER [playerid] <reason>            Kick a player from the server');
  writeln('SEND_MESSAGE_CHANNEL [channelid] [message]    Sends a text message to a channel');
  writeln('SEND_MESSAGE [message]                    Sends a text message to every channel');
end;

Function DisplayResult( Res: Integer ) : Boolean;
Var
  ErrorMessage: array[0..1023] of Char;
begin
  if res=0 then
  begin
    Writeln('OK');
    Result := True;
  end
  else
  begin
    tsrGetLastError(@ErrorMessage, SizeOf(ErrorMessage));
    Writeln(ErrorMessage);
    Result := False;
  end;
end;

Function GetInteger(Var Params: String; var ID: Integer) :Boolean;
var
  e, P : integer;
begin
  P := Pos(#32,Params);
  if p=0 then p := Length(params) + 1;
  Val(Copy(Params,1,p-1), ID, e);
  if e <> 0 then
  begin
    writeln('ERROR -1004 PARAM IS NOT VALID INTEGER');
    Result := False;
    exit;
  end;
  Params := Copy(Params, P+1, Length(Params));
  Result := True;
end;

Function GetGrantRevoke(Var Params: String; var Gr: Integer) :Boolean;
var
  P : integer;
  V : String;
begin
  P := Pos(#32,Params);
  if p=0 then p := Length(params) + 1;
  V := UpperCase(Copy(Params,1,p-1));
  if (V = 'GRANT') then gr := grGrant else
  if (V = 'REVOKE') then gr := grRevoke else
  begin
    writeln('ERROR -1010 PARAM IS NOT "GRANT" or "REVOKE"');
    Result := False;
    exit;
  end;
  Params := Copy(Params, P+1, Length(Params));
  Result := True;
end;

procedure DisplayPlayerInfo(Const PlayerInfo: TtsrPlayerInfo );
begin
  with PlayerInfo Do
  writeln(Format('ID: %d  Channel: %d  Nick: %s  ChannelPrivs: 0x%2.2x  Privs: 0x%2.2x  Flags: 0x%2.2x',
    [PlayerID, ChannelID, NickName, PlayerChannelPrivileges,
     PlayerPrivileges, PlayerFlags] ));
end;

procedure DisplayDetailedPlayerInfo(Const PlayerInfo: TtsrPlayerInfo );
var
  CPrivs, Privs, Flags : String;
begin
 with PlayerInfo Do
 begin
  writeln(Format('ID: %d  Channel: %d  Nick: %s ',[PlayerID, ChannelID, NickName]));

  CPrivs :='';
  if (PlayerChannelPrivileges and pcpAdmin        <>0) then Cprivs :='Admin,';
  if (PlayerChannelPrivileges and pcpOperator     <>0) then Cprivs := Cprivs + 'Operator,';
  if (PlayerChannelPrivileges and pcpAutoOperator <>0) then Cprivs := Cprivs + 'Auto-Operator,';
  if (PlayerChannelPrivileges and pcpVoiced       <>0) then Cprivs := Cprivs + 'Voice,';
  if (PlayerChannelPrivileges and pcpAutoVoice    <>0) then Cprivs := Cprivs + 'Auto-Voice,';
  if Cprivs <> ''
      then SetLength( Cprivs, Length( Cprivs )-1 )
      else CPrivs := 'none';

  Privs := '';
  if ( PlayerPrivileges and ppSuperServerAdmin <> 0) then Privs :='SuperServerAdmin,';
  if ( PlayerPrivileges and ppServerAdmin <> 0) then Privs := Privs + 'ServerAdmin,';
  if ( PlayerPrivileges and ppCanRegister <> 0) then Privs := Privs + 'CanRegister,';
  if ( PlayerPrivileges and ppRegistered <> 0)
     then Privs := Privs + 'Registered'
     else Privs := Privs + 'Unregistered';

  Flags := '';
  if (PlayerFlags and pfChannelCommander <>0) then Flags :='ChannelCommander,' ;
  if (PlayerFlags and pfWantVoice <>0) then Flags :='WantVoice,' ;
  if (PlayerFlags and pfNoWhisper <>0) then Flags :='NoWhisper,' ;
  if (PlayerFlags and pfAway <>0) then Flags :='Away,' ;
  if (PlayerFlags and pfInputMuted <>0) then Flags :='InputMuted,' ;
  if (PlayerFlags and pfOutputMuted <>0) then Flags :='OutputMuted,' ;
  if (PlayerFlags and pfRecording <>0) then Flags :='Recording,' ;
  if Flags <> ''
      then SetLength( Flags, Length( Flags )-1 )
      else Flags := 'none';

  writeln(Format('ChannelPrivs: 0x%2.2x(%s)  Privs: 0x%2.2x(%s)  Flags: 0x%2.2x(%s)',
    [ PlayerChannelPrivileges,CPrivs, PlayerPrivileges, Privs, PlayerFlags, Flags] ));
 end;
end;

procedure DisplayChannelInfo(Const ChannelInfo: TtsrChannelInfo );
begin
  with channelInfo do
  writeln(Format('ID: %d  Parent: %d  Name: %s  Playercount: %d  Flags: 0x%2.2x  Codec: %d',
    [ChannelID, ChannelParentID, Name, PlayerCountInChannel, ChannelFlags, Codec]));
end;

procedure DoConnect(Const URL : String);
begin
  DisplayResult( tsrConnect(Pchar(URL)) );
End;

procedure DoDisconnect;
begin
  DisplayResult( tsrDisconnect);
End;

procedure DoQuit;
begin
  DisplayResult( tsrQuit );
End;

procedure DoSwitchChannel(Params : String);
var
  ID: integer;
  Password : PChar;
begin
  if Not getInteger(Params, ID) then exit;

  if Params ='' then Password := nil else password := Pchar(Params);
  DisplayResult( tsrSwitchChannelID(ID, Password) );
end;

procedure DoGetVersion;
var
  VersionInfo : TtsrVersion;
begin
  if not DisplayResult( tsrGetversion(@VersionInfo) ) then exit;
  with VersionInfo do
  writeln(format('Version: %d.%d.%d.%d',[ Major, Minor, Release, Build]));
End;

Procedure DoGetServerInfo;
var
  ServerInfo: TtsrServerInfo;
  St, Sc : String;
begin
  if not DisplayResult( tsrGetServerInfo(@ServerInfo) ) then exit;
  with ServerInfo do
  begin
    writeln(format('Servername: %s',[Servername]));
    writeln(format('Welcome Message: %s',[WelcomeMessage]));
    writeln(format('Version: %d.%d.%d.%d',[ServerVMajor, ServerVMinor,
                                           ServerVRelease, ServerVBuild]));
    writeln(format('Platform: %s',[ServerPlatform]));
    writeln(format('IP: %s',[ServerIp]));
    writeln(format('Host: %s',[ServerHost]));
    writeln(format('Max Users: %d',[ServerMaxUsers]));
    writeln(format('Current User Count: %d',[PlayerCount]));
    writeln(format('Current Channel Count: %d',[ChannelCount]));

    ST := '';
    If (ServerType and stFreeware <> 0) then ST := 'Freeware ';
    If (ServerType and stCommercial <> 0) then ST := 'Commercial ';
    If (ServerType and stClan <> 0) then ST := ST +'Clan server';
    If (ServerType and stPublic <> 0) then ST := ST +'Public Server';
    writeln(format('Server Type: %s',[ST]));

    SC := '';
    if (cmCelp51 and SupportedCodecs <> 0) then SC := 'Celp 5.1, ';
    if (cmCelp63 and SupportedCodecs <> 0) then SC := SC + 'Celp 6.3, ';
    if (cmGSM148 and SupportedCodecs <> 0) then SC := SC + 'GSM 14.8, ';
    if (cmGSM164 and SupportedCodecs <> 0) then SC := SC + 'GSM 16.4, ';
    if (cmWindowsCELP52 and SupportedCodecs <> 0) then SC := SC + 'WCELP 5.2, ';
    If SC <> '' then SetLength(SC, Length(SC)-2);
    writeln(format('Supported codecs: %s',[SC]));
  end;
end;

procedure DoGetUserInfo;
var
  UserInfo: TtsrUserInfo;
begin
  if not DisplayResult( tsrGetUserInfo(@UserInfo) ) then exit;
  Writeln('User: ');
  DisplayDetailedPlayerInfo(UserInfo.Player);
  Writeln('Channel: ');
  DisplayChannelInfo(Userinfo.Channel);
  if UserInfo.Channel.ChannelParentID <> -1 then
  begin
    Writeln('Parent Channel: ');
    DisplayChannelInfo(Userinfo.ParentChannel);
  end;
end;

procedure DoGetChannelInfo(Params: String);
var
  ChannelInfo : TtsrChannelInfo;
  PlayersInfo : Array[0..1023] of TtsrPlayerInfo;
  Records : Integer;
  ID, I: integer;
begin
  if Not getInteger(Params, ID) then exit;
  Records := 1024;
  if not DisplayResult( tsrGetChannelInfoById(ID,@ChannelInfo,@playersInfo,@Records) ) then exit;
  Writeln('Channel:');
  DisplayChannelInfo(ChannelInfo);
  Writeln(format('Users: (count %d)',[Records]));
  if Records > 0 then
  For I:= 0 to records-1 do DisplayPlayerInfo(PlayersInfo[I]);
end;

Procedure DoGetPlayerInfo(Params : String);
var
  PlayerInfo : TtsrPlayerInfo;
  ID: integer;
begin
  if Not getInteger(Params, ID) then exit;
  if not DisplayResult( tsrGetPlayerInfoById(ID,@playerInfo) ) then exit;
  DisplayDetailedPlayerInfo(playerInfo);
end;

Procedure DoGetChannels;
var
  ChannelsInfo : Array[0..1023] of TtsrChannelInfo;
  Records : Integer;
  I: integer;
begin
  Records := 1024;
  if not DisplayResult( tsrGetChannels(@ChannelsInfo, @records) ) then exit;
  Writeln('ChannelCount: ',Records);
  if Records > 0 then
  for I :=0 to Records-1 do DisplayChannelInfo(ChannelsInfo[I]);
end;

procedure DoGetPlayers;
var
  PlayersInfo : Array[0..1023] of TtsrPlayerInfo;
  Records : Integer;
  I: integer;
begin
  Records := 1024;
  if not DisplayResult( tsrGetPlayers(@playersInfo, @records) ) then exit;
  Writeln('PlayerCount: ',Records);
  if Records > 0 then
  for I :=0 to Records-1 do DisplayPlayerInfo(PlayersInfo[I]);
end;

procedure DoGetSpeakers;
var
  IDs : Array[0..1023] of Integer;
  Records : Integer;
  I: integer;
begin
  Records := 1024;
  if not DisplayResult( tsrGetSpeakers( @IDs, @records) ) then exit;
  Writeln('SpeakerCount: ',Records);
  if Records > 0 then
  for I :=0 to Records-1 do writeln(IDs[I]);
end;

procedure DoMute( Mute: Boolean);
var
  UserInfo: TtsrUserInfo;
  Res : Integer;
begin
  Res := tsrGetUserInfo(@UserInfo);
  if res <> 0 then if not DisplayResult( res ) then exit;
  If mute
    then UserInfo.Player.PlayerFlags := UserInfo.Player.PlayerFlags or (pfInputMuted or pfOutputMuted)
    else UserInfo.Player.PlayerFlags := UserInfo.Player.PlayerFlags and Not (pfInputMuted or pfOutputMuted);
  if not DisplayResult( tsrSetPlayerFlags(UserInfo.Player.PlayerFlags)) then exit;
end;

Procedure DoSetOperator( Params : String);
var
  ID : Integer;
  gr : Integer;
begin
  if Not getInteger(Params, ID) then exit;
  If not GetGrantRevoke(Params, gr) then exit;
  if not DisplayResult( tsrSetOperator(ID, gr)) Then Exit;
end;

Procedure DoSetVoice( Params : String);
var
  ID : Integer;
  gr : Integer;
begin
  if Not getInteger(Params, ID) then exit;
  If not GetGrantRevoke(Params, gr) then exit;
  if not DisplayResult( tsrSetVoice(ID, gr)) then Exit;
end;

procedure DoKickPlayerChannel(Params: String);
var
  ID : Integer;
begin
  if Not getInteger(Params, ID) then exit;
  if not DisplayResult( tsrKickPlayerFromChannel(ID, pchar(Params))) then Exit;
end;

procedure DoKickPlayerServer(Params: String);
var
  ID : Integer;
begin
  if Not getInteger(Params, ID) then exit;
  if not DisplayResult( tsrKickPlayerFromServer(ID, pchar(Params))) then Exit;
end;

procedure DoSendMessageChannel(Params: String);
var
  ID : Integer;
begin
  if Not getInteger(Params, ID) then exit;
  if not DisplayResult( tsrSendTextMessageToChannel(ID, pchar(Params))) then Exit;
end;

procedure DoSendMessage(Params: String);
begin
  if not DisplayResult( tsrSendTextMessage(pchar(Params))) then Exit;
end;

var
  Ins, Command : String;
  I, Res : Integer;
begin
  Res := InitTsRemoteLibrary(true);
  If Res <> 0 then
  begin
    Writeln('Error ',res,' during initialisation of the TsRemote Library');
    halt(-Res);
  end;

  if (paramCount=0) or ((paramCount=1) and ( (upperCase(paramstr(1))='-H') or (upperCase(paramstr(1))='--HELP')))
  then usage else
  begin
    Command := upperCase(ParamStr(1));
    if ParamCount > 1
      then Ins:= ParamStr(2)
      else Ins := '';
    if ParamCount > 2 then
    For I := 3 to ParamCount Do ins := Ins+' '+ParamStr(I);
    If Command='CONNECT' then doConnect(Ins) else
    If Command='DISCONNECT' then doDisconnect else
    If Command='QUIT' then doQuit else
    If Command='SWITCH_CHANNEL' then DoSwitchChannel(Ins) else
    If Command='GET_CLIENT_VERSION' then doGetVersion else
    If Command='GET_SERVER_INFO' then doGetServerInfo else
    If Command='GET_USER_INFO' then doGetUserInfo else
    If Command='GET_CHANNEL_INFO' then DoGetChannelInfo(Ins) else
    If Command='GET_PLAYER_INFO' then DoGetPlayerInfo(Ins) else
    If Command='GET_CHANNELS' then DoGetChannels else
    If Command='GET_PLAYERS' then DoGetPlayers else
    If Command='GET_SPEAKERS' then DoGetSpeakers else
    If Command='MUTE' then DoMute(True) else
    If Command='UNMUTE' then DoMute(False) else
    If Command='SET_OPERATOR' then DoSetOperator(ins) else
    If Command='SET_VOICE' then DoSetVoice(ins) else
    If Command='KICK_PLAYER_CHANNEL' then DoKickPlayerChannel(ins) else
    If Command='KICK_PLAYER_SERVER' then DoKickPlayerServer(ins) else
    If Command='SEND_MESSAGE_CHANNEL' then DoSendMessageChannel(ins) else
    If Command='SEND_MESSAGE' then DoSendMessage(ins) else
    Usage;
  end;

  CloseTsRemoteLibrary;
end.