http://www.fotosik.pl/pokaz_obrazek/frvn5ikoh95r7n54.html o to blad a to kod
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls, ComCtrls, ExtCtrls, ShellAPI, Menus;
type
TForm1 = class(TForm)
Label1: TLabel;
Memo1: TMemo;
Label4: TLabel;
Edit3: TEdit;
Button1: TButton;
Label2: TLabel;
Edit2: TEdit;
ClientSocket1: TClientSocket;
StatusBar1: TStatusBar;
Timer1: TTimer;
Edit1: TComboBox;
procedure Edit1Change(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Connect(adres: string; oper: integer);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormEnabled(b: boolean);
procedure Button1Click(Sender: TObject);
function ue(s: string): string;
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Clear();
procedure Zapisz(plik, str: string; tryb: integer);
function Check(s: string): boolean;
procedure Timer1Timer(Sender: TObject);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
procedure Edit3KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
function cuter(s, fs, ls: string; fc, lc: integer): string;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Odbior, Nadanie, Post, Code, Cookie, Path : String;
Operacja, Limit : integer;
implementation
uses Unit2;
{$R *.dfm}
function TForm1.Check(s: string): boolean; // Sprawdza czy wystąpił podany ciąg znaków
begin
Result := false;
if Pos(s, Odbior) > 0 then
begin
MessageBox(Handle, 'Wiadomość została wysłana. ', 'Simple SMS Sender', MB_OK + MB_ICONINFORMATION);
if Edit1.Items.IndexOf(Edit1.Text) < 0 then
Edit1.Items.Add(Edit1.Text); //dodaje numer na listę
Clear();
Result := true;
end
else
if MessageBox(Handle, 'Wiadomość nie została wysłana.'#13'Czy chcesz zobaczyć stronę zwrotną operatora? ', 'Simple SMS Sender', MB_OKCANCEL + MB_ICONWARNING) = IDOK then
begin
Zapisz(Path + 'opertmp.html', cuter(Odbior, '<html>', '</html>', 0, 0), 1);
ShellExecute(Handle, 'open', 'iexplore', PChar('file://' + Path + 'opertmp.html'), nil, SW_NORMAL);
end;
FormEnabled(true);
end;
function TForm1.ue(s: string): string; // URL Encode
var
i: integer;
r: string;
begin
for i := 1 to Length(s) do
if s[i] in [#1..#44,#47,#58..#64,#91..#94,#96,#123..#255] then
r := r + '%' + IntToHex(Ord(s[i]), 2)
else
r := r + s[i];
Result := r;
end;
function TForm1.cuter(s, fs, ls: string; fc, lc: integer): string; // Wycina text ze stringa
begin
fs := LowerCase(fs);
ls := LowerCase(ls);
Delete(s, 1, Pos(fs, LowerCase(s)) - 1);
if Pos(ls, LowerCase(s)) = 0 then
Delete(s, Length(s) + 1, Length(s))
else
Delete(s, Pos(ls, LowerCase(s)) + Length(ls), Length(s));
Delete(s, 1, fc);
if lc > Length(s) then
Delete(s, 1, lc)
else
Delete(s, Length(s) - lc + 1, lc);
Result := s;
end;
procedure TForm1.Clear(); // Czyści pola edycji
begin
Edit1.Text := '';
Edit2.Text := '????';
Edit3.Text := '';
Memo1.Text := '';
end;
procedure TForm1.FormEnabled(b: boolean); // Blokuje formę
begin
Edit1.Enabled := b;
Edit2.Enabled := b;
Edit3.Enabled := b;
Button1.Enabled := b;
Memo1.Enabled := b;
if b then
begin
Edit1.Color := clCream;
Edit2.Color := clCream;
Edit3.Color := clCream;
Memo1.Color := clCream;
Operacja := 0;
end
else
begin
Edit1.Color := clSilver;
Edit2.Color := clSilver;
Edit3.Color := clSilver;
Memo1.Color := clSilver;
end;
end;
procedure TForm1.Connect(adres: string; oper: integer); // Łączy z odpowiednim adresem
var
ip : boolean;
i : integer;
begin
ip := true;
for i := 1 to Length(adres) do //sprawdza czy adres jest hostem czy ip'ekiem
if not (adres[i] in ['0'..'9', '.']) then ip := false;
ClientSocket1.Port := 80;
if ip then
ClientSocket1.Address := adres
else
ClientSocket1.Host := adres;
Operacja := oper;
ClientSocket1.Active := true;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject; // Przy połączeniu
Socket: TCustomWinSocket);
begin
Odbior := '';
FormEnabled(false);
Socket.SendText(Nadanie);
end;
procedure TForm1.ClientSocket1Read(Sender: TObject; // Przy odbiorze
Socket: TCustomWinSocket);
begin
Odbior := Odbior + Socket.ReceiveText;
end;
procedure TForm1.ClientSocket1Error(Sender: TObject; // Przy błędzie
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0;
MessageBox(Handle, 'Wystąpił błąd przy próbie łączenia z bramką operatora. ', 'Simple SMS Sender', MB_OK + MB_ICONWARNING);
FormEnabled(true);
end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; // Przy rozłączeniu
Socket: TCustomWinSocket);
begin
Nadanie := '';
case Operacja of
0:begin end; //nic
1:begin //sprawdzenie od Plusa
Check('SMS zosta');
end;
2:begin //sprawdzenie z pierwszego łączenia z Erą
Cookie := cuter(Odbior, 'Set-Cookie: ', ';', 12, 1);
Code := cuter(Odbior, 'name="Code" value="', '">', 19, 2);
Post :=
'bookopen=&numer=' + ue(Edit1.Text) +
'&ksiazka=&message=' + ue(Memo1.Text) +
'&podpis=' + ue(Edit3.Text) +
'&kontakt=&code=' + Code +
'&Nadaj=Nadaj';
Nadanie :=
'POST /sms/sendsms.asp HTTP/1.0' + #13#10 +
'Content-type: application/x-www-form-urlencoded' + #13#10 +
'Content-length: ' + IntToStr(Length(Post)) + #13#10 +
'Cookie: ' + Cookie + #13#10#13#10 +
Post + #13#10;
Timer1.Enabled := true; {wywołanie Connect('boa.eragsm.com.pl', 2);
z timera bo ze zdarzenia onDisconnect jakoś
nie chce działać :((( }
end;
3:begin //sprawdzenie z drugiego łączenia z Erą
Check('11 wiadomo');
end;
4:begin //sprawdzenie z pierwszego łączenia z Ideą
Cookie := cuter(Odbior, 'Set-Cookie: ', ';', 12, 1);
Code := cuter(Odbior, '?token=', '"', 7, 1);
Form2.Show; // ...reszta wysyłanie w Unit 2
end;
5:begin //sprawdzenie z drugiego łączenia z Ideą
if Check('tekstowa zosta') then Zapisz(Path + 'daneidea.sss', Code + ' ' + Form2.Edit1.Text + #13#10, 0);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject); //Button1.Click :)
begin
if Edit2.Text = 'Idea' then
begin
Nadanie := //zestawianie nagłówka
'GET / HTTP/1.0' + #13#10#13#10;
Connect('213.218.116.131', 4);
end;
if Edit2.Text = 'Plus' then
begin
Post := //zestawianie zmiennych post
'tprefix=' + ue(Copy(Edit1.Text, 1, 3)) +
'&numer=' + ue(Copy(Edit1.Text, 4, 6)) +
'&odkogo=' + ue(Edit3.Text) +
'&tekst=' + ue(Memo1.Text);
Nadanie := //zestawianie nagłówków
'POST /sms/sendsms.php HTTP/1.0' + #13#10 +
'Content-type: application/x-www-form-urlencoded' + #13#10 +
'Content-length: ' + IntToStr(Length(Post)) + #13#10#13#10 +
Post + #13#10;
Connect('www.text.plusgsm.pl', 1);
end;
if Edit2.Text = 'Era' then
begin
Nadanie := //zestawianie nagłówka
'GET /sms/sendsms.asp?sms=1 HTTP/1.0' + #13#10#13#10;
Connect('boa.eragsm.com.pl', 2);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject); //drugie łączenie z Erą
begin
Timer1.Enabled := false;
Connect('boa.eragsm.com.pl', 3);
end;
{*** funkcjie do obsługi pól edycji ***}
procedure TForm1.Edit1Change(Sender: TObject); // Sprawdza sieć
begin
if Length(Edit1.Text) = 9 then
begin
if Edit1.Text[1] = '5' then
begin
Edit2.Text := 'Idea';
Limit := 631;
end
else
if Edit1.Text[1] = '6' then
begin
if StrToInt(Edit1.Text[3]) mod 2 = 1 then
begin
Edit2.Text := 'Plus';
Limit := 617;
end
else
begin
Edit2.Text := 'Era';
Limit := 125;
end;
end
else
begin
Edit2.Text := '????';
Limit := 0;
end;
end
else
begin
Edit2.Text := '????';
Limit := 0;
end;
Button1.Enabled := ((Edit2.Text <> '????') and (Memo1.Text <> '') and (Edit3.Text <> ''));
if Limit > 0 then
StatusBar1.Panels[1].Text := IntToStr(Limit - (Length(Memo1.Text) + Length(Edit3.Text)))
else
StatusBar1.Panels[1].Text := '?';
end;
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char); // Blokuje wpisywanie znaków gdy jest ich za dużo
begin
if Limit > 0 then
if ((Length(Memo1.Text) + Length(Edit3.Text) >= Limit) and (not (Key in [#8]))) then
Key := #0;
end;
procedure TForm1.Edit3KeyUp(Sender: TObject; var Key: Word; // Obcina tekst gdy jest za długi
Shift: TShiftState);
begin
if Limit > 0 then
if Length(Memo1.Text) + Length(Edit3.Text) > Limit then
begin
Memo1.Text := Copy(Memo1.Text, 1, Limit - Length(Edit3.Text));
Memo1.SelStart := Length(Memo1.Text);
Memo1.Perform(EM_SCROLLCARET,0,0);
end;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); // Blokuje wpisywanie liter
begin
if not (Key in ['0'..'9', #8]) then Key := #0;
end;
{*** funkcjie od plików ***}
procedure TForm1.Zapisz(plik, str: string; tryb: integer); // Zapis Tokena i kodu dla statystyk :)) może ktoś to rozszyfruje...
var
TF : TextFile;
begin
SetFileAttributes(PChar(plik), 0);
AssignFile(TF, plik);
if tryb = 1 then Rewrite(TF) else Append(TF);
try
Write(TF, str);
finally
CloseFile(TF);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); // Zapisuje listę numerów
begin
Edit1.Items.SaveToFile(Path + 'numery.sss');
end;
procedure TForm1.FormCreate(Sender: TObject); // Odczytuje listę numerów
var
WDir : array[0..255] of char;
begin
GetWindowsDirectory(WDir, SizeOf(WDir));
Path := WDir + '\temp\';
if not DirectoryExists(Path) then CreateDir(Path);
if FileExists(Path + 'numery.sss') then
Edit1.Items.LoadFromFile(Path + 'numery.sss');
end;
end.