source: SMSSender/gateways/SwisscomXtraZone_Old/GtwySwisscomXtraZone/GtwySwisscomXtraZone.pas @ 76:5bd34e566fe7

2.2 2.2.5
Last change on this file since 76:5bd34e566fe7 was 76:5bd34e566fe7, checked in by Sämy Zehnder <saemy.zehnder@…>, 12 years ago
  • Forgot to update the changed source of the SwisscomXtraZone_Old gateway. (yes, this already should have been done a revision earlier)
File size: 13.4 KB
Line 
1unit GtwySwisscomXtraZone;
2
3 {Swisscom XtraZone gateway plugin - The SMSSender-plugin for the Swisscom Xtra-Liberty platform.
4  Copyright (C) 2007-2009, gorrión. See http://www.gorrion.ch
5
6  This program is free software: you can redistribute it and/or modify
7  it under the terms of the GNU General Public License as published by
8  the Free Software Foundation, either version 3 of the License, or
9  (at your option) any later version.
10
11  This program is distributed in the hope that it will be useful,
12  but WITHOUT ANY WARRANTY; without even the implied warranty of
13  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  GNU General Public License for more details.
15
16  You should have received a copy of the GNU General Public License
17  along with this program.  If not, see <http://www.gnu.org/licenses/>.}
18
19interface
20
21uses
22  Classes, IdHTTP, JclContainerIntf,
23  Interfaces, XtraInterfaces,
24  BCTypes, AbstractGateway;
25
26const
27  MAIN_PAGE:       String  = 'https://www.swisscom-mobile.ch/youth/sms_senden-de.aspx';
28  LOGIN_PAGE:      String  = 'https://www.swisscom-mobile.ch/youth/sms_senden-de.aspx?login&isiwebuserid=%s&isiwebpasswd=%s';
29  LOGOUT_PAGE:     String  = 'https://www.swisscom-mobile.ch/youth/youth_zone_home-de.aspx?logout';
30  MAX_MOBILE:      integer = 10;
31  SHORTSMS_LENGTH: integer = 160;
32
33type
34  TGtwySwisscomXtraZone = class(TAbstractLogInOutGateway, IGateway, ILogInOutGateway, ISwisscomXtraZoneGateway)
35  private
36    FLongSMSLength:    integer;
37    FAddonText:        String;
38    FStopInitializing: IJclStrSet;
39
40    procedure parseLoginPage(html: String; account: ISwisscomXtraZoneAccount);
41
42    property  LongSMSLength: integer read FLongSMSLength write FLongSMSLength;
43    property  AddonText:     String  read FAddonText     write FAddonText;
44
45    class var instance: IGateway;
46  protected
47    constructor Create; override;
48
49    { IGateway }
50    procedure sendSMS(account: IAccount; text: String; recipients: IJclIntfSet); override;
51    function  getName: String; override;
52    function  getAccountInstance: IAccount; override;
53    function  createAccountSettingsFrame(AOwner: TComponent): IAccountSettingsFrame; override;
54
55    { ILogInOutGateway }
56    procedure doLogin(account: ILogInOutAccount); override;
57    procedure doLogout(account: ILogInOutAccount); override;
58    function  getStayLoggedIn: boolean; override;
59    function  checkIfStillLoggedIn(account: ILogInOutAccount): boolean; override;
60
61    procedure initialize(account: ILogInOutAccount); override;
62    procedure stopInitializing(account: ILogInOutAccount); override;
63
64    { ISwisscomXtraZoneGateway }
65    function  splitTextToLongSMS(text: String): TStringArray;
66    function  splitTextToShortSMS(text: String): TStringArray;
67  public
68    class function getInstance: IGateway;
69  end;
70
71implementation
72
73uses
74  SysUtils, Math, JclStrings, JclHashSets, RegExpr,
75  BCSettings,
76  ACSwisscomXtraZone,
77  UVCFrmEditSettings;
78
79class function TGtwySwisscomXtraZone.getInstance: IGateway;
80begin
81  if not Assigned(instance) then
82    instance := TGtwySwisscomXtraZone.Create;
83  Result := instance;
84end;
85
86constructor TGtwySwisscomXtraZone.Create;
87begin
88  inherited;
89
90  LongSMSLength     := 1000; { Initialize to a non-zero value, because splitToSMS wont work otherwise}
91  FStopInitializing := TJclStrHashSet.Create;
92end;
93
94function TGtwySwisscomXtraZone.getName: String;
95begin
96  Result := 'SwisscomXtraZone_Old';
97end;
98
99function TGtwySwisscomXtraZone.getStayLoggedIn: boolean;
100begin
101  Result := true;
102end;
103
104function TGtwySwisscomXtraZone.getAccountInstance: IAccount;
105begin
106  Result := TACSwisscomXtraZone.Create;
107end;
108
109function TGtwySwisscomXtraZone.createAccountSettingsFrame(AOwner: TComponent): IAccountSettingsFrame;
110begin
111  Result := TVCFrmEditSettings.Create(AOwner);
112end;
113
114procedure TGtwySwisscomXtraZone.initialize(account: ILogInOutAccount);
115var
116  acc: ISwisscomXtraZoneAccount;
117begin
118  if not Supports(account, ISwisscomXtraZoneAccount, acc) then
119    raise Exception.Create('I don''t know this account type!');
120
121  if Assigned(account.http.CookieManager) then
122    account.http.CookieManager.CookieCollection.Clear;
123
124  FStopInitializing.Remove(account.getAccountId);
125  try
126    // Results the html of the main page
127    login(acc);
128    parseLoginPage(LastHtml[account], acc);
129    logout(acc);
130  except // No inet-connection or swisscom changed their web-layout
131    on E: Exception do
132      raise Exception.Create('Unable to connect to the SMS-Gateway.'#13#10
133                             + 'Please check your internet connection settings and tray again.'+#13#10
134                             + #13#10
135                             + '[' + E.Message + ']');
136  end;
137end;
138
139procedure TGtwySwisscomXtraZone.stopInitializing(account: ILogInOutAccount);
140begin
141  inherited;
142
143  FStopInitializing.Add(account.getAccountId);
144  account.disconnectAndDestroyHTTP; // Stop all running posts or gets
145end;
146
147procedure TGtwySwisscomXtraZone.parseLoginPage(html: String; account: ISwisscomXtraZoneAccount);
148var
149  exp: TRegExpr;
150begin
151  if FStopInitializing.Contains(account.getAccountId) then Exit;
152
153  exp := TRegExpr.Create;
154  try
155    with exp do
156    begin
157      ModifierI  := true; {Ignore case}
158      ModifierG  := false; {Non-Greedy - necessary, no idea why, but otherwise it wont find the substrings correctly}
159
160      try
161        Expression    := '<input.*id="CobYouthSMSSenden_txtMessageDisabled".*value="(.*)".*/>';
162        if not Exec(html) then raise Exception.Create('Could not get the addon text!');
163        AddonText     := Match[1];
164
165        Expression    := '<input.*id="lblcounter".*value=''(\d*)''.*/?>';
166        if not Exec(html) then raise Exception.Create('Could not get the longSMSLength!');
167        LongSMSLength := StrToInt(Match[1]) + Length(AddonText);
168
169        account.parseLoginPage(html);
170      except
171        // Not on the main page (e.g. wrong password) or swisscom changed their web-layout...
172        on E: Exception do
173          raise Exception.Create('Unexpected error occured! (This mostly occurs when your login data is incorrect)'+#13#10+'[' + E.Message + ']');
174      end;
175    end;
176  finally
177    exp.Free;
178  end;
179end;
180
181function TGtwySwisscomXtraZone.splitTextToLongSMS(text: String): TStringArray;
182var
183  longSMSLengthWOAddonText: integer;
184begin
185  SetLength(Result, 0);
186  longSMSLengthWOAddonText := LongSMSLength - Length(AddonText);
187
188  while text <> '' do
189  begin
190    SetLength(Result, Length(Result)+1);
191    Result[High(Result)] := Copy(text, 1, longSMSLengthWOAddonText);
192
193    Delete(text, 1, longSMSLengthWOAddonText);
194  end;
195end;
196
197function TGtwySwisscomXtraZone.splitTextToShortSMS(text: String): TStringArray;
198var
199  longSMSArr: TStringArray;
200  x:          integer;
201begin
202  SetLength(Result, 0);
203  longSMSArr := splitTextToLongSMS(text);
204  if Length(longSMSArr) = 0 then
205    Exit;
206
207  (* The number of fully filled LongSMSes multiplied with the number of shortSMSes in a longSMS. *)
208  for x := 0 to High(longSMSArr) do
209  begin
210    text := longSMSArr[x] + AddonText;
211    while text <> '' do
212    begin
213      SetLength(Result, Length(Result)+1);
214      Result[High(Result)] := Copy(text, 1, SHORTSMS_LENGTH);
215
216      Delete(text, 1, SHORTSMS_LENGTH);
217    end;
218  end;
219end;
220
221
222procedure TGtwySwisscomXtraZone.doLogin(account: ILogInOutAccount);
223var
224  acc:       ISwisscomXtraZoneAccount;
225  paramData: TStringStream;
226begin
227  if not Supports(account, ISwisscomXtraZoneAccount, acc) then
228    raise Exception.Create('I don''t know this account type!');
229
230  paramData := TStringStream.Create('');
231  paramData.WriteString('');
232
233  try
234    if FStopInitializing.Contains(account.getAccountId) then Exit;
235    LastHTML[account] := account.http.Post(Format(LOGIN_PAGE, [acc.getMobileNo, acc.getPassword]),
236                                           paramData);
237
238    { Go shure to be at the right place... (Particulary after connection timeout) }
239    if FStopInitializing.Contains(account.getAccountId) then Exit;
240    LastHTML[account] := account.http.Get(MAIN_PAGE);
241  finally
242    paramData.Free;
243  end;
244end;
245
246
247function TGtwySwisscomXtraZone.checkIfStillLoggedIn(account: ILogInOutAccount): boolean;
248begin
249  Result := false;
250 
251  if FStopInitializing.Contains(account.getAccountId) then Exit;
252  LastHTML[account] := account.http.Get(MAIN_PAGE);
253  Result            := Pos('CobYouthSMSSenden:txtMessage', LastHTML[account]) > 0;
254end;
255
256procedure TGtwySwisscomXtraZone.doLogout(account: ILogInOutAccount);
257begin
258  try
259    if FStopInitializing.Contains(account.getAccountId) then Exit;
260    LastHTML[account] := account.http.Get(LOGOUT_PAGE);
261  finally
262    account.http.Disconnect;
263  end;
264end;
265
266
267procedure TGtwySwisscomXtraZone.sendSMS(account: IAccount; text: String; recipients: IJclIntfSet);
268var
269  acc: ISwisscomXtraZoneAccount;
270
271  procedure doPost(params: String);
272  var
273    exp:   TRegExpr;
274    pdata: TStringStream;
275  begin
276    if params <> '' then
277      params := params + '&';
278
279    pdata := TStringStream.Create('');
280    pdata.WriteString(params);
281    pdata.WriteString('__EVENTTARGET=&__EVENTARGUMENT=&__VIEWSTATE_SCM=4&__VIEWSTATE=');
282
283    try
284      if FStopInitializing.Contains(account.getAccountId) then Exit;
285      LastHtml[account] := acc.http.Post(MAIN_PAGE, pdata);
286    finally
287      pdata.Free;
288    end;
289
290    exp := TRegExpr.Create;
291    try
292      with exp do
293      begin
294        ModifierI  := true; {Ignore case}
295        ModifierG  := false; {Non-Greedy - necessary, no idea why, but otherwise it wont find the substrings correctly}
296
297        Expression := '<span.*id="CobYouthSMSSenden_lblErrorBox".*>(.*)</span>';
298        if Exec(LastHTML[account]) then
299          raise Exception.Create(Match[1]);
300      end;
301    finally
302      exp.Free;
303    end;
304  end;
305
306  procedure removeRecipients;
307  begin
308    while Pos('CobYouthSMSSenden:RecipientsDG:_ctl2:_ctl0', LastHTML[account]) > 0 do
309      doPost('CobYouthSMSSenden:RecipientsDG:_ctl2:_ctl0=');
310  end;
311
312  procedure addRecipient(recipient: IContact);
313  begin
314    doPost(  'CobYouthSMSSenden:btnAddReceiver='
315           + '&CobYouthSMSSenden:txtNewReceiver=' + recipient.getNumber);
316  end;
317
318  procedure sendSMS(text: String);
319  var
320    txt: String;
321  begin
322    txt := text;
323    StrReplace(txt, '&', '%26', [rfReplaceAll]);
324    StrReplace(txt, '+', '%2B', [rfReplaceAll]);
325
326    doPost(  'CobYouthSMSSenden:btnSend='
327           + '&CobYouthSMSSenden:txtMessage=' + UTF8Encode(txt));
328  end;
329
330var
331  longSMSArr:  TStringArray;
332  shortSMSArr: TStringArray;
333  x:           integer;
334  y:           integer;
335  percent_per_sms: integer;
336  i:           IJclIntfIterator;
337  ix:          integer;
338begin
339  if not Supports(account, ISwisscomXtraZoneAccount, acc) then
340    raise Exception.Create('I don''t know this account type!');
341
342  uncancelSendingSMS;
343
344  if (text = '') or recipients.IsEmpty then
345    Exit;
346
347  try
348    changeStatus('Login...', 0);
349    login(acc);
350  except
351    on E: Exception do
352    begin
353      if FStopInitializing.Contains(account.getAccountId) then Exit;
354      acc.http.Disconnect; // to give it a second chance on the next try...
355      raise Exception.Create('Unable to connect to the SMS-Gateway.'#13#10+
356                             'Please check your internet connection settings and tray again.'+#13#10+
357                             '[' + E.Message + ']');
358    end;
359  end;
360
361  if Pos('Deine Nachricht', LastHTML[account]) = 0 then
362    raise Exception.Create('Wrong username/password combination!'#13#10'Please adjust your settings.');
363
364  parseLoginPage(LastHTML[account], acc);
365  longSMSArr  := account.splitTextToLongSMS(text);
366  shortSMSArr := account.splitTextToShortSMS(text);
367
368  if (Length(shortSMSArr) * recipients.Size) > account.getFreeSMSCount then
369    raise Exception.Create('You have only ' + IntToStr(account.getFreeSMSCount) + ' SMS for free. '
370                           + '(You need at least ' + IntToStr(Length(longSMSArr) * recipients.Size) + ' SMS left to send this message!)');
371
372  percent_per_sms := 70 div Length(longSMSArr);
373  for x := 0 to High(longSMSArr) do
374  begin
375    y := 0;
376    i := recipients.First;
377    repeat
378      changeStatus('Removing old recipients...', 10 + percent_per_sms*x);
379      removeRecipients;  // REMOVE ALL RECIPIENTS IF THERE ARE ANY EXISTING
380
381      if isSendingCanceled then break;
382
383      changeStatus(Format('Adding recipients %d to %d (of %d)',
384                          [y*MAX_MOBILE + 1, Min(recipients.Size, (y+1)*MAX_MOBILE), recipients.Size]),
385                   10 + Round(percent_per_sms * (33 / 100 + x)));
386
387      ix := 0;
388      while i.HasNext and (ix < MAX_MOBILE) do
389      begin // ADD THE NEXT RECIPIENTS (0 < ix <= MAX_MOBILE)
390        addRecipient(i.Next as IContact);
391        Inc(ix);
392      end;
393
394      if isSendingCanceled then break;
395
396      changeStatus(Format('Sending sms... %d (of %d)', [x+1, Length(longSMSArr)]),
397                   10 + Round(percent_per_sms * (66 / 100 + x)));
398      sendSMS(longSMSArr[x]); // SEND THE MESSAGE
399      changeStatus('SMS sent.', 10 + Round(percent_per_sms * (100 / 100 + x)));
400
401      Inc(y);
402    until (y*MAX_MOBILE) >= recipients.Size; // SEND THE MESSAGE ONLY TO THE NUMBER OF RECIPIENTS WHICH ARE POSSIBLE
403  end;
404  parseLoginPage(LastHtml[account], acc);
405
406  changeStatus('Logout...', 90);
407  logout(acc);
408
409  if not isSendingCanceled then 
410    changeStatus('SMS Sent.', 100)
411  else begin
412    changeStatus('User abort.', 100);
413    raise Exception.Create('User abort.');
414  end;
415end;
416
417
418end.
Note: See TracBrowser for help on using the repository browser.